131 files changed, 82574 insertions, 37691 deletions

diff --git a/generic/regc_color.c b/generic/regc_color.c
index 35e7904..92e0aad 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -37,7 +37,7 @@
 
 /*
  - initcm - set up new colormap
- ^ static VOID initcm(struct vars *, struct colormap *);
+ ^ static void initcm(struct vars *, struct colormap *);
  */
 static void
 initcm(
@@ -88,7 +88,7 @@ initcm(
 
 /*
  - freecm - free dynamically-allocated things in a colormap
- ^ static VOID freecm(struct colormap *);
+ ^ static void freecm(struct colormap *);
  */
 static void
 freecm(
@@ -116,7 +116,7 @@ freecm(
 
 /*
  - 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(
@@ -294,7 +294,7 @@ newcolor(
 
 /*
  - 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(
@@ -327,7 +327,7 @@ freecolor(
 	    cm->free = cm->cd[cm->free].sub;
 	}
 	if (cm->free > 0) {
-	    assert(cm->free < cm->max);
+	    assert((size_t)cm->free < cm->max);
 	    pco = cm->free;
 	    nco = cm->cd[pco].sub;
 	    while (nco > 0) {
@@ -339,7 +339,7 @@ freecolor(
 		    nco = cm->cd[nco].sub;
 		    cm->cd[pco].sub = nco;
 		} else {
-		    assert(nco < cm->max);
+		    assert((size_t)nco < cm->max);
 		    pco = nco;
 		    nco = cm->cd[pco].sub;
 		}
@@ -429,7 +429,7 @@ newsub(
 
 /*
  - 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
@@ -477,7 +477,7 @@ subrange(
 
 /*
  - 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(
@@ -582,7 +582,7 @@ subblock(
 
 /*
  - okcolors - promote subcolors to full colors
- ^ static VOID okcolors(struct nfa *, struct colormap *);
+ ^ static void okcolors(struct nfa *, struct colormap *);
  */
 static void
 okcolors(
@@ -643,7 +643,7 @@ okcolors(
 
 /*
  - 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(
@@ -662,7 +662,7 @@ colorchain(
 
 /*
  - 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(
@@ -688,7 +688,7 @@ uncolorchain(
 
 /*
  - 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
@@ -715,7 +715,7 @@ rainbow(
 /*
  - 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
@@ -748,7 +748,7 @@ colorcomplement(
 
 /*
  - dumpcolors - debugging output
- ^ static VOID dumpcolors(struct colormap *, FILE *);
+ ^ static void dumpcolors(struct colormap *, FILE *);
  */
 static void
 dumpcolors(
@@ -777,18 +777,19 @@ dumpcolors(
 	    }
 
 	    /*
-	     * It's hard to do this more efficiently.
+	     * Unfortunately, it's hard to do this next bit more efficiently.
+	     *
+	     * Spencer's original coding has the loop iterating from CHR_MIN
+	     * to CHR_MAX, but that's utterly unusable for 32-bit chr, or
+	     * even 16-bit.  For debugging purposes it seems fine to print
+	     * only chr codes up to 1000 or so.
 	     */
 
-	    for (c=CHR_MIN ; c<CHR_MAX ; c++) {
+	    for (c=CHR_MIN ; c<1000 ; c++) {
 		if (GETCOLOR(cm, c) == co) {
 		    dumpchr(c, f);
 		}
 	    }
-	    assert(c == CHR_MAX);
-	    if (GETCOLOR(cm, c) == co) {
-		dumpchr(c, f);
-	    }
 	    fprintf(f, "\n");
 	}
     }
@@ -796,7 +797,7 @@ dumpcolors(
 
 /*
  - 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(
@@ -825,7 +826,7 @@ fillcheck(
 /*
  - 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(
diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c
index 64f34cd..d450d3e 100644
--- a/generic/regc_cvec.c
+++ b/generic/regc_cvec.c
@@ -74,19 +74,20 @@ clearcvec(
 
 /*
  - 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 */
 {
+    assert(cv->nchrs < cv->chrspace);
     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(
@@ -128,7 +129,7 @@ getcvec(
 
 /*
  - freecvec - free a cvec
- ^ static VOID freecvec(struct cvec *);
+ ^ static void freecvec(struct cvec *);
  */
 static void
 freecvec(
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 51cf8a4..affcb48 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -63,7 +63,7 @@
 
 /*
  - lexstart - set up lexical stuff, scan leading options
- ^ static VOID lexstart(struct vars *);
+ ^ static void lexstart(struct vars *);
  */
 static void
 lexstart(
@@ -89,7 +89,7 @@ lexstart(
 
 /*
  - prefixes - implement various special prefixes
- ^ static VOID prefixes(struct vars *);
+ ^ static void prefixes(struct vars *);
  */
 static void
 prefixes(
@@ -207,7 +207,7 @@ prefixes(
  - 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 *, const chr *, const chr *);
  */
 static void
 lexnest(
@@ -288,7 +288,7 @@ static const chr brbackw[] = {	/* \w within brackets */
 /*
  - 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(
@@ -755,6 +755,7 @@ lexescape(
     struct vars *v)
 {
     chr c;
+    int i;
     static const chr alert[] = {
 	CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
     };
@@ -831,18 +832,23 @@ lexescape(
 	RETV(PLAIN, CHR('\t'));
 	break;
     case CHR('u'):
-	c = lexdigits(v, 16, 4, 4);
+	c = (uchr) lexdigits(v, 16, 1, 4);
 	if (ISERR()) {
 	    FAILW(REG_EESCAPE);
 	}
 	RETV(PLAIN, c);
 	break;
     case CHR('U'):
-	c = lexdigits(v, 16, 8, 8);
+	i = lexdigits(v, 16, 1, 8);
 	if (ISERR()) {
 	    FAILW(REG_EESCAPE);
 	}
-	RETV(PLAIN, c);
+	if (i > 0xFFFF) {
+	    /* TODO: output a Surrogate pair
+	     */
+	    i = 0xFFFD;
+	}
+	RETV(PLAIN, (uchr) i);
 	break;
     case CHR('v'):
 	RETV(PLAIN, CHR('\v'));
@@ -857,7 +863,7 @@ lexescape(
 	break;
     case CHR('x'):
 	NOTE(REG_UUNPORT);
-	c = lexdigits(v, 16, 1, 255);	/* REs >255 long outside spec */
+	c = (uchr) lexdigits(v, 16, 1, 2);
 	if (ISERR()) {
 	    FAILW(REG_EESCAPE);
 	}
@@ -879,7 +885,7 @@ lexescape(
     case CHR('9'):
 	save = v->now;
 	v->now--;		/* put first digit back */
-	c = lexdigits(v, 10, 1, 255);	/* REs >255 long outside spec */
+	c = (uchr) lexdigits(v, 10, 1, 255);	/* REs >255 long outside spec */
 	if (ISERR()) {
 	    FAILW(REG_EESCAPE);
 	}
@@ -906,10 +912,15 @@ lexescape(
     case CHR('0'):
 	NOTE(REG_UUNPORT);
 	v->now--;		/* put first digit back */
-	c = lexdigits(v, 8, 1, 3);
+	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;
+	}
 	RETV(PLAIN, c);
 	break;
     default:
@@ -922,23 +933,27 @@ lexescape(
 
 /*
  - lexdigits - slurp up digits and return chr value
- ^ static chr lexdigits(struct vars *, int, int, int);
+ ^ static int lexdigits(struct vars *, int, int, int);
  */
-static chr			/* chr value; errors signalled via ERR */
+static int			/* chr value; errors signalled via ERR */
 lexdigits(
     struct vars *v,
     int base,
     int minlen,
     int maxlen)
 {
-    uchr n;			/* unsigned to avoid overflow misbehavior */
+    int n;
     int len;
     chr c;
     int d;
-    CONST uchr ub = (uchr) base;
+    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'):
@@ -971,7 +986,7 @@ lexdigits(
 	ERR(REG_EESCAPE);
     }
 
-    return (chr)n;
+    return n;
 }
 
 /*
@@ -1093,7 +1108,7 @@ brenext(
 
 /*
  - skip - skip white space and comments in expanded form
- ^ static VOID skip(struct vars *);
+ ^ static void skip(struct vars *);
  */
 static void
 skip(
@@ -1137,24 +1152,6 @@ newline(void)
 }
 
 /*
- - 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);
- ^ #endif
- */
-#ifdef REG_DEBUG
-static const chr *
-ch(void)
-{
-    static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
-
-    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.
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 6444b55..a6958fe 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -395,7 +395,7 @@ static const crange spaceRangeTable[] = {
 #define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
 
 static const chr spaceCharTable[] = {
-    0x20, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f,
+    0x20, 0x85, 0xa0, 0x1680, 0x180e, 0x2028, 0x2029, 0x202f, 0x205f,
     0x2060, 0x3000, 0xfeff
 };
 
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index d155b23..088c6c0 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -62,7 +62,6 @@ newnfa(
     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. */
@@ -90,63 +89,8 @@ newnfa(
 }
 
 /*
- - TooManyStates - checks if the max states exceeds the compile-time value
- ^ static int TooManyStates(struct nfa *);
- */
-static int
-TooManyStates(
-    struct nfa *nfa)
-{
-    struct nfa *parent = nfa->parent;
-    size_t sz = nfa->size;
-
-    while (parent != NULL) {
-	sz = parent->size;
-	parent = parent->parent;
-    }
-    if (sz > REG_MAX_STATES) {
-	return 1;
-    }
-    return 0;
-}
-
-/*
- - IncrementSize - increases the tracked size of the NFA and its parents.
- ^ static void IncrementSize(struct nfa *);
- */
-static void
-IncrementSize(
-    struct nfa *nfa)
-{
-    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 *);
- */
-static void
-DecrementSize(
-    struct nfa *nfa)
-{
-    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(
@@ -180,20 +124,20 @@ newstate(
 {
     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 {
+	if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
+	    NERR(REG_ETOOBIG);
+	    return NULL;
+	}
 	s = (struct state *) MALLOC(sizeof(struct state));
 	if (s == NULL) {
 	    NERR(REG_ESPACE);
 	    return NULL;
 	}
+	nfa->v->spaceused += sizeof(struct state);
 	s->oas.next = NULL;
 	s->free = NULL;
 	s->noas = 0;
@@ -217,12 +161,6 @@ newstate(
     }
     s->prev = nfa->slast;
     nfa->slast = s;
-
-    /*
-     * Track the current size and the parent size.
-     */
-
-    IncrementSize(nfa);
     return s;
 }
 
@@ -246,7 +184,7 @@ newfstate(
 
 /*
  - 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(
@@ -266,7 +204,7 @@ dropstate(
 
 /*
  - 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(
@@ -293,12 +231,11 @@ freestate(
     s->prev = NULL;
     s->next = nfa->free;	/* don't delete it, put it on the free list */
     nfa->free = s;
-    DecrementSize(nfa);
 }
 
 /*
  - destroystate - really get rid of an already-freed state
- ^ static VOID destroystate(struct nfa *, struct state *);
+ ^ static void destroystate(struct nfa *, struct state *);
  */
 static void
 destroystate(
@@ -312,16 +249,18 @@ destroystate(
     for (ab=s->oas.next ; ab!=NULL ; ab=abnext) {
 	abnext = ab->next;
 	FREE(ab);
+	nfa->v->spaceused -= sizeof(struct arcbatch);
     }
     s->ins = NULL;
     s->outs = NULL;
     s->next = NULL;
     FREE(s);
+    nfa->v->spaceused -= sizeof(struct state);
 }
 
 /*
  - 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 *);
  */
 /*
@@ -354,7 +293,7 @@ newarc(
 	    }
 	}
     }
-  
+
     /* no dup, so create the arc */
     createarc(nfa, t, co, from, to);
 }
@@ -439,14 +378,19 @@ allocarc(
      */
 
     if (s->free == NULL) {
-	struct arcbatch *newAb = (struct arcbatch *)
-		MALLOC(sizeof(struct arcbatch));
+	struct arcbatch *newAb;
 	int i;
 
+	if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
+	    NERR(REG_ETOOBIG);
+	    return NULL;
+	}
+	newAb = (struct arcbatch *) MALLOC(sizeof(struct arcbatch));
 	if (newAb == NULL) {
 	    NERR(REG_ESPACE);
 	    return NULL;
 	}
+	nfa->v->spaceused += sizeof(struct arcbatch);
 	newAb->next = s->oas.next;
 	s->oas.next = newAb;
 
@@ -466,7 +410,7 @@ allocarc(
 
 /*
  - freearc - free an arc
- ^ static VOID freearc(struct nfa *, struct arc *);
+ ^ static void freearc(struct nfa *, struct arc *);
  */
 static void
 freearc(
@@ -625,7 +569,7 @@ findarc(
 
 /*
  - 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
@@ -713,7 +657,7 @@ sortins_cmp(
     }
     return 0;
 }
- 
+
 /*
  * sortouts - sort the out arcs of a state by to/color/type
  */
@@ -812,7 +756,7 @@ sortouts_cmp(
  * checks become too slow.  In that case we proceed by sorting and merging
  * the arc lists, and then we can indeed just update the arcs in-place.
  *
- ^ static VOID moveins(struct nfa *, struct state *, struct state *);
+ ^ static void moveins(struct nfa *, struct state *, struct state *);
  */
 static void
 moveins(
@@ -1072,7 +1016,7 @@ mergeins(
 
 /*
  - 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(
@@ -1232,7 +1176,7 @@ copyouts(
 
 /*
  - 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
@@ -1256,7 +1200,7 @@ cloneouts(
  - 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(
@@ -1279,7 +1223,7 @@ delsub(
 /*
  - 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(
@@ -1322,7 +1266,7 @@ deltraverse(
  * 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 *,
+ ^ static void dupnfa(struct nfa *, struct state *, struct state *,
  ^ 	struct state *, struct state *);
  */
 static void
@@ -1339,7 +1283,7 @@ dupnfa(
     }
 
     stop->tmp = to;
-    duptraverse(nfa, start, from);
+    duptraverse(nfa, start, from, 0);
     /* done, except for clearing out the tmp pointers */
 
     stop->tmp = NULL;
@@ -1348,13 +1292,14 @@ dupnfa(
 
 /*
  - 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 */
+    struct state *stmp,		/* s's duplicate, or NULL */
+    int depth)
 {
     struct arc *a;
 
@@ -1368,8 +1313,20 @@ duptraverse(
 	return;
     }
 
+    /*
+     * Arbitrary depth limit. Needs tuning, but this value is sufficient to
+     * make all normal tests (not reg-33.14) pass.
+     */
+#ifndef DUPTRAVERSE_MAX_DEPTH
+#define DUPTRAVERSE_MAX_DEPTH 15000
+#endif
+
+    if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
+	NERR(REG_ESPACE);
+    }
+
     for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {
-	duptraverse(nfa, a->to, NULL);
+	duptraverse(nfa, a->to, NULL, depth);
 	if (NISERR()) {
 	    break;
 	}
@@ -1380,7 +1337,7 @@ duptraverse(
 
 /*
  - 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(
@@ -1401,7 +1358,7 @@ cleartraverse(
 
 /*
  - specialcolors - fill in special colors for an NFA
- ^ static VOID specialcolors(struct nfa *);
+ ^ static void specialcolors(struct nfa *);
  */
 static void
 specialcolors(
@@ -1484,7 +1441,7 @@ optimize(
 
 /*
  - pullback - pull back constraints backward to eliminate them
- ^ static VOID pullback(struct nfa *, FILE *);
+ ^ static void pullback(struct nfa *, FILE *);
  */
 static void
 pullback(
@@ -1664,7 +1621,7 @@ pull(
 
 /*
  - pushfwd - push forward constraints forward to eliminate them
- ^ static VOID pushfwd(struct nfa *, FILE *);
+ ^ static void pushfwd(struct nfa *, FILE *);
  */
 static void
 pushfwd(
@@ -1903,7 +1860,7 @@ combine(
 
 /*
  - fixempties - get rid of EMPTY arcs
- ^ static VOID fixempties(struct nfa *, FILE *);
+ ^ static void fixempties(struct nfa *, FILE *);
  */
 static void
 fixempties(
@@ -2063,7 +2020,7 @@ fixempties(
 		    arcarray[arccount++] = a;
 		}
 	    }
-  
+
   	    /* Reset the tmp fields as we walk back */
   	    nexts = s2->tmp;
   	    s2->tmp = NULL;
@@ -2085,7 +2042,7 @@ fixempties(
 	}
 	inarcsorig[s->no] = a;
     }
-  
+
     FREE(arcarray);
     FREE(inarcsorig);
 
@@ -2236,7 +2193,7 @@ fixconstraintloops(
  	    dropstate(nfa, s);
 	}
     }
- 
+
     /* Nothing to do if no remaining constraint arcs */
     if (NISERR() || !hasconstraints) {
 	return;
@@ -2726,7 +2683,7 @@ clonesuccessorstates(
 
 /*
  - cleanup - clean up NFA after optimizations
- ^ static VOID cleanup(struct nfa *);
+ ^ static void cleanup(struct nfa *);
  */
 static void
 cleanup(
@@ -2767,7 +2724,7 @@ cleanup(
 
 /*
  - 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
@@ -2791,7 +2748,7 @@ markreachable(
 
 /*
  - 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
@@ -2839,7 +2796,7 @@ analyze(
 
 /*
  - compact - construct the compact representation of an NFA
- ^ static VOID compact(struct nfa *, struct cnfa *);
+ ^ static void compact(struct nfa *, struct cnfa *);
  */
 static void
 compact(
@@ -2859,13 +2816,16 @@ compact(
     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 */
+	narcs += s->nouts + 1;	/* need one extra for endmarker */
     }
 
+    cnfa->stflags = (char *) MALLOC(nstates * sizeof(char));
     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->stflags == NULL || cnfa->states == NULL || cnfa->arcs == NULL) {
+	if (cnfa->stflags != NULL) {
+	    FREE(cnfa->stflags);
+	}
 	if (cnfa->states != NULL) {
 	    FREE(cnfa->states);
 	}
@@ -2888,9 +2848,8 @@ compact(
     ca = cnfa->arcs;
     for (s = nfa->states; s != NULL; s = s->next) {
 	assert((size_t) s->no < nstates);
+	cnfa->stflags[s->no] = 0;
 	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) {
@@ -2924,14 +2883,14 @@ compact(
      */
 
     for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
-	cnfa->states[a->to->no]->co = 1;
+	cnfa->stflags[a->to->no] = CNFA_NOPROGRESS;
     }
-    cnfa->states[nfa->pre->no]->co = 1;
+    cnfa->stflags[nfa->pre->no] = CNFA_NOPROGRESS;
 }
 
 /*
  - carcsort - sort compacted-NFA arcs by color
- ^ static VOID carcsort(struct carc *, struct carc *);
+ ^ static void carcsort(struct carc *, struct carc *);
  */
 static void
 carcsort(
@@ -2950,7 +2909,7 @@ carc_cmp(
 {
     const struct carc *aa = (const struct carc *) a;
     const struct carc *bb = (const struct carc *) b;
-  
+
     if (aa->co < bb->co) {
 	return -1;
     }
@@ -2968,7 +2927,7 @@ carc_cmp(
 
 /*
  - freecnfa - free a compacted NFA
- ^ static VOID freecnfa(struct cnfa *);
+ ^ static void freecnfa(struct cnfa *);
  */
 static void
 freecnfa(
@@ -2976,13 +2935,14 @@ freecnfa(
 {
     assert(cnfa->nstates != 0);	/* not empty already */
     cnfa->nstates = 0;
+    FREE(cnfa->stflags);
     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(
@@ -3028,7 +2988,7 @@ 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(
@@ -3058,7 +3018,7 @@ dumpstate(
 
 /*
  - dumparcs - dump out-arcs in human-readable form
- ^ static VOID dumparcs(struct state *, FILE *);
+ ^ static void dumparcs(struct state *, FILE *);
  */
 static void
 dumparcs(
@@ -3092,7 +3052,7 @@ dumparcs(
 
 /*
  - 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(
@@ -3166,7 +3126,7 @@ dumparc(
 
 /*
  - dumpcnfa - dump a compacted NFA in human-readable form
- ^ static VOID dumpcnfa(struct cnfa *, FILE *);
+ ^ static void dumpcnfa(struct cnfa *, FILE *);
  */
 static void
 dumpcnfa(
@@ -3194,7 +3154,7 @@ dumpcnfa(
     }
     fprintf(f, "\n");
     for (st = 0; st < cnfa->nstates; st++) {
-	dumpcstate(st, cnfa->states[st], cnfa, f);
+	dumpcstate(st, cnfa, f);
     }
     fflush(f);
 #endif
@@ -3207,25 +3167,24 @@ 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 cnfa *, FILE *);
  */
 static void
 dumpcstate(
     int st,
-    struct carc *ca,
     struct cnfa *cnfa,
     FILE *f)
 {
-    int i;
+    struct carc *ca;
     int pos;
 
-    fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
+    fprintf(f, "%d%s", st, (cnfa->stflags[st] & CNFA_NOPROGRESS) ? ":" : ".");
     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);
+    for (ca = cnfa->states[st]; ca->co != COLORLESS; ca++) {
+	if (ca->co < cnfa->ncolors) {
+	    fprintf(f, "\t[%ld]->%d", (long) ca->co, ca->to);
 	} else {
-	    fprintf(f, "\t:%ld:->%d", (long) ca[i].co-cnfa->ncolors,ca[i].to);
+	    fprintf(f, "\t:%ld:->%d", (long) (ca->co - cnfa->ncolors), ca->to);
 	}
 	if (pos == 5) {
 	    fprintf(f, "\n");
@@ -3234,7 +3193,7 @@ dumpcstate(
 	    pos++;
 	}
     }
-    if (i == 1 || pos != 1) {
+    if (ca == cnfa->states[st] || pos != 1) {
 	fprintf(f, "\n");
     }
     fflush(f);
diff --git a/generic/regcomp.c b/generic/regcomp.c
index fda40e0..211cd70 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -79,13 +79,10 @@ static void lexnest(struct vars *, const chr *, const chr *);
 static void lexword(struct vars *);
 static int next(struct vars *);
 static int lexescape(struct vars *);
-static chr lexdigits(struct vars *, int, int, int);
+static int lexdigits(struct vars *, int, int, int);
 static int brenext(struct vars *, pchr);
 static void skip(struct vars *);
 static chr newline(NOPARMS);
-#ifdef REG_DEBUG
-static const chr *ch(NOPARMS);
-#endif
 static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
 /* === regc_color.c === */
 static void initcm(struct vars *, struct colormap *);
@@ -139,7 +136,7 @@ static void cloneouts(struct nfa *, struct state *, struct state *, struct state
 static void delsub(struct nfa *, struct state *, struct state *);
 static void deltraverse(struct nfa *, struct state *, struct state *);
 static void dupnfa(struct nfa *, struct state *, struct state *, struct state *, struct state *);
-static void duptraverse(struct nfa *, struct state *, struct state *);
+static void 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 *);
@@ -177,7 +174,7 @@ static void dumparc(struct arc *, struct state *, FILE *);
 #endif
 static void dumpcnfa(struct cnfa *, FILE *);
 #ifdef REG_DEBUG
-static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+static void dumpcstate(int, struct cnfa *, FILE *);
 #endif
 /* === regc_cvec.c === */
 static struct cvec *clearcvec(struct cvec *);
@@ -222,11 +219,12 @@ struct vars {
     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 */
+    int ntree;			/* number of tree nodes, plus one */
     struct cvec *cv;		/* interface cvec */
     struct cvec *cv2;		/* utility cvec */
     struct subre *lacons;	/* lookahead-constraint vector */
     int nlacons;		/* size of lacons */
+    size_t spaceused;		/* approx. space used for compilation */
 };
 
 /* parsing macros; most know that `v' is the struct vars pointer */
@@ -235,13 +233,13 @@ struct vars {
 #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	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 */
 #define	NOERRZ()	{if (ISERR()) return 0;}	/* NOERR with retval */
-#define	INSIST(c, e)	((c) ? 0 : ERR(e))	/* if condition false, error */
+#define INSIST(c, e) do { if (!(c)) ERR(e); } while (0)	/* error if c false */
 #define	NOTE(b)	(v->re->re_info |= (b))		/* note visible condition */
 #define	EMPTYARC(x, y)	newarc(v->nfa, EMPTY, 0, x, y)
 
@@ -270,12 +268,14 @@ struct vars {
 	((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND)
 
 /* static function list */
-static struct fns functions = {
+static const struct fns functions = {
     rfree,			/* regfree insides */
 };
 
 /*
  - compile - compile regular expression
+ * Note: on failure, no resources remain allocated, so regfree()
+ * need not be applied to re.
  ^ int compile(regex_t *, const chr *, size_t, int);
  */
 int
@@ -336,6 +336,7 @@ compile(
     v->cv2 = NULL;
     v->lacons = NULL;
     v->nlacons = 0;
+    v->spaceused = 0;
     re->re_magic = REMAGIC;
     re->re_info = 0;		/* bits get set during parse */
     re->re_csize = sizeof(chr);
@@ -605,7 +606,7 @@ makesearch(
 		break;
 	    }
 	}
- 
+
 	/*
 	 * We want to mark states as being in the list already by having non
 	 * NULL tmp fields, but we can't just store the old slist value in tmp
@@ -1118,11 +1119,17 @@ parseqatom(
     /*
      * Prepare a general-purpose state skeleton.
      *
-     *    ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
-     *   /                                            /
-     * [lp] ----> [s2] ----bypass---------------------
+     * In the no-backrefs case, we want this:
+     *
+     * [lp] ---> [s] ---prefix---> [begin] ---atom---> [end] ---rest---> [rp]
+     *
+     * where prefix is some repetitions of atom.  In the general case we need
      *
-     * where bypass is an empty, and prefix is some repetitions of atom
+     * [lp] ---> [s] ---iterator---> [s2] ---rest---> [rp]
+     *
+     * where the iterator wraps around [begin] ---atom---> [end]
+     *
+     * We make the s state here for both cases; s2 is made below if needed
      */
 
     s = newstate(v->nfa);	/* first, new endpoints for the atom */
@@ -1133,11 +1140,9 @@ parseqatom(
     NOERR();
     atom->begin = s;
     atom->end = s2;
-    s = newstate(v->nfa);	/* and spots for prefix and bypass */
-    s2 = newstate(v->nfa);
+    s = newstate(v->nfa);	/* set up starting state */
     NOERR();
     EMPTYARC(lp, s);
-    EMPTYARC(lp, s2);
     NOERR();
 
     /*
@@ -1184,27 +1189,8 @@ parseqatom(
     }
 
     /*
-     * 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.
+     * It's quantifier time.  If the atom is just a backref, we'll let it deal
+     * with quantifiers internally.
      */
 
     if (atomtype == BACKREF) {
@@ -1222,16 +1208,24 @@ parseqatom(
 	atom->min = (short) m;
 	atom->max = (short) n;
 	atom->flags |= COMBINE(qprefer, atom->flags);
+	/* rest of branch can be strung starting from atom->end */
+	s2 = atom->end;
     } else if (m == 1 && n == 1) {
 	/*
 	 * No/vacuous quantifier: done.
 	 */
 
 	EMPTYARC(s, atom->begin);	/* empty prefix */
-    } else {
+	/* rest of branch can be strung starting from atom->end */
+	s2 = atom->end;
+    } else if (m > 0 && !(atom->flags & BACKR)) {
 	/*
-	 * Turn x{m,n} into x{m-1,n-1}x, with capturing parens in only second
-	 * x
+	 * If there's no backrefs involved, we can turn x{m,n} into
+	 * x{m-1,n-1}x, with capturing parens in only the second x.  This
+	 * is valid because we only care about capturing matches from the
+	 * final iteration of the quantifier.  It's a win because we can
+	 * implement the backref-free left side as a plain DFA node, since
+	 * we don't really care where its submatches are.
 	 */
 
 	dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
@@ -1244,6 +1238,24 @@ parseqatom(
 	NOERR();
 	t->right = atom;
 	*atomp = t;
+	/* rest of branch can be strung starting from atom->end */
+	s2 = atom->end;
+    } else {
+	/* general case: need an iteration node */
+	s2 = newstate(v->nfa);
+	NOERR();
+	moveouts(v->nfa, atom->end, s2);
+	NOERR();
+	dupnfa(v->nfa, atom->begin, atom->end, s, s2);
+	repeat(v, s, s2, m, n);
+	f = COMBINE(qprefer, atom->flags);
+	t = subre(v, '*', f, s, s2);
+	NOERR();
+	t->min = (short) m;
+	t->max = (short) n;
+	t->left = atom;
+	*atomp = t;
+	/* rest of branch is to be strung from iteration's end state */
     }
 
     /*
@@ -1252,10 +1264,10 @@ parseqatom(
 
     t = top->right;
     if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
-	t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
+	t->right = parsebranch(v, stopper, type, s2, rp, 1);
     } else {
-	EMPTYARC(atom->end, rp);
-	t->right = subre(v, '=', 0, atom->end, rp);
+	EMPTYARC(s2, rp);
+	t->right = subre(v, '=', 0, s2, rp);
     }
     NOERR();
     assert(SEE('|') || SEE(stopper) || SEE(EOS));
@@ -1322,6 +1334,8 @@ scannum(
 
 /*
  - repeat - replicate subNFA for quantifiers
+ * The sub-NFA strung from lp to rp is modified to represent m to n
+ * repetitions of its initial contents.
  * 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
@@ -1482,7 +1496,7 @@ brackpart(
     celt startc, endc;
     struct cvec *cv;
     const chr *startp, *endp;
-    chr c[1];
+    chr c;
 
     /*
      * Parse something, get rid of special cases, take shortcuts.
@@ -1494,7 +1508,7 @@ brackpart(
 	return;
 	break;
     case PLAIN:
-	c[0] = v->nextvalue;
+	c = v->nextvalue;
 	NEXT();
 
 	/*
@@ -1502,10 +1516,10 @@ brackpart(
 	 */
 
 	if (!SEE(RANGE)) {
-	    onechr(v, c[0], lp, rp);
+	    onechr(v, c, lp, rp);
 	    return;
 	}
-	startc = element(v, c, c+1);
+	startc = element(v, &c, &c+1);
 	NOERR();
 	break;
     case COLLEL:
@@ -1549,9 +1563,9 @@ brackpart(
 	switch (v->nexttype) {
 	case PLAIN:
 	case RANGE:
-	    c[0] = v->nextvalue;
+	    c = v->nextvalue;
 	    NEXT();
-	    endc = element(v, c, c+1);
+	    endc = element(v, &c, &c+1);
 	    NOERR();
 	    break;
 	case COLLEL:
@@ -1731,11 +1745,11 @@ subre(
 	v->treechain = ret;
     }
 
-    assert(strchr("|.b(=", op) != NULL);
+    assert(strchr("=b|.*(", op) != NULL);
 
     ret->op = op;
     ret->flags = flags;
-    ret->retry = 0;
+    ret->id = 0;		/* will be assigned later */
     ret->subno = 0;
     ret->min = ret->max = 1;
     ret->left = NULL;
@@ -1788,7 +1802,8 @@ freesrnode(
     }
     sr->flags = 0;
 
-    if (v != NULL) {
+    if (v != NULL && v->treechain != NULL) {
+	/* we're still parsing, maybe we can reuse the subre */
 	sr->left = v->treefree;
 	v->treefree = sr;
     } else {
@@ -1816,7 +1831,7 @@ optst(
 }
 
 /*
- - numst - number tree nodes (assigning retry indexes)
+ - numst - number tree nodes (assigning "id" indexes)
  ^ static int numst(struct subre *, int);
  */
 static int			/* next number */
@@ -1829,7 +1844,7 @@ numst(
     assert(t != NULL);
 
     i = start;
-    t->retry = (short) i++;
+    t->id = (short) i++;
     if (t->left != NULL) {
 	i = numst(t->left, i);
     }
@@ -1841,6 +1856,19 @@ numst(
 
 /*
  - markst - mark tree nodes as INUSE
+ * Note: this is a great deal more subtle than it looks.  During initial
+ * parsing of a regex, all subres are linked into the treechain list;
+ * discarded ones are also linked into the treefree list for possible reuse.
+ * After we are done creating all subres required for a regex, we run markst()
+ * then cleanst(), which results in discarding all subres not reachable from
+ * v->tree.  We then clear v->treechain, indicating that subres must be found
+ * by descending from v->tree.  This changes the behavior of freesubre(): it
+ * will henceforth FREE() unwanted subres rather than sticking them into the
+ * treefree list.  (Doing that any earlier would result in dangling links in
+ * the treechain list.)  This all means that freev() will clean up correctly
+ * if invoked before or after markst()+cleanst(); but it would not work if
+ * called partway through this state conversion, so we mustn't error out
+ * in or between these two functions.
  ^ static void markst(struct subre *);
  */
 static void
@@ -1947,24 +1975,26 @@ newlacon(
     struct state *end,
     int pos)
 {
-    struct subre *sub;
     int n;
+    struct subre *newlacons;
+    struct subre *sub;
 
     if (v->nlacons == 0) {
-	v->lacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
 	n = 1;		/* skip 0th */
-	v->nlacons = 2;
+	newlacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
     } else {
-	v->lacons = (struct subre *) REALLOC(v->lacons,
-		(v->nlacons+1)*sizeof(struct subre));
-	n = v->nlacons++;
+	n = v->nlacons;
+	newlacons = (struct subre *) REALLOC(v->lacons,
+					     (n + 1) * sizeof(struct subre));
     }
 
-    if (v->lacons == NULL) {
+    if (newlacons == NULL) {
 	ERR(REG_ESPACE);
 	return 0;
     }
 
+    v->lacons = newlacons;
+    v->nlacons = n + 1;
     sub = &v->lacons[n];
     sub->begin = begin;
     sub->end = end;
@@ -2012,18 +2042,20 @@ rfree(
     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);
+    if (g != 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);
     }
-    FREE(g);
 }
 
 /*
@@ -2055,7 +2087,7 @@ dump(
 
     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);
+	    (int) re->re_nsub, re->re_info, re->re_csize, g->ntree);
 
     dumpcolors(&g->cmap, f);
     if (!NULLCNFA(g->search)) {
@@ -2164,14 +2196,14 @@ stid(
     size_t bufsize)
 {
     /*
-     * Big enough for hex int or decimal t->retry?
+     * Big enough for hex int or decimal t->id?
      */
 
-    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) {
+    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) {
 	return "unable";
     }
-    if (t->retry != 0) {
-	sprintf(buf, "%d", t->retry);
+    if (t->id != 0) {
+	sprintf(buf, "%d", t->id);
     } else {
 	sprintf(buf, "%p", t);
     }
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 57a2d47..681b97d 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -30,16 +30,16 @@
  * Headers if any.
  */
 
-#include "tclInt.h"
+#include "regex.h"
 
 /*
  * Overrides for regguts.h definitions, if any.
  */
 
 #define	FUNCPTR(name, args)	(*name)args
-#define	MALLOC(n)		ckalloc(n)
+#define	MALLOC(n)		VS(attemptckalloc(n))
 #define	FREE(p)			ckfree(VS(p))
-#define	REALLOC(p,n)		ckrealloc(VS(p),n)
+#define	REALLOC(p,n)		VS(attemptckrealloc(VS(p),n))
 
 /*
  * Do not insert extras between the "begin" and "end" lines - this chunk is
@@ -60,12 +60,6 @@
 #ifdef __REG_REGOFF_T
 #undef __REG_REGOFF_T
 #endif
-#ifdef __REG_VOID_T
-#undef __REG_VOID_T
-#endif
-#ifdef __REG_CONST
-#undef __REG_CONST
-#endif
 #ifdef __REG_NOFRONT
 #undef __REG_NOFRONT
 #endif
@@ -75,8 +69,6 @@
 /* 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_WIDE_COMPILE	TclReComp
 #define	__REG_WIDE_EXEC		TclReExec
@@ -155,7 +147,9 @@ typedef int celt;		/* Type to hold chr, or NOCELT */
 #endif
 
 /*
- * And pick up the standard header.
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
  */
-
-#include "regex.h"
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index e233680..e5f22c4 100644
--- a/generic/rege_dfa.c
+++ b/generic/rege_dfa.c
@@ -36,17 +36,16 @@
  */
 static chr *			/* endpoint, or NULL */
 longest(
-    struct vars *v,		/* used only for debug and exec flags */
-    struct dfa *d,
-    chr *start,			/* where the match should start */
-    chr *stop,			/* match must end at or before here */
-    int *hitstopp)		/* record whether hit v->stop, if non-NULL */
+    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 */
 {
     chr *cp;
     chr *realstop = (stop == v->stop) ? stop : stop + 1;
     color co;
-    struct sset *css;
-    struct sset *ss;
+    struct sset *css, *ss;
     chr *post;
     int i;
     struct colormap *cm = d->cm;
@@ -85,7 +84,7 @@ longest(
 
     if (v->eflags&REG_FTRACE) {
 	while (cp < realstop) {
-	    FDEBUG(("+++ at c%d +++\n", css - d->ssets));
+	    FDEBUG(("+++ at c%d +++\n", (int) (css - d->ssets)));
 	    co = GETCOLOR(cm, *cp);
 	    FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
 	    ss = css->outs[co];
@@ -119,7 +118,7 @@ longest(
      * Shutdown.
      */
 
-    FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
+    FDEBUG(("+++ shutdown at c%d +++\n", (int) (css - d->ssets)));
     if (cp == v->stop && stop == v->stop) {
 	if (hitstopp != NULL) {
 	    *hitstopp = 1;
@@ -164,20 +163,19 @@ longest(
  */
 static chr *			/* endpoint, or NULL */
 shortest(
-    struct vars *v,
-    struct dfa *d,
-    chr *start,			/* where the match should start */
-    chr *min,			/* match must end at or after here */
-    chr *max,			/* match must end at or before here */
-    chr **coldp,		/* store coldstart pointer here, if nonNULL */
-    int *hitstopp)		/* record whether hit v->stop, if non-NULL */
+    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 */
 {
     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 sset *css, *ss;
     struct colormap *cm = d->cm;
 
     /*
@@ -215,7 +213,7 @@ shortest(
 
     if (v->eflags&REG_FTRACE) {
 	while (cp < realmax) {
-	    FDEBUG(("--- at c%d ---\n", css - d->ssets));
+	    FDEBUG(("--- at c%d ---\n", (int) (css - d->ssets)));
 	    co = GETCOLOR(cm, *cp);
 	    FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
 	    ss = css->outs[co];
@@ -256,7 +254,7 @@ shortest(
     }
 
     if (coldp != NULL) {	/* report last no-progress state set, if any */
-	*coldp = lastcold(v, d);
+	*coldp = lastCold(v, d);
     }
 
     if ((ss->flags&POSTSTATE) && cp > min) {
@@ -284,19 +282,18 @@ shortest(
 }
 
 /*
- - 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 *v,
-    struct dfa *d)
+lastCold(
+    struct vars *const v,
+    struct dfa *const d)
 {
     struct sset *ss;
-    chr *nopr;
+    chr *nopr = d->lastnopr;
     int i;
 
-    nopr = d->lastnopr;
     if (nopr == NULL) {
 	nopr = v->start;
     }
@@ -309,15 +306,15 @@ lastcold(
 }
 
 /*
- - 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 *v,
-    struct cnfa *cnfa,
-    struct colormap *cm,
+newDFA(
+    struct vars *const v,
+    struct cnfa *const cnfa,
+    struct colormap *const cm,
     struct smalldfa *sml)	/* preallocated space, may be NULL */
 {
     struct dfa *d;
@@ -345,12 +342,12 @@ newdfa(
 	d->cptsmalloced = 0;
 	d->mallocarea = (smallwas == NULL) ? (char *)sml : NULL;
     } else {
-	d = (struct dfa *)MALLOC(sizeof(struct dfa));
+	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->ssets = (struct sset *) MALLOC(nss * sizeof(struct sset));
 	d->statesarea = (unsigned *)
 		MALLOC((nss+WORK) * wordsper * sizeof(unsigned));
 	d->work = &d->statesarea[nss * wordsper];
@@ -362,7 +359,7 @@ newdfa(
 	d->mallocarea = (char *)d;
 	if (d->ssets == NULL || d->statesarea == NULL ||
 		d->outsarea == NULL || d->incarea == NULL) {
-	    freedfa(d);
+	    freeDFA(d);
 	    ERR(REG_ESPACE);
 	    return NULL;
 	}
@@ -387,12 +384,12 @@ newdfa(
 }
 
 /*
- - freedfa - free a DFA
- ^ static void freedfa(struct dfa *);
+ - freeDFA - free a DFA
+ ^ static void freeDFA(struct dfa *);
  */
 static void
-freedfa(
-    struct dfa *d)
+freeDFA(
+    struct dfa *const d)
 {
     if (d->cptsmalloced) {
 	if (d->ssets != NULL) {
@@ -421,8 +418,8 @@ freedfa(
  */
 static unsigned
 hash(
-    unsigned *uv,
-    int n)
+    unsigned *const uv,
+    const int n)
 {
     int i;
     unsigned h;
@@ -440,9 +437,9 @@ hash(
  */
 static struct sset *
 initialize(
-    struct vars *v,		/* used only for debug flags */
-    struct dfa *d,
-    chr *start)
+    struct vars *const v,	/* used only for debug flags */
+    struct dfa *const d,
+    chr *const start)
 {
     struct sset *ss;
     int i;
@@ -454,7 +451,7 @@ initialize(
     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);
+	ss = getVacantSS(v, d, start, start);
 	for (i = 0; i < d->wordsper; i++) {
 	    ss->states[i] = 0;
 	}
@@ -484,23 +481,18 @@ initialize(
  */
 static struct sset *		/* NULL if goes to empty set */
 miss(
-    struct vars *v,		/* used only for debug flags */
-    struct dfa *d,
-    struct sset *css,
-    pcolor co,
-    chr *cp,			/* next chr */
-    chr *start)			/* where the attempt got started */
+    struct 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 */
 {
     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;
+    int i, isPost, noProgress, gotState, doLAConstraints, sawLAConstraints;
 
     /*
      * For convenience, we can be called even if it might not be a miss.
@@ -519,57 +511,57 @@ miss(
     for (i = 0; i < d->wordsper; i++) {
 	d->work[i] = 0;
     }
-    ispost = 0;
-    noprogress = 1;
-    gotstate = 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++) {
+	    for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
 		if (ca->co == co) {
 		    BSET(d->work, ca->to);
-		    gotstate = 1;
+		    gotState = 1;
 		    if (ca->to == cnfa->post) {
-			ispost = 1;
+			isPost = 1;
 		    }
-		    if (!cnfa->states[ca->to]->co) {
-			noprogress = 0;
+		    if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
+			noProgress = 0;
 		    }
 		    FDEBUG(("%d -> %d\n", i, ca->to));
 		}
 	    }
 	}
     }
-    dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
-    sawlacons = 0;
-    while (dolacons) {		/* transitive closure */
-	dolacons = 0;
+    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 */
+		for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
+		    if (ca->co < cnfa->ncolors) {
+			continue;	/* NOTE CONTINUE */
 		    }
-		    sawlacons = 1;
+		    sawLAConstraints = 1;
 		    if (ISBSET(d->work, ca->to)) {
-			continue; /* NOTE CONTINUE */
+			continue;	/* NOTE CONTINUE */
 		    }
-		    if (!lacon(v, cnfa, cp, ca->co)) {
-			continue; /* NOTE CONTINUE */
+		    if (!checkLAConstraint(v, cnfa, cp, ca->co)) {
+			continue;	/* NOTE CONTINUE */
 		    }
 		    BSET(d->work, ca->to);
-		    dolacons = 1;
+		    doLAConstraints = 1;
 		    if (ca->to == cnfa->post) {
-			ispost = 1;
+			isPost = 1;
 		    }
-		    if (!cnfa->states[ca->to]->co) {
-			noprogress = 0;
+		    if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
+			noProgress = 0;
 		    }
 		    FDEBUG(("%d :> %d\n", i, ca->to));
 		}
 	    }
 	}
     }
-    if (!gotstate) {
+    if (!gotState) {
 	return NULL;
     }
     h = HASH(d->work, d->wordsper);
@@ -580,19 +572,19 @@ miss(
 
     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));
+	     FDEBUG(("cached c%d\n", (int) (p - d->ssets)));
 	     break;			/* NOTE BREAK OUT */
 	 }
     }
     if (i == 0) {		/* nope, need a new cache entry */
-	p = getvacant(v, d, cp, start);
+	p = getVacantSS(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 = (isPost ? POSTSTATE : 0);
+	if (noProgress) {
 	    p->flags |= NOPROGRESS;
 	}
 
@@ -601,26 +593,27 @@ miss(
 	 */
     }
 
-    if (!sawlacons) {		/* lookahead conds. always cache miss */
-	FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
+    if (!sawLAConstraints) {	/* lookahead conds. always cache miss */
+	FDEBUG(("c%d[%d]->c%d\n",
+		(int) (css - d->ssets), co, (int) (p - d->ssets)));
 	css->outs[co] = p;
 	css->inchain[co] = p->ins;
 	p->ins.ss = css;
-	p->ins.co = (color)co;
+	p->ins.co = (color) co;
     }
     return p;
 }
 
 /*
- - lacon - lookahead-constraint checker for miss()
- ^ static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
+ - checkLAConstraint - lookahead-constraint checker for miss()
+ ^ static int checkLAConstraint(struct vars *, struct cnfa *, chr *, pcolor);
  */
 static int			/* predicate:  constraint satisfied? */
-lacon(
-    struct vars *v,
-    struct cnfa *pcnfa,		/* parent cnfa */
-    chr *cp,
-    pcolor co)			/* "color" of the lookahead constraint */
+checkLAConstraint(
+    struct vars *const v,
+    struct cnfa *const pcnfa,	/* parent cnfa */
+    chr *const cp,
+    const pcolor co)		/* "color" of the lookahead constraint */
 {
     int n;
     struct subre *sub;
@@ -632,38 +625,36 @@ lacon(
     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);
+    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);
+    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);
 }
 
 /*
- - getvacant - get a vacant state set
+ - getVacantSS - 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 *getvacant(struct vars *, struct dfa *, chr *, chr *);
+ ^ static struct sset *getVacantSS(struct vars *, struct dfa *, chr *, chr *);
  */
 static struct sset *
-getvacant(
-    struct vars *v,		/* used only for debug flags */
-    struct dfa *d,
-    chr *cp,
-    chr *start)
+getVacantSS(
+    struct vars *const v,	/* used only for debug flags */
+    struct dfa *const d,
+    chr *const cp,
+    chr *const start)
 {
     int i;
-    struct sset *ss;
-    struct sset *p;
-    struct arcp ap;
-    struct arcp lastap = {NULL, 0}; /* silence gcc 4 warning */
+    struct sset *ss, *p;
+    struct arcp ap, lastap = {NULL, 0}; /* silence gcc 4 warning */
     color co;
 
-    ss = pickss(v, d, cp, start);
+    ss = pickNextSS(v, d, cp, start);
     assert(!(ss->flags&LOCKED));
 
     /*
@@ -673,7 +664,7 @@ getvacant(
     ap = ss->ins;
     while ((p = ap.ss) != NULL) {
 	co = ap.co;
-	FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
+	FDEBUG(("zapping c%d's %ld outarc\n", (int) (p - d->ssets), (long)co));
 	p->outs[co] = NULL;
 	ap = p->inchain[co];
 	p->inchain[co].ss = NULL; /* paranoia */
@@ -690,13 +681,12 @@ getvacant(
 	if (p == NULL) {
 	    continue;		/* NOTE CONTINUE */
 	}
-	FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
+	FDEBUG(("del outarc %d from c%d's in chn\n", i, (int) (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);
+	    for (ap = p->ins; ap.ss != NULL && !(ap.ss == ss && ap.co == i);
 		    ap = ap.ss->inchain[ap.co]) {
 		lastap = ap;
 	    }
@@ -729,19 +719,18 @@ getvacant(
 }
 
 /*
- - pickss - pick the next stateset to be used
- ^ static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
+ - pickNextSS - pick the next stateset to be used
+ ^ static struct sset *pickNextSS(struct vars *, struct dfa *, chr *, chr *);
  */
 static struct sset *
-pickss(
-    struct vars *v,		/* used only for debug flags */
-    struct dfa *d,
-    chr *cp,
-    chr *start)
+pickNextSS(
+    struct vars *const v,	/* used only for debug flags */
+    struct dfa *const d,
+    chr *const cp,
+    chr *const start)
 {
     int i;
-    struct sset *ss;
-    struct sset *end;
+    struct sset *ss, *end;
     chr *ancient;
 
     /*
@@ -784,7 +773,7 @@ pickss(
 	if ((ss->lastseen == NULL || ss->lastseen < ancient)
 		&& !(ss->flags&LOCKED)) {
 	    d->search = ss + 1;
-	    FDEBUG(("replacing c%d\n", ss - d->ssets));
+	    FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
 	    return ss;
 	}
     }
@@ -792,7 +781,7 @@ pickss(
 	if ((ss->lastseen == NULL || ss->lastseen < ancient)
 		&& !(ss->flags&LOCKED)) {
 	    d->search = ss + 1;
-	    FDEBUG(("replacing c%d\n", ss - d->ssets));
+	    FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
 	    return ss;
 	}
     }
diff --git a/generic/regerror.c b/generic/regerror.c
index a1a0163..49d93ed 100644
--- a/generic/regerror.c
+++ b/generic/regerror.c
@@ -41,7 +41,7 @@ static const char unk[] = "*** unknown regex error code 0x%x ***";
  * Struct to map among codes, code names, and explanations.
  */
 
-static struct rerr {
+static const struct rerr {
     int code;
     const char *name;
     const char *explain;
@@ -62,7 +62,7 @@ regerror(
     char *errbuf,		/* Result buffer (unless errbuf_size==0) */
     size_t errbuf_size)		/* Available space in errbuf, can be 0 */
 {
-    struct rerr *r;
+    const struct rerr *r;
     const char *msg;
     char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
     size_t len;
diff --git a/generic/regerrs.h b/generic/regerrs.h
index 72548ff..ee203d5 100644
--- a/generic/regerrs.h
+++ b/generic/regerrs.h
@@ -16,5 +16,5 @@
 { REG_INVARG,	"REG_INVARG",	"invalid argument to regex function" },
 { REG_MIXED,	"REG_MIXED",	"character widths of regex and string differ" },
 { REG_BADOPT,	"REG_BADOPT",	"invalid embedded option" },
-{ REG_ETOOBIG,	"REG_ETOOBIG",	"nfa has too many states" },
+{ REG_ETOOBIG,	"REG_ETOOBIG",	"regular expression is too complex" },
 { REG_ECOLORS,	"REG_ECOLORS",	"too many colors" },
diff --git a/generic/regex.h b/generic/regex.h
index b5dce50..8845f72 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -1,5 +1,8 @@
 #ifndef _REGEX_H_
 #define	_REGEX_H_	/* never again */
+
+#include "tclInt.h"
+
 /*
  * regular expressions
  *
@@ -89,12 +92,6 @@ extern "C" {
 #ifdef __REG_REGOFF_T
 #undef __REG_REGOFF_T
 #endif
-#ifdef __REG_VOID_T
-#undef __REG_VOID_T
-#endif
-#ifdef __REG_CONST
-#undef __REG_CONST
-#endif
 #ifdef __REG_NOFRONT
 #undef __REG_NOFRONT
 #endif
@@ -104,8 +101,6 @@ 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
 /* names and declarations */
 #define	__REG_WIDE_COMPILE	TclReComp
 #define	__REG_WIDE_EXEC		TclReExec
@@ -131,26 +126,6 @@ typedef long regoff_t;
 #endif
 
 /*
- * For benefit of old compilers, we offer <sys/types.h> the option of
- * overriding the `void' type used to declare nonexistent return types.
- */
-#ifdef __REG_VOID_T
-typedef __REG_VOID_T re_void;
-#else
-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'.
- */
-#ifndef __REG_CONST
-#define	__REG_CONST	const
-#endif
-
-
-
-/*
  * other interface types
  */
 
@@ -194,13 +169,13 @@ typedef struct {
 /*
  * compilation
  ^ #ifndef __REG_NOCHAR
- ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+ ^ int re_comp(regex_t *, const char *, size_t, int);
  ^ #endif
  ^ #ifndef __REG_NOFRONT
- ^ int regcomp(regex_t *, __REG_CONST char *, int);
+ ^ int regcomp(regex_t *, const char *, int);
  ^ #endif
  ^ #ifdef __REG_WIDE_T
- ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+ ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
  ^ #endif
  */
 #define	REG_BASIC	000000	/* BREs (convenience) */
@@ -225,14 +200,14 @@ typedef struct {
 /*
  * execution
  ^ #ifndef __REG_NOCHAR
- ^ int re_exec(regex_t *, __REG_CONST char *, size_t,
+ ^ int re_exec(regex_t *, 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(regex_t *, const char *, size_t, regmatch_t [], int);
  ^ #endif
  ^ #ifdef __REG_WIDE_T
- ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t,
+ ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t,
  ^				rm_detail_t *, size_t, regmatch_t [], int);
  ^ #endif
  */
@@ -245,7 +220,7 @@ typedef struct {
 
 /*
  * misc generics (may be more functions here eventually)
- ^ re_void regfree(regex_t *);
+ ^ void regfree(regex_t *);
  */
 
 /*
@@ -257,7 +232,7 @@ typedef struct {
  * 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);
+ ^ extern size_t regerror(int, const regex_t *, char *, size_t);
  */
 #define	REG_OKAY	 0	/* no errors detected */
 #define	REG_NOMATCH	 1	/* failed to match */
@@ -277,7 +252,7 @@ typedef struct {
 #define	REG_INVARG	16	/* invalid argument to regex function */
 #define	REG_MIXED	17	/* character widths of regex and string differ */
 #define	REG_BADOPT	18	/* invalid embedded option */
-#define	REG_ETOOBIG	19	/* nfa has too many states */
+#define	REG_ETOOBIG	19	/* regular expression is too complex */
 #define	REG_ECOLORS	20	/* too many colors */
 /* two specials for debugging and testing */
 #define	REG_ATOI	101	/* convert error-code name to number */
@@ -290,25 +265,25 @@ 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(regex_t *, const char *, size_t, int);
 #endif
 #ifndef __REG_NOFRONT
-int regcomp(regex_t *, __REG_CONST char *, int);
+int regcomp(regex_t *, const char *, int);
 #endif
 #ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, 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(regex_t *, 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(regex_t *, 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);
+MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, 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);
+MODULE_SCOPE void regfree(regex_t *);
+MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t);
 /* automatically gathered by fwd; do not hand-edit */
 /* =====^!^===== end forwards =====^!^===== */
 
@@ -320,3 +295,11 @@ 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:
+ */
diff --git a/generic/regexec.c b/generic/regexec.c
index f3be137..6d12827 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -107,13 +107,13 @@ struct vars {
     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 dfa **subdfas;	/* per-subre DFAs */
     struct smalldfa dfa1;
     struct smalldfa dfa2;
 };
 #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 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)
@@ -125,45 +125,45 @@ struct vars {
 /* =====^!^===== 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 find(struct vars *, struct cnfa *, struct colormap *);
-static int cfind(struct vars *, struct cnfa *, struct colormap *);
-static int cfindloop(struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **);
-static VOID zapsubs(regmatch_t *, size_t);
-static VOID zapmem(struct vars *, struct subre *);
-static VOID subset(struct vars *, struct subre *, chr *, chr *);
-static int dissect(struct vars *, struct subre *, chr *, chr *);
-static int condissect(struct vars *, struct subre *, chr *, chr *);
-static int altdissect(struct vars *, struct subre *, chr *, chr *);
+int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+static struct dfa *getsubdfa(struct vars *, struct subre *);
+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 zapallsubs(regmatch_t *const, const size_t);
+static void zaptreesubs(struct vars *const, struct subre *const);
+static void subset(struct vars *const, struct subre *const, chr *const, chr *const);
 static int cdissect(struct vars *, struct subre *, chr *, chr *);
 static int ccondissect(struct vars *, struct subre *, chr *, chr *);
-static int crevdissect(struct vars *, struct subre *, chr *, chr *);
+static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
 static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
 static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+static int citerdissect(struct vars *, struct subre *, chr *, chr *);
+static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
 /* === rege_dfa.c === */
-static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
-static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *);
-static chr *lastcold(struct vars *, struct dfa *);
-static struct dfa *newdfa(struct vars *, struct cnfa *, struct colormap *, struct smalldfa *);
-static VOID freedfa(struct dfa *);
-static unsigned hash(unsigned *, int);
-static struct sset *initialize(struct vars *, struct dfa *, chr *);
-static struct sset *miss(struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *);
-static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
-static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
-static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
+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);
 /* 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,
+    const chr *string,
     size_t len,
     rm_detail_t *details,
     size_t nmatch,
@@ -171,13 +171,13 @@ exec(
     int flags)
 {
     AllocVars(v);
-    int st;
+    int st, backref;
     size_t n;
-    int backref;
+    size_t i;
 #define	LOCALMAT	20
     regmatch_t mat[LOCALMAT];
-#define	LOCALMEM	40
-    regoff_t mem[LOCALMEM];
+#define LOCALDFAS	40
+    struct dfa *subdfas[LOCALDFAS];
 
     /*
      * Sanity checks.
@@ -235,28 +235,20 @@ exec(
     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);
-	    }
-	    FreeVars(v);
-	    return REG_ESPACE;
-	}
-    } else {
-	v->mem = NULL;
+    assert(v->g->ntree >= 0);
+    n = (size_t) v->g->ntree;
+    if (n <= LOCALDFAS)
+	v->subdfas = subdfas;
+    else
+	v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *));
+    if (v->subdfas == NULL) {
+	if (v->pmatch != pmatch && v->pmatch != mat)
+	    FREE(v->pmatch);
+	FreeVars(v);
+	return REG_ESPACE;
     }
+    for (i = 0; i < n; i++)
+	v->subdfas[i] = NULL;
 
     /*
      * Do it.
@@ -264,9 +256,9 @@ exec(
 
     assert(v->g->tree != NULL);
     if (backref) {
-	st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
+	st = complicatedFind(v, &v->g->tree->cnfa, &v->g->cmap);
     } else {
-	st = find(v, &v->g->tree->cnfa, &v->g->cmap);
+	st = simpleFind(v, &v->g->tree->cnfa, &v->g->cmap);
     }
 
     /*
@@ -274,7 +266,7 @@ exec(
      */
 
     if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
-	zapsubs(pmatch, nmatch);
+	zapallsubs(pmatch, nmatch);
 	n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
 	memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
     }
@@ -286,31 +278,49 @@ exec(
     if (v->pmatch != pmatch && v->pmatch != mat) {
 	FREE(v->pmatch);
     }
-    if (v->mem != NULL && v->mem != mem) {
-	FREE(v->mem);
+    n = (size_t) v->g->ntree;
+    for (i = 0; i < n; i++) {
+	if (v->subdfas[i] != NULL)
+	    freeDFA(v->subdfas[i]);
     }
+    if (v->subdfas != subdfas)
+	FREE(v->subdfas);
     FreeVars(v);
     return st;
 }
 
 /*
- - find - find a match for the main NFA (no-complications case)
- ^ static int find(struct vars *, struct cnfa *, struct colormap *);
+ - getsubdfa - create or re-fetch the DFA for a subre node
+ * We only need to create the DFA once per overall regex execution.
+ * The DFA will be freed by the cleanup step in exec().
+ */
+static struct dfa *
+getsubdfa(struct vars * v,
+	  struct subre * t)
+{
+    if (v->subdfas[t->id] == NULL) {
+	v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, DOMALLOC);
+	if (ISERR())
+	    return NULL;
+    }
+    return v->subdfas[t->id];
+}
+
+/*
+ - simpleFind - find a match for the main NFA (no-complications case)
+ ^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *);
  */
 static int
-find(
-    struct vars *v,
-    struct cnfa *cnfa,
-    struct colormap *cm)
+simpleFind(
+    struct vars *const v,
+    struct cnfa *const cnfa,
+    struct colormap *const cm)
 {
-    struct dfa *s;
-    struct dfa *d;
-    chr *begin;
-    chr *end = NULL;
+    struct dfa *s, *d;
+    chr *begin, *end = NULL;
     chr *cold;
-    chr *open;			/* Open and close of range of possible
+    chr *open, *close;		/* Open and close of range of possible
 				 * starts */
-    chr *close;
     int hitend;
     int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
 
@@ -318,13 +328,13 @@ find(
      * First, a shot with the search RE.
      */
 
-    s = newdfa(v, &v->g->search, cm, &v->dfa1);
+    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);
+    freeDFA(s);
     NOERR();
     if (v->g->cflags&REG_EXPECT) {
 	assert(v->details != NULL);
@@ -350,7 +360,7 @@ find(
     open = cold;
     cold = NULL;
     MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
-    d = newdfa(v, cnfa, cm, &v->dfa1);
+    d = newDFA(v, cnfa, cm, &v->dfa1);
     assert(!(ISERR() && d != NULL));
     NOERR();
     for (begin = open; begin <= close; begin++) {
@@ -360,7 +370,10 @@ find(
 	} else {
 	    end = longest(v, d, begin, v->stop, &hitend);
 	}
-	NOERR();
+	if (ISERR()) {
+	    freeDFA(d);
+	    return v->err;
+	}
 	if (hitend && cold == NULL) {
 	    cold = begin;
 	}
@@ -369,7 +382,7 @@ find(
 	}
     }
     assert(end != NULL);	/* search RE succeeded so loop should */
-    freedfa(d);
+    freeDFA(d);
 
     /*
      * And pin down details.
@@ -391,41 +404,40 @@ find(
     }
 
     /*
-     * Submatches.
+     * Find submatches.
      */
 
-    zapsubs(v->pmatch, v->nmatch);
-    return dissect(v, v->g->tree, begin, end);
+    zapallsubs(v->pmatch, v->nmatch);
+    return cdissect(v, v->g->tree, begin, end);
 }
 
 /*
- - cfind - find a match for the main NFA (with complications)
- ^ static int cfind(struct vars *, struct cnfa *, struct colormap *);
+ - complicatedFind - find a match for the main NFA (with complications)
+ ^ static int complicatedFind(struct vars *, struct cnfa *, struct colormap *);
  */
 static int
-cfind(
-    struct vars *v,
-    struct cnfa *cnfa,
-    struct colormap *cm)
+complicatedFind(
+    struct vars *const v,
+    struct cnfa *const cnfa,
+    struct colormap *const cm)
 {
-    struct dfa *s;
-    struct dfa *d;
+    struct dfa *s, *d;
     chr *cold = NULL; /* silence gcc 4 warning */
     int ret;
 
-    s = newdfa(v, &v->g->search, cm, &v->dfa1);
+    s = newDFA(v, &v->g->search, cm, &v->dfa1);
     NOERR();
-    d = newdfa(v, cnfa, cm, &v->dfa2);
+    d = newDFA(v, cnfa, cm, &v->dfa2);
     if (ISERR()) {
 	assert(d == NULL);
-	freedfa(s);
+	freeDFA(s);
 	return v->err;
     }
 
-    ret = cfindloop(v, cnfa, cm, d, s, &cold);
+    ret = complicatedFindLoop(v, cnfa, cm, d, s, &cold);
 
-    freedfa(d);
-    freedfa(s);
+    freeDFA(d);
+    freeDFA(s);
     NOERR();
     if (v->g->cflags&REG_EXPECT) {
 	assert(v->details != NULL);
@@ -440,30 +452,26 @@ cfind(
 }
 
 /*
- - cfindloop - the heart of cfind
- ^ static int cfindloop(struct vars *, struct cnfa *, struct colormap *,
+ - complicatedFindLoop - the heart of complicatedFind
+ ^ static int complicatedFindLoop(struct vars *, struct cnfa *, struct colormap *,
  ^	struct dfa *, struct dfa *, chr **);
  */
 static int
-cfindloop(
-    struct vars *v,
-    struct cnfa *cnfa,
-    struct colormap *cm,
-    struct dfa *d,
-    struct dfa *s,
-    chr **coldp)		/* where to put coldstart pointer */
+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 */
 {
-    chr *begin;
-    chr *end;
+    chr *begin, *end;
     chr *cold;
-    chr *open;			/* Open and close of range of possible
+    chr *open, *close;		/* Open and close of range of possible
 				 * starts */
-    chr *close;
-    chr *estart;
-    chr *estop;
-    int er;
+    chr *estart, *estop;
+    int er, hitend;
     int shorter = v->g->tree->flags&SHORTER;
-    int hitend;
 
     assert(d != NULL && s != NULL);
     cold = NULL;
@@ -479,7 +487,7 @@ cfindloop(
 	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)));
+	    MDEBUG(("\ncomplicatedFind trying at %ld\n", LOFF(begin)));
 	    estart = begin;
 	    estop = v->stop;
 	    for (;;) {
@@ -496,8 +504,7 @@ cfindloop(
 		}
 
 		MDEBUG(("tentative end %ld\n", LOFF(end)));
-		zapsubs(v->pmatch, v->nmatch);
-		zapmem(v, v->g->tree);
+		zapallsubs(v->pmatch, v->nmatch);
 		er = cdissect(v, v->g->tree, begin, end);
 		if (er == REG_OKAY) {
 		    if (v->nmatch > 0) {
@@ -509,6 +516,7 @@ cfindloop(
 		}
 		if (er != REG_NOMATCH) {
 		    ERR(er);
+		    *coldp = cold;
 		    return er;
 		}
 		if ((shorter) ? end == estop : end == begin) {
@@ -533,13 +541,13 @@ cfindloop(
 }
 
 /*
- - zapsubs - initialize the subexpression matches to "no match"
- ^ static VOID zapsubs(regmatch_t *, size_t);
+ - zapallsubs - initialize all subexpression matches to "no match"
+ ^ static void zapallsubs(regmatch_t *, size_t);
  */
 static void
-zapsubs(
-    regmatch_t *p,
-    size_t n)
+zapallsubs(
+    regmatch_t *const p,
+    const size_t n)
 {
     size_t i;
 
@@ -550,44 +558,41 @@ zapsubs(
 }
 
 /*
- - zapmem - initialize the retry memory of a subtree to zeros
- ^ static VOID zapmem(struct vars *, struct subre *);
+ - zaptreesubs - initialize subexpressions within subtree to "no match"
+ ^ static void zaptreesubs(struct vars *, struct subre *);
  */
 static void
-zapmem(
-    struct vars *v,
-    struct subre *t)
+zaptreesubs(
+    struct vars *const v,
+    struct subre *const 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;
+	int n = t->subno;
+	assert(n > 0);
+	if ((size_t) n < v->nmatch) {
+	    v->pmatch[n].rm_so = -1;
+	    v->pmatch[n].rm_eo = -1;
+	}
     }
 
     if (t->left != NULL) {
-	zapmem(v, t->left);
+	zaptreesubs(v, t->left);
     }
     if (t->right != NULL) {
-	zapmem(v, t->right);
+	zaptreesubs(v, t->right);
     }
 }
 
 /*
- - subset - set any subexpression relevant to a successful subre
- ^ static VOID subset(struct vars *, struct subre *, chr *, chr *);
+ - subset - set subexpression match data for a successful subre
+ ^ static void subset(struct vars *, struct subre *, chr *, chr *);
  */
 static void
 subset(
-    struct vars *v,
-    struct subre *sub,
-    chr *begin,
-    chr *end)
+    struct vars *const v,
+    struct subre *const sub,
+    chr *const begin,
+    chr *const end)
 {
     int n = sub->subno;
 
@@ -602,185 +607,25 @@ subset(
 }
 
 /*
- - dissect - determine subexpression matches (uncomplicated case)
- ^ static int dissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int			/* regexec return code */
-dissect(
-    struct vars *v,
-    struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
-{
-    assert(t != NULL);
-    MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
-
-    switch (t->op) {
-    case '=':			/* terminal node */
-	assert(t->left == NULL && t->right == NULL);
-	return REG_OKAY;	/* no action, parent did the work */
-    case '|':			/* alternation */
-	assert(t->left != NULL);
-	return altdissect(v, t, begin, end);
-    case 'b':			/* back ref -- shouldn't be calling us! */
-	return REG_ASSERT;
-    case '.':			/* concatenation */
-	assert(t->left != NULL && t->right != NULL);
-	return condissect(v, t, begin, end);
-    case '(':			/* capturing */
-	assert(t->left != NULL && t->right == NULL);
-	assert(t->subno > 0);
-	subset(v, t, begin, end);
-	return dissect(v, t->left, begin, end);
-    default:
-	return REG_ASSERT;
-    }
-}
-
-/*
- - condissect - determine concatenation subexpression matches (uncomplicated)
- ^ static int condissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int			/* regexec return code */
-condissect(
-    struct vars *v,
-    struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
-{
-    struct dfa *d;
-    struct dfa *d2;
-    chr *mid;
-    int i;
-    int shorter = (t->left->flags&SHORTER) ? 1 : 0;
-    chr *stop = (shorter) ? end : begin;
-
-    assert(t->op == '.');
-    assert(t->left != NULL && t->left->cnfa.nstates > 0);
-    assert(t->right != NULL && t->right->cnfa.nstates > 0);
-
-    d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
-    NOERR();
-    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
-    if (ISERR()) {
-	assert(d2 == NULL);
-	freedfa(d);
-	return v->err;
-    }
-
-    /*
-     * 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;
-	}
-	MDEBUG(("new midpoint %ld\n", LOFF(mid)));
-    }
-
-    /*
-     * Satisfaction.
-     */
-
-    MDEBUG(("successful\n"));
-    freedfa(d);
-    freedfa(d2);
-    i = dissect(v, t->left, begin, mid);
-    if (i != REG_OKAY) {
-	return i;
-    }
-    return dissect(v, t->right, mid, end);
-}
-
-/*
- - altdissect - determine alternative subexpression matches (uncomplicated)
- ^ static int altdissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int			/* regexec return code */
-altdissect(
-    struct vars *v,
-    struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
-{
-    struct dfa *d;
-    int i;
-
-    assert(t != NULL);
-    assert(t->op == '|');
-
-    for (i = 0; t != NULL; t = t->right, i++) {
-	MDEBUG(("trying %dth\n", i));
-	assert(t->left != NULL && t->left->cnfa.nstates > 0);
-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
-	if (ISERR()) {
-	    return v->err;
-	}
-	if (longest(v, d, begin, end, 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".
+ - cdissect - check backrefs and determine subexpression matches
+ * cdissect recursively processes a subre tree to check matching of backrefs
+ * and/or identify submatch boundaries for capture nodes.  The proposed match
+ * runs from "begin" to "end" (not including "end"), and we are basically
+ * "dissecting" it to see where the submatches are.
+ * Before calling any level of cdissect, the caller must have run the node's
+ * DFA and found that the proposed substring satisfies the DFA.  (We make
+ * the caller do that because in concatenation and iteration nodes, it's
+ * much faster to check all the substrings against the child DFAs before we
+ * recurse.)  Also, caller must have cleared subexpression match data via
+ * zaptreesubs (or zapallsubs at the top level).
  ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
 cdissect(
     struct vars *v,
     struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
+    chr *begin,		/* beginning of relevant substring */
+    chr *end)		/* end of same */
 {
     int er;
 
@@ -790,16 +635,30 @@ cdissect(
     switch (t->op) {
     case '=':			/* terminal node */
 	assert(t->left == NULL && t->right == NULL);
-	return REG_OKAY;	/* no action, parent did the work */
-    case '|':			/* alternation */
-	assert(t->left != NULL);
-	return caltdissect(v, t, begin, end);
-    case 'b':			/* back ref -- shouldn't be calling us! */
+	er = REG_OKAY;		/* no action, parent did the work */
+	break;
+    case 'b':			/* back reference */
 	assert(t->left == NULL && t->right == NULL);
-	return cbrdissect(v, t, begin, end);
+	er = cbrdissect(v, t, begin, end);
+	break;
     case '.':			/* concatenation */
 	assert(t->left != NULL && t->right != NULL);
-	return ccondissect(v, t, begin, end);
+	if (t->left->flags & SHORTER) /* reverse scan */
+	    er = crevcondissect(v, t, begin, end);
+	else
+	    er = ccondissect(v, t, begin, end);
+	break;
+    case '|':			/* alternation */
+	assert(t->left != NULL);
+	er = caltdissect(v, t, begin, end);
+	break;
+    case '*':			/* iteration */
+	assert(t->left != NULL);
+	if (t->left->flags & SHORTER) /* reverse scan */
+	    er = creviterdissect(v, t, begin, end);
+	else
+	    er = citerdissect(v, t, begin, end);
+	break;
     case '(':			/* capturing */
 	assert(t->left != NULL && t->right == NULL);
 	assert(t->subno > 0);
@@ -807,65 +666,56 @@ cdissect(
 	if (er == REG_OKAY) {
 	    subset(v, t, begin, end);
 	}
-	return er;
+	break;
     default:
-	return REG_ASSERT;
+	er = REG_ASSERT;
+	break;
     }
+
+    /*
+     * We should never have a match failure unless backrefs lurk below;
+     * otherwise, either caller failed to check the DFA, or there's some
+     * inconsistency between the DFA and the node's innards.
+     */
+    assert(er != REG_NOMATCH || (t->flags & BACKR));
+
+    return er;
 }
 
 /*
- - 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".
+ - ccondissect - dissect match for concatenation node
  ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
 ccondissect(
     struct vars *v,
     struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
+    chr *begin,		/* beginning of relevant substring */
+    chr *end)		/* end of same */
 {
     struct dfa *d, *d2;
     chr *mid;
-    int er;
 
     assert(t->op == '.');
     assert(t->left != NULL && t->left->cnfa.nstates > 0);
     assert(t->right != NULL && t->right->cnfa.nstates > 0);
+    assert(!(t->left->flags & SHORTER));
 
-    if (t->left->flags&SHORTER) { /* reverse scan */
-	return crevdissect(v, t, begin, end);
-    }
+    d = getsubdfa(v, t->left);
+    NOERR();
+    d2 = getsubdfa(v, t->right);
+    NOERR();
 
-    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));
+    MDEBUG(("cConcat %d\n", t->id));
 
     /*
      * 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;
-	}
-	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)));
+    mid = longest(v, d, begin, end, (int *) NULL);
+    if (mid == NULL) {
+	return REG_NOMATCH;
     }
+    MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
 
     /*
      * Iterate until satisfaction or failure.
@@ -877,23 +727,20 @@ ccondissect(
 	 */
 
 	if (longest(v, d2, mid, end, NULL) == end) {
-	    er = cdissect(v, t->left, begin, mid);
+	    int 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);
+	    if (er != REG_NOMATCH) {
 		return er;
 	    }
 	}
@@ -907,9 +754,7 @@ ccondissect(
 	     * All possibilities exhausted.
 	     */
 
-	    MDEBUG(("%d no midpoint\n", t->retry));
-	    freedfa(d);
-	    freedfa(d2);
+	    MDEBUG(("%d no midpoint\n", t->id));
 	    return REG_NOMATCH;
 	}
 	mid = longest(v, d, begin, mid-1, NULL);
@@ -918,73 +763,50 @@ ccondissect(
 	     * Failed to find a new one.
 	     */
 
-	    MDEBUG(("%d failed midpoint\n", t->retry));
-	    freedfa(d);
-	    freedfa(d2);
+	    MDEBUG(("%d failed midpoint\n", t->id));
 	    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->id, LOFF(mid)));
+	zaptreesubs(v, t->left);
+	zaptreesubs(v, t->right);
     }
 }
 
 /*
- - crevdissect - determine backref shortest-first subexpression matches
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int crevdissect(struct vars *, struct subre *, chr *, chr *);
+ - crevcondissect - dissect match for concatenation node, shortest-first
+ ^ static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-crevdissect(
+crevcondissect(
     struct vars *v,
     struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
+    chr *begin,		/* beginning of relevant substring */
+    chr *end)		/* end of same */
 {
-    struct dfa *d;
-    struct dfa *d2;
+    struct dfa *d, *d2;
     chr *mid;
-    int er;
 
     assert(t->op == '.');
     assert(t->left != NULL && t->left->cnfa.nstates > 0);
     assert(t->right != NULL && t->right->cnfa.nstates > 0);
     assert(t->left->flags&SHORTER);
 
-    /*
-     * Concatenation -- need to split the substring between parts.
-     */
+    d = getsubdfa(v, t->left);
+    NOERR();
+    d2 = getsubdfa(v, t->right);
+    NOERR();
 
-    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));
+    MDEBUG(("crevcon %d\n", t->id));
 
     /*
      * 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;
-	}
-	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)));
+    mid = shortest(v, d, begin, begin, end, (chr **) NULL, (int *) NULL);
+    if (mid == NULL) {
+	return REG_NOMATCH;
     }
+    MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
 
     /*
      * Iterate until satisfaction or failure.
@@ -996,7 +818,8 @@ crevdissect(
 	 */
 
 	if (longest(v, d2, mid, end, NULL) == end) {
-	    er = cdissect(v, t->left, begin, mid);
+	    int er = cdissect(v, t->left, begin, mid);
+
 	    if (er == REG_OKAY) {
 		er = cdissect(v, t->right, mid, end);
 		if (er == REG_OKAY) {
@@ -1005,14 +828,10 @@ crevdissect(
 		     */
 
 		    MDEBUG(("successful\n"));
-		    freedfa(d);
-		    freedfa(d2);
 		    return REG_OKAY;
 		}
 	    }
-	    if (er != REG_OKAY && er != REG_NOMATCH) {
-		freedfa(d);
-		freedfa(d2);
+	    if (er != REG_NOMATCH) {
 		return er;
 	    }
 	}
@@ -1026,9 +845,7 @@ crevdissect(
 	     * All possibilities exhausted.
 	     */
 
-	    MDEBUG(("%d no midpoint\n", t->retry));
-	    freedfa(d);
-	    freedfa(d2);
+	    MDEBUG(("%d no midpoint\n", t->id));
 	    return REG_NOMATCH;
 	}
 	mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
@@ -1037,157 +854,474 @@ crevdissect(
 	     * Failed to find a new one.
 	     */
 
-	    MDEBUG(("%d failed midpoint\n", t->retry));
-	    freedfa(d);
-	    freedfa(d2);
+	    MDEBUG(("%d failed midpoint\n", t->id));
 	    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->id, LOFF(mid)));
+	zaptreesubs(v, t->left);
+	zaptreesubs(v, t->right);
     }
 }
 
 /*
- - cbrdissect - determine backref subexpression matches
+ - cbrdissect - dissect match for backref node
  ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
 cbrdissect(
     struct vars *v,
     struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
+    chr *begin,		/* beginning of relevant substring */
+    chr *end)		/* end of same */
 {
-    int i;
-    int n = t->subno;
-    size_t len;
-    chr *paren;
+    int n = t->subno, min = t->min, max = t->max;
+    size_t numreps;
+    size_t tlen;
+    size_t brlen;
+    chr *brstring;
     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));
+    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));
 
+    /* get the backreferenced string */
     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;
+    brstring = v->start + v->pmatch[n].rm_so;
+    brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
 
-    /*
-     * No room to maneuver -- retries are pointless.
-     */
-
-    if (v->mem[t->retry]) {
+    /* special cases for zero-length strings */
+    if (brlen == 0) {
+	/*
+	 * matches only if target is zero length, but any number of
+	 * repetitions can be considered to be present
+	 */
+	if (begin == end && min <= max) {
+	    MDEBUG(("cbackref matched trivially\n"));
+	    return REG_OKAY;
+	}
 	return REG_NOMATCH;
     }
-    v->mem[t->retry] = 1;
-
-    /*
-     * Special-case zero-length string.
-     */
-
-    if (len == 0) {
-	if (begin == end) {
+    if (begin == end) {
+	/* matches only if zero repetitions are okay */
+	if (min == 0) {
+	    MDEBUG(("cbackref matched trivially\n"));
 	    return REG_OKAY;
 	}
 	return REG_NOMATCH;
     }
 
     /*
-     * And too-short string.
+     * check target length to see if it could possibly be an allowed number of
+     * repetitions of brstring
      */
 
-    assert(end >= begin);
-    if ((size_t)(end - begin) < len) {
+    assert(end > begin);
+    tlen = end - begin;
+    if (tlen % brlen != 0)
 	return REG_NOMATCH;
+    numreps = tlen / brlen;
+    if (numreps < (size_t)min || (numreps > (size_t)max && max != DUPINF))
+	return REG_NOMATCH;
+
+    /* okay, compare the actual string contents */
+    p = begin;
+    while (numreps-- > 0) {
+	if ((*v->g->compare) (brstring, p, brlen) != 0)
+	    return REG_NOMATCH;
+	p += brlen;
     }
-    stop = end - len;
 
-    /*
-     * Count occurrences.
-     */
+    MDEBUG(("cbackref matched\n"));
+    return REG_OKAY;
+}
+
+/*
+ - caltdissect - dissect match for alternation node
+ ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int			/* regexec return code */
+caltdissect(
+    struct vars *v,
+    struct subre *t,
+    chr *begin,		/* beginning of relevant substring */
+    chr *end)		/* end of same */
+{
+    struct dfa *d;
+    int er;
+
+    /* We loop, rather than tail-recurse, to handle a chain of alternatives */
+    while (t != NULL) {
+	assert(t->op == '|');
+	assert(t->left != NULL && t->left->cnfa.nstates > 0);
 
-    i = 0;
-    for (p = begin; p <= stop && (i < max || max == DUPINF); p += len) {
-	if ((*v->g->compare)(paren, p, len) != 0) {
-	    break;
+	MDEBUG(("calt n%d\n", t->id));
+
+	d = getsubdfa(v, t->left);
+	NOERR();
+	if (longest(v, d, begin, end, (int *) NULL) == end) {
+	    MDEBUG(("calt matched\n"));
+	    er = cdissect(v, t->left, begin, end);
+	    if (er != REG_NOMATCH) {
+		return er;
+	    }
 	}
-	i++;
+
+	t = t->right;
     }
-    MDEBUG(("cbackref found %d\n", i));
+
+    return REG_NOMATCH;
+}
+
+/*
+ - citerdissect - dissect match for iteration node
+ ^ static int citerdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int			/* regexec return code */
+citerdissect(struct vars * v,
+	     struct subre * t,
+	     chr *begin,	/* beginning of relevant substring */
+	     chr *end)		/* end of same */
+{
+    struct dfa *d;
+    chr	  **endpts;
+    chr	   *limit;
+    int		min_matches;
+    size_t	max_matches;
+    int		nverified;
+    int		k;
+    int		i;
+    int		er;
+
+    assert(t->op == '*');
+    assert(t->left != NULL && t->left->cnfa.nstates > 0);
+    assert(!(t->left->flags & SHORTER));
+    assert(begin <= end);
 
     /*
-     * And sort it out.
+     * If zero matches are allowed, and target string is empty, just declare
+     * victory.  OTOH, if target string isn't empty, zero matches can't work
+     * so we pretend the min is 1.
      */
+    min_matches = t->min;
+    if (min_matches <= 0) {
+	if (begin == end)
+	    return REG_OKAY;
+	min_matches = 1;
+    }
 
-    if (p != end) {		/* didn't consume all of it */
-	return REG_NOMATCH;
+    /*
+     * We need workspace to track the endpoints of each sub-match.  Normally
+     * we consider only nonzero-length sub-matches, so there can be at most
+     * end-begin of them.  However, if min is larger than that, we will also
+     * consider zero-length sub-matches in order to find enough matches.
+     *
+     * For convenience, endpts[0] contains the "begin" pointer and we store
+     * sub-match endpoints in endpts[1..max_matches].
+     */
+    max_matches = end - begin;
+    if (max_matches > (size_t)t->max && t->max != DUPINF)
+	max_matches = t->max;
+    if (max_matches < (size_t)min_matches)
+	max_matches = min_matches;
+    endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
+    if (endpts == NULL)
+	return REG_ESPACE;
+    endpts[0] = begin;
+
+    d = getsubdfa(v, t->left);
+    if (ISERR()) {
+	FREE(endpts);
+	return v->err;
     }
-    if (min <= i && (i <= max || max == DUPINF)) {
-	return REG_OKAY;
+    MDEBUG(("citer %d\n", t->id));
+
+    /*
+     * Our strategy is to first find a set of sub-match endpoints that are
+     * valid according to the child node's DFA, and then recursively dissect
+     * each sub-match to confirm validity.  If any validity check fails,
+     * backtrack the last sub-match and try again.  And, when we next try for
+     * a validity check, we need not recheck any successfully verified
+     * sub-matches that we didn't move the endpoints of.  nverified remembers
+     * how many sub-matches are currently known okay.
+     */
+
+    /* initialize to consider first sub-match */
+    nverified = 0;
+    k = 1;
+    limit = end;
+
+    /* iterate until satisfaction or failure */
+    while (k > 0) {
+	/* try to find an endpoint for the k'th sub-match */
+	endpts[k] = longest(v, d, endpts[k - 1], limit, (int *) NULL);
+	if (endpts[k] == NULL) {
+	    /* no match possible, so see if we can shorten previous one */
+	    k--;
+	    goto backtrack;
+	}
+	MDEBUG(("%d: working endpoint %d: %ld\n",
+		t->id, k, LOFF(endpts[k])));
+
+	/* k'th sub-match can no longer be considered verified */
+	if (nverified >= k)
+	    nverified = k - 1;
+
+	if (endpts[k] != end) {
+	    /* haven't reached end yet, try another iteration if allowed */
+	    if ((size_t)k >= max_matches) {
+		/* must try to shorten some previous match */
+		k--;
+		goto backtrack;
+	    }
+
+	    /* reject zero-length match unless necessary to achieve min */
+	    if (endpts[k] == endpts[k - 1] &&
+		(k >= min_matches || min_matches - k < end - endpts[k]))
+		goto backtrack;
+
+	    k++;
+	    limit = end;
+	    continue;
+	}
+
+	/*
+	 * We've identified a way to divide the string into k sub-matches
+	 * that works so far as the child DFA can tell.  If k is an allowed
+	 * number of matches, start the slow part: recurse to verify each
+	 * sub-match.  We always have k <= max_matches, needn't check that.
+	 */
+	if (k < min_matches)
+	    goto backtrack;
+
+	MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));
+
+	for (i = nverified + 1; i <= k; i++) {
+	    zaptreesubs(v, t->left);
+	    er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
+	    if (er == REG_OKAY) {
+		nverified = i;
+		continue;
+	    }
+	    if (er == REG_NOMATCH)
+		break;
+	    /* oops, something failed */
+	    FREE(endpts);
+	    return er;
+	}
+
+	if (i > k) {
+	    /* satisfaction */
+	    MDEBUG(("%d successful\n", t->id));
+	    FREE(endpts);
+	    return REG_OKAY;
+	}
+
+	/* match failed to verify, so backtrack */
+
+    backtrack:
+	/*
+	 * Must consider shorter versions of the current sub-match.  However,
+	 * we'll only ask for a zero-length match if necessary.
+	 */
+	while (k > 0) {
+	    chr	   *prev_end = endpts[k - 1];
+
+	    if (endpts[k] > prev_end) {
+		limit = endpts[k] - 1;
+		if (limit > prev_end ||
+		    (k < min_matches && min_matches - k >= end - prev_end)) {
+		    /* break out of backtrack loop, continue the outer one */
+		    break;
+		}
+	    }
+	    /* can't shorten k'th sub-match any more, consider previous one */
+	    k--;
+	}
     }
-    return REG_NOMATCH;		/* out of range */
+
+    /* all possibilities exhausted */
+    MDEBUG(("%d failed\n", t->id));
+    FREE(endpts);
+    return REG_NOMATCH;
 }
 
 /*
- - caltdissect - determine alternative subexpression matches (w. complications)
- ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+ - creviterdissect - dissect match for iteration node, shortest-first
+ ^ static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-caltdissect(
-    struct vars *v,
-    struct subre *t,
-    chr *begin,			/* beginning of relevant substring */
-    chr *end)			/* end of same */
+creviterdissect(struct vars * v,
+		struct subre * t,
+		chr *begin,	/* beginning of relevant substring */
+		chr *end)	/* end of same */
 {
     struct dfa *d;
-    int er;
-#define	UNTRIED	0		/* not yet tried at all */
-#define	TRYING	1		/* top matched, trying submatches */
-#define	TRIED	2		/* top didn't match or submatches exhausted */
+    chr	  **endpts;
+    chr	   *limit;
+    int		min_matches;
+    size_t	max_matches;
+    int		nverified;
+    int		k;
+    int		i;
+    int		er;
+
+    assert(t->op == '*');
+    assert(t->left != NULL && t->left->cnfa.nstates > 0);
+    assert(t->left->flags & SHORTER);
+    assert(begin <= end);
 
-    if (t == NULL) {
-	return REG_NOMATCH;
+    /*
+     * If zero matches are allowed, and target string is empty, just declare
+     * victory.  OTOH, if target string isn't empty, zero matches can't work
+     * so we pretend the min is 1.
+     */
+    min_matches = t->min;
+    if (min_matches <= 0) {
+	if (begin == end)
+	    return REG_OKAY;
+	min_matches = 1;
     }
-    assert(t->op == '|');
-    if (v->mem[t->retry] == TRIED) {
-	return caltdissect(v, t->right, begin, end);
+
+    /*
+     * We need workspace to track the endpoints of each sub-match.  Normally
+     * we consider only nonzero-length sub-matches, so there can be at most
+     * end-begin of them.  However, if min is larger than that, we will also
+     * consider zero-length sub-matches in order to find enough matches.
+     *
+     * For convenience, endpts[0] contains the "begin" pointer and we store
+     * sub-match endpoints in endpts[1..max_matches].
+     */
+    max_matches = end - begin;
+    if (max_matches > (size_t)t->max && t->max != DUPINF)
+	max_matches = t->max;
+    if (max_matches < (size_t)min_matches)
+	max_matches = min_matches;
+    endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
+    if (endpts == NULL)
+	return REG_ESPACE;
+    endpts[0] = begin;
+
+    d = getsubdfa(v, t->left);
+    if (ISERR()) {
+	FREE(endpts);
+	return v->err;
     }
+    MDEBUG(("creviter %d\n", t->id));
 
-    MDEBUG(("calt n%d\n", t->retry));
-    assert(t->left != NULL);
+    /*
+     * Our strategy is to first find a set of sub-match endpoints that are
+     * valid according to the child node's DFA, and then recursively dissect
+     * each sub-match to confirm validity.  If any validity check fails,
+     * backtrack the last sub-match and try again.  And, when we next try for
+     * a validity check, we need not recheck any successfully verified
+     * sub-matches that we didn't move the endpoints of.  nverified remembers
+     * how many sub-matches are currently known okay.
+     */
 
-    if (v->mem[t->retry] == UNTRIED) {
-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
-	if (ISERR()) {
-	    return v->err;
+    /* initialize to consider first sub-match */
+    nverified = 0;
+    k = 1;
+    limit = begin;
+
+    /* iterate until satisfaction or failure */
+    while (k > 0) {
+	/* disallow zero-length match unless necessary to achieve min */
+	if (limit == endpts[k - 1] &&
+	    limit != end &&
+	    (k >= min_matches || min_matches - k < end - limit))
+	    limit++;
+
+	/* if this is the last allowed sub-match, it must reach to the end */
+	if ((size_t)k >= max_matches)
+	    limit = end;
+
+	/* try to find an endpoint for the k'th sub-match */
+	endpts[k] = shortest(v, d, endpts[k - 1], limit, end,
+			     (chr **) NULL, (int *) NULL);
+	if (endpts[k] == NULL) {
+	    /* no match possible, so see if we can lengthen previous one */
+	    k--;
+	    goto backtrack;
+	}
+	MDEBUG(("%d: working endpoint %d: %ld\n",
+		t->id, k, LOFF(endpts[k])));
+
+	/* k'th sub-match can no longer be considered verified */
+	if (nverified >= k)
+	    nverified = k - 1;
+
+	if (endpts[k] != end) {
+	    /* haven't reached end yet, try another iteration if allowed */
+	    if ((size_t)k >= max_matches) {
+		/* must try to lengthen some previous match */
+		k--;
+		goto backtrack;
+	    }
+
+	    k++;
+	    limit = endpts[k - 1];
+	    continue;
 	}
-	if (longest(v, d, begin, end, NULL) != end) {
-	    freedfa(d);
-	    v->mem[t->retry] = TRIED;
-	    return caltdissect(v, t->right, begin, end);
+
+	/*
+	 * We've identified a way to divide the string into k sub-matches
+	 * that works so far as the child DFA can tell.  If k is an allowed
+	 * number of matches, start the slow part: recurse to verify each
+	 * sub-match.  We always have k <= max_matches, needn't check that.
+	 */
+	if (k < min_matches)
+	    goto backtrack;
+
+	MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));
+
+	for (i = nverified + 1; i <= k; i++) {
+	    zaptreesubs(v, t->left);
+	    er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
+	    if (er == REG_OKAY) {
+		nverified = i;
+		continue;
+	    }
+	    if (er == REG_NOMATCH)
+		break;
+	    /* oops, something failed */
+	    FREE(endpts);
+	    return er;
 	}
-	freedfa(d);
-	MDEBUG(("calt matched\n"));
-	v->mem[t->retry] = TRYING;
-    }
 
-    er = cdissect(v, t->left, begin, end);
-    if (er != REG_NOMATCH) {
-	return er;
+	if (i > k) {
+	    /* satisfaction */
+	    MDEBUG(("%d successful\n", t->id));
+	    FREE(endpts);
+	    return REG_OKAY;
+	}
+
+	/* match failed to verify, so backtrack */
+
+    backtrack:
+	/*
+	 * Must consider longer versions of the current sub-match.
+	 */
+	while (k > 0) {
+	    if (endpts[k] < end) {
+		limit = endpts[k] + 1;
+		/* break out of backtrack loop, continue the outer one */
+		break;
+	    }
+	    /* can't lengthen k'th sub-match any more, consider previous one */
+	    k--;
+	}
     }
 
-    v->mem[t->retry] = TRIED;
-    return caltdissect(v, t->right, begin, end);
+    /* all possibilities exhausted */
+    MDEBUG(("%d failed\n", t->id));
+    FREE(endpts);
+    return REG_NOMATCH;
 }
 
 #include "rege_dfa.c"
diff --git a/generic/regfronts.c b/generic/regfronts.c
index 5003297..088a640 100644
--- a/generic/regfronts.c
+++ b/generic/regfronts.c
@@ -39,7 +39,7 @@
 int
 regcomp(
     regex_t *re,
-    CONST char *str,
+    const char *str,
     int flags)
 {
     size_t len;
@@ -61,12 +61,12 @@ regcomp(
 int
 regexec(
     regex_t *re,
-    CONST char *str,
+    const char *str,
     size_t nmatch,
     regmatch_t pmatch[],
     int flags)
 {
-    CONST char *start;
+    const char *start;
     size_t len;
     int f = flags;
 
diff --git a/generic/regguts.h b/generic/regguts.h
index 7ed8ec1..1ac2465 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -39,15 +39,6 @@
  * 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
@@ -75,11 +66,6 @@
 #define	NOPARMS	void		/* for empty parm lists */
 #endif
 
-/* const */
-#ifndef CONST
-#define	CONST	const		/* for old compilers, might be empty */
-#endif
-
 /* function-pointer declarator */
 #ifndef FUNCPTR
 #if __STDC__ >= 1
@@ -101,9 +87,6 @@
 #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> */
 #endif
@@ -203,7 +186,14 @@ struct colordesc {
     union tree *block;		/* block of solid color, if any */
 };
 
-/* the color map itself */
+/*
+ * The color map itself
+ *
+ * Much of the data in the colormap struct is only used at compile time.
+ * However, the bulk of the space usage is in the "tree" structure, so it's
+ * not clear that there's much point in converting the rest to a more compact
+ * form when compilation is finished.
+ */
 struct colormap {
     int magic;
 #define	CMMAGIC	0x876
@@ -259,12 +249,11 @@ struct cvec {
 struct state;
 
 struct arc {
-    int type;
-#define	ARCFREE	'\0'
+    int type;			/* 0 if free, else an NFA arc type code */
     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 */
+    struct arc *outchain;	/* link in *from's outs chain or free chain */
     struct arc *outchainRev;	/* back-link in *from's outs chain */
 #define	freechain outchain	/* we do not maintain "freechainRev" */
     struct arc *inchain;	/* *to's ins chain */
@@ -307,20 +296,28 @@ struct nfa {
     struct colormap *cm;	/* the color map */
     color bos[2];		/* colors, if any, assigned to BOS and BOL */
     color eos[2];		/* colors, if any, assigned to EOS and EOL */
-    size_t size;		/* Current NFA size; differs from nstates as
-				 * it also counts the number of states created
-				 * by children of this state. */
     struct vars *v;		/* simplifies compile error reporting */
     struct nfa *parent;		/* parent NFA, if any */
 };
 
 /*
  * definitions for compacted NFA
+ *
+ * The main space savings in a compacted NFA is from making the arcs as small
+ * as possible.  We store only the transition color and next-state number for
+ * each arc.  The list of out arcs for each state is an array beginning at
+ * cnfa.states[statenumber], and terminated by a dummy carc struct with
+ * co == COLORLESS.
+ *
+ * The non-dummy carc structs are of two types: plain arcs and LACON arcs.
+ * Plain arcs just store the transition color number as "co".  LACON arcs
+ * store the lookahead constraint number plus cnfa.ncolors as "co".  LACON
+ * arcs can be distinguished from plain by testing for co >= cnfa.ncolors.
  */
 
 struct carc {
     color co;			/* COLORLESS is list terminator */
-    int to;			/* state number */
+    int to;			/* next-state number */
 };
 
 struct cnfa {
@@ -332,27 +329,52 @@ struct cnfa {
     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 */
+    char *stflags;		/* vector of per-state flags bytes */
+#define CNFA_NOPROGRESS	01	/* flag bit for a no-progress state */
     struct carc **states;	/* vector of pointers to outarc lists */
+    /* states[n] are pointers into a single malloc'd array of arcs */
     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]
+ * This symbol limits the transient heap space used by the regex compiler,
+ * and thereby also the maximum complexity of NFAs that we'll deal with.
+ * Currently we only count NFA states and arcs against this; the other
+ * transient data is generally not large enough to notice compared to those.
+ * Note that we do not charge anything for the final output data structures
+ * (the compacted NFA and the colormap).
  */
-
-#ifndef REG_MAX_STATES
-#   define REG_MAX_STATES	100000
+#ifndef REG_MAX_COMPILE_SPACE
+#define REG_MAX_COMPILE_SPACE  \
+	(100000 * sizeof(struct state) + 100000 * sizeof(struct arcbatch))
 #endif
 
 /*
  * subexpression tree
+ *
+ * "op" is one of:
+ *	'='  plain regex without interesting substructure (implemented as DFA)
+ *	'b'  back-reference (has no substructure either)
+ *	'('  capture node: captures the match of its single child
+ *	'.'  concatenation: matches a match for left, then a match for right
+ *	'|'  alternation: matches a match for left or a match for right
+ *	'*'  iteration: matches some number of matches of its single child
+ *
+ * Note: the right child of an alternation must be another alternation or
+ * NULL; hence, an N-way branch requires N alternation nodes, not N-1 as you
+ * might expect.  This could stand to be changed.  Actually I'd rather see
+ * a single alternation node with N children, but that will take revising
+ * the representation of struct subre.
+ *
+ * Note: when a backref is directly quantified, we stick the min/max counts
+ * into the backref rather than plastering an iteration node on top.  This is
+ * for efficiency: there is no need to search for possible division points.
  */
 
 struct subre {
-    char op;			/* '|', '.' (concat), 'b' (backref), '(',
-				 * '=' */
+    char op;			/* see type codes above */
     char flags;
 #define	LONGER	01		/* prefers longer match */
 #define	SHORTER	02		/* prefers shorter match */
@@ -368,10 +390,10 @@ struct subre {
 #define	PREF(f)	((f)&NOPROP)
 #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 */
+    short id;			/* ID of subre (1..ntree-1) */
     int subno;			/* subexpression number (for 'b' and '(') */
-    short min;			/* min repetitions, for backref only */
-    short max;			/* max repetitions, for backref only */
+    short min;			/* min repetitions for iteration or backref */
+    short max;			/* max repetitions for iteration or backref */
     struct subre *left;		/* left child, if any (also freelist chain) */
     struct subre *right;	/* right child, if any */
     struct state *begin;	/* outarcs from here... */
@@ -386,7 +408,7 @@ struct subre {
  */
 
 struct fns {
-    VOID FUNCPTR(free, (regex_t *));
+    void FUNCPTR(free, (regex_t *));
 };
 
 /*
@@ -401,9 +423,9 @@ struct guts {
     size_t nsub;		/* copy of re_nsub */
     struct subre *tree;
     struct cnfa search;		/* for fast preliminary search */
-    int ntree;
+    int ntree;			/* number of subre's, plus one */
     struct colormap cmap;
-    int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
+    int FUNCPTR(compare, (const chr *, const chr *, size_t));
     struct subre *lacons;	/* lookahead-constraint vector */
     int nlacons;		/* size of lacons */
 };
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 92ccdcf..574b49b 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -21,6 +21,7 @@ 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
@@ -28,15 +29,15 @@ hooks {tclPlat tclInt tclIntPlat}
 
 declare 0 {
     int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
-	    const char *version, ClientData clientData)
+	    const char *version, const void *clientData)
 }
 declare 1 {
     CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
 	    const char *name, const char *version, int exact,
-	    ClientData *clientDataPtr)
+	    void *clientDataPtr)
 }
 declare 2 {
-    void Tcl_Panic(const char *format, ...)
+    TCL_NORETURN void Tcl_Panic(const char *format, ...)
 }
 declare 3 {
     char *Tcl_Alloc(unsigned int size)
@@ -70,13 +71,13 @@ declare 10 unix {
     void Tcl_DeleteFileHandler(int fd)
 }
 declare 11 {
-    void Tcl_SetTimer(Tcl_Time *timePtr)
+    void Tcl_SetTimer(const Tcl_Time *timePtr)
 }
 declare 12 {
     void Tcl_Sleep(int ms)
 }
 declare 13 {
-    int Tcl_WaitForEvent(Tcl_Time *timePtr)
+    int Tcl_WaitForEvent(const Tcl_Time *timePtr)
 }
 declare 14 {
     int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
@@ -92,7 +93,7 @@ declare 17 {
 }
 declare 18 {
     int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    Tcl_ObjType *typePtr)
+	    const Tcl_ObjType *typePtr)
 }
 declare 19 {
     void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line)
@@ -153,7 +154,7 @@ declare 35 {
 }
 declare 36 {
     int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    CONST84 char **tablePtr, const char *msg, int flags, int *indexPtr)
+	    CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
 }
 declare 37 {
     int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
@@ -165,7 +166,7 @@ declare 39 {
     int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
 }
 declare 40 {
-    Tcl_ObjType *Tcl_GetObjType(const char *typeName)
+    CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
 }
 declare 41 {
     char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
@@ -325,7 +326,7 @@ declare 87 {
 	    Tcl_Obj *const objv[])
 }
 declare 88 {
-    Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr,
+    Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
 	    const char *chanName, ClientData instanceData, int mask)
 }
 declare 89 {
@@ -479,7 +480,7 @@ declare 132 {
     void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
 }
 declare 133 {
-    void Tcl_Exit(int status)
+    TCL_NORETURN void Tcl_Exit(int status)
 }
 declare 134 {
     int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
@@ -565,7 +566,7 @@ declare 157 {
 	    const char *optionName, Tcl_DString *dsPtr)
 }
 declare 158 {
-    Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
+    CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
 }
 declare 159 {
     int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
@@ -750,7 +751,7 @@ declare 210 {
     void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
 }
 declare 211 {
-    void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
+    void Tcl_RegisterObjType(const Tcl_ObjType *typePtr)
 }
 declare 212 {
     Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern)
@@ -811,10 +812,10 @@ declare 228 {
     void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
 }
 declare 229 {
-    void Tcl_SetMaxBlockTime(Tcl_Time *timePtr)
+    void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
 }
 declare 230 {
-    void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
+    void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
 }
 declare 231 {
     int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
@@ -964,7 +965,7 @@ declare 271 {
 declare 272 {
     CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
 	    const char *name, const char *version, int exact,
-	    ClientData *clientDataPtr)
+	    void *clientDataPtr)
 }
 declare 273 {
     int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
@@ -985,7 +986,7 @@ declare 277 {
     Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
 }
 declare 278 {
-    void Tcl_PanicVA(const char *format, va_list argList)
+    TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
 }
 declare 279 {
     void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
@@ -1010,7 +1011,7 @@ declare 280 {
 
 declare 281 {
     Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
-	    Tcl_ChannelType *typePtr, ClientData instanceData,
+	    const Tcl_ChannelType *typePtr, ClientData instanceData,
 	    int mask, Tcl_Channel prevChan)
 }
 declare 282 {
@@ -1117,7 +1118,7 @@ declare 310 {
 }
 declare 311 {
     void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
-	    Tcl_Time *timePtr)
+	    const Tcl_Time *timePtr)
 }
 declare 312 {
     int Tcl_NumUtfChars(const char *src, int length)
@@ -1389,7 +1390,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)
 }
 
@@ -1493,15 +1494,15 @@ declare 420 {
 	    const Tcl_UniChar *uniPattern, int nocase)
 }
 declare 421 {
-    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const char *key)
+    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
 }
 declare 422 {
     Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
-	    const char *key, int *newPtr)
+	    const void *key, int *newPtr)
 }
 declare 423 {
     void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
-	    Tcl_HashKeyType *typePtr)
+	    const Tcl_HashKeyType *typePtr)
 }
 declare 424 {
     void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
@@ -1616,7 +1617,7 @@ declare 452 {
 	    int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
 }
 declare 453 {
-    const char **Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
+    const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
 	    Tcl_Obj **objPtrRef)
 }
 declare 454 {
@@ -1656,7 +1657,7 @@ declare 464 {
 }
 declare 465 {
     ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
-	    Tcl_Filesystem *fsPtr)
+	    const Tcl_Filesystem *fsPtr)
 }
 declare 466 {
     Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
@@ -1665,11 +1666,11 @@ declare 467 {
     int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
 }
 declare 468 {
-    Tcl_Obj *Tcl_FSNewNativePath(Tcl_Filesystem *fromFilesystem,
+    Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem,
 	    ClientData clientData)
 }
 declare 469 {
-    const char *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
+    const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
 }
 declare 470 {
     Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
@@ -1681,20 +1682,20 @@ declare 472 {
     Tcl_Obj *Tcl_FSListVolumes(void)
 }
 declare 473 {
-    int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
+    int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr)
 }
 declare 474 {
-    int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
+    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
 }
 declare 475 {
-    ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
+    ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
 }
 declare 476 {
     const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
 	    Tcl_Obj *pathPtr)
 }
 declare 477 {
-    Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
+    CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
 }
 declare 478 {
     Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
@@ -1705,7 +1706,7 @@ declare 479 {
     int Tcl_OutputBuffered(Tcl_Channel chan)
 }
 declare 480 {
-    void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
+    void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr)
 }
 
 # TIP#56 (evaluate a parsed script) msofer
@@ -1813,7 +1814,7 @@ declare 504 {
 # TIP#59 (configuration reporting) akupries
 declare 505 {
     void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName,
-	    Tcl_Config *configuration, const char *valEncoding)
+	    const Tcl_Config *configuration, const char *valEncoding)
 }
 
 # TIP #139 (partial exposure of namespace API - transferred from tclInt.decls)
@@ -1871,7 +1872,7 @@ declare 518 {
 
 # TIP#121 (exit handler) dkf for Joe Mistachkin
 declare 519 {
-    Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
+    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
 }
 
 # TIP#143 (resource limits) dkf
@@ -2083,7 +2084,7 @@ declare 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[], ClientData *clientDataPtr)
+	    int objc, Tcl_Obj *const objv[], void *clientDataPtr)
 }
 
 # TIP#270 (utility C routines for string formatting) dgp
@@ -2108,10 +2109,223 @@ declare 578 {
 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)
+}
+
+# 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)
+}
+
+# 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)
+}
+
+# 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)
+}
+
+# TIP#336 (manipulate the error line) dgp
+declare 605 {
+    int Tcl_GetErrorLine(Tcl_Interp *interp)
+}
+declare 606 {
+    void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum)
+}
+
+# TIP#307 (move results between interpreters) dkf
+declare 607 {
+    void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result,
+	    Tcl_Interp *targetInterp)
+}
+
+# TIP#335 (detect if interpreter in use) jmistachkin
+declare 608 {
+    int Tcl_InterpActive(Tcl_Interp *interp)
+}
+
+# TIP#337 (log exception for background processing) dgp
+declare 609 {
+    void Tcl_BackgroundException(Tcl_Interp *interp, int code)
+}
+
+# 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 617 {
+    int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle)
+}
+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)
+}
+
+# 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)
+}
+
+# TIP#332 (half-close made public) aferrieux
+declare 624 {
+    int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags)
+}
+
+# TIP #353 (NR-enabled expressions) dgp
+declare 625 {
+    int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr)
+}
+
+# TIP #356 (NR-enabled substitution) dgp
+declare 626 {
+    int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+}
+
+# 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)
+}
+declare 629 {
+    int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
+}
+
+# TIP #400
 declare 630 {
-    void TclUnusedStubEntry(void)
+    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
+	    Tcl_Obj *compressionDictionaryObj)
 }
 
+# ----- BASELINE -- FOR -- 8.6.0 ----- #
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface. These functions are only
@@ -2172,23 +2386,6 @@ export {
     void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
 }
 
-# Global variables that need to be exported from the tcl shared library.
-
-export {
-    TclStubs *tclStubsPtr                       (fool checkstubs)
-}
-export {
-    TclPlatStubs *tclPlatStubsPtr               (fool checkstubs)
-}
-export {
-    TclIntStubs *tclIntStubsPtr                 (fool checkstubs)
-}
-export {
-    TclIntPlatStubs *tclIntPlatStubsPtr         (fool checkstubs)
-}
-export {
-    TclTomMathStubs *tclTomMathStubsPtr         (fool checkstubs)
-}
 # Local Variables:
 # mode: tcl
 # End:
diff --git a/generic/tcl.h b/generic/tcl.h
index 64c4683..759f824 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -41,7 +41,6 @@ extern "C" {
  * 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)
  * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
  * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
@@ -51,44 +50,30 @@ extern "C" {
  * win/README		(not patchlevel) (sections 0 and 2)
  * unix/tcl.spec	(1 LOC patch)
  * tools/tcl.hpj.in	(not patchlevel, for windows installer)
- * tools/tcl.wse.in	(for windows installer)
- * tools/tclSplash.bmp	(not patchlevel)
  */
 
 #define TCL_MAJOR_VERSION   8
-#define TCL_MINOR_VERSION   5
+#define TCL_MINOR_VERSION   6
 #define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL  19
-
-#define TCL_VERSION	    "8.5"
-#define TCL_PATCH_LEVEL	    "8.5.19"
+#define TCL_RELEASE_SERIAL  6
 
+#define TCL_VERSION	    "8.6"
+#define TCL_PATCH_LEVEL	    "8.6.6"
+
 /*
+ *----------------------------------------------------------------------------
  * The following definitions set up the proper options for Windows compilers.
  * We use this method because there is no autoconf equivalent.
  */
 
-#ifndef __WIN32__
-#   if defined(_WIN32) || defined(WIN32) || defined(__MSVCRT__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
+#ifdef _WIN32
+#   ifndef __WIN32__
 #	define __WIN32__
-#	ifndef WIN32
-#	    define WIN32
-#	endif
-#	ifndef _WIN32
-#	    define _WIN32
-#	endif
 #   endif
-#endif
-
-/*
- * STRICT: See MSDN Article Q83456
- */
-
-#ifdef __WIN32__
-#   ifndef STRICT
-#	define STRICT
+#   ifndef WIN32
+#	define WIN32
 #   endif
-#endif /* __WIN32__ */
+#endif
 
 /*
  * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -139,6 +124,7 @@ extern "C" {
 #include <stdio.h>
 
 /*
+ *----------------------------------------------------------------------------
  * Support for functions with a variable number of arguments.
  *
  * The following TCL_VARARGS* macros are to support old extensions
@@ -154,8 +140,43 @@ extern "C" {
 #    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)))
+#   define TCL_NORETURN __attribute__ ((noreturn))
+#   if defined(BUILD_tcl) || defined(BUILD_tk)
+#	define TCL_NORETURN1 __attribute__ ((noreturn))
+#   else
+#	define TCL_NORETURN1 /* nothing */
+#   endif
+#else
+#   define TCL_FORMAT_PRINTF(a,b)
+#   if defined(_MSC_VER) && (_MSC_VER >= 1310)
+#	define TCL_NORETURN _declspec(noreturn)
+#   else
+#	define TCL_NORETURN /* nothing */
+#   endif
+#   define TCL_NORETURN1 /* nothing */
+#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.
+ */
+
+#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
+#else
+#   define TCL_DEPRECATED_API(msg)	/* nothing portable */
+#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
@@ -168,7 +189,7 @@ extern "C" {
  *       MSVCRT.
  */
 
-#if (defined(__WIN32__) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
 #   define HAVE_DECLSPEC 1
 #   ifdef STATIC_BUILD
 #       define DLLIMPORT
@@ -221,26 +242,34 @@ 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 like function prototypes.
+ * ANSI C features.
  */
 
-#undef _ANSI_ARGS_
-#undef CONST
 #ifndef INLINE
 #   define INLINE
 #endif
 
-#ifndef NO_CONST
-#   define CONST const
-#else
-#   define CONST
+#ifdef NO_CONST
+#   ifndef const
+#      define const
+#   endif
 #endif
-
-#ifndef NO_PROTOTYPES
-#   define _ANSI_ARGS_(x)	x
-#else
-#   define _ANSI_ARGS_(x)	()
+#ifndef CONST
+#   define CONST const
 #endif
 
 #ifdef USE_NON_CONST
@@ -252,13 +281,17 @@ 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.
  */
@@ -274,19 +307,20 @@ 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.
  */
 
-#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
+#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
 #ifndef VOID
 #define VOID void
 typedef char CHAR;
 typedef short SHORT;
 typedef long LONG;
 #endif
-#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
+#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
 
 /*
  * Macro to use instead of "void" for arguments that must have type "void *"
@@ -338,8 +372,8 @@ typedef long LONG;
  * 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
+ *	LP64 system such as modern Solaris or Linux ... not including Win64)
  * Tcl_WideAsLong - forgetful converter from wideInt to long.
  * Tcl_LongAsWide - sign-extending converter from long to wideInt.
  * Tcl_WideAsDouble - converter from wideInt to double.
@@ -354,7 +388,7 @@ typedef long LONG;
  */
 
 #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-#   if defined(__WIN32__)
+#   if defined(_WIN32)
 #      define TCL_WIDE_INT_TYPE __int64
 #      ifdef __BORLANDC__
 #         define TCL_LL_MODIFIER	"L"
@@ -364,22 +398,18 @@ typedef long LONG;
 #   elif defined(__GNUC__)
 #      define TCL_WIDE_INT_TYPE long long
 #      define TCL_LL_MODIFIER	"ll"
-#   else /* ! __WIN32__ && ! __GNUC__ */
+#   else /* ! _WIN32 && ! __GNUC__ */
 /*
  * 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
-#      else /* !NO_LIMITS_H */
-#	  include <limits.h>
-#	  if (INT_MAX < LONG_MAX)
-#	     define TCL_WIDE_INT_IS_LONG	1
-#	  else
-#	     define TCL_WIDE_INT_TYPE long long
-#         endif
-#      endif /* NO_LIMITS_H */
-#   endif /* __WIN32__ */
+#      include <limits.h>
+#      if (INT_MAX < LONG_MAX)
+#         define TCL_WIDE_INT_IS_LONG	1
+#      else
+#         define TCL_WIDE_INT_TYPE long long
+#      endif
+#   endif /* _WIN32 */
 #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
 #ifdef TCL_WIDE_INT_IS_LONG
 #   undef TCL_WIDE_INT_TYPE
@@ -411,7 +441,7 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #   define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
 #endif /* TCL_WIDE_INT_IS_LONG */
 
-#if defined(__WIN32__)
+#if defined(_WIN32)
 #   ifdef __BORLANDC__
 	typedef struct stati64 Tcl_StatBuf;
 #   elif defined(_WIN64)
@@ -445,6 +475,7 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #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.
@@ -463,10 +494,17 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
  * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
  */
 
-typedef struct Tcl_Interp {
-    char *result;		/* If the last command returned a string
+typedef struct Tcl_Interp
+#ifndef TCL_NO_DEPRECATED
+{
+    /* TIP #330: Strongly discourage extensions from using the string
+     * result. */
+#ifdef USE_INTERP_RESULT
+    char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
+				/* If the last command returned a string
 				 * result, this points to it. */
-    void (*freeProc) _ANSI_ARGS_((char *blockPtr));
+    void (*freeProc) (char *blockPtr)
+	    TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
 				/* Zero means the string result is statically
 				 * allocated. TCL_DYNAMIC means it was
 				 * allocated with ckalloc and should be freed
@@ -474,10 +512,21 @@ typedef struct Tcl_Interp {
 				 * of function to invoke to free the result.
 				 * Tcl_Eval must free it before executing next
 				 * command. */
-    int errorLine;		/* When TCL_ERROR is returned, this gives the
+#else
+    char *resultDontUse; /* Don't use in extensions! */
+    void (*freeProcDontUse) (char *); /* Don't use in extensions! */
+#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). */
-} Tcl_Interp;
+#else
+    int errorLineDontUse; /* Don't use in extensions! */
+#endif
+}
+#endif /* TCL_NO_DEPRECATED */
+Tcl_Interp;
 
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
 typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -498,17 +547,19 @@ 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;
 
 /*
+ *----------------------------------------------------------------------------
  * Definition of the interface to functions implementing threads. A function
  * following this definition is given to each call of 'Tcl_CreateThread' and
  * will be called as the main fuction of the new thread created by that call.
  */
 
-#if defined __WIN32__
-typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#if defined _WIN32
+typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
 #else
-typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
 #endif
 
 /*
@@ -517,7 +568,7 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
  * in generic/tclThreadTest.c for it's usage.
  */
 
-#if defined __WIN32__
+#if defined _WIN32
 #   define Tcl_ThreadCreateType		unsigned __stdcall
 #   define TCL_THREAD_CREATE_RETURN	return 0
 #else
@@ -598,6 +649,7 @@ 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
@@ -626,6 +678,7 @@ typedef struct stat *Tcl_OldStat_;
 #define TCL_RESULT_SIZE		200
 
 /*
+ *----------------------------------------------------------------------------
  * Flags to control what substitutions are performed by Tcl_SubstObj():
  */
 
@@ -658,84 +711,78 @@ typedef struct Tcl_Value {
 struct Tcl_Obj;
 
 /*
+ *----------------------------------------------------------------------------
  * Function 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 int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	int flags));
-typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...));
-typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
-	Tcl_Channel chan, char *address, int port));
-typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
-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));
-
+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);
+
 /*
+ *----------------------------------------------------------------------------
  * The following structure represents a type of object, which is a particular
  * internal representation for an object plus a set of functions that provide
  * standard operations on objects of that type.
  */
 
 typedef struct Tcl_ObjType {
-    char *name;			/* Name of the type, e.g. "int". */
+    const 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
@@ -773,24 +820,28 @@ typedef struct Tcl_Obj {
 				 * array as a readonly value. */
     int length;			/* The number of bytes at *bytes, not
 				 * including the terminating null. */
-    Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
+    const 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). */
     union {			/* The internal representation: */
 	long longValue;		/*   - an long integer value. */
 	double doubleValue;	/*   - a double-precision floating value. */
-	VOID *otherValuePtr;	/*   - another, type-specific value. */
+	void *otherValuePtr;	/*   - another, type-specific value,
+	                       not used internally any more. */
 	Tcl_WideInt wideValue;	/*   - a long long value. */
-	struct {		/*   - internal rep as two pointers. */
-	    VOID *ptr1;
-	    VOID *ptr2;
+	struct {		/*   - internal rep as two pointers.
+				 *     the main use of which is a bignum's
+				 *     tightly packed fields, where the alloc,
+				 *     used and signum flags are packed into
+				 *     ptr2 with everything else hung off ptr1. */
+	    void *ptr1;
+	    void *ptr2;
 	} twoPtrValue;
-	struct {		/*   - internal rep as a wide int, tightly
-				 *     packed fields. */
-	    VOID *ptr;		/* Pointer to digits. */
-	    unsigned long value;/* Alloc, used, and signum packed into a
-				 * single word. */
+	struct {		/*   - internal rep as a pointer and a long,
+	                       not used internally any more. */
+	    void *ptr;
+	    unsigned long value;
 	} ptrAndLongRep;
     } internalRep;
 } Tcl_Obj;
@@ -803,11 +854,12 @@ typedef struct Tcl_Obj {
  * made public in tcl.h to support Tcl_DecrRefCount's macro definition.
  */
 
-void		Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
-void		Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
-int		Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
-
+void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
+void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
+int		Tcl_IsShared(Tcl_Obj *objPtr);
+
 /*
+ *----------------------------------------------------------------------------
  * 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.
@@ -824,6 +876,7 @@ 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).
@@ -848,6 +901,7 @@ typedef struct Tcl_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
@@ -873,20 +927,21 @@ 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.
@@ -922,6 +977,7 @@ typedef struct Tcl_CmdInfo {
 } 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.
@@ -982,6 +1038,7 @@ 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!
@@ -995,11 +1052,19 @@ typedef struct Tcl_DString {
  *				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.
  */
-#define TCL_NO_EVAL		0x10000
-#define TCL_EVAL_GLOBAL		0x20000
-#define TCL_EVAL_DIRECT		0x40000
-#define TCL_EVAL_INVOKE		0x80000
+
+#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
 
 /*
  * Special freeProc values that may be passed to Tcl_SetResult (see the man
@@ -1012,6 +1077,8 @@ typedef struct Tcl_DString {
 
 /*
  * Flag values passed to variable-related functions.
+ * WARNING: these bit choices must not conflict with the bit choice for
+ * TCL_CANCEL_UNWIND, above.
  */
 
 #define TCL_GLOBAL_ONLY		 1
@@ -1026,10 +1093,10 @@ 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
 
@@ -1045,8 +1112,8 @@ typedef struct Tcl_DString {
  * Flag values passed to command-related functions.
  */
 
-#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
 
@@ -1080,8 +1147,9 @@ typedef struct Tcl_DString {
 #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.
  */
 
@@ -1089,13 +1157,11 @@ typedef struct Tcl_HashKeyType Tcl_HashKeyType;
 typedef struct Tcl_HashTable Tcl_HashTable;
 typedef struct Tcl_HashEntry Tcl_HashEntry;
 
-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));
+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);
 
 /*
  * This flag controls whether the hash table stores the hash of a key, or
@@ -1119,7 +1185,7 @@ struct Tcl_HashEntry {
 				 * 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
+    void *hash;			/* Hash value, stored as pointer to ensure
 				 * that the offsets of the fields in this
 				 * structure are not changed. */
 #else
@@ -1135,7 +1201,7 @@ struct Tcl_HashEntry {
 	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
+	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!! */
 };
@@ -1230,11 +1296,11 @@ struct Tcl_HashTable {
 				 * TCL_ONE_WORD_KEYS, or an integer giving the
 				 * number of ints that is the size of the
 				 * key. */
-    Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-	    CONST char *key));
-    Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
-	    CONST char *key, int *newPtr));
-    Tcl_HashKeyType *typePtr;	/* Type of the keys used in the
+    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. */
 };
 
@@ -1272,10 +1338,10 @@ typedef struct Tcl_HashSearch {
  * accessed from the entry and not the behaviour.
  */
 
-#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_STRING_KEYS		(0)
+#define TCL_ONE_WORD_KEYS	(1)
+#define TCL_CUSTOM_TYPE_KEYS	(-2)
+#define TCL_CUSTOM_PTR_KEYS	(-1)
 
 /*
  * Structure definition for information used to keep track of searches through
@@ -1290,8 +1356,9 @@ typedef struct {
 				 * or -1 if search has terminated. */
     Tcl_Dict dictionaryPtr;	/* Reference to dictionary being searched. */
 } Tcl_DictSearch;
-
+
 /*
+ *----------------------------------------------------------------------------
  * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of
  * events:
  */
@@ -1344,19 +1411,18 @@ typedef struct Tcl_Time {
     long usec;			/* Microseconds. */
 } Tcl_Time;
 
-typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
-typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
+typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
+typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
 
 /*
  * TIP #233 (Virtualized Time)
  */
 
-typedef void (Tcl_GetTimeProc)   _ANSI_ARGS_((Tcl_Time *timebuf,
-	ClientData clientData));
-typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_((Tcl_Time *timebuf,
-	ClientData clientData));
+typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, ClientData clientData);
+typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
 
 /*
+ *----------------------------------------------------------------------------
  * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
  * indicate what sorts of events are of interest:
  */
@@ -1412,45 +1478,41 @@ typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_((Tcl_Time *timebuf,
  * Typedefs for the various operations in a channel type:
  */
 
-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));
+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) _ANSI_ARGS_ ((
-		    ClientData instanceData, int action));
+typedef void	(Tcl_DriverThreadActionProc) (ClientData instanceData,
+			int action);
 /*
  * TIP #208, File Truncation (etc.)
  */
-typedef int	(Tcl_DriverTruncateProc) _ANSI_ARGS_((
-		    ClientData instanceData, Tcl_WideInt length));
+typedef int	(Tcl_DriverTruncateProc) (ClientData instanceData,
+			Tcl_WideInt length);
 
 /*
  * struct Tcl_ChannelType:
@@ -1464,7 +1526,7 @@ typedef int	(Tcl_DriverTruncateProc) _ANSI_ARGS_((
  */
 
 typedef struct Tcl_ChannelType {
-    char *typeName;		/* The name of the channel type in Tcl
+    const char *typeName;	/* The name of the channel type in Tcl
 				 * commands. This storage is owned by channel
 				 * type. */
     Tcl_ChannelTypeVersion version;
@@ -1523,7 +1585,6 @@ typedef struct Tcl_ChannelType {
 				/* 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.
@@ -1545,6 +1606,7 @@ typedef struct Tcl_ChannelType {
 					 * mode. */
 
 /*
+ *----------------------------------------------------------------------------
  * Enum for different types of file paths.
  */
 
@@ -1596,71 +1658,60 @@ typedef struct Tcl_GlobTypeData {
  * Typedefs for the various filesystem operations:
  */
 
-typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
-typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
-typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((
-	Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions));
-typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern,
-	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));
+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);
 /* We have to declare the utime structure here. */
 struct utimbuf;
-typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
-	struct utimbuf *tval));
-typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp,
-	Tcl_Obj *pathPtr, int nextCheckpoint));
-typedef int (Tcl_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 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 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)
 
 /*
@@ -1677,7 +1728,7 @@ typedef struct Tcl_FSVersion_ *Tcl_FSVersion;
  */
 
 typedef struct Tcl_Filesystem {
-    CONST char *typeName;	/* The name of the 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. */
@@ -1839,6 +1890,7 @@ typedef struct Tcl_Filesystem {
 #define TCL_CREATE_HARD_LINK		0x02
 
 /*
+ *----------------------------------------------------------------------------
  * The following structure represents the Notifier functions that you can
  * override with the Tcl_SetNotifier call.
  */
@@ -1853,73 +1905,11 @@ 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;
-				/* 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 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.
@@ -1928,7 +1918,7 @@ typedef struct Tcl_EncodingType {
 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. */
+    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
@@ -2042,13 +2032,13 @@ typedef struct Tcl_Token {
 #define NUM_STATIC_TOKENS 20
 
 typedef struct Tcl_Parse {
-    CONST char *commentStart;	/* Pointer to # that begins the first of one
+    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 *commandStart;	/* First character in first word of
 				 * command. */
     int commandSize;		/* Number of bytes in command, including first
 				 * character of first word, up through the
@@ -2072,13 +2062,13 @@ typedef struct Tcl_Parse {
      * They should not be used by functions 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
+    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
+    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
@@ -2095,6 +2085,85 @@ typedef struct Tcl_Parse {
 				 * 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.
+ * TCL_ENCODING_NO_TERMINATE - 	If set, Tcl_ExternalToUtf will not append a
+ *				terminating NUL byte.  Knowing that it will
+ *				not need space to do so, it will fill all
+ *				dstLen bytes with encoded UTF-8 content, as
+ *				other circumstances permit.  If clear, the
+ *				default behavior is to reserve a byte in
+ *				the dst space for NUL termination, and to
+ *				append the NUL byte.
+ * TCL_ENCODING_CHAR_LIMIT -	If set and dstCharsPtr is not NULL, then
+ *				Tcl_ExternalToUtf takes the initial value
+ *				of *dstCharsPtr is taken as a limit of the
+ *				maximum number of chars to produce in the
+ *				encoded UTF-8 content.  Otherwise, the
+ *				number of chars produced is controlled only
+ *				by other limiting factors.
+ */
+
+#define TCL_ENCODING_START		0x01
+#define TCL_ENCODING_END		0x02
+#define TCL_ENCODING_STOPONERROR	0x04
+#define TCL_ENCODING_NO_TERMINATE	0x08
+#define TCL_ENCODING_CHAR_LIMIT		0x10
 
 /*
  * The following definitions are the error codes returned by the conversion
@@ -2124,19 +2193,19 @@ typedef struct Tcl_Parse {
  *				TCL_ENCODING_STOPONERROR was specified.
  */
 
-#define TCL_CONVERT_MULTIBYTE	-1
-#define TCL_CONVERT_SYNTAX	-2
-#define TCL_CONVERT_UNKNOWN	-3
-#define TCL_CONVERT_NOSPACE	-4
+#define TCL_CONVERT_MULTIBYTE	(-1)
+#define TCL_CONVERT_SYNTAX	(-2)
+#define TCL_CONVERT_UNKNOWN	(-3)
+#define TCL_CONVERT_NOSPACE	(-4)
 
 /*
  * The maximum number of bytes that are necessary to represent a single
- * Unicode character in UTF-8. The valid values should be 3 or 6 (or perhaps 1
- * if we want to support a non-unicode enabled core). If 3, then Tcl_UniChar
- * must be 2-bytes in size (UCS-2) (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, 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.
  */
 
 #ifndef TCL_UTF_MAX
@@ -2162,20 +2231,22 @@ 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
+    const char *key;		/* Configuration key to register. ASCII
 				 * encoded, thus UTF-8. */
-    CONST char *value;		/* The value associated with the key. System
+    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.
  */
@@ -2188,9 +2259,13 @@ typedef struct Tcl_Config {
  * command- or time-limit is exceeded by an interpreter.
  */
 
-typedef void (Tcl_LimitHandlerProc) _ANSI_ARGS_((ClientData clientData,
-	Tcl_Interp *interp));
-typedef void (Tcl_LimitHandlerDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef 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
@@ -2198,6 +2273,122 @@ 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.
+ */
+
+#define TCL_ZLIB_NO_FLUSH	0
+#define TCL_ZLIB_FLUSH		2
+#define TCL_ZLIB_FULLFLUSH	3
+#define TCL_ZLIB_FINALIZE	4
+
+/*
+ *----------------------------------------------------------------------------
+ * Definitions needed for the Tcl_LoadFile function. [TIP #416]
+ */
+
+#define TCL_LOAD_GLOBAL 1
+#define TCL_LOAD_LAZY 2
+
+/*
+ *----------------------------------------------------------------------------
+ * Single public declaration for NRE.
+ */
+
+typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
+				int result);
+
+/*
+ *----------------------------------------------------------------------------
  * The following constant is used to test for older versions of Tcl in the
  * stubs tables.
  *
@@ -2214,42 +2405,39 @@ typedef unsigned int mp_digit;
  * main library in case an extension is statically linked into an application.
  */
 
-EXTERN CONST char *	Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *version, int exact));
-EXTERN CONST char *	TclTomMathInitializeStubs _ANSI_ARGS_((
-			    Tcl_Interp *interp, CONST char *version,
-			    int epoch, int revision));
-
-#ifndef USE_TCL_STUBS
+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.
  */
 
+#ifndef USE_TCL_STUBS
 #define Tcl_InitStubs(interp, version, exact) \
     Tcl_PkgInitStubsCheck(interp, version, exact)
-
 #endif
 
-    /*
-     * TODO - tommath stubs export goes here!
-     */
-
+/*
+ * TODO - tommath stubs export goes here!
+ */
 
 /*
  * Public functions that are not accessible via the stubs table.
  * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
  */
 
-EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv,
-			    Tcl_AppInitProc *appInitProc));
-EXTERN CONST char *	Tcl_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *version, int exact));
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
-#endif
-
+#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
+	    ((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);
+EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
+
 /*
+ *----------------------------------------------------------------------------
  * Include the public function declarations that are accessible via the stubs
  * table.
  */
@@ -2258,12 +2446,19 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 
 /*
  * Include platform specific public function declarations that are accessible
- * via the stubs table.
+ * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only
+ * has effect on building it as a shared library). See ticket [3010352].
  */
 
+#if defined(BUILD_tcl)
+#   undef TCLAPI
+#   define TCLAPI MODULE_SCOPE
+#endif
+
 #include "tclPlatDecls.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.
@@ -2271,11 +2466,16 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 
 #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__)
+#   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 */
 
@@ -2285,11 +2485,16 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
  * 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 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
@@ -2316,7 +2521,7 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 #   define Tcl_DecrRefCount(objPtr) \
 	do { \
 	    Tcl_Obj *_objPtr = (objPtr); \
-	    if (--(_objPtr)->refCount <= 0) { \
+	    if ((_objPtr)->refCount-- <= 1) { \
 		TclFreeObj(_objPtr); \
 	    } \
 	} while(0)
@@ -2364,13 +2569,14 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 #endif /* TCL_MEM_DEBUG */
 
 /*
+ *----------------------------------------------------------------------------
  * Macros for clients to use to access fields of hash entries:
  */
 
 #define Tcl_GetHashValue(h) ((h)->clientData)
 #define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
 #define Tcl_GetHashKey(tablePtr, h) \
-	((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
+	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
 		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
 		   ? (h)->key.oneWordValue \
 		   : (h)->key.string))
@@ -2382,12 +2588,13 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 
 #undef  Tcl_FindHashEntry
 #define Tcl_FindHashEntry(tablePtr, key) \
-	(*((tablePtr)->findProc))(tablePtr, key)
+	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
 #undef  Tcl_CreateHashEntry
 #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
-	(*((tablePtr)->createProc))(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.
  */
@@ -2407,11 +2614,16 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 #define Tcl_ConditionFinalize(condPtr)
 #endif /* TCL_THREADS */
 
+/*
+ *----------------------------------------------------------------------------
+ * Deprecated Tcl functions:
+ */
+
 #ifndef TCL_NO_DEPRECATED
-    /*
-     * These function have been renamed. The old names are deprecated, but we
-     * define these macros for backwards compatibilty.
-     */
+/*
+ * These function have been renamed. The old names are deprecated, but we
+ * define these macros for backwards compatibilty.
+ */
 
 #   define Tcl_Ckalloc		Tcl_Alloc
 #   define Tcl_Ckfree		Tcl_Free
@@ -2422,21 +2634,16 @@ EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
 #   define panic		Tcl_Panic
 #endif
 #   define panicVA		Tcl_PanicVA
-#endif
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
+ *----------------------------------------------------------------------------
  * Convenience declaration of Tcl_AppInit for backwards compatibility. This
  * function is not *implemented* by the tcl library, so the storage class is
  * neither DLLEXPORT nor DLLIMPORT.
  */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS
-
-EXTERN int		Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
+extern Tcl_AppInitProc Tcl_AppInit;
 
 #endif /* RC_INVOKED */
 
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 675e1a4..cda1f38 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -72,7 +72,7 @@ union overhead {
 #define RMAGIC		0x5555	/* magic # on range info */
 
 #ifndef NDEBUG
-#define	RSLOP		sizeof (unsigned short)
+#define	RSLOP		sizeof(unsigned short)
 #else
 #define	RSLOP		0
 #endif
@@ -134,7 +134,6 @@ static int allocInit = 0;
  */
 
 static	unsigned int numMallocs[NBUCKETS+1];
-#include <stdio.h>
 #endif
 
 #if !defined(NDEBUG)
@@ -149,7 +148,7 @@ static	unsigned int numMallocs[NBUCKETS+1];
  * Prototypes for functions used only in this file.
  */
 
-static void 		MoreCore(int bucket);
+static void		MoreCore(int bucket);
 
 /*
  *-------------------------------------------------------------------------
@@ -458,7 +457,7 @@ TclpFree(
     }
 
     Tcl_MutexLock(allocMutexPtr);
-    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));
+    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
 
     ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
     ASSERT(overPtr->overMagic1 == MAGIC);
@@ -527,7 +526,7 @@ TclpRealloc(
 
     Tcl_MutexLock(allocMutexPtr);
 
-    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));
+    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
 
     ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
     ASSERT(overPtr->overMagic1 == MAGIC);
@@ -697,7 +696,7 @@ char *
 TclpAlloc(
     unsigned int numBytes)	/* Number of bytes to allocate. */
 {
-    return (char*) malloc(numBytes);
+    return (char *) malloc(numBytes);
 }
 
 /*
@@ -745,7 +744,7 @@ TclpRealloc(
     char *oldPtr,		/* Pointer to alloced block. */
     unsigned int numBytes)	/* New size of memory. */
 {
-    return (char*) realloc(oldPtr, numBytes);
+    return (char *) realloc(oldPtr, numBytes);
 }
 
 #endif /* !USE_TCLALLOC */
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
new file mode 100644
index 0000000..120fd9a
--- /dev/null
+++ b/generic/tclAssembly.c
@@ -0,0 +1,4351 @@
+/*
+ * 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, expandDrop
+ *-   dictFirst, dictNext, dictDone
+ *-   dictUpdateStart, dictUpdateEnd
+ *-   jumpTable testing
+ *-   syntax (?)
+ *-   returnCodeBranch
+ *-   tclooNext, tclooNextClass
+ */
+
+#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_CLOCK_READ,		/* 1-byte unsigned-integer case number, in the
+				 * range 0-3 */
+    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*,
+			    const 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 */
+};
+
+/*
+ * Source instructions recognized in the Tcl Assembly Language (TAL)
+ */
+
+static const 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},
+    {"arrayExistsImm",	ASSEM_LVT4,	INST_ARRAY_EXISTS_IMM,	0,	1},
+    {"arrayExistsStk",	ASSEM_1BYTE,	INST_ARRAY_EXISTS_STK,	1,	1},
+    {"arrayMakeImm",	ASSEM_LVT4,	INST_ARRAY_MAKE_IMM,	0,	0},
+    {"arrayMakeStk",	ASSEM_1BYTE,	INST_ARRAY_MAKE_STK,	1,	0},
+    {"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},
+    {"clockRead",	ASSEM_CLOCK_READ, INST_CLOCK_READ,	0,	1},
+    {"concat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
+    {"concatStk",	ASSEM_LIST,	INST_CONCAT_STK,	INT_MIN,1},
+    {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
+    {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
+    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
+    {"dictExists",	ASSEM_DICT_GET, INST_DICT_EXISTS,	INT_MIN,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_STK,		2,	1},
+    {"incrStkImm",	ASSEM_SINT1,	INST_INCR_STK_IMM,	1,	1},
+    {"infoLevelArgs",	ASSEM_1BYTE,	INST_INFO_LEVEL_ARGS,	1,	1},
+    {"infoLevelNumber",	ASSEM_1BYTE,	INST_INFO_LEVEL_NUM,	0,	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},
+    {"lappendList",	ASSEM_LVT4,	INST_LAPPEND_LIST,	1,	1},
+    {"lappendListArray",ASSEM_LVT4,	INST_LAPPEND_LIST_ARRAY,2,	1},
+    {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3,	1},
+    {"lappendListStk",	ASSEM_1BYTE,	INST_LAPPEND_LIST_STK,	2,	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},
+    {"listConcat",	ASSEM_1BYTE,	INST_LIST_CONCAT,	2,	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_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},
+    {"numericType",	ASSEM_1BYTE,	INST_NUM_TYPE,		1,	1},
+    {"originCmd",	ASSEM_1BYTE,	INST_ORIGIN_COMMAND,	1,	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},
+    {"resolveCmd",	ASSEM_1BYTE,	INST_RESOLVE_COMMAND,	1,	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_STK,		2,	1},
+    {"strcaseLower",	ASSEM_1BYTE,	INST_STR_LOWER,		1,	1},
+    {"strcaseTitle",	ASSEM_1BYTE,	INST_STR_TITLE,		1,	1},
+    {"strcaseUpper",	ASSEM_1BYTE,	INST_STR_UPPER,		1,	1},
+    {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
+    {"strcat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
+    {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
+    {"strfind",		ASSEM_1BYTE,	INST_STR_FIND,		2,	1},
+    {"strindex",	ASSEM_1BYTE,	INST_STR_INDEX,		2,	1},
+    {"strlen",		ASSEM_1BYTE,	INST_STR_LEN,		1,	1},
+    {"strmap",		ASSEM_1BYTE,	INST_STR_MAP,		3,	1},
+    {"strmatch",	ASSEM_BOOL,	INST_STR_MATCH,		2,	1},
+    {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
+    {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
+    {"strreplace",	ASSEM_1BYTE,	INST_STR_REPLACE,	4,	1},
+    {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
+    {"strtrim",		ASSEM_1BYTE,	INST_STR_TRIM,		2,	1},
+    {"strtrimLeft",	ASSEM_1BYTE,	INST_STR_TRIM_LEFT,	2,	1},
+    {"strtrimRight",	ASSEM_1BYTE,	INST_STR_TRIM_RIGHT,	2,	1},
+    {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
+    {"tclooClass",	ASSEM_1BYTE,	INST_TCLOO_CLASS,	1,	1},
+    {"tclooIsObject",	ASSEM_1BYTE,	INST_TCLOO_IS_OBJECT,	1,	1},
+    {"tclooNamespace",	ASSEM_1BYTE,	INST_TCLOO_NS,		1,	1},
+    {"tclooSelf",	ASSEM_1BYTE,	INST_TCLOO_SELF,	0,	1},
+    {"tryCvtToBoolean",	ASSEM_1BYTE,	INST_TRY_CVT_TO_BOOLEAN,1,	2},
+    {"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},
+    {"verifyDict",	ASSEM_1BYTE,	INST_DICT_VERIFY,	1,	0},
+    {"yield",		ASSEM_1BYTE,	INST_YIELD,		1,	1},
+    {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_LIST,							/* 79 */
+    INST_OVER,							/* 95 */
+    INST_PUSH_RETURN_OPTIONS,					/* 108 */
+    INST_REVERSE,						/* 126 */
+    INST_NOP,							/* 132 */
+    INST_STR_MAP,						/* 143 */
+    INST_STR_FIND,						/* 144 */
+    INST_COROUTINE_NAME,					/* 149 */
+    INST_NS_CURRENT,						/* 151 */
+    INST_INFO_LEVEL_NUM,					/* 152 */
+    INST_RESOLVE_COMMAND,					/* 154 */
+    INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 166-168 */
+    INST_CONCAT_STK,						/* 169 */
+    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE,		/* 170-172 */
+    INST_NUM_TYPE						/* 180 */
+};
+
+/*
+ * 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);
+    TclUpdateAtCmdStart(op, envPtr);
+    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);
+    }
+    TclUpdateAtCmdStart(op, envPtr);
+    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_AppendObjToErrorInfo(interp, objv[0]);
+	Tcl_AddErrorInfo(interp, "\" body, line ");
+	backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
+	Tcl_AppendObjToErrorInfo(interp, 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 */
+    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 */
+
+
+    /*
+     * 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.twoPtrValue.ptr1;
+	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.
+	 */
+	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.twoPtrValue.ptr1;
+    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 */
+
+    int numCommands = envPtr->numCommands;
+    int offset = envPtr->codeNext - envPtr->codeStart;
+    int depth = envPtr->currStackDepth;
+
+    /*
+     * 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 convert any error from the compilation into
+     * bytecode reporting the error;
+     */
+
+    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
+	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {
+
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"%.*s\" body, line %d)",
+		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
+		Tcl_GetErrorLine(interp)));
+	envPtr->numCommands = numCommands;
+	envPtr->codeNext = envPtr->codeStart + offset;
+	envPtr->currStackDepth = depth;
+	TclCompileSyntaxError(interp, envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 */
+    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);
+
+	/*
+	 * Report errors in the parse.
+	 */
+
+	if (status != TCL_OK) {
+	    if (flags & TCL_EVAL_DIRECT) {
+		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
+			parsePtr->term + 1 - parsePtr->commandStart);
+	    }
+	    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) {
+	    int instLen = parsePtr->commandSize;
+		    /* Length in bytes of the current command */
+
+	    if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+		--instLen;
+	    }
+
+	    /*
+	     * 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 = 1;
+    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_CLOCK_READ:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	if (opnd < 0 || opnd > 3) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("operand must be [0..3]", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL);
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
+	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 */
+    const 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->catchDepth = 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 = TclFetchAuxData(envPtr, auxDataIndex);
+    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;
+	if (catches[catchDepth] != NULL) {
+	    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_AppendObjToErrorInfo(interp, lineNo);
+    Tcl_AddErrorInfo(interp, " and ");
+    if (bbPtr->successor1 != NULL) {
+	Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
+	Tcl_AppendObjToErrorInfo(interp, 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.twoPtrValue.ptr1;
+
+    codePtr->refCount--;
+    if (codePtr->refCount <= 0) {
+	TclCleanupByteCode(codePtr);
+    }
+    objPtr->typePtr = NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index ca18f5e..14804e4 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -118,7 +118,7 @@ Tcl_AsyncCreate(
     AsyncHandler *asyncPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
+    asyncPtr = ckalloc(sizeof(AsyncHandler));
     asyncPtr->ready = 0;
     asyncPtr->nextPtr = NULL;
     asyncPtr->proc = proc;
@@ -235,7 +235,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;
@@ -260,7 +260,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.
  *
@@ -310,7 +310,7 @@ Tcl_AsyncDelete(
 	}
     }
     Tcl_MutexUnlock(&tsdPtr->asyncMutex);
-    ckfree((char *) asyncPtr);
+    ckfree(asyncPtr);
 }
 
 /*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 44cf543..0486383 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -10,17 +10,22 @@
  * 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.
  */
 
 #include "tclInt.h"
+#include "tclOOInt.h"
 #include "tclCompile.h"
-#include <float.h>
-#include <limits.h>
-#include <math.h>
 #include "tommath.h"
+#include <math.h>
+#include <assert.h>
+
+#define INTERP_STACK_INITIAL_SIZE 2000
+#define CORO_STACK_INITIAL_SIZE    200
 
 /*
  * Determine whether we're using IEEE floating point
@@ -45,59 +50,128 @@ typedef struct OldMathFuncData {
 } 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.
+ */
+
+#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	CheckDoubleResult(Tcl_Interp *interp, double dResult);
-static void	DeleteInterpProc(Tcl_Interp *interp);
-static void	DeleteOpCmdClientData(ClientData clientData);
-static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
-	            int numChars, int objc, Tcl_Obj *const objv[]);
-static void	ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
-static int	OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static void	OldMathFuncDeleteProc(ClientData clientData);
-static int	ExprAbsFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprBoolFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprCeilFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprEntierFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprFloorFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprIntFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprIsqrtFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprRandFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprRoundFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprSqrtFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprSrandFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static int	ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
-		    int argc, Tcl_Obj *const *objv);
-static void	MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
-		    int actual, Tcl_Obj *const *objv);
+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 int	DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
-		    Tcl_Obj *const objv[]);
-#endif
+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 void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
+			    int actual, Tcl_Obj *const *objv);
+static Tcl_NRPostProc	NRCoroutineCallerCallback;
+static Tcl_NRPostProc	NRCoroutineExitCallback;
+static Tcl_NRPostProc	NRCommand;
+
+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, Tcl_Obj *commandPtr, int objc,
+			    Tcl_Obj *const objv[]);
+static Tcl_NRPostProc	RewindCoroutineCallback;
+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	EvalObjvCore;
+static Tcl_NRPostProc	Dispatch;
+
+static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_NRPostProc NRPostInvoke;
+
+MODULE_SCOPE const TclStubs tclStubs;
+
+/*
+ * Magical counts for the number of arguments accepted by a coroutine command
+ * after particular kinds of [yield].
+ */
 
-extern TclStubs tclStubs;
+#define CORO_ACTIVATE_YIELD    PTR2INT(NULL)
+#define CORO_ACTIVATE_YIELDM   PTR2INT(NULL)+1
 
+#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL     (-1)
+#define COROUTINE_ARGUMENTS_ARBITRARY           (-2)
+
 /*
  * The following structure define the commands in the Tcl core.
  */
@@ -106,11 +180,17 @@ 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. */
-    int isSafe;			/* If non-zero, command will be present in
-				 * safe interpreter. Otherwise it will be
-				 * hidden. */
+    Tcl_ObjCmdProc *nreProc;	/* NR-based function for command */
+    int flags;			/* Various flag bits, as defined below. */
 } CmdInfo;
 
+#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
+                                 * commands present by default in a safe
+                                 * interpreter. */
+/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
+ * expansion for itself rather than needing the generic layer to take care of
+ * it for it. Defined in tclInt.h. */
+
 /*
  * The built-in commands, and the functions that implement them:
  */
@@ -120,93 +200,95 @@ static const CmdInfo builtInCmds[] = {
      * Commands in the generic core.
      */
 
-    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	1},
-    {"apply",		Tcl_ApplyObjCmd,	NULL,			1},
-    {"array",		Tcl_ArrayObjCmd,	NULL,			1},
-    {"binary",		Tcl_BinaryObjCmd,	NULL,			1},
-    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	1},
+    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
+    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
+    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
 #ifndef EXCLUDE_OBSOLETE_COMMANDS
-    {"case",		Tcl_CaseObjCmd,		NULL,			1},
+    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
 #endif
-    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	1},
-    {"concat",		Tcl_ConcatObjCmd,	NULL,			1},
-    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	1},
-    {"error",		Tcl_ErrorObjCmd,	NULL,			1},
-    {"eval",		Tcl_EvalObjCmd,		NULL,			1},
-    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	1},
-    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	1},
-    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	1},
-    {"format",		Tcl_FormatObjCmd,	NULL,			1},
-    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	1},
-    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	1},
-    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	1},
-    {"join",		Tcl_JoinObjCmd,		NULL,			1},
-    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	1},
-    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	1},
-    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	1},
-    {"linsert",		Tcl_LinsertObjCmd,	NULL,			1},
-    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	1},
-    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	1},
-    {"lrange",		Tcl_LrangeObjCmd,	NULL,			1},
-    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			1},
-    {"lreplace",	Tcl_LreplaceObjCmd,	NULL,			1},
-    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			1},
-    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			1},
-    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	1},
-    {"lsort",		Tcl_LsortObjCmd,	NULL,			1},
-    {"namespace",	Tcl_NamespaceObjCmd,	TclCompileNamespaceCmd,	1},
-    {"package",		Tcl_PackageObjCmd,	NULL,			1},
-    {"proc",		Tcl_ProcObjCmd,		NULL,			1},
-    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	1},
-    {"regsub",		Tcl_RegsubObjCmd,	NULL,			1},
-    {"rename",		Tcl_RenameObjCmd,	NULL,			1},
-    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	1},
-    {"scan",		Tcl_ScanObjCmd,		NULL,			1},
-    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	1},
-    {"split",		Tcl_SplitObjCmd,	NULL,			1},
-    {"subst",		Tcl_SubstObjCmd,	NULL,			1},
-    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	1},
-    {"trace",		Tcl_TraceObjCmd,	NULL,			1},
-    {"unset",		Tcl_UnsetObjCmd,	NULL,			1},
-    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			1},
-    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	1},
-    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	1},
-    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	1},
+    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
+    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
+    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
+    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
+    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
+    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
+    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
+    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
+    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
+    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
+    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
+    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
+    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
+    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
+    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
+    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
+    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
+    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
+    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
+    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
+    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
+    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
+    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
+    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
+    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
+    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	CMD_IS_SAFE},
+    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
+    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	CMD_IS_SAFE},
+    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, CMD_IS_SAFE},
+    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	CMD_IS_SAFE},
+    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	CMD_IS_SAFE},
+    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	CMD_IS_SAFE},
+    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	CMD_IS_SAFE},
+    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	CMD_IS_SAFE},
+    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	CMD_IS_SAFE},
+    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
+    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
+    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
+    {"yieldto",		NULL,			TclCompileYieldToCmd,	TclNRYieldToObjCmd,	CMD_IS_SAFE},
 
     /*
      * Commands in the OS-interface. Note that many of these are unsafe.
      */
 
-    {"after",		Tcl_AfterObjCmd,	NULL,			1},
-    {"cd",		Tcl_CdObjCmd,		NULL,			0},
-    {"close",		Tcl_CloseObjCmd,	NULL,			1},
-    {"eof",		Tcl_EofObjCmd,		NULL,			1},
-    {"encoding",	Tcl_EncodingObjCmd,	NULL,			0},
-    {"exec",		Tcl_ExecObjCmd,		NULL,			0},
-    {"exit",		Tcl_ExitObjCmd,		NULL,			0},
-    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			1},
-    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			0},
-    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			1},
-    {"file",		Tcl_FileObjCmd,		NULL,			0},
-    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			1},
-    {"flush",		Tcl_FlushObjCmd,	NULL,			1},
-    {"gets",		Tcl_GetsObjCmd,		NULL,			1},
-    {"glob",		Tcl_GlobObjCmd,		NULL,			0},
-    {"load",		Tcl_LoadObjCmd,		NULL,			0},
-    {"open",		Tcl_OpenObjCmd,		NULL,			0},
-    {"pid",		Tcl_PidObjCmd,		NULL,			1},
-    {"puts",		Tcl_PutsObjCmd,		NULL,			1},
-    {"pwd",		Tcl_PwdObjCmd,		NULL,			0},
-    {"read",		Tcl_ReadObjCmd,		NULL,			1},
-    {"seek",		Tcl_SeekObjCmd,		NULL,			1},
-    {"socket",		Tcl_SocketObjCmd,	NULL,			0},
-    {"source",		Tcl_SourceObjCmd,	NULL,			0},
-    {"tell",		Tcl_TellObjCmd,		NULL,			1},
-    {"time",		Tcl_TimeObjCmd,		NULL,			1},
-    {"unload",		Tcl_UnloadObjCmd,	NULL,			0},
-    {"update",		Tcl_UpdateObjCmd,	NULL,			1},
-    {"vwait",		Tcl_VwaitObjCmd,	NULL,			1},
-    {NULL,		NULL,			NULL,			0}
+    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
+    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"exec",		Tcl_ExecObjCmd,		NULL,			NULL,	0},
+    {"exit",		Tcl_ExitObjCmd,		NULL,			NULL,	0},
+    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			NULL,	0},
+    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"glob",		Tcl_GlobObjCmd,		NULL,			NULL,	0},
+    {"load",		Tcl_LoadObjCmd,		NULL,			NULL,	0},
+    {"open",		Tcl_OpenObjCmd,		NULL,			NULL,	0},
+    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
+    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
+    {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
+    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
+    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
+    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {NULL,		NULL,			NULL,			NULL,	0}
 };
 
 /*
@@ -215,40 +297,40 @@ static const CmdInfo builtInCmds[] = {
 
 typedef struct {
     const char *name;		/* Name of the function. The full name is
-				 * "::tcl::mathfunc::<name>".  */
+				 * "::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 	},
+    { "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 	},
+    { "ceil",	ExprCeilFunc,	NULL			},
+    { "cos",	ExprUnaryFunc,	(ClientData) cos	},
     { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
     { "double",	ExprDoubleFunc,	NULL			},
     { "entier",	ExprEntierFunc,	NULL			},
     { "exp",	ExprUnaryFunc,	(ClientData) exp	},
-    { "floor",	ExprFloorFunc,	NULL		 	},
+    { "floor",	ExprFloorFunc,	NULL			},
     { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
-    { "hypot",	ExprBinaryFunc,	(ClientData) hypot 	},
+    { "hypot",	ExprBinaryFunc,	(ClientData) hypot	},
     { "int",	ExprIntFunc,	NULL			},
     { "isqrt",	ExprIsqrtFunc,	NULL			},
-    { "log",	ExprUnaryFunc,	(ClientData) log 	},
-    { "log10",	ExprUnaryFunc,	(ClientData) log10 	},
-    { "pow",	ExprBinaryFunc,	(ClientData) pow 	},
+    { "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		 	},
+    { "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		 	},
+    { "tan",	ExprUnaryFunc,	(ClientData) tan	},
+    { "tanh",	ExprUnaryFunc,	(ClientData) tanh	},
+    { "wide",	ExprWideFunc,	NULL			},
     { NULL, NULL, NULL }
 };
 
@@ -317,47 +399,33 @@ static const OpCmdInfo mathOpCmds[] = {
     { NULL,	NULL,			NULL,
 		{0},			NULL}
 };
-
-/*
- * Macros for stack checks. The goal of these macros is to allow the size of
- * the stack to be checked (so preventing overflow) in a *cheap* way. Note
- * that the check needs to be (amortized) cheap since it is on the critical
- * path for recursion.
- */
-
-#if defined(TCL_NO_STACK_CHECK)
-/*
- * Stack check disabled: make them noops.
- */
-
-#   define CheckCStack(interp, localIntPtr)	1
-#   define GetCStackParams(iPtr)		/* do nothing */
-#elif defined(TCL_CROSS_COMPILE)
-
+
 /*
- * This variable is static and only set *once*, during library initialization.
- * It therefore needs no thread guards.
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeEvaluation --
+ *
+ *	Finalizes the script cancellation hash table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
  */
 
-static int stackGrowsDown = 1;
-#   define GetCStackParams(iPtr) \
-    stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBound))
-#   define CheckCStack(iPtr, localIntPtr) \
-    (stackGrowsDown \
-	    ? ((localIntPtr) > (iPtr)->stackBound) \
-	    : ((localIntPtr) < (iPtr)->stackBound) \
-    )
-#else /* !TCL_NO_STACK_CHECK && !TCL_CROSS_COMPILE */
-#   define GetCStackParams(iPtr) \
-    TclpGetCStackParams(&((iPtr)->stackBound))
-#   ifdef TCL_STACK_GROWS_UP
-#	define CheckCStack(iPtr, localIntPtr) \
-	   (!(iPtr)->stackBound || (localIntPtr) < (iPtr)->stackBound)
-#    else /* TCL_STACK_GROWS_UP */
-#	define CheckCStack(iPtr, localIntPtr) \
-	   ((localIntPtr) > (iPtr)->stackBound)
-#    endif /* TCL_STACK_GROWS_UP */
-#endif /* TCL_NO_STACK_CHECK/TCL_CROSS_COMPILE */
+void
+TclFinalizeEvaluation(void)
+{
+    Tcl_MutexLock(&cancelLock);
+    if (cancelTableInitialized == 1) {
+	Tcl_DeleteHashTable(&cancelTable);
+	cancelTableInitialized = 0;
+    }
+    Tcl_MutexUnlock(&cancelLock);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -387,6 +455,9 @@ Tcl_CreateInterp(void)
     const OpCmdInfo *opcmdInfoPtr;
     const CmdInfo *cmdInfoPtr;
     Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+    CancelInfo *cancelInfo;
     union {
 	char c[sizeof(short)];
 	short s;
@@ -396,7 +467,6 @@ Tcl_CreateInterp(void)
 #endif /* TCL_COMPILE_STATS */
     char mathFuncName[32];
     CallFrame *framePtr;
-    int result;
 
     TclInitSubsystems();
 
@@ -422,13 +492,22 @@ Tcl_CreateInterp(void)
     }
 #endif
 
+    if (cancelTableInitialized == 0) {
+	Tcl_MutexLock(&cancelLock);
+	if (cancelTableInitialized == 0) {
+	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
+	    cancelTableInitialized = 1;
+	}
+	Tcl_MutexUnlock(&cancelLock);
+    }
+
     /*
      * 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.
      */
 
-    iPtr = (Interp *) ckalloc(sizeof(Interp));
+    iPtr = ckalloc(sizeof(Interp));
     interp = (Tcl_Interp *) iPtr;
 
     iPtr->result = iPtr->resultSpace;
@@ -441,21 +520,24 @@ Tcl_CreateInterp(void)
     iPtr->hiddenCmdTablePtr = NULL;
     iPtr->interpInfo = NULL;
 
+    TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
+    iPtr->extra.optimizer = TclOptimizeBytecode;
+
     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 */
 
     /*
-     * 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 = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-    iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
-    iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
-    iPtr->lineLABCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+    iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable));
+    iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable));
+    iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable));
+    iPtr->lineLABCPtr = 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);
@@ -468,6 +550,17 @@ Tcl_CreateInterp(void)
     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);
@@ -492,7 +585,7 @@ Tcl_CreateInterp(void)
     }
 
     iPtr->cmdCount = 0;
-    TclInitLiteralTable(&(iPtr->literalTable));
+    TclInitLiteralTable(&iPtr->literalTable);
     iPtr->compileEpoch = 0;
     iPtr->compiledProcPtr = NULL;
     iPtr->resolverPtr = NULL;
@@ -542,12 +635,9 @@ Tcl_CreateInterp(void)
      */
 
     /* This is needed to satisfy GCC 3.3's strict aliasing rules */
-    framePtr = (CallFrame *) ckalloc(sizeof(CallFrame));
-    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+    framePtr = ckalloc(sizeof(CallFrame));
+    (void) 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;
@@ -561,7 +651,7 @@ Tcl_CreateInterp(void)
      * variable).
      */
 
-    iPtr->execEnvPtr = TclCreateExecEnv(interp);
+    iPtr->execEnvPtr = TclCreateExecEnv(interp, INTERP_STACK_INITIAL_SIZE);
 
     /*
      * TIP #219, Tcl Channel Reflection API support.
@@ -570,25 +660,44 @@ Tcl_CreateInterp(void)
     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);
+
+    /*
      * Initialize the compilation and execution statistics kept for this
      * interpreter.
      */
 
 #ifdef TCL_COMPILE_STATS
-    statsPtr = &(iPtr->stats);
+    statsPtr = &iPtr->stats;
     statsPtr->numExecutions = 0;
     statsPtr->numCompilations = 0;
     statsPtr->numByteCodesFreed = 0;
-    (void) memset(statsPtr->instructionCount, 0,
+    memset(statsPtr->instructionCount, 0,
 	    sizeof(statsPtr->instructionCount));
 
     statsPtr->totalSrcBytes = 0.0;
     statsPtr->totalByteCodeBytes = 0.0;
     statsPtr->currentSrcBytes = 0.0;
     statsPtr->currentByteCodeBytes = 0.0;
-    (void) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
-    (void) memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
-    (void) memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount));
+    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;
@@ -599,7 +708,7 @@ Tcl_CreateInterp(void)
     statsPtr->numLiteralsCreated = 0;
     statsPtr->totalLitStringBytes = 0.0;
     statsPtr->currentLitStringBytes = 0.0;
-    (void) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
+    memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
 #endif /* TCL_COMPILE_STATS */
 
     /*
@@ -612,9 +721,7 @@ Tcl_CreateInterp(void)
      * Initialize the ensemble error message rewriting support.
      */
 
-    iPtr->ensembleRewrite.sourceObjs = NULL;
-    iPtr->ensembleRewrite.numRemovedObjs = 0;
-    iPtr->ensembleRewrite.numInsertedObjs = 0;
+    TclResetRewriteEnsemble(interp, 1);
 
     /*
      * TIP#143: Initialise the resource limit support.
@@ -623,7 +730,8 @@ Tcl_CreateInterp(void)
     TclInitLimitSupport(interp);
 
     /*
-     * Initialise the thread-specific data ekeko.
+     * 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)
@@ -633,13 +741,7 @@ Tcl_CreateInterp(void)
 #endif
     iPtr->pendingObjDataPtr = NULL;
     iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
-
-    /*
-     * Insure that the stack checking mechanism for this interp is
-     * initialized.
-     */
-
-    GetCStackParams(iPtr);
+    iPtr->deferredCallbacks = NULL;
 
     /*
      * Create the core commands. Do it here, rather than calling
@@ -652,19 +754,17 @@ Tcl_CreateInterp(void)
      * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
      */
 
-    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL; cmdInfoPtr++) {
-	int isNew;
-	Tcl_HashEntry *hPtr;
-
+    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
 	if ((cmdInfoPtr->objProc == NULL)
-		&& (cmdInfoPtr->compileProc == NULL)) {
+		&& (cmdInfoPtr->compileProc == NULL)
+		&& (cmdInfoPtr->nreProc == NULL)) {
 	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
 	}
 
 	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
 		cmdInfoPtr->name, &isNew);
 	if (isNew) {
-	    cmdPtr = (Command *) ckalloc(sizeof(Command));
+	    cmdPtr = ckalloc(sizeof(Command));
 	    cmdPtr->hPtr = hPtr;
 	    cmdPtr->nsPtr = iPtr->globalNsPtr;
 	    cmdPtr->refCount = 1;
@@ -677,22 +777,33 @@ Tcl_CreateInterp(void)
 	    cmdPtr->deleteProc = NULL;
 	    cmdPtr->deleteData = NULL;
 	    cmdPtr->flags = 0;
+            if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
+                cmdPtr->flags |= CMD_COMPILES_EXPANDED;
+            }
 	    cmdPtr->importRefPtr = NULL;
 	    cmdPtr->tracePtr = NULL;
+	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
 	    Tcl_SetHashValue(hPtr, cmdPtr);
 	}
     }
 
     /*
-     * Create the "chan", "dict", "info" and "string" ensembles. Note that all
-     * these commands (and their subcommands that are not present in the
-     * global namespace) are wholly safe.
+     * Create the "array", "binary", "chan", "clock", "dict", "encoding",
+     * "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 "clock", "encoding" and "file".
      */
 
+    TclInitArrayCmd(interp);
+    TclInitBinaryCmd(interp);
     TclInitChanCmd(interp);
     TclInitDictCmd(interp);
+    TclInitEncodingCmd(interp);
+    TclInitFileCmd(interp);
     TclInitInfoCmd(interp);
+    TclInitNamespaceCmd(interp);
     TclInitStringCmd(interp);
+    TclInitPrefixCmd(interp);
 
     /*
      * Register "clock" subcommands. These *do* go through
@@ -715,11 +826,24 @@ Tcl_CreateInterp(void)
 	    TclDefaultBgErrorHandlerObjCmd, NULL, NULL);
 
     /*
-     * Create an unsupported command for debugging bytecode.
+     * Create unsupported commands for debugging bytecode and objects.
      */
 
     Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
-	    Tcl_DisassembleObjCmd, NULL, NULL);
+	    Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
+    Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
+	    Tcl_DisassembleObjCmd, INT2PTR(1), 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
     /*
@@ -737,8 +861,8 @@ Tcl_CreateInterp(void)
     if (mathfuncNSPtr == NULL) {
 	Tcl_Panic("Can't create math function namespace");
     }
-    strcpy(mathFuncName, "::tcl::mathfunc::");
 #define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
+    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
     for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
 	    builtinFuncPtr++) {
 	strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
@@ -752,15 +876,14 @@ Tcl_CreateInterp(void)
      */
 
     mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
-#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
     if (mathopNSPtr == NULL) {
 	Tcl_Panic("can't create math operator namespace");
     }
-    (void) Tcl_Export(interp, mathopNSPtr, "*", 1);
-    strcpy(mathFuncName, "::tcl::mathop::");
+    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 = (TclOpCmdClientData *)
-		ckalloc(sizeof(TclOpCmdClientData));
+	TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData));
 
 	occdPtr->op = opcmdInfoPtr->name;
 	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
@@ -841,15 +964,26 @@ Tcl_CreateInterp(void)
 
     Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
 
-#ifdef Tcl_InitStubs
-#undef Tcl_InitStubs
-#endif
-    Tcl_InitStubs(interp, TCL_VERSION, 1);
-
     if (TclTommath_Init(interp) != TCL_OK) {
 	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
     }
 
+    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.
+     */
+
+#ifdef HAVE_ZLIB
+    if (TclZlibInit(interp) != TCL_OK) {
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+    }
+#endif
+
+    TOP_CB(iPtr) = NULL;
     return interp;
 }
 
@@ -859,7 +993,7 @@ DeleteOpCmdClientData(
 {
     TclOpCmdClientData *occdPtr = clientData;
 
-    ckfree((char *) occdPtr);
+    ckfree(occdPtr);
 }
 
 /*
@@ -888,10 +1022,12 @@ TclHideUnsafeCommands(
 	return TCL_ERROR;
     }
     for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
-	if (!cmdInfoPtr->isSafe) {
+	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
 	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
 	}
     }
+    TclMakeEncodingCommandSafe(interp); /* Ugh! */
+    TclMakeFileCommandSafe(interp);     /* Ugh! */
     return TCL_OK;
 }
 
@@ -929,14 +1065,14 @@ Tcl_CallWhenDeleted(
 	    Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
     int isNew;
     char buffer[32 + TCL_INTEGER_SPACE];
-    AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+    AssocData *dPtr = ckalloc(sizeof(AssocData));
     Tcl_HashEntry *hPtr;
 
     sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
     (*assocDataCounterPtr)++;
 
     if (iPtr->assocData == NULL) {
-	iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
 	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
     }
     hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
@@ -983,9 +1119,9 @@ Tcl_DontCallWhenDeleted(
     }
     for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&hSearch)) {
-	dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+	dPtr = Tcl_GetHashValue(hPtr);
 	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
-	    ckfree((char *) dPtr);
+	    ckfree(dPtr);
 	    Tcl_DeleteHashEntry(hPtr);
 	    return;
 	}
@@ -1025,14 +1161,14 @@ Tcl_SetAssocData(
     int isNew;
 
     if (iPtr->assocData == NULL) {
-	iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	iPtr->assocData = 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);
     } else {
-	dPtr = (AssocData *) ckalloc(sizeof(AssocData));
+	dPtr = ckalloc(sizeof(AssocData));
     }
     dPtr->proc = proc;
     dPtr->clientData = clientData;
@@ -1077,7 +1213,7 @@ Tcl_DeleteAssocData(
     if (dPtr->proc != NULL) {
 	dPtr->proc(dPtr->clientData, interp);
     }
-    ckfree((char *) dPtr);
+    ckfree(dPtr);
     Tcl_DeleteHashEntry(hPtr);
 }
 
@@ -1232,12 +1368,14 @@ DeleteInterpProc(
     Tcl_HashSearch search;
     Tcl_HashTable *hTablePtr;
     ResolverScheme *resPtr, *nextResPtr;
+    int i;
 
     /*
-     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
+     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
+	 * unless we are exiting.
      */
 
-    if (iPtr->numLevels > 0) {
+    if ((iPtr->numLevels > 0) && !TclInExit()) {
 	Tcl_Panic("DeleteInterpProc called with active evals");
     }
 
@@ -1260,6 +1398,37 @@ DeleteInterpProc(
     }
 
     /*
+     * 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;
+    }
+
+    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.
      */
@@ -1288,17 +1457,16 @@ DeleteInterpProc(
 	/*
 	 * 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
+	 * 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_Command) Tcl_GetHashValue(hPtr));
+	    Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
 	}
 	Tcl_DeleteHashTable(hTablePtr);
-	ckfree((char *) hTablePtr);
+	ckfree(hTablePtr);
     }
 
     /*
@@ -1319,10 +1487,10 @@ DeleteInterpProc(
 	    if (dPtr->proc != NULL) {
 		dPtr->proc(dPtr->clientData, interp);
 	    }
-	    ckfree((char *) dPtr);
+	    ckfree(dPtr);
 	}
 	Tcl_DeleteHashTable(hTablePtr);
-	ckfree((char *) hTablePtr);
+	ckfree(hTablePtr);
     }
 
     /*
@@ -1330,11 +1498,11 @@ DeleteInterpProc(
      * namespace. The order is important [Bug 1658572].
      */
 
-    if (iPtr->framePtr != iPtr->rootFramePtr) {
+    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
 	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
     }
     Tcl_PopCallFrame(interp);
-    ckfree((char *) iPtr->rootFramePtr);
+    ckfree(iPtr->rootFramePtr);
     iPtr->rootFramePtr = NULL;
     Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
 
@@ -1344,7 +1512,7 @@ DeleteInterpProc(
      */
 
     Tcl_FreeResult(interp);
-    interp->result = NULL;
+    iPtr->result = NULL;
     Tcl_DecrRefCount(iPtr->objResultPtr);
     iPtr->objResultPtr = NULL;
     Tcl_DecrRefCount(iPtr->ecVar);
@@ -1357,6 +1525,12 @@ DeleteInterpProc(
 	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);
     }
@@ -1382,7 +1556,7 @@ DeleteInterpProc(
     while (resPtr) {
 	nextResPtr = resPtr->nextPtr;
 	ckfree(resPtr->name);
-	ckfree((char *) resPtr);
+	ckfree(resPtr);
 	resPtr = nextResPtr;
     }
 
@@ -1391,104 +1565,101 @@ DeleteInterpProc(
      * interpreter.
      */
 
-    TclDeleteLiteralTable(interp, &(iPtr->literalTable));
+    TclDeleteLiteralTable(interp, &iPtr->literalTable);
 
     /*
      * TIP #280 - Release the arrays for ByteCode/Proc extension, and
      * contents.
      */
 
-    {
-	Tcl_HashEntry *hPtr;
-	Tcl_HashSearch hSearch;
-	int i;
+    for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
+	    hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&search)) {
+	CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
+	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
 
-	for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
-		hPtr != NULL;
-		hPtr = Tcl_NextHashEntry(&hSearch)) {
-	    CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
-	    Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
-	    procPtr->iPtr = NULL;
-	    if (cfPtr) {
-		if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		    Tcl_DecrRefCount(cfPtr->data.eval.path);
-		}
-		ckfree((char *) cfPtr->line);
-		ckfree((char *) cfPtr);
+	procPtr->iPtr = NULL;
+	if (cfPtr) {
+	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+		Tcl_DecrRefCount(cfPtr->data.eval.path);
 	    }
-	    Tcl_DeleteHashEntry(hPtr);
+	    ckfree(cfPtr->line);
+	    ckfree(cfPtr);
 	}
-	Tcl_DeleteHashTable(iPtr->linePBodyPtr);
-	ckfree((char *) iPtr->linePBodyPtr);
-	iPtr->linePBodyPtr = NULL;
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
+    ckfree(iPtr->linePBodyPtr);
+    iPtr->linePBodyPtr = NULL;
 
-	/*
-	 * See also tclCompile.c, TclCleanupByteCode
-	 */
+    /*
+     * See also tclCompile.c, TclCleanupByteCode
+     */
 
-	for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);
-		hPtr != NULL;
-		hPtr = Tcl_NextHashEntry(&hSearch)) {
-	    ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr);
+    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
+	    hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&search)) {
+	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);
 
-	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
-		Tcl_DecrRefCount(eclPtr->path);
-	    }
-	    for (i=0; i< eclPtr->nuloc; i++) {
-		ckfree((char *) eclPtr->loc[i].line);
-	    }
+	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((char *) eclPtr->loc);
-	    }
+	if (eclPtr->loc != NULL) {
+	    ckfree(eclPtr->loc);
+	}
 
-	    Tcl_DeleteHashTable (&eclPtr->litInfo);
+	ckfree(eclPtr);
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    Tcl_DeleteHashTable(iPtr->lineBCPtr);
+    ckfree(iPtr->lineBCPtr);
+    iPtr->lineBCPtr = NULL;
 
-	    ckfree((char *) eclPtr);
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-	Tcl_DeleteHashTable(iPtr->lineBCPtr);
-	ckfree((char *) iPtr->lineBCPtr);
-	iPtr->lineBCPtr = NULL;
+    /*
+     * 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 (iPtr->lineLAPtr->numEntries && !TclInExit()) {
 	/*
-	 * 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.
+	 * When the interp goes away we have nothing on the stack, so there
+	 * are no arguments, so this table has to be 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_Panic("Argument location tracking table not empty");
+    }
 
-	    Tcl_Panic ("Argument location tracking table not empty");
-	}
+    Tcl_DeleteHashTable(iPtr->lineLAPtr);
+    ckfree((char *) iPtr->lineLAPtr);
+    iPtr->lineLAPtr = NULL;
 
-	Tcl_DeleteHashTable (iPtr->lineLAPtr);
-	ckfree((char*) iPtr->lineLAPtr);
-	iPtr->lineLAPtr = 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.
+	 */
 
-	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.
-	     */
+	Tcl_Panic("Argument location tracking table not empty");
+    }
 
-	    Tcl_Panic ("Argument location tracking table not empty");
-	}
+    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
+    ckfree(iPtr->lineLABCPtr);
+    iPtr->lineLABCPtr = NULL;
 
-	Tcl_DeleteHashTable (iPtr->lineLABCPtr);
-	ckfree((char*) iPtr->lineLABCPtr);
-	iPtr->lineLABCPtr = NULL;
-    }
+    /*
+     * Squelch the tables of traces on variables and searches over arrays in
+     * the in the interpreter.
+     */
 
     Tcl_DeleteHashTable(&iPtr->varTraces);
     Tcl_DeleteHashTable(&iPtr->varSearches);
 
-    ckfree((char *) iPtr);
+    ckfree(iPtr);
 }
 
 /*
@@ -1554,9 +1725,10 @@ Tcl_HideCommand(
      */
 
     if (strstr(hiddenCmdToken, "::") != NULL) {
-	Tcl_AppendResult(interp,
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"cannot use namespace qualifiers in hidden command"
-		" token (rename)", NULL);
+		" token (rename)", -1));
+        Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
 	return TCL_ERROR;
     }
 
@@ -1578,8 +1750,10 @@ Tcl_HideCommand(
      */
 
     if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
-	Tcl_AppendResult(interp, "can only hide global namespace commands"
-		" (use rename then hide)", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "can only hide global namespace commands (use rename then hide)",
+                -1));
+        Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
 	return TCL_ERROR;
     }
 
@@ -1589,8 +1763,7 @@ Tcl_HideCommand(
 
     hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
     if (hiddenCmdTablePtr == NULL) {
-	hiddenCmdTablePtr = (Tcl_HashTable *)
-		ckalloc((unsigned) sizeof(Tcl_HashTable));
+	hiddenCmdTablePtr = ckalloc(sizeof(Tcl_HashTable));
 	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
 	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
     }
@@ -1603,8 +1776,10 @@ Tcl_HideCommand(
 
     hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
     if (!isNew) {
-	Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
-		"\" already exists", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "hidden command named \"%s\" already exists",
+                hiddenCmdToken));
+        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
 	return TCL_ERROR;
     }
 
@@ -1705,8 +1880,10 @@ Tcl_ExposeCommand(
      */
 
     if (strstr(cmdName, "::") != NULL) {
-	Tcl_AppendResult(interp, "cannot expose to a namespace "
-		"(use expose to toplevel, then rename)", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "cannot expose to a namespace (use expose to toplevel, then rename)",
+                -1));
+        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
 	return TCL_ERROR;
     }
 
@@ -1720,27 +1897,29 @@ Tcl_ExposeCommand(
 	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
     }
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
-		"\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "unknown hidden command \"%s\"", hiddenCmdToken));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
+                hiddenCmdToken, NULL);
 	return TCL_ERROR;
     }
     cmdPtr = Tcl_GetHashValue(hPtr);
 
     /*
      * Check that we have a true global namespace command (enforced by
-     * Tcl_HideCommand() but let's double check. (If it was not, we would not
+     * 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()
+	 * This case is theoritically impossible, we might rather Tcl_Panic
 	 * than 'nicely' erroring out ?
 	 */
 
-	Tcl_AppendResult(interp,
-		"trying to expose a non global command name space command",
-		NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"trying to expose a non-global command namespace command",
+		-1));
 	return TCL_ERROR;
     }
 
@@ -1757,12 +1936,24 @@ Tcl_ExposeCommand(
 
     hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
     if (!isNew) {
-	Tcl_AppendResult(interp, "exposed command \"", cmdName,
-		"\" already exists", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "exposed command \"%s\" already exists", cmdName));
+        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", 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.
@@ -1915,10 +2106,22 @@ Tcl_CreateCommand(
 	     * stuck in an infinite loop).
 	     */
 
-	     ckfree((char *) Tcl_GetHashValue(hPtr));
+	    ckfree(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.
@@ -1927,7 +2130,7 @@ Tcl_CreateCommand(
 	TclInvalidateNsCmdLookup(nsPtr);
 	TclInvalidateNsPath(nsPtr);
     }
-    cmdPtr = (Command *) ckalloc(sizeof(Command));
+    cmdPtr = ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = nsPtr;
@@ -1943,6 +2146,7 @@ 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
@@ -2006,7 +2210,7 @@ Tcl_CreateObjCommand(
     Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
 				 * name. */
     ClientData clientData,	/* Arbitrary value to pass to object
-    				 * function. */
+				 * function. */
     Tcl_CmdDeleteProc *deleteProc)
 				/* If not NULL, gives a function to call when
 				 * this command is deleted. */
@@ -2054,7 +2258,7 @@ Tcl_CreateObjCommand(
 	/* Command already exists. */
 
 	/*
-	 * [***] This is wrong.  See Tcl Bug a16752c252.  
+	 * [***] This is wrong.  See Tcl Bug a16752c252.
 	 * However, this buggy behavior is kept under particular
 	 * circumstances to accommodate deployed binaries of the
 	 * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
@@ -2098,10 +2302,22 @@ Tcl_CreateObjCommand(
 	     * stuck in an infinite loop).
 	     */
 
-	     ckfree(Tcl_GetHashValue(hPtr));
+	    ckfree(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.
@@ -2109,7 +2325,7 @@ Tcl_CreateObjCommand(
 
 	TclInvalidateNsCmdLookup(nsPtr);
     }
-    cmdPtr = (Command *) ckalloc(sizeof(Command));
+    cmdPtr = ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = nsPtr;
@@ -2125,6 +2341,7 @@ Tcl_CreateObjCommand(
     cmdPtr->flags = 0;
     cmdPtr->importRefPtr = NULL;
     cmdPtr->tracePtr = NULL;
+    cmdPtr->nreProc = NULL;
 
     /*
      * Plug in any existing import references found above. Be sure to update
@@ -2182,10 +2399,10 @@ TclInvokeStringCommand(
 {
     Command *cmdPtr = clientData;
     int i, result;
-    const char **argv = (const char **)
+    const char **argv =
 	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
 
-    for (i = 0;  i < objc;  i++) {
+    for (i = 0; i < objc; i++) {
 	argv[i] = Tcl_GetString(objv[i]);
     }
     argv[objc] = 0;
@@ -2194,7 +2411,7 @@ 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);
     return result;
@@ -2228,13 +2445,13 @@ TclInvokeObjectCommand(
     int argc,			/* Number of arguments. */
     register const char **argv)	/* Argument strings. */
 {
-    Command *cmdPtr = (Command *) clientData;
+    Command *cmdPtr = clientData;
     Tcl_Obj *objPtr;
     int i, length, result;
-    Tcl_Obj **objv = (Tcl_Obj **)
+    Tcl_Obj **objv =
 	    TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
 
-    for (i = 0;  i < argc;  i++) {
+    for (i = 0; i < argc; i++) {
 	length = strlen(argv[i]);
 	TclNewStringObj(objPtr, argv[i], length);
 	Tcl_IncrRefCount(objPtr);
@@ -2245,7 +2462,12 @@ TclInvokeObjectCommand(
      * Invoke the command's object-based Tcl_ObjCmdProc.
      */
 
-    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+    if (cmdPtr->objProc != NULL) {
+	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
+    } else {
+	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
+		cmdPtr->objClientData, argc, objv);
+    }
 
     /*
      * Move the interpreter's object result to the string result, then reset
@@ -2259,7 +2481,7 @@ TclInvokeObjectCommand(
      * 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);
     }
@@ -2315,9 +2537,11 @@ TclRenameCommand(
     cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
     cmdPtr = (Command *) cmd;
     if (cmdPtr == NULL) {
-	Tcl_AppendResult(interp, "can't ",
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't %s \"%s\": command doesn't exist",
 		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
-		" \"", oldName, "\": command doesn't exist", NULL);
+		oldName));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
 	return TCL_ERROR;
     }
     cmdNsPtr = cmdPtr->nsPtr;
@@ -2346,21 +2570,24 @@ TclRenameCommand(
 	    TCL_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_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't rename to \"%s\": bad command name", newName));
+        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", 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_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't rename to \"%s\": command already exists", newName));
+        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
+                "TARGET_EXISTS", NULL);
 	result = TCL_ERROR;
 	goto done;
     }
 
     /*
      * Warning: any changes done in the code here are likely to be needed in
-     * Tcl_HideCommand() code too (until the common parts are extracted out).
+     * Tcl_HideCommand code too (until the common parts are extracted out).
      * - dl
      */
 
@@ -2401,6 +2628,17 @@ TclRenameCommand(
     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
@@ -2415,7 +2653,7 @@ TclRenameCommand(
     Tcl_DStringInit(&newFullName);
     Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
     if (newNsPtr != iPtr->globalNsPtr) {
-	Tcl_DStringAppend(&newFullName, "::", 2);
+	TclDStringAppendLiteral(&newFullName, "::");
     }
     Tcl_DStringAppend(&newFullName, newTail, -1);
     cmdPtr->refCount++;
@@ -2519,7 +2757,7 @@ Tcl_SetCommandInfoFromToken(
 {
     Command *cmdPtr;		/* Internal representation of the command */
 
-    if (cmd == (Tcl_Command) NULL) {
+    if (cmd == NULL) {
 	return 0;
     }
 
@@ -2533,8 +2771,12 @@ Tcl_SetCommandInfoFromToken(
     if (infoPtr->objProc == NULL) {
 	cmdPtr->objProc = TclInvokeStringCommand;
 	cmdPtr->objClientData = cmdPtr;
+	cmdPtr->nreProc = NULL;
     } else {
-	cmdPtr->objProc = infoPtr->objProc;
+	if (infoPtr->objProc != cmdPtr->objProc) {
+	    cmdPtr->nreProc = NULL;
+	    cmdPtr->objProc = infoPtr->objProc;
+	}
 	cmdPtr->objClientData = infoPtr->objClientData;
     }
     cmdPtr->deleteProc = infoPtr->deleteProc;
@@ -2599,7 +2841,7 @@ Tcl_GetCommandInfoFromToken(
 {
     Command *cmdPtr;		/* Internal representation of the command */
 
-    if (cmd == (Tcl_Command) NULL) {
+    if (cmd == NULL) {
 	return 0;
     }
 
@@ -2744,7 +2986,7 @@ Tcl_DeleteCommand(
      */
 
     cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
-    if (cmd == (Tcl_Command) NULL) {
+    if (cmd == NULL) {
 	return -1;
     }
     return Tcl_DeleteCommandFromToken(interp, cmd);
@@ -2839,8 +3081,9 @@ Tcl_DeleteCommandFromToken(
 	tracePtr = cmdPtr->tracePtr;
 	while (tracePtr != NULL) {
 	    CommandTrace *nextPtr = tracePtr->nextPtr;
-	    if ((--tracePtr->refCount) <= 0) {
-		ckfree((char *) tracePtr);
+
+	    if (tracePtr->refCount-- <= 1) {
+		ckfree(tracePtr);
 	    }
 	    tracePtr = nextPtr;
 	}
@@ -2874,19 +3117,17 @@ 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()
+	 * 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);
     }
 
     /*
@@ -2895,7 +3136,7 @@ Tcl_DeleteCommandFromToken(
      * imported commands now.
      */
     if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
-	for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
+	for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
 		refPtr = nextRefPtr) {
 	    nextRefPtr = refPtr->nextPtr;
 	    importCmd = (Tcl_Command) refPtr->importedCmdPtr;
@@ -2916,11 +3157,10 @@ Tcl_DeleteCommandFromToken(
     }
 
     /*
-     * 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.
+     * 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.
      */
 
     cmdPtr->objProc = NULL;
@@ -2930,14 +3170,31 @@ Tcl_DeleteCommandFromToken(
      * 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).
+     * CmdName Command reference is found to be invalid and
+     * TclNRExecuteByteCode looks up the command in the command hashtable).
      */
 
     TclCleanupCommandMacro(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. */
@@ -3008,11 +3265,11 @@ CallCommandTraces(
 	if (state == NULL) {
 	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
 	}
-	(*tracePtr->traceProc)(tracePtr->clientData,
-		(Tcl_Interp *) iPtr, oldName, newName, flags);
+	tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
+		oldName, newName, flags);
 	cmdPtr->flags &= ~tracePtr->flags;
-	if ((--tracePtr->refCount) <= 0) {
-	    ckfree((char *) tracePtr);
+	if (tracePtr->refCount-- <= 1) {
+	    ckfree(tracePtr);
 	}
     }
 
@@ -3039,34 +3296,82 @@ CallCommandTraces(
     Tcl_Release(iPtr);
     return result;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
- * GetCommandSource --
+ * 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.
  *
- *	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.
+ * Side effects:
+ *	Transfers a message from the cancelation message to the interpreter.
  *
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-GetCommandSource(
-    Interp *iPtr,
-    const char *command,
-    int numChars,
-    int objc,
-    Tcl_Obj *const objv[])
+static int
+CancelEvalProc(
+    ClientData clientData,	/* Interp to cancel the script in progress. */
+    Tcl_Interp *interp,		/* Ignored */
+    int code)			/* Current return code from command. */
 {
-    if (!command) {
-	return Tcl_NewListObj(objc, objv);
-    }
-    if (command == (char *) -1) {
-	command = TclGetSrcInfoForCmd(iPtr, &numChars);
+    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 Tcl_NewStringObj(command, numChars);
+
+    return code;
 }
 
 /*
@@ -3097,7 +3402,7 @@ TclCleanupCommand(
 {
     cmdPtr->refCount--;
     if (cmdPtr->refCount <= 0) {
-	ckfree((char *) cmdPtr);
+	ckfree(cmdPtr);
     }
 }
 
@@ -3138,18 +3443,16 @@ Tcl_CreateMathFunc(
 				 * function. */
 {
     Tcl_DString bigName;
-    OldMathFuncData *data = (OldMathFuncData *)
-	    ckalloc(sizeof(OldMathFuncData));
+    OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
 
     data->proc = proc;
     data->numArgs = numArgs;
-    data->argTypes = (Tcl_ValueType *)
-	    ckalloc(numArgs * sizeof(Tcl_ValueType));
+    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);
+    TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
     Tcl_DStringAppend(&bigName, name, -1);
 
     Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
@@ -3201,10 +3504,9 @@ OldMathFuncProc(
      * Convert arguments from Tcl_Obj's to Tcl_Value's.
      */
 
-    args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
+    args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
     for (j = 1, k = 0; j < objc; ++j, ++k) {
-
-	/* TODO: Convert to TclGetNumberFromObj() ? */
+	/* TODO: Convert to TclGetNumberFromObj? */
 	valuePtr = objv[j];
 	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
 #ifdef ACCEPT_NAN
@@ -3219,9 +3521,10 @@ OldMathFuncProc(
 	     */
 
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "argument to math function didn't have numeric value",-1));
+		    "argument to math function didn't have numeric value",
+		    -1));
 	    TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
-	    ckfree((char *)args);
+	    ckfree(args);
 	    return TCL_ERROR;
 	}
 
@@ -3235,12 +3538,12 @@ OldMathFuncProc(
 	args[k].type = dataPtr->argTypes[k];
 	switch (args[k].type) {
 	case TCL_EITHER:
-	    if (Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue))
+	    if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue)
 		    == TCL_OK) {
 		args[k].type = TCL_INT;
 		break;
 	    }
-	    if (Tcl_GetWideIntFromObj(interp, valuePtr, &(args[k].wideValue))
+	    if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
 		    == TCL_OK) {
 		args[k].type = TCL_WIDE_INT;
 		break;
@@ -3252,21 +3555,21 @@ OldMathFuncProc(
 	    args[k].doubleValue = d;
 	    break;
 	case TCL_INT:
-	    if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
-		ckfree((char *)args);
+	    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_GetLongFromObj(NULL, valuePtr, &args[k].intValue);
 	    Tcl_ResetResult(interp);
 	    break;
 	case TCL_WIDE_INT:
-	    if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
-		ckfree((char *)args);
+	    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_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
 	    Tcl_ResetResult(interp);
 	    break;
 	}
@@ -3277,8 +3580,8 @@ OldMathFuncProc(
      */
 
     errno = 0;
-    result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
-    ckfree((char *)args);
+    result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
+    ckfree(args);
     if (result != TCL_OK) {
 	return result;
     }
@@ -3317,12 +3620,12 @@ OldMathFuncProc(
 
 static void
 OldMathFuncDeleteProc(
-     ClientData clientData)
+    ClientData clientData)
 {
     OldMathFuncData *dataPtr = clientData;
 
-    ckfree((void *) dataPtr->argTypes);
-    ckfree((void *) dataPtr);
+    ckfree(dataPtr->argTypes);
+    ckfree(dataPtr);
 }
 
 /*
@@ -3376,12 +3679,9 @@ Tcl_GetMathFuncInfo(
      */
 
     if (cmdPtr == NULL) {
-	Tcl_Obj *message;
-
-	TclNewLiteralStringObj(message, "unknown math function \"");
-	Tcl_AppendToObj(message, name, -1);
-	Tcl_AppendToObj(message, "\"", 1);
-	Tcl_SetObjResult(interp, message);
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "unknown math function \"%s\"", name));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
 	*numArgsPtr = -1;
 	*argTypesPtr = NULL;
 	*procPtr = NULL;
@@ -3482,9 +3782,6 @@ int
 TclInterpReady(
     Tcl_Interp *interp)
 {
-#if !defined(TCL_NO_STACK_CHECK)
-    int localInt; /* used for checking the stack */
-#endif
     register Interp *iPtr = (Interp *) interp;
 
     /*
@@ -3499,208 +3796,538 @@ TclInterpReady(
      */
 
     if (iPtr->flags & DELETED) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp,
-		"attempt to call eval in deleted interpreter", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to call eval in deleted interpreter", -1));
 	Tcl_SetErrorCode(interp, "TCL", "IDELETE",
 		"attempt to call eval in deleted interpreter", NULL);
 	return TCL_ERROR;
     }
 
+    if (iPtr->execEnvPtr->rewind) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure the script being evaluated (if any) has not been canceled.
+     */
+
+    if (TclCanceled(iPtr) &&
+	    (TCL_OK != Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG))) {
+	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)
-	    && CheckCStack(iPtr, &localInt)) {
+    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
 	return TCL_OK;
     }
 
-    if (!CheckCStack(iPtr, &localInt)) {
-	Tcl_AppendResult(interp,
-		"out of stack space (infinite loop?)", NULL);
-    } else {
-	Tcl_AppendResult(interp,
-		"too many nested evaluations (infinite loop?)", NULL);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "too many nested evaluations (infinite loop?)", -1));
+    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclResetCancellation --
+ *
+ *	Reset the script cancellation flags if the nesting level
+ *	(iPtr->numLevels) for the interp is zero or argument force is
+ *	non-zero.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	The script cancellation flags for the interp may be reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclResetCancellation(
+    Tcl_Interp *interp,
+    int force)
+{
+    register Interp *iPtr = (Interp *) interp;
+
+    if (iPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    if (force || (iPtr->numLevels == 0)) {
+	TclUnsetCancelFlags(iPtr);
     }
+    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 (!TclCanceled(iPtr)) {
+        return TCL_OK;
+    }
+
+    /*
+     * 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.
+     */
+
+    iPtr->flags &= ~CANCELED;
+
+    /*
+     * 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.
+     */
+
+    if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
+        return TCL_OK;
+    }
+
+    /*
+     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
+     * interp's result; otherwise, we leave it alone.
+     */
+
+    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 (iPtr->flags & TCL_CANCEL_UNWIND) {
+            id = "IUNWIND";
+            if (length == 0) {
+                message = "eval unwound";
+            }
+        } else {
+            id = "ICANCEL";
+            if (length == 0) {
+                message = "eval canceled";
+            }
+        }
+
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
+        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
+    }
+
+    /*
+     * 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.
+     */
+
     return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclEvalObjvInternal
+ * Tcl_CancelEval --
  *
- *	This function evaluates a Tcl command that has already been parsed
- *	into words, with one Tcl_Obj holding each word. The caller is
- *	responsible for managing the iPtr->numLevels.
+ *	This function schedules the cancellation of the current script in the
+ *	given interpreter.
+ *
+ * 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.
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+
+    if (interp == NULL) {
+	return TCL_ERROR;
+    }
+
+    Tcl_MutexLock(&cancelLock);
+    if (cancelTableInitialized != 1) {
+	/*
+	 * No CancelInfo hash table (Tcl_CreateInterp has never been called?)
+	 */
+
+	goto done;
+    }
+    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) interp);
+    if (hPtr == NULL) {
+	/*
+	 * No CancelInfo record for this interpreter.
+	 */
+
+	goto done;
+    }
+    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;
+    }
+    cancelInfo->clientData = clientData;
+    cancelInfo->flags = flags;
+    Tcl_AsyncMark(cancelInfo->async);
+    code = TCL_OK;
+
+  done:
+    Tcl_MutexUnlock(&cancelLock);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InterpActive --
+ *
+ *	Returns non-zero if the specified interpreter is in use, i.e. if there
+ *	is an evaluation currently active in the interpreter.
+ *
+ * Results:
+ *	See above.
+ *
+ * Side effects:
+ *	None.
  *
- *      TclEvalObjvInternal is the backend for Tcl_EvalObjv, the bytecode
- *      engine also calls it directly.
+ *----------------------------------------------------------------------
+ */
+
+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. If an
- *	error occurs, this function does NOT add any information to the
- *	errorInfo variable.
+ *	TCL_ERROR. A result or error message is left in interp's result.
  *
  * Side effects:
- *	Depends on the command.
+ *	Always pushes a callback. Other side effects depend on the command.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclEvalObjvInternal(
+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. */
-    const char *command,	/* Points to the beginning of the string
-				 * representation of the command; this is used
-				 * for traces. NULL if the string
-				 * representation of the command is unknown is
-				 * to be generated from (objc,objv), -1 if it
-				 * is to be generated from bytecode
-				 * source. This is only needed the traces. */
-    int length,			/* Number of bytes in command; if -1, all
-				 * characters up to the first null byte are
-				 * used. */
     int flags)			/* Collection of OR-ed bits that control the
 				 * evaluation of the script. Only
-				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
-				 * currently supported. */
+				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
+				 * TCL_EVAL_NOERR are currently supported. */
 {
-    Command *cmdPtr;
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj **newObjv;
-    int i;
-    CallFrame *savedVarFramePtr = NULL;
-    CallFrame *varFramePtr = iPtr->varFramePtr;
-    int code = TCL_OK;
-    int traceCode = TCL_OK;
-    int checkTraces = 1, traced;
-    Namespace *savedNsPtr = NULL;
-    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
-    Tcl_Obj *commandPtr = NULL;
+    int result;
+    NRE_callback *rootPtr = TOP_CB(interp);
 
-    if (TclInterpReady(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
+    result = TclNREvalObjv(interp, objc, objv, flags, NULL);
+    return TclNRRunCallbacks(interp, result, rootPtr);
+}
 
-    if (objc == 0) {
-	return TCL_OK;
-    }
+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. */
+{
+    Interp *iPtr = (Interp *) interp;
 
     /*
-     * If any execution traces rename or delete the current command, we may
-     * need (at most) two passes here.
+     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
+     * command redirectors (imports, alias, ensembles) so that tailcall skips
+     * this callback (that marks the end of the target command) and goes back
+     * to the end of the source command.
      */
 
-  reparseBecauseOfTraces:
+    if (iPtr->deferredCallbacks) {
+        iPtr->deferredCallbacks = NULL;
+    } else {
+	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+    }
 
-    /*
-     * Configure evaluation context to match the requested flags.
-     */
+    iPtr->numLevels++;
+    TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
+	    INT2PTR(objc), objv);
+    return TCL_OK;
+}
 
-    if (flags) {
-	if (flags & TCL_EVAL_INVOKE) {
-	    savedNsPtr = varFramePtr->nsPtr;
-	    if (lookupNsPtr) {
-		varFramePtr->nsPtr = lookupNsPtr;
-		iPtr->lookupNsPtr = NULL;
-	    } else {
-		varFramePtr->nsPtr = iPtr->globalNsPtr;
-	    }
-	} else if ((flags & TCL_EVAL_GLOBAL)
-		&& (varFramePtr != iPtr->rootFramePtr) && !savedVarFramePtr) {
-	    varFramePtr = iPtr->rootFramePtr;
-	    savedVarFramePtr = iPtr->varFramePtr;
-	    iPtr->varFramePtr = varFramePtr;
-	}
-    }
+static int
+EvalObjvCore(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Command *cmdPtr = NULL, *preCmdPtr = data[0];
+    int flags = PTR2INT(data[1]);
+    int objc = PTR2INT(data[2]);
+    Tcl_Obj **objv = data[3];
+    Interp *iPtr = (Interp *) interp;
+    Namespace *lookupNsPtr = NULL;
+    int enterTracesDone = 0;
 
     /*
-     * Find the function to execute this command. If there isn't one, then see
-     * if there is an unknown command handler registered for this namespace.
-     * If so, create a new word array with the handler as the first words and
-     * the original command words as arguments. Then call ourselves
-     * recursively to execute it.
+     * Push records for task to be done on return, in INVERSE order. First, if
+     * needed, the exception handlers (as they should happen last).
      */
 
-    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
-    if (!cmdPtr) {
-	goto notFound;
+    if (!(flags & TCL_EVAL_NOERR)) {
+	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
     }
 
-    if (savedNsPtr) {
-	varFramePtr->nsPtr = savedNsPtr;
-    } else if (iPtr->ensembleRewrite.sourceObjs) {
-	/*
-	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
-	 */
+    if (TCL_OK != TclInterpReady(interp)) {
+	return TCL_ERROR;
+    }
+
+    if (objc == 0) {
+	return TCL_OK;
+    }
 
-	iPtr->ensembleRewrite.sourceObjs = NULL;
+    if (TclLimitExceeded(iPtr->limit)) {
+	return TCL_ERROR;
     }
 
     /*
-     * Call trace functions if needed.
+     * Configure evaluation context to match the requested flags.
      */
 
-    traced = (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES));
-    if (traced && checkTraces) {
-	int cmdEpoch = cmdPtr->cmdEpoch;
-	int newEpoch;
+    if (iPtr->lookupNsPtr) {
 
 	/*
-	 * Insure that we have a correct nul-terminated command string for the
-	 * trace code.
+	 * Capture the namespace we should do command name resolution in, as
+	 * instructed by our caller sneaking it in to us in a private interp
+	 * field.  Clear that field right away so we cannot possibly have its
+	 * use leak where it should not.  The sneaky message pass is done.
+	 *
+	 * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag.
+	 * TODO: Is that a bug?
 	 */
 
-	commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
-	command = TclGetStringFromObj(commandPtr, &length);
+	lookupNsPtr = iPtr->lookupNsPtr;
+	iPtr->lookupNsPtr = NULL;
+    } else if (flags & TCL_EVAL_INVOKE) {
+	lookupNsPtr = iPtr->globalNsPtr;
+    } else {
 
 	/*
-	 * 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.
+	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
 	 */
 
-	cmdPtr->refCount++;
-	if (iPtr->tracePtr && (traceCode == TCL_OK)) {
-	    traceCode = TclCheckInterpTraces(interp, command, length,
-		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
+	TclResetRewriteEnsemble(interp, 1);
+
+	if (flags & TCL_EVAL_GLOBAL) {
+	    TEOV_SwitchVarFrame(interp);
+	    lookupNsPtr = iPtr->globalNsPtr;
 	}
-	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
-	    traceCode = TclCheckExecutionTraces(interp, command, length,
-		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
+    }
+
+    /*
+     * Lookup the Command to dispatch.
+     */
+
+    reresolve:
+    assert(cmdPtr == NULL);
+    if (preCmdPtr) {
+	/* Caller gave it to us */
+	if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
+	    /* So long as it exists, use it. */
+	    cmdPtr = preCmdPtr;
+	} else if (flags & TCL_EVAL_NORESOLVE) {
+	    /*
+	     * When it's been deleted, and we're told not to attempt
+	     * resolving it ourselves, all we can do is raise an error.
+	     */
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "attempt to invoke a deleted command"));
+	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
+	    return TCL_ERROR;
 	}
-	newEpoch = cmdPtr->cmdEpoch;
-	TclCleanupCommandMacro(cmdPtr);
+    }
+    if (cmdPtr == NULL) {
+	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+	if (!cmdPtr) {
+	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	}
+    }
 
-	/*
-	 * If the traces modified/deleted the command or any existing traces,
-	 * they will update the command's epoch. When that happens, set
-	 * checkTraces is set to 0 to prevent the re-calling of traces (and
-	 * any possible infinite loop) and we go back to re-find the command
-	 * implementation.
-	 */
+    if (enterTracesDone || iPtr->tracePtr
+	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+
+	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
+		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
+		objc, objv);
+	Tcl_IncrRefCount(commandPtr);
+
+	if (!enterTracesDone) {
+
+	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
+		    objc, objv);
 
-	if (traceCode == TCL_OK && cmdEpoch != newEpoch) {
-	    checkTraces = 0;
-	    if (commandPtr) {
+	    /*
+	     * Send any exception from enter traces back as an exception
+	     * raised by the traced command.
+	     * TODO: Is this a bug?  Letting an execution trace BREAK or
+	     * CONTINUE or RETURN in the place of the traced command?
+	     * Would either converting all exceptions to TCL_ERROR, or
+	     * just swallowing them be better?  (Swallowing them has the
+	     * problem of permanently hiding program errors.)
+	     */
+
+	    if (code != TCL_OK) {
 		Tcl_DecrRefCount(commandPtr);
-		commandPtr = NULL;
+		return code;
+	    }
+
+	    /*
+	     * If the enter traces made the resolved cmdPtr unusable, go
+	     * back and resolve again, but next time don't run enter
+	     * traces again.
+	     */
+
+	    if (cmdPtr == NULL) {
+		enterTracesDone = 1;
+		Tcl_DecrRefCount(commandPtr);
+		goto reresolve;
 	    }
-	    goto reparseBecauseOfTraces;
 	}
+
+	/*
+	 * Schedule leave traces.  Raise the refCount on the resolved
+	 * cmdPtr, so that when it passes to the leave traces we know
+	 * it's still valid.
+	 */
+
+	cmdPtr->refCount++;
+	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+		    commandPtr, cmdPtr, objv);
     }
 
+    TclNRAddCallback(interp, Dispatch,
+	    cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
+	    cmdPtr->objClientData, INT2PTR(objc), objv);
+    return TCL_OK;
+}
+
+static int
+Dispatch(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_ObjCmdProc *objProc = data[0];
+    ClientData clientData = data[1];
+    int objc = PTR2INT(data[2]);
+    Tcl_Obj **objv = data[3];
+    Interp *iPtr = (Interp *) interp;
+
 #ifdef USE_DTRACE
     if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
-	char *a[10];
+	const char *a[10];
 	int i = 0;
 
 	while (i < 10) {
@@ -3711,172 +4338,304 @@ TclEvalObjvInternal(
     }
     if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
 	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
-	char *a[4]; int i[2];
+	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]);
+	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 */
 
+    iPtr->cmdCount++;
+    return objProc(clientData, interp, objc, objv);
+}
+
+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;
+
     /*
-     * Finally, invoke the command's Tcl_ObjCmdProc.
+     * 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.
      */
 
-    cmdPtr->refCount++;
-    iPtr->cmdCount++;
-    if (code == TCL_OK && traceCode == TCL_OK
-	    && !TclLimitExceeded(iPtr->limit)) {
-	if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
-	    TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
-		    (Tcl_Obj **)(objv + 1));
-	}
-	code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
-	if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
-	    TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
-	}
+    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;
+}
+
+static int
+NRCommand(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    iPtr->numLevels--;
+
+     /*
+      * If there is a tailcall, schedule it next
+      */
+
+    if (data[1] && (data[1] != INT2PTR(1))) {
+        TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
     }
 
+    /* OPT ??
+     * Do not interrupt a series of cleanups with async or limit checks:
+     * just check at the end?
+     */
+
     if (TclAsyncReady(iPtr)) {
-	code = Tcl_AsyncInvoke(interp, code);
+	result = Tcl_AsyncInvoke(interp, result);
+    }
+    if ((result == TCL_OK) && TclCanceled(iPtr)) {
+	result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG);
     }
-    if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
-	code = Tcl_LimitCheck(interp);
+    if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
+	result = Tcl_LimitCheck(interp);
     }
 
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TEOV_Exception	 -
+ * TEOV_LookupCmdFromObj -
+ * TEOV_RunEnterTraces	 -
+ * TEOV_RunLeaveTraces	 -
+ * TEOV_NotFound	 -
+ *
+ *	These are helper functions for Tcl_EvalObjv.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TEOV_PushExceptionHandlers(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[],
+    int flags)
+{
+    Interp *iPtr = (Interp *) interp;
+
     /*
-     * Call 'leave' command traces
+     * 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 (traced) {
-	if (!(cmdPtr->flags & CMD_IS_DELETED)) {
-	    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
-		traceCode = TclCheckExecutionTraces(interp, command, length,
-			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
-	    }
-	    if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
-		traceCode = TclCheckInterpTraces(interp, command, length,
-			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
-	    }
-	}
+    if (!(flags & TCL_EVAL_INVOKE)) {
+	/*
+	 * Error messages
+	 */
+
+	TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc),
+		(ClientData) objv, NULL, NULL);
+    }
 
+    if (iPtr->numLevels == 1) {
 	/*
-	 * 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.
+	 * No CONTINUE or BREAK at level 0, manage RETURN
 	 */
 
-	if (traceCode != TCL_OK) {
-	    code = traceCode;
-	}
-	if (commandPtr) {
-	    Tcl_DecrRefCount(commandPtr);
-	}
+	TclNRAddCallback(interp, TEOV_Exception, INT2PTR(iPtr->evalFlags),
+		NULL, NULL, NULL);
     }
+}
+
+static void
+TEOV_SwitchVarFrame(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
 
     /*
-     * Decrement the reference count of cmdPtr and deallocate it if it has
-     * dropped to zero.
+     * Change the varFrame to be the rootVarFrame, and push a record to
+     * restore things at the end.
      */
 
-    TclCleanupCommandMacro(cmdPtr);
+    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;
+	}
+    }
 
     /*
-     * 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.
+     * 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.
      */
 
-    if (*(iPtr->result) != 0) {
-	(void) Tcl_GetObjResult(interp);
-    }
+    TclUnsetCancelFlags(iPtr);
+    return result;
+}
 
-#ifdef USE_DTRACE
-    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
-	Tcl_Obj *r;
+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];
 
-	r = Tcl_GetObjResult(interp);
-	TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
-    }
-#endif /* USE_DTRACE */
+    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.
+	 */
 
-  done:
-    if (savedVarFramePtr) {
-	iPtr->varFramePtr = savedVarFramePtr;
+	listPtr = Tcl_NewListObj(objc, objv);
+	cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
+	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+	Tcl_DecrRefCount(listPtr);
     }
-    return code;
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    return result;
+}
 
-  notFound:
-    {
-	Namespace *currNsPtr = NULL;	/* Used to check for and invoke any
-					 * registered unknown command handler
-					 * for the current namespace (TIP
-					 * 181). */
-	int newObjc, handlerObjc;
-	Tcl_Obj **handlerObjv;
-
-	currNsPtr = varFramePtr->nsPtr;
-	if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
-	    currNsPtr = iPtr->globalNsPtr;
-	    if (currNsPtr == NULL) {
-		Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
-	    }
+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;
+
+    currNsPtr = varFramePtr->nsPtr;
+    if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+	currNsPtr = iPtr->globalNsPtr;
+	if (currNsPtr == NULL) {
+	    Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer");
 	}
+    }
 
-	/*
-	 * Check to see if the resolution namespace has lost its unknown
-	 * handler. If so, reset it to "::unknown".
-	 */
+    /*
+     * Check to see if the resolution namespace has lost its unknown handler.
+     * If so, reset it to "::unknown".
+     */
 
-	if (currNsPtr->unknownHandlerPtr == NULL) {
-	    TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
-	    Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
-	}
+    if (currNsPtr->unknownHandlerPtr == NULL) {
+	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+    }
 
-	/*
-	 * 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.
-	 */
+    /*
+     * Get the list of words for the unknown handler and allocate enough space
+     * to hold both the handler prefix and all words of the command invokation
+     * itself.
+     */
 
-	Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
-		&handlerObjc, &handlerObjv);
-	newObjc = objc + handlerObjc;
-	newObjv = (Tcl_Obj **) TclStackAlloc(interp,
-		(int) sizeof(Tcl_Obj *) * newObjc);
+    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+	    &handlerObjc, &handlerObjv);
+    newObjc = objc + handlerObjc;
+    newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);
 
-	/*
-	 * Copy command prefix from unknown handler and add on the real
-	 * command's full argument list. Note that we only use memcpy() once
-	 * because we have to increment the reference count of all the handler
-	 * arguments anyway.
-	 */
+    /*
+     * Copy command prefix from unknown handler and add on the real command's
+     * full argument list. Note that we only use memcpy() once because we have
+     * to increment the reference count of all the handler arguments anyway.
+     */
 
-	for (i = 0; i < handlerObjc; ++i) {
-	    newObjv[i] = handlerObjv[i];
-	    Tcl_IncrRefCount(newObjv[i]);
-	}
-	memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
+    for (i = 0; i < handlerObjc; ++i) {
+	newObjv[i] = handlerObjv[i];
+	Tcl_IncrRefCount(newObjv[i]);
+    }
+    memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
 
-	/*
-	 * 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.
-	 */
+    /*
+     * 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.
+     */
 
-	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
-	if (cmdPtr == NULL) {
-	    Tcl_AppendResult(interp, "invalid command name \"",
-		    TclGetString(objv[0]), "\"", NULL);
-	    code = TCL_ERROR;
-	} else {
-	    iPtr->numLevels++;
-	    code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
-		    length, 0);
-	    iPtr->numLevels--;
-	}
+    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
+    if (cmdPtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "invalid command name \"%s\"", TclGetString(objv[0])));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+                TclGetString(objv[0]), NULL);
 
 	/*
 	 * Release any resources we locked and allocated during the handler
@@ -3887,89 +4646,165 @@ TclEvalObjvInternal(
 	    Tcl_DecrRefCount(newObjv[i]);
 	}
 	TclStackFree(interp, newObjv);
-	if (savedNsPtr) {
-	    varFramePtr->nsPtr = savedNsPtr;
-	}
-	goto done;
+	return TCL_ERROR;
+    }
+
+    if (lookupNsPtr) {
+	savedNsPtr = varFramePtr->nsPtr;
+	varFramePtr->nsPtr = lookupNsPtr;
     }
+    TclSkipTailcall(interp);
+    TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
+	    newObjv, savedNsPtr, NULL);
+    return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * 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:
- *	Depends on the command.
- *
- *----------------------------------------------------------------------
- */
 
-int
-Tcl_EvalObjv(
-    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
-				 * command. Also used for error reporting. */
-    int objc,			/* Number of words in command. */
-    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
-				 * the words that make up the command. */
-    int flags)			/* Collection of OR-ed bits that control the
-				 * evaluation of the script. Only
-				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
-				 * currently supported. */
+static int
+TEOV_NotFoundCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
 {
     Interp *iPtr = (Interp *) interp;
-    int code = TCL_OK;
-    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+    int objc = PTR2INT(data[0]);
+    Tcl_Obj **objv = data[1];
+    Namespace *savedNsPtr = data[2];
 
-    iPtr->numLevels++;
-    code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
-    iPtr->numLevels--;
+    int i;
 
-    if (code == TCL_OK) {
-	return code;
-    } else {
+    if (savedNsPtr) {
+	iPtr->varFramePtr->nsPtr = savedNsPtr;
+    }
 
-	/*
-	 * If we are again at the top level, process any unusual return code
-	 * returned by the evaluated code.
-	 */
+    /*
+     * Release any resources we locked and allocated during the handler call.
+     */
 
-	if (iPtr->numLevels == 0) {
-	    if (code == TCL_RETURN) {
-		code = TclUpdateReturnInfo(iPtr);
-	    }
-	    if ((code != TCL_ERROR) && !allowExceptions) {
-		ProcessUnexpectedResult(interp, code);
-		code = TCL_ERROR;
-	    }
+    for (i = 0; i < objc; ++i) {
+	Tcl_DecrRefCount(objv[i]);
+    }
+    TclStackFree(interp, objv);
+
+    return result;
+}
+
+static int
+TEOV_RunEnterTraces(
+    Tcl_Interp *interp,
+    Command **cmdPtrPtr,
+    Tcl_Obj *commandPtr,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Interp *iPtr = (Interp *) interp;
+    Command *cmdPtr = *cmdPtrPtr;
+    int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+    int length, traceCode = TCL_OK;
+    const char *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 (traceCode != TCL_OK) {
+	if (traceCode == TCL_ERROR) {
+	    Tcl_Obj *info;
+
+	    TclNewLiteralStringObj(info, "\n    (enter trace on \"");
+	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+	    Tcl_AppendToObj(info, "\")", 2);
+	    Tcl_AppendObjToErrorInfo(interp, info);
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
 	}
+	return traceCode;
+    }
+    if (cmdEpoch != newEpoch) {
+	*cmdPtrPtr = NULL;
+    }
+    return TCL_OK;
+}
 
-	if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
-	    /*
-	     * If there was an error, a command string will be needed for the
-	     * error log: generate it now. Do not worry too much about doing
-	     * it expensively.
-	     */
+static int
+TEOV_RunLeaveTraces(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    int traceCode = TCL_OK;
+    int objc = PTR2INT(data[0]);
+    Tcl_Obj *commandPtr = data[1];
+    Command *cmdPtr = data[2];
+    Tcl_Obj **objv = data[3];
+    int length;
+    const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+
+    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
+	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
+	    traceCode = TclCheckExecutionTraces(interp, command, length,
+		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	}
+	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+	    traceCode = TclCheckInterpTraces(interp, command, length,
+		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	}
+    }
 
-	    Tcl_Obj *listPtr;
-	    char *cmdString;
-	    int cmdLen;
+    /*
+     * 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.
+     */
 
-	    listPtr = Tcl_NewListObj(objc, objv);
-	    cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
-	    Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
-	    Tcl_DecrRefCount(listPtr);
+    TclCleanupCommandMacro(cmdPtr);
+
+    if (traceCode != TCL_OK) {
+	if (traceCode == TCL_ERROR) {
+	    Tcl_Obj *info;
+
+	    TclNewLiteralStringObj(info, "\n    (leave trace on \"");
+	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
+	    Tcl_AppendToObj(info, "\")", 2);
+	    Tcl_AppendObjToErrorInfo(interp, info);
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
 	}
+	result = traceCode;
+    }
+    Tcl_DecrRefCount(commandPtr);
+    return result;
+}
 
-	return code;
+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;
     }
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
+    iPtr->varFramePtr->nsPtr = savedNsPtr;
+    return cmdPtr;
 }
 
 /*
@@ -4003,7 +4838,7 @@ Tcl_EvalTokensStandard(
 				 * Must be at least 1. */
 {
     return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
-			  NULL, NULL);
+	    NULL, NULL);
 }
 
 /*
@@ -4087,7 +4922,7 @@ Tcl_EvalEx(
 				 * evaluation of the script. Only
 				 * TCL_EVAL_GLOBAL is currently supported. */
 {
-  return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
+    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
 }
 
 int
@@ -4102,23 +4937,23 @@ TclEvalEx(
 				 * 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.
-			      */
+    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. */
 {
     Interp *iPtr = (Interp *) interp;
     const char *p, *next;
@@ -4136,25 +4971,21 @@ TclEvalEx(
 				 * state has been allocated while evaluating
 				 * the script, so that it can be freed
 				 * properly if an error occurs. */
-    Tcl_Parse *parsePtr = (Tcl_Parse *)
-	    TclStackAlloc(interp, sizeof(Tcl_Parse));
-    CmdFrame *eeFramePtr = (CmdFrame *)
-	    TclStackAlloc(interp, sizeof(CmdFrame));
-    Tcl_Obj **stackObjArray = (Tcl_Obj **)
+    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 = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
-    int *linesStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
+    int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int));
+    int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
 				/* TIP #280 Structures for tracking of command
 				 * locations. */
-    /*
-     * Pointer for the tracking of invisible continuation lines. Initialized
-     * only if the caller gave us a table of locations to track, via
-     * 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;
+    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. */
 
     if (iPtr->scriptCLLocPtr) {
 	if (clNextOuter) {
@@ -4188,23 +5019,22 @@ TclEvalEx(
     /*
      * 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.
+     * We 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.
-	 */
+    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
+    eeFramePtr->framePtr = iPtr->framePtr;
+    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
+    eeFramePtr->nline = 0;
+    eeFramePtr->line = NULL;
+    eeFramePtr->cmdObj = NULL;
 
-	eeFramePtr->type = TCL_LOCATION_SOURCE;
-	eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
-	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
-    } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
+    iPtr->cmdFramePtr = eeFramePtr;
+    if (iPtr->evalFlags & TCL_EVAL_FILE) {
 	/*
 	 * Set up for a sourced file.
 	 */
@@ -4225,6 +5055,7 @@ TclEvalEx(
 		/*
 		 * Error message in the interp result.
 		 */
+
 		code = TCL_ERROR;
 		goto error;
 	    }
@@ -4242,17 +5073,13 @@ TclEvalEx(
 	eeFramePtr->data.eval.path = NULL;
     }
 
-    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
-    eeFramePtr->framePtr = iPtr->framePtr;
-    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
-    eeFramePtr->nline = 0;
-    eeFramePtr->line = NULL;
-
     iPtr->evalFlags = 0;
     do {
 	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
 	    code = TCL_ERROR;
-	    goto error;
+	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
+		    parsePtr->term + 1 - parsePtr->commandStart);
+	    goto posterror;
 	}
 
 	/*
@@ -4262,8 +5089,8 @@ TclEvalEx(
 	 */
 
 	TclAdvanceLines(&line, p, parsePtr->commandStart);
-	TclAdvanceContinuations (&line, &clNext,
-				 parsePtr->commandStart - outerScript);
+	TclAdvanceContinuations(&line, &clNext,
+		parsePtr->commandStart - outerScript);
 
 	gotParse = 1;
 	if (parsePtr->numWords > 0) {
@@ -4274,27 +5101,26 @@ TclEvalEx(
 	     * per-command parsing.
 	     */
 
-	    int wordLine  = line;
+	    int wordLine = line;
 	    const char *wordStart = parsePtr->commandStart;
-	    int*        wordCLNext = clNext;
+	    int *wordCLNext = clNext;
+	    unsigned int objectsNeeded = 0;
+	    unsigned int numWords = parsePtr->numWords;
 
 	    /*
 	     * Generate an array of objects for the words of the command.
 	     */
 
-	    unsigned int objectsNeeded = 0;
-	    unsigned int numWords = parsePtr->numWords;
-
 	    if (numWords > minObjs) {
-		expand = (int *) ckalloc(numWords * sizeof(int));
-		objvSpace = (Tcl_Obj **)
-			ckalloc(numWords * sizeof(Tcl_Obj *));
-		lineSpace = (int *) ckalloc(numWords * sizeof(int));
+		expand =    ckalloc(numWords * sizeof(int));
+		objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
+		lineSpace = ckalloc(numWords * sizeof(int));
 	    }
 	    expandRequested = 0;
 	    objv = objvSpace;
 	    lines = lineSpace;
 
+	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
 	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
 		    objectsUsed < numWords;
 		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
@@ -4307,8 +5133,8 @@ TclEvalEx(
 		 */
 
 		TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
-		TclAdvanceContinuations (&wordLine, &wordCLNext,
-					 tokenPtr->start - outerScript);
+		TclAdvanceContinuations(&wordLine, &wordCLNext,
+			tokenPtr->start - outerScript);
 		wordStart = tokenPtr->start;
 
 		lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
@@ -4320,12 +5146,12 @@ TclEvalEx(
 
 		code = TclSubstTokens(interp, tokenPtr+1,
 			tokenPtr->numComponents, NULL, wordLine,
-		        wordCLNext, outerScript);
+			wordCLNext, outerScript);
 
 		iPtr->evalFlags = 0;
 
 		if (code != TCL_OK) {
-		    goto error;
+		    break;
 		}
 		objv[objectsUsed] = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(objv[objectsUsed]);
@@ -4342,7 +5168,7 @@ TclEvalEx(
 			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 				"\n    (expanding word %d)", objectsUsed));
 			Tcl_DecrRefCount(objv[objectsUsed]);
-			goto error;
+			break;
 		    }
 		    expandRequested = 1;
 		    expand[objectsUsed] = 1;
@@ -4354,10 +5180,14 @@ TclEvalEx(
 		}
 
 		if (wordCLNext) {
-		    TclContinuationsEnterDerived (objv[objectsUsed],
-				  wordStart - outerScript, 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.
@@ -4368,11 +5198,10 @@ TclEvalEx(
 		int wordIdx = numWords;
 		int objIdx = objectsNeeded - 1;
 
-		if ((numWords > minObjs) || (objectsNeeded >  minObjs)) {
-		    objv = objvSpace = (Tcl_Obj **)
+		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
+		    objv = objvSpace =
 			    ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
-		    lines = lineSpace = (int *)
-			    ckalloc(objectsNeeded * sizeof(int));
+		    lines = lineSpace = ckalloc(objectsNeeded * sizeof(int));
 		}
 
 		objectsUsed = 0;
@@ -4399,10 +5228,10 @@ TclEvalEx(
 		objv += objIdx+1;
 
 		if (copy != stackObjArray) {
-		    ckfree((char *) copy);
+		    ckfree(copy);
 		}
 		if (lcopy != linesStack) {
-		    ckfree((char *) lcopy);
+		    ckfree(lcopy);
 		}
 	    }
 
@@ -4416,28 +5245,28 @@ TclEvalEx(
 	     * have been executed.
 	     */
 
-	    eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
-	    eeFramePtr->cmd.str.len = parsePtr->commandSize;
+	    eeFramePtr->cmd = parsePtr->commandStart;
+	    eeFramePtr->len = parsePtr->commandSize;
 
 	    if (parsePtr->term ==
 		    parsePtr->commandStart + parsePtr->commandSize - 1) {
-		eeFramePtr->cmd.str.len--;
+		eeFramePtr->len--;
 	    }
 
 	    eeFramePtr->nline = objectsUsed;
 	    eeFramePtr->line = lines;
 
-	    TclArgumentEnter (interp, objv, objectsUsed, eeFramePtr);
-	    iPtr->cmdFramePtr = eeFramePtr;
-	    iPtr->numLevels++;
-	    code = TclEvalObjvInternal(interp, objectsUsed, objv,
-		    parsePtr->commandStart, parsePtr->commandSize, 0);
-	    iPtr->numLevels--;
-	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
-	    TclArgumentRelease (interp, objv, objectsUsed);
+	    TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr);
+	    code = Tcl_EvalObjv(interp, objectsUsed, objv,
+		    TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME);
+	    TclArgumentRelease(interp, objv, objectsUsed);
 
 	    eeFramePtr->line = NULL;
 	    eeFramePtr->nline = 0;
+	    if (eeFramePtr->cmdObj) {
+		Tcl_DecrRefCount(eeFramePtr->cmdObj);
+		eeFramePtr->cmdObj = NULL;
+	    }
 
 	    if (code != TCL_OK) {
 		goto error;
@@ -4447,9 +5276,9 @@ TclEvalEx(
 	    }
 	    objectsUsed = 0;
 	    if (objvSpace != stackObjArray) {
-		ckfree((char *) objvSpace);
+		ckfree(objvSpace);
 		objvSpace = stackObjArray;
-		ckfree((char *) lineSpace);
+		ckfree(lineSpace);
 		lineSpace = linesStack;
 	    }
 
@@ -4459,7 +5288,7 @@ TclEvalEx(
 	     */
 
 	    if (expand != expandStack) {
-		ckfree((char *) expand);
+		ckfree(expand);
 		expand = expandStack;
 	    }
 	}
@@ -4511,6 +5340,7 @@ TclEvalEx(
 	Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
 		commandLength);
     }
+ posterror:
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
 
     /*
@@ -4524,11 +5354,11 @@ TclEvalEx(
 	Tcl_FreeParse(parsePtr);
     }
     if (objvSpace != stackObjArray) {
-	ckfree((char *) objvSpace);
-	ckfree((char *) lineSpace);
+	ckfree(objvSpace);
+	ckfree(lineSpace);
     }
     if (expand != expandStack) {
-	ckfree((char *) expand);
+	ckfree(expand);
     }
     iPtr->varFramePtr = savedVarFramePtr;
 
@@ -4537,6 +5367,7 @@ TclEvalEx(
      * TIP #280. Release the local CmdFrame, and its contents.
      */
 
+    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
     if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
 	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
     }
@@ -4603,29 +5434,31 @@ TclAdvanceLines(
  */
 
 void
-TclAdvanceContinuations (line,clNextPtrPtr,loc)
-     int* line;
-     int** clNextPtrPtr;
-     int loc;
+TclAdvanceContinuations(
+    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
+     * TclSubstTokens via TclParseBackslash.
      *
      * *clNextPtrPtr         <=> We have continuation lines to track.
      * **clNextPtrPtr >= 0   <=> We are not beyond the last possible location.
      * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
      */
 
-    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)++;
     }
 }
 
@@ -4643,8 +5476,8 @@ TclAdvanceContinuations (line,clNextPtrPtr,loc)
  *
  * 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.
  *
@@ -4659,45 +5492,49 @@ TclAdvanceContinuations (line,clNextPtrPtr,loc)
  */
 
 void
-TclArgumentEnter(interp,objv,objc,cfPtr)
-     Tcl_Interp* interp;
-     Tcl_Obj**   objv;
-     int         objc;
-     CmdFrame*   cfPtr;
+TclArgumentEnter(
+    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, (char*) objv[i], &new);
+	if (cfPtr->line[i] < 0) {
+	    continue;
+	}
+	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new);
 	if (new) {
-           /*
-	    * 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);
+	    /*
+	     * 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);
 	} else {
-           /*
-	    * 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 ++;
+	    /*
+	     * 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++;
 	}
     }
 }
@@ -4707,10 +5544,10 @@ TclArgumentEnter(interp,objv,objc,cfPtr)
  *
  * 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.
@@ -4723,27 +5560,31 @@ TclArgumentEnter(interp,objv,objc,cfPtr)
  */
 
 void
-TclArgumentRelease(interp,objv,objc)
-     Tcl_Interp* interp;
-     Tcl_Obj**   objv;
-     int         objc;
-{
-    Interp*        iPtr = (Interp*) interp;
-    Tcl_HashEntry* hPtr;
-    CFWord*        cfwPtr;
+TclArgumentRelease(
+    Tcl_Interp *interp,
+    Tcl_Obj **objv,
+    int objc)
+{
+    Interp *iPtr = (Interp *) interp;
     int i;
 
-    for (i=1; i < objc; i++) {
-       hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) objv[i]);
+    for (i = 1; i < objc; i++) {
+	CFWord *cfwPtr;
+	Tcl_HashEntry *hPtr =
+		Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);
 
-       if (!hPtr) { continue; }
-       cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+	if (!hPtr) {
+	    continue;
+	}
+	cfwPtr = Tcl_GetHashValue(hPtr);
 
-       cfwPtr->refCount --;
-       if (cfwPtr->refCount > 0) { continue; }
+	cfwPtr->refCount--;
+	if (cfwPtr->refCount > 0) {
+	    continue;
+	}
 
-       ckfree ((char*) cfwPtr);
-       Tcl_DeleteHashEntry (hPtr);
+	ckfree(cfwPtr);
+	Tcl_DeleteHashEntry(hPtr);
     }
 }
 
@@ -4752,9 +5593,9 @@ TclArgumentRelease(interp,objv,objc)
  *
  * 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 invoked. Only the first entry has the actual
  *	data, further entries simply count the usage up.
  *
  * Results:
@@ -4768,73 +5609,94 @@ TclArgumentRelease(interp,objv,objc)
  */
 
 void
-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);
-
-    if (hePtr) {
-	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
-	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
-
-	if (hePtr) {
-	    int  cmd  = PTR2INT(Tcl_GetHashValue(hePtr));
-	    ECL* ePtr = &eclPtr->loc[cmd];
-	    int word;
+TclArgumentBCEnter(
+    Tcl_Interp *interp,
+    Tcl_Obj *objv[],
+    int objc,
+    void *codePtr,
+    CmdFrame *cfPtr,
+    int cmd,
+    int pc)
+{
+    ExtCmdLoc *eclPtr;
+    int word;
+    ECL *ePtr;
+    CFWordBC *lastPtr = NULL;
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hePtr =
+	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
 
-	    /*
-	     * 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) {
+	return;
+    }
+    eclPtr = Tcl_GetHashValue(hePtr);
+    ePtr = &eclPtr->loc[cmd];
 
-	    if (ePtr->nline != objc) {
-		Tcl_Panic ("TIP 280 data structure inconsistency");
-	    }
+    /*
+     * ePtr->nline is the number of words originally parsed.
+     *
+     * objc is the number of elements getting invoked.
+     *
+     * If they are not the same, we arrived here by compiling an
+     * ensemble dispatch.  Ensemble subcommands that lead to script
+     * evaluation are not supposed to get compiled, because a command
+     * such as [info level] in the script can expose some of the dispatch
+     * shenanigans.  This means that we don't have to tend to the
+     * housekeeping, and can escape now.
+     */
 
-	    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));
+    if (ePtr->nline != objc) {
+        return;
+    }
 
-		    cfwPtr->framePtr = cfPtr;
-		    cfwPtr->pc       = pc;
-		    cfwPtr->word     = word;
+    /*
+     * Having disposed of the ensemble cases, we can state...
+     * 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 (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);
-		    }
+    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));
 
-		    Tcl_SetHashValue (hPtr, cfwPtr);
-		}
-	    } /* for */
-	} /* if */
-    } /* if */
+	    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.
+		 */
+
+		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 = Tcl_GetHashValue(hPtr);
+	    }
+
+	    Tcl_SetHashValue(hPtr, cfwPtr);
+	}
+    } /* for */
+
+    cfPtr->litarg = lastPtr;
 }
 
 /*
@@ -4842,10 +5704,10 @@ TclArgumentBCEnter(interp,objv,objc,codePtr,cfPtr,pc)
  *
  * 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.
@@ -4858,48 +5720,34 @@ TclArgumentBCEnter(interp,objv,objc,codePtr,cfPtr,pc)
  */
 
 void
-TclArgumentBCRelease(interp,objv,objc,codePtr,pc)
-     Tcl_Interp* interp;
-     Tcl_Obj*    objv[];
-     int         objc;
-     void*       codePtr;
-     int         pc;
+TclArgumentBCRelease(
+    Tcl_Interp *interp,
+    CmdFrame *cfPtr)
 {
-    Interp*        iPtr  = (Interp*) interp;
-    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
-
-    if (hePtr) {
-	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
-	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
+    Interp *iPtr = (Interp *) interp;
+    CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg;
 
-	if (hePtr) {
-	    int  cmd  = PTR2INT(Tcl_GetHashValue(hePtr));
-	    ECL* ePtr = &eclPtr->loc[cmd];
-	    int word;
+    while (cfwPtr) {
+	CFWordBC *nextPtr = cfwPtr->nextPtr;
+	Tcl_HashEntry *hPtr =
+		Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
+	CFWordBC *xPtr = Tcl_GetHashValue(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);
-			}
+	if (xPtr != cfwPtr) {
+	    Tcl_Panic("TclArgumentBC Enter/Release Mismatch");
+	}
 
-			ckfree((char *) cfwPtr);
-		    }
-		}
-	    }
+	if (cfwPtr->prevPtr) {
+	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
+	} else {
+	    Tcl_DeleteHashEntry(hPtr);
 	}
+
+	ckfree(cfwPtr);
+	cfwPtr = nextPtr;
     }
+
+    cfPtr->litarg = NULL;
 }
 
 /*
@@ -4907,8 +5755,8 @@ TclArgumentBCRelease(interp,objv,objc,codePtr,pc)
  *
  * TclArgumentGet --
  *
- *	This procedure is a helper for the TIP #280 uplevel extension.
- *	It find the location references for a Tcl_Obj, if any.
+ *	This procedure is a helper for the TIP #280 uplevel extension. It
+ *	finds the location references for a Tcl_Obj, if any.
  *
  * Results:
  *	None.
@@ -4921,15 +5769,15 @@ TclArgumentBCRelease(interp,objv,objc,codePtr,pc)
  */
 
 void
-TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
-     Tcl_Interp* interp;
-     Tcl_Obj*    obj;
-     CmdFrame**  cfPtrPtr;
-     int*        wordPtr;
+TclArgumentGet(
+    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
@@ -4947,10 +5795,11 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
      * stack. That is nearest.
      */
 
-    hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) obj);
+    hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
     if (hPtr) {
-	CFWord* cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
-	*wordPtr  = cfwPtr->word;
+	CFWord *cfwPtr = Tcl_GetHashValue(hPtr);
+
+	*wordPtr = cfwPtr->word;
 	*cfPtrPtr = cfwPtr->framePtr;
 	return;
     }
@@ -4960,16 +5809,15 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
      * that stack.
      */
 
-    hPtr = Tcl_FindHashEntry (iPtr->lineLABCPtr, (char *) obj);
-
+    hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
     if (hPtr) {
-	CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
+	CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr);
 
 	framePtr = cfwPtr->framePtr;
-	framePtr->data.tebc.pc = (char *) (((ByteCode*)
+	framePtr->data.tebc.pc = (char *) (((ByteCode *)
 		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
 	*cfPtrPtr = cfwPtr->framePtr;
-	*wordPtr  = cfwPtr->word;
+	*wordPtr = cfwPtr->word;
 	return;
     }
 }
@@ -4996,6 +5844,7 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_Eval
 int
 Tcl_Eval(
     Tcl_Interp *interp,		/* Token for command interpreter (returned by
@@ -5039,7 +5888,6 @@ Tcl_EvalObj(
 {
     return Tcl_EvalObjEx(interp, objPtr, 0);
 }
-
 #undef Tcl_GlobalEvalObj
 int
 Tcl_GlobalEvalObj(
@@ -5058,6 +5906,11 @@ Tcl_GlobalEvalObj(
  *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
  *	specified.
  *
+ *	If the flag TCL_EVAL_DIRECT is passed in, the value of invoker
+ *	must be NULL.  Support for non-NULL invokers in that mode has
+ *	been removed since it was unused and untested.  Failure to
+ *	follow this limitation will lead to an assertion panic.
+ *
  * 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
@@ -5097,89 +5950,148 @@ TclEvalObjEx(
     const CmdFrame *invoker,	/* Frame of the command doing the eval. */
     int word)			/* Index of the word which is in objPtr. */
 {
-    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 result = TCL_OK;
+    NRE_callback *rootPtr = TOP_CB(interp);
 
-    Tcl_IncrRefCount(objPtr);
+    result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
+    return TclNRRunCallbacks(interp, result, rootPtr);
+}
 
-    /* Pure List Optimization (no string representation). In this case, we can
-     * safely use Tcl_EvalObjv instead and get an appreciable improvement in
-     * execution speed. This is because it allows us to avoid a setFromAny
-     * step that would just pack everything into a string and back out again.
-     *
-     * This also preserves any associations between list elements and location
-     * information for such elements.
-     *
-     * This restriction has been relaxed a bit by storing in lists whether
-     * they are "canonical" or not (a canonical list being one that is either
-     * pure or that has its string rep derived by UpdateStringOfList from the
-     * internal rep).
+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;
+    int result;
+
+    /*
+     * 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)) {
+	CmdFrame *eoFramePtr = NULL;
+	int objc;
+	Tcl_Obj *listPtr, **objv;
+
 	/*
-	 * TIP #280 Structures for tracking lines. As we know that this is
-	 * dynamic execution we ignore the invoker, even if known.
+	 * Canonical List Optimization:  In this case, we
+	 * can safely use Tcl_EvalObjv instead and get an appreciable
+	 * improvement in execution speed. This is because it allows us to
+	 * avoid a setFromAny step that would just pack everything into a
+	 * string and back out again.
+	 *
+	 * This also preserves any associations between list elements and
+	 * location information for such elements.
 	 */
 
-	int nelements;
-	Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
-	CmdFrame *eoFramePtr = (CmdFrame *)
-		TclStackAlloc(interp, sizeof(CmdFrame));
+	/*
+	 * 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.
+	 *
+	 * TODO: Create a test to demo this need, or eliminate it.
+	 * FIXME OPT: preserve just the internal rep?
+	 */
 
-	eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
-	eoFramePtr->level = (iPtr->cmdFramePtr == NULL?  1 
-		: iPtr->cmdFramePtr->level + 1);
-	eoFramePtr->framePtr = iPtr->framePtr;
-	eoFramePtr->nextPtr = iPtr->cmdFramePtr;
+	Tcl_IncrRefCount(objPtr);
+	listPtr = TclListObjCopy(interp, objPtr);
+	Tcl_IncrRefCount(listPtr);
 
-	eoFramePtr->nline = 0;
-	eoFramePtr->line = NULL;
+	if (word != INT_MIN) {
+	    /*
+	     * 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.
+	     *
+	     * Note that we use (word==INTMIN) to signal that no command frame
+	     * should be pushed, as needed by alias and ensemble redirections.
+	     */
 
-	eoFramePtr->cmd.listPtr  = objPtr;
-	Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
-	eoFramePtr->data.eval.path = NULL;
+	    eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	    eoFramePtr->nline = 0;
+	    eoFramePtr->line = NULL;
 
-	/*
-	 * TIP #280 We do _not_ compute all the line numbers for the words
-	 * in the command. For the eval of a pure list the most sensible
-	 * choice is to put all words on line 1. Given that we neither
-	 * need memory for them nor compute anything.  'line' is left
-	 * NULL. The two places using this information (TclInfoFrame, and
-	 * TclInitCompileEnv), are special-cased to use the proper line
-	 * number directly instead of accessing the 'line' array.
-	 */
+	    eoFramePtr->type = TCL_LOCATION_EVAL;
+	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
+		    1 : iPtr->cmdFramePtr->level + 1);
+	    eoFramePtr->framePtr = iPtr->framePtr;
+	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
-	Tcl_ListObjGetElements(NULL, copyPtr, &nelements, &elements);
+	    eoFramePtr->cmdObj = objPtr;
+	    eoFramePtr->cmd = NULL;
+	    eoFramePtr->len = 0;
+	    eoFramePtr->data.eval.path = NULL;
 
-	iPtr->cmdFramePtr = eoFramePtr;
-	result = Tcl_EvalObjv(interp, nelements, elements, flags);
+	    iPtr->cmdFramePtr = eoFramePtr;
 
-	Tcl_DecrRefCount(copyPtr);
-	iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
-	Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
-	TclStackFree(interp, eoFramePtr);
-    } else if (flags & TCL_EVAL_DIRECT) {
+	    flags |= TCL_EVAL_SOURCE_IN_FRAME;
+	}
+
+	TclMarkTailcall(interp);
+        TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+		objPtr, NULL);
+
+	ListObjGetElements(listPtr, objc, objv);
+	return TclNREvalObjv(interp, objc, objv, flags, NULL);
+    }
+
+    if (!(flags & TCL_EVAL_DIRECT)) {
 	/*
-	 * We're not supposed to use the compiler or byte-code interpreter.
-	 * Let Tcl_EvalEx evaluate the command directly (and probably more
-	 * slowly).
+	 * Let 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);
+    }
+
+    {
 	/*
-	 * 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.
+	 * We're not supposed to use the compiler or byte-code
+	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
+	 * probably more slowly).
 	 */
 
+	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
@@ -5189,7 +6101,7 @@ TclEvalObjEx(
 	 * 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"
+	 * 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
@@ -5197,135 +6109,94 @@ TclEvalObjEx(
 	 * executing nested commands in the eval/direct path.
 	 */
 
-	ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr;
-	ContLineLoc* clLocPtr = TclContinuationsGet (objPtr);
+	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
 
-	if (clLocPtr) {
-	    iPtr->scriptCLLocPtr = clLocPtr;
-	    Tcl_Preserve (iPtr->scriptCLLocPtr);
-	} else {
-	    iPtr->scriptCLLocPtr = NULL;
-	}
+	assert(invoker == NULL);
 
-	if (invoker == NULL) {
-	    /*
-	     * No context, force opening of our own.
-	     */
+	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);
 
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-	} else {
-	    /*
-	     * We have an invoker, describing the command asking for the
-	     * evaluation of a subordinate script. This script may originate
-	     * in a literal word, or from a variable, etc. Using the line
-	     * array we now check if we have good line information for the
-	     * relevant word. The type of context is relevant as well. In a
-	     * non-'source' context we don't have to try tracking lines.
-	     *
-	     * First see if the word exists and is a literal. If not we go
-	     * through the easy dynamic branch. No need to perform more
-	     * complex invokations.
-	     */
-
-	    int pc = 0;
-	    CmdFrame *ctxPtr = (CmdFrame *)
-		TclStackAlloc(interp, sizeof(CmdFrame));
-
-	    *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.
-		 */
-
-		TclGetSrcInfoForPc(ctxPtr);
-		pc = 1;
-	    }
-
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-
-	    if ((ctxPtr->nline <= word) ||
-		(ctxPtr->line[word] < 0) ||
-		(ctxPtr->type != TCL_LOCATION_SOURCE)) {
-		/*
-		 * Dynamic script, or dynamic context, force our own
-		 * context.
-		 */
-
-		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+	Tcl_IncrRefCount(objPtr);
 
-	    } else {
-		/*
-		 * Absolute context to reuse.
-		 */
+	script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
 
-		iPtr->invokeCmdFramePtr = ctxPtr;
-		iPtr->evalFlags |= TCL_EVAL_CTX;
+	TclDecrRefCount(objPtr);
 
-		result = TclEvalEx(interp, script, numSrcBytes, flags,
-				   ctxPtr->line[word], NULL, script);
-	    }
+	iPtr->scriptCLLocPtr = saveCLLocPtr;
+	return result;
+    }
+}
 
-	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
-		/*
-		 * Death of SrcInfo reference.
-		 */
+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]);
 
-		Tcl_DecrRefCount(ctxPtr->data.eval.path);
-	    }
-	    TclStackFree(interp, ctxPtr);
+    if (iPtr->numLevels == 0) {
+	if (result == TCL_RETURN) {
+	    result = TclUpdateReturnInfo(iPtr);
 	}
+	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
+	    const char *script;
+	    int numSrcBytes;
 
-	/*
-	 * Now release the lock on the continuation line information, if
-	 * any, and restore the caller's settings.
-	 */
-
-	if (iPtr->scriptCLLocPtr) {
-	    Tcl_Release (iPtr->scriptCLLocPtr);
+	    ProcessUnexpectedResult(interp, result);
+	    result = TCL_ERROR;
+	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
 	}
-	iPtr->scriptCLLocPtr = saveCLLocPtr;
-    } else {
+
 	/*
-	 * Let the compiler/engine subsystem do the evaluation.
-	 *
-	 * TIP #280 The invoker provides us with the context for the script.
-	 * We transfer this to the byte code compiler.
+	 * We are returning to level 0, so should call TclResetCancellation.
+	 * Let us just unset the flags inline.
 	 */
-	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-
-	savedVarFramePtr = iPtr->varFramePtr;
-	if (flags & TCL_EVAL_GLOBAL) {
-	    iPtr->varFramePtr = iPtr->rootFramePtr;
-	}
 
-	result = TclCompEvalObj(interp, objPtr, invoker, word);
+	TclUnsetCancelFlags(iPtr);
+    }
+    iPtr->evalFlags = 0;
 
-	/*
-	 * If we are again at the top level, process any unusual return code
-	 * returned by the evaluated code.
-	 */
+    /*
+     * Restore the callFrame if this was a TCL_EVAL_GLOBAL.
+     */
 
-	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;
-		script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-		Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
-	    }
-	}
-	iPtr->evalFlags = 0;
+    if (savedVarFramePtr) {
 	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];
+    Tcl_Obj *objPtr = data[2];
+
+    /*
+     * Remove the cmdFrame
+     */
+
+    if (eoFramePtr) {
+	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
+	TclStackFree(interp, eoFramePtr);
+    }
+    TclDecrRefCount(objPtr);
+    TclDecrRefCount(listPtr);
+
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -5353,17 +6224,21 @@ ProcessUnexpectedResult(
 				 * result code was returned. */
     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_SetObjResult(interp, Tcl_NewStringObj(
+		"invoked \"break\" outside of a loop", -1));
     } else if (returnCode == TCL_CONTINUE) {
-	Tcl_AppendResult(interp,
-		"invoked \"continue\" outside of a loop", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"invoked \"continue\" outside of a loop", -1));
     } else {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"command returned bad code: %d", returnCode));
     }
+    sprintf(buf, "%d", returnCode);
+    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
 }
 
 /*
@@ -5514,7 +6389,7 @@ Tcl_ExprLongObj(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK){
+    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -5607,6 +6482,7 @@ Tcl_ExprBooleanObj(
  *
  *	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.
@@ -5640,11 +6516,7 @@ TclObjInvokeNamespace(
      * command.
      */
 
-    result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-
+    (void) TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
     result = TclObjInvoke(interp, objc, objv, flags);
 
     TclPopStackFrame(interp);
@@ -5679,29 +6551,32 @@ TclObjInvoke(
 				 * 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]. */
-    Tcl_HashEntry *hPtr = NULL;
-    Command *cmdPtr;
-    int result;
-
     if (interp == NULL) {
 	return TCL_ERROR;
     }
-
     if ((objc < 1) || (objv == NULL)) {
-	Tcl_AppendResult(interp, "illegal argument vector", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "illegal argument vector", -1));
 	return TCL_ERROR;
     }
-
     if ((flags & TCL_INVOKE_HIDDEN) == 0) {
 	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
     }
+    return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
+}
 
-    if (TclInterpReady(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
+int
+TclNRInvoke(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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;
 
     cmdName = TclGetString(objv[0]);
     hTblPtr = iPtr->hiddenCmdTablePtr;
@@ -5709,37 +6584,35 @@ TclObjInvoke(
 	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
     }
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "invalid hidden command name \"",
-		cmdName, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "invalid hidden command name \"%s\"", cmdName));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
+                NULL);
 	return TCL_ERROR;
     }
     cmdPtr = Tcl_GetHashValue(hPtr);
 
-    /*
-     * Invoke the command function.
-     */
-
-    iPtr->cmdCount++;
-    result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
+    /* Avoid the exception-handling brain damage when numLevels == 0 . */
+    iPtr->numLevels++;
+    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
 
     /*
-     * If an error occurred, record information about what was being executed
-     * when the error occurred.
+     * Normal command resolution of objv[0] isn't going to find cmdPtr.
+     * That's the whole point of **hidden** commands.  So tell the
+     * Eval core machinery not to even try (and risk finding something wrong).
      */
 
-    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;
+    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
+}
 
-	Tcl_IncrRefCount(command);
-	cmdString = Tcl_GetStringFromObj(command, &length);
-	Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
-	Tcl_DecrRefCount(command);
-	iPtr->flags &= ~ERR_ALREADY_LOGGED;
-    }
+static int
+NRPostInvoke(
+    ClientData clientData[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *)interp;
+    iPtr->numLevels--;
     return result;
 }
 
@@ -5776,7 +6649,7 @@ Tcl_ExprString(
 	 * An empty string. Just set the interpreter's result to 0.
 	 */
 
-	Tcl_SetResult(interp, "0", TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
     } else {
 	Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1);
 
@@ -5787,13 +6660,13 @@ Tcl_ExprString(
 	    Tcl_SetObjResult(interp, resultPtr);
 	    Tcl_DecrRefCount(resultPtr);
 	}
+    }
 
-	/*
-	 * Force the string rep of the interp result.
-	 */
+    /*
+     * Force the string rep of the interp result.
+     */
 
-	(void) Tcl_GetStringResult(interp);
-    }
+    (void) Tcl_GetStringResult(interp);
     return code;
 }
 
@@ -5816,6 +6689,7 @@ Tcl_ExprString(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_AddObjErrorInfo
 void
 Tcl_AppendObjToErrorInfo(
     Tcl_Interp *interp,		/* Interpreter to which error information
@@ -5849,6 +6723,7 @@ Tcl_AppendObjToErrorInfo(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_AddErrorInfo
 void
 Tcl_AddErrorInfo(
     Tcl_Interp *interp,		/* Interpreter to which error information
@@ -5906,7 +6781,7 @@ Tcl_AddObjErrorInfo(
 	     * interp->result completely.
 	     */
 
-	    iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
+	    iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
 	} else {
 	    iPtr->errorInfo = iPtr->objResultPtr;
 	}
@@ -5950,7 +6825,7 @@ Tcl_AddObjErrorInfo(
 
 int
 Tcl_VarEvalVA(
-    Tcl_Interp *interp,		/* Interpreter in which to evaluate command. */
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate command */
     va_list argList)		/* Variable argument list. */
 {
     Tcl_DString buf;
@@ -6029,9 +6904,11 @@ Tcl_VarEval(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GlobalEval
 int
 Tcl_GlobalEval(
-    Tcl_Interp *interp,		/* Interpreter in which to evaluate command. */
+    Tcl_Interp *interp,		/* Interpreter in which to evaluate
+				 * command. */
     const char *command)	/* Command to evaluate. */
 {
     register Interp *iPtr = (Interp *) interp;
@@ -6189,6 +7066,7 @@ ExprCeilFunc(
     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);
@@ -6224,6 +7102,7 @@ ExprFloorFunc(
     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);
@@ -6245,9 +7124,8 @@ ExprIsqrtFunc(
     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. */
+    int exact = 0;		/* Flag ==1 if the argument can be represented
+				 * in a double as an exact integer. */
 
     /*
      * Check syntax.
@@ -6324,12 +7202,13 @@ ExprIsqrtFunc(
 	mp_clear(&big);
 	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
     }
-
     return TCL_OK;
 
   negarg:
-    Tcl_SetObjResult(interp,
-	    Tcl_NewStringObj("square root of negative argument", -1));
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+            "square root of negative argument", -1));
+    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+	    "domain error: argument not in valid range", NULL);
     return TCL_ERROR;
 }
 
@@ -6404,7 +7283,7 @@ ExprUnaryFunc(
 	return TCL_ERROR;
     }
     errno = 0;
-    return CheckDoubleResult(interp, (*func)(d));
+    return CheckDoubleResult(interp, func(d));
 }
 
 static int
@@ -6475,7 +7354,7 @@ ExprBinaryFunc(
 	return TCL_ERROR;
     }
     errno = 0;
-    return CheckDoubleResult(interp, (*func)(d1, d2));
+    return CheckDoubleResult(interp, func(d1, d2));
 }
 
 static int
@@ -6528,23 +7407,23 @@ ExprAbsFunc(
 	double d = *((const double *) ptr);
 	static const double poszero = 0.0;
 
-	/* We need to distinguish here between positive 0.0 and
-	 * negative -0.0, see Bug ID #2954959.
+	/*
+	 * 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) {
+	    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
+#ifndef TCL_WIDE_INT_IS_LONG
     if (type == TCL_NUMBER_WIDE) {
 	Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
 
@@ -6561,8 +7440,7 @@ ExprAbsFunc(
 #endif
 
     if (type == TCL_NUMBER_BIG) {
-	/* TODO: const correctness ? */
-	if (mp_cmp_d((mp_int *) ptr, 0) == MP_LT) {
+	if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
 	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
 	tooLarge:
 	    mp_neg(&big, &big);
@@ -6580,6 +7458,7 @@ ExprAbsFunc(
 	return TCL_OK;
 #else
 	double d;
+
 	Tcl_GetDoubleFromObj(interp, objv[1], &d);
 	return TCL_ERROR;
 #endif
@@ -6617,6 +7496,7 @@ ExprDoubleFunc(
     Tcl_Obj *const *objv)	/* Actual parameter vector. */
 {
     double dResult;
+
     if (objc != 2) {
 	MathFuncWrongNumArgs(interp, 2, objc, objv);
 	return TCL_ERROR;
@@ -6732,6 +7612,7 @@ ExprWideFunc(
 {
     Tcl_WideInt wResult;
     Tcl_Obj *objPtr;
+
     if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -6960,7 +7841,7 @@ ExprSrandFunc(
 
     /*
      * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
-     * ExprRandFunc() for more details.
+     * ExprRandFunc for more details.
      */
 
     iPtr->flags |= RAND_SEED_INITIALIZED;
@@ -7007,7 +7888,7 @@ MathFuncWrongNumArgs(
     const char *tail = name + strlen(name);
 
     while (tail > name+1) {
-	--tail;
+	tail--;
 	if (*tail == ':' && tail[-1] == ':') {
 	    name = tail+1;
 	    break;
@@ -7016,9 +7897,10 @@ MathFuncWrongNumArgs(
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 	    "too %s arguments for math function \"%s\"",
 	    (found < expected ? "few" : "many"), name));
+    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
 }
-#ifdef USE_DTRACE
 
+#ifdef USE_DTRACE
 /*
  *----------------------------------------------------------------------
  *
@@ -7074,49 +7956,1131 @@ DTraceObjCmd(
 void
 TclDTraceInfo(
     Tcl_Obj *info,
-    char **args,
+    const char **args,
     int *argsi)
 {
-    static Tcl_Obj *keys[7] = { NULL };
+    static Tcl_Obj *keys[10] = { NULL };
     Tcl_Obj **k = keys, *val;
-    int i;
+    int i = 0;
 
     if (!*k) {
-	TclNewLiteralStringObj(keys[0], "cmd");
-	TclNewLiteralStringObj(keys[1], "type");
-	TclNewLiteralStringObj(keys[2], "proc");
-	TclNewLiteralStringObj(keys[3], "file");
-	TclNewLiteralStringObj(keys[4], "lambda");
-	TclNewLiteralStringObj(keys[5], "line");
-	TclNewLiteralStringObj(keys[6], "level");
-    }
-    for (i = 0; i < 4; i++) {
+#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]));
+	    TclGetIntFromObj(NULL, val, &argsi[i]);
 	} else {
 	    argsi[i] = 0;
 	}
     }
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DTraceCmdReturn --
+ *
+ *	NR callback for DTrace command return probes.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DTraceCmdReturn(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    char *cmdName = TclGetString((Tcl_Obj *) data[0]);
+
+    if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
+	TCL_DTRACE_CMD_RETURN(cmdName, result);
+    }
+    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
+	Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+	TCL_DTRACE_CMD_RESULT(cmdName, result, TclGetString(r), r);
+    }
+    return result;
+}
 
 TCL_DTRACE_DEBUG_LOG()
 
 #endif /* USE_DTRACE */
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NRCallObjProc --
+ *
+ *	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.
+ *
+ * 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 objProc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_NRCallObjProc(
+    Tcl_Interp *interp,
+    Tcl_ObjCmdProc *objProc,
+    ClientData clientData,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    NRE_callback *rootPtr = TOP_CB(interp);
+
+    TclNRAddCallback(interp, Dispatch, objProc, clientData,
+	    INT2PTR(objc), objv);
+    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NRCreateCommand --
+ *
+ *	Define a new NRE-enabled 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.
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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|TCL_EVAL_NOERR,
+	    (Command *) cmd);
+}
+
+/*****************************************************************************
+ * Tailcall related code
+ *****************************************************************************
+ *
+ * The steps of the tailcall dance are as follows:
+ *
+ *   1. when [tailcall] is invoked, it stores the corresponding callback in
+ *      the current CallFrame and returns TCL_RETURN
+ *   2. when the CallFrame is popped, it calls TclSetTailcall to store the
+ *      callback in the proper NRCommand callback - the spot where the command
+ *      that pushed the CallFrame is completely cleaned up
+ *   3. when the NRCommand callback runs, it schedules the tailcall callback
+ *      to run immediately after it returns
+ *
+ *   One delicate point is to properly define the NRCommand where the tailcall
+ *   will execute. There are functions whose purpose is to help define the
+ *   precise spot:
+ *     TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
+ *         should continue right here
+ *     TclSkipTailcall:  if the NEXT command to be pushed tailcalls, execution
+ *         should continue after the CURRENT command is fully returned ("skip
+ *         the next command: we are redirecting to it, tailcalls should run
+ *         after WE return")
+ *     TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
+ *         this point. This is special for OO, as some of the oo constructs
+ *         that behave like commands may not push an NRCommand callback.
+ */
+
+void
+TclMarkTailcall(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->deferredCallbacks == NULL) {
+	TclNRAddCallback(interp, NRCommand, NULL, NULL,
+                NULL, NULL);
+        iPtr->deferredCallbacks = TOP_CB(interp);
+    }
+}
+
+void
+TclSkipTailcall(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    TclMarkTailcall(interp);
+    iPtr->deferredCallbacks->data[1] = INT2PTR(1);
+}
+
+void
+TclPushTailcallPoint(
+    Tcl_Interp *interp)
+{
+    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+    ((Interp *) interp)->numLevels++;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetTailcall --
+ *
+ *	Splice a tailcall command in the proper spot of the NRE callback
+ *	stack, so that it runs at the right time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetTailcall(
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr)
+{
+    /*
+     * Find the splicing spot: right before the NRCommand of the thing
+     * being tailcalled. Note that we skip NRCommands marked by a 1 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!");
+    }
+    runPtr->data[1] = listPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRTailcallObjCmd --
+ *
+ *	Prepare the tailcall as a list and store it in the current
+ *	varFrame. When the frame is later popped the tailcall will be spliced
+ *	at the proper place.
+ *
+ * Results:
+ *	The first NRCommand callback that is not marked to be skipped is
+ *	updated so that its data[1] field contains the tailcall list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 & 1)) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "tailcall can only be called from a proc, lambda or method", -1));
+        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) {
+        Tcl_DecrRefCount(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.
+     */
+
+    if (objc > 1) {
+        Tcl_Obj *listPtr, *nsObjPtr;
+        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+        Tcl_Namespace *ns1Ptr;
+
+        /* The tailcall data is in a Tcl list: the first element is the
+         * namespace, the rest the command to be tailcalled. */
+
+        listPtr = Tcl_NewListObj(objc, objv);
+
+        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+        if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
+                || (nsPtr != ns1Ptr)) {
+            Tcl_Panic("Tailcall failed to find the proper namespace");
+        }
+ 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
+        iPtr->varFramePtr->tailcallPtr = listPtr;
+    }
+    return TCL_RETURN;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRTailcallEval --
+ *
+ *	This NREcallback actually causes the tailcall to be evaluated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNRTailcallEval(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *listPtr = data[0], *nsObjPtr;
+    Tcl_Namespace *nsPtr;
+    int objc;
+    Tcl_Obj **objv;
+
+    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
+    nsObjPtr = objv[0];
+
+    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.
+         */
+
+	Tcl_DecrRefCount(listPtr);
+        return result;
+    }
+
+    /*
+     * Perform the tailcall
+     */
+
+    TclMarkTailcall(interp);
+    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
+    iPtr->lookupNsPtr = (Namespace *) nsPtr;
+    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
+}
+
+int
+TclNRReleaseValues(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    int i = 0;
+    while (i < 4) {
+	if (data[i]) {
+	    Tcl_DecrRefCount((Tcl_Obj *) data[i]);
+	} else {
+	    break;
+	}
+	i++;
+    }
+    return result;
+}
+
+
+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?!");
+    }
+    TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineObjCmd -- (and friends)
+ *
+ *	This object-based function is invoked to process the "coroutine" Tcl
+ *	command. It is heavily based on "apply".
+ *
+ * Results:
+ *	A standard Tcl object result value.
+ *
+ * Side effects:
+ *	A new procedure gets created.
+ *
+ * ** 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_SetObjResult(interp, Tcl_NewStringObj(
+                "yield can only be called in a coroutine", -1));
+	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, TclNRCoroutineActivateCallback, 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 = TclGetCurrentNamespace(interp);
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (!corPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "yieldto can only be called in a coroutine", -1));
+	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
+	return TCL_ERROR;
+    }
+
+    if (((Namespace *) nsPtr)->flags & NS_DYING) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"yieldto called in deleted namespace", -1));
+        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+		NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * Add the tailcall in the caller env, then just yield.
+     *
+     * This is essentially code from TclNRTailcallObjCmd
+     */
+
+    listPtr = Tcl_NewListObj(objc, objv);
+    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
+    /*
+     * Add the callback in the caller's env, then instruct TEBC to yield.
+     */
+
+    iPtr->execEnvPtr = corPtr->callerEEPtr;
+    TclSetTailcall(interp, listPtr);
+    iPtr->execEnvPtr = corPtr->eePtr;
+
+    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
+}
+
+static int
+RewindCoroutineCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    return Tcl_RestoreInterpState(interp, data[0]);
+}
+
+static int
+RewindCoroutine(
+    CoroutineData *corPtr,
+    int result)
+{
+    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);
+
+    corPtr->eePtr->rewind = 1;
+    TclNRAddCallback(interp, RewindCoroutineCallback, state,
+	    NULL, NULL, NULL);
+    return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
+}
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineActivateCallback --
+ *
+ *      This is the workhorse for coroutines: it implements both yield and
+ *      resume.
+ *
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNRCoroutineActivateCallback(
+    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_SetObjResult(interp, Tcl_NewStringObj(
+                    "cannot yield: C stack busy", -1));
+            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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNREvalList --
+ *
+ *      Callback to invoke command as list, used in order to delayed
+ *	processing of canonical list command in sane environment.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclNREvalList(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    int objc;
+    Tcl_Obj **objv;
+    Tcl_Obj *listPtr = data[0];
+
+    Tcl_IncrRefCount(listPtr);
+
+    TclMarkTailcall(interp);
+    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
+    TclListObjGetElements(NULL, listPtr, &objc, &objv);
+    return TclNREvalObjv(interp, objc, objv, 0, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NRCoroInjectObjCmd --
+ *
+ *      Implementation of [::tcl::unsupported::inject] command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NRCoroInjectObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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 != TclNRInterpCoroutine)) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "can only inject a command into a coroutine", -1));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
+                TclGetString(objv[1]), NULL);
+        return TCL_ERROR;
+    }
+
+    corPtr = cmdPtr->objClientData;
+    if (!COR_IS_SUSPENDED(corPtr)) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "can only inject a command into a suspended coroutine", -1));
+        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
+        return TCL_ERROR;
+    }
+
+    /*
+     * 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;
+    TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
+	NULL, NULL, NULL);
+    iPtr->execEnvPtr = savedEEPtr;
+
+    return TCL_OK;
+}
+
+int
+TclNRInterpCoroutine(
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+                "coroutine \"%s\" is already running",
+                Tcl_GetString(objv[0])));
+	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * 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;
+    }
+
+    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+            NULL, NULL, NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRCoroutineObjCmd --
+ *
+ *      Implementation of [coroutine] command; see documentation for
+ *      description of what this does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNRCoroutineObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't create procedure \"%s\": unknown namespace",
+                fullName));
+        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
+	return TCL_ERROR;
+    }
+    if (procName == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't create procedure \"%s\": bad procedure name",
+                fullName));
+        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
+	return TCL_ERROR;
+    }
+    if ((nsPtr != iPtr->globalNsPtr)
+	    && (procName != NULL) && (procName[0] == ':')) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't create procedure \"%s\" in non-global namespace with"
+                " name starting with \":\"", procName));
+        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);
+	TclDStringAppendLiteral(&ds, "::");
+    }
+    Tcl_DStringAppend(&ds, procName, -1);
+
+    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
+	    /*objProc*/ NULL, TclNRInterpCoroutine, 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);
+
+	    Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
+	}
+    }
+
+    /*
+     * 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;
+
+    /*
+     * 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);
+
+    /* insure that the command is looked up in the correct namespace */
+    iPtr->lookupNsPtr = lookupNsPtr;
+    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
+    iPtr->numLevels--;
+
+    SAVE_CONTEXT(corPtr->running);
+    RESTORE_CONTEXT(corPtr->caller);
+    iPtr->execEnvPtr = corPtr->callerEEPtr;
+
+    /*
+     * Now just resume the coroutine.
+     */
+
+    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, 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;
+}
+
+#undef iPtr
+
+/*
  * 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 cbe4970..2a4fd84 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -59,7 +59,7 @@ static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
 static int		FormatNumber(Tcl_Interp *interp, int type,
 			    Tcl_Obj *src, unsigned char **cursorPtr);
 static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
-static int		GetFormatSpec(char **formatPtr, char *cmdPtr,
+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);
@@ -69,7 +69,90 @@ static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
 static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
 static int		NeedReversing(int format);
 static void		CopyNumber(const void *from, void *to,
-			    unsigned int length, int type);
+			    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		BinaryDecode64(ClientData clientData,
+			    Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
+static int		BinaryEncodeUu(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[]);
+
+/*
+ * 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', '+', '/',
+    '='
+};
+
+/*
+ * How to construct the ensembles.
+ */
+
+static const EnsembleImplMap binaryMap[] = {
+    { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
+    { "scan",   BinaryScanCmd, TclCompileBasicMin2ArgCmd, 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, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
+    { "base64",   BinaryEncode64,  NULL, NULL, NULL, 0 },
+    { NULL, NULL, NULL, NULL, NULL, 0 }
+};
+static const EnsembleImplMap decodeMap[] = {
+    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+    { NULL, NULL, NULL, NULL, NULL, 0 }
+};
 
 /*
  * The following object type represents an array of bytes. An array of bytes
@@ -96,7 +179,7 @@ static void		CopyNumber(const void *from, void *to,
  * converting an arbitrary String to a ByteArray may be.
  */
 
-Tcl_ObjType tclByteArrayType = {
+const Tcl_ObjType tclByteArrayType = {
     "bytearray",
     FreeByteArrayInternalRep,
     DupByteArrayInternalRep,
@@ -116,17 +199,17 @@ typedef struct ByteArray {
 				 * array. */
     int allocated;		/* The amount of space actually allocated
 				 * minus 1 byte. */
-    unsigned char bytes[4];	/* The array of bytes. The actual size of this
+    unsigned char bytes[1];	/* The array of bytes. The actual size of this
 				 * field depends on the 'allocated' field
 				 * above. */
 } ByteArray;
 
 #define BYTEARRAY_SIZE(len) \
-		((unsigned) (sizeof(ByteArray) - 4 + (len)))
+		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
 #define GET_BYTEARRAY(objPtr) \
 		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
 #define SET_BYTEARRAY(objPtr, baPtr) \
-		(objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (baPtr)
+		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
 
 
 /*
@@ -147,7 +230,6 @@ typedef struct ByteArray {
  *----------------------------------------------------------------------
  */
 
-#ifdef TCL_MEM_DEBUG
 #undef Tcl_NewByteArrayObj
 
 Tcl_Obj *
@@ -157,25 +239,16 @@ Tcl_NewByteArrayObj(
     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(
-    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 */
+}
 
 /*
  *----------------------------------------------------------------------
@@ -202,8 +275,6 @@ Tcl_NewByteArrayObj(
  *----------------------------------------------------------------------
  */
 
-#ifdef TCL_MEM_DEBUG
-
 Tcl_Obj *
 Tcl_DbNewByteArrayObj(
     const unsigned char *bytes,	/* The array of bytes used to initialize the
@@ -215,30 +286,17 @@ Tcl_DbNewByteArrayObj(
     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(
-    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 */
-
+}
+
 /*
  *---------------------------------------------------------------------------
  *
@@ -261,9 +319,9 @@ 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. */
-    int length)			/* Length of the array of bytes, which must be
-				 * >= 0. */
+				   value. May be NULL even if length > 0. */
+    int length)			/* Length of the array of bytes, which must
+				   be >= 0. */
 {
     ByteArray *byteArrayPtr;
 
@@ -276,7 +334,7 @@ Tcl_SetByteArrayObj(
     if (length < 0) {
 	length = 0;
     }
-    byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
     byteArrayPtr->used = length;
     byteArrayPtr->allocated = length;
 
@@ -362,8 +420,7 @@ Tcl_SetByteArrayLength(
 
     byteArrayPtr = GET_BYTEARRAY(objPtr);
     if (length > byteArrayPtr->allocated) {
-	byteArrayPtr = (ByteArray *) ckrealloc(
-		(char *) byteArrayPtr, BYTEARRAY_SIZE(length));
+	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
 	byteArrayPtr->allocated = length;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
     }
@@ -394,7 +451,7 @@ SetByteArrayFromAny(
     Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
 {
     int length;
-    char *src, *srcEnd;
+    const char *src, *srcEnd;
     unsigned char *dst;
     ByteArray *byteArrayPtr;
     Tcl_UniChar ch;
@@ -403,10 +460,10 @@ SetByteArrayFromAny(
 	src = TclGetStringFromObj(objPtr, &length);
 	srcEnd = src + length;
 
-	byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+	byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
 	for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
 	    src += Tcl_UtfToUniChar(src, &ch);
-	    *dst++ = (unsigned char) ch;
+	    *dst++ = UCHAR(ch);
 	}
 
 	byteArrayPtr->used = dst - byteArrayPtr->bytes;
@@ -440,7 +497,7 @@ static void
 FreeByteArrayInternalRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    ckfree((char *) GET_BYTEARRAY(objPtr));
+    ckfree(GET_BYTEARRAY(objPtr));
     objPtr->typePtr = NULL;
 }
 
@@ -472,7 +529,7 @@ DupByteArrayInternalRep(
     srcArrayPtr = GET_BYTEARRAY(srcPtr);
     length = srcArrayPtr->used;
 
-    copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
     copyArrayPtr->used = length;
     copyArrayPtr->allocated = length;
     memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
@@ -531,7 +588,7 @@ UpdateStringOfByteArray(
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     }
 
-    dst = (char *) ckalloc((unsigned) (size + 1));
+    dst = ckalloc(size + 1);
     objPtr->bytes = dst;
     objPtr->length = size;
 
@@ -565,7 +622,6 @@ UpdateStringOfByteArray(
  *----------------------------------------------------------------------
  */
 
-#define TCL_MIN_GROWTH 1024
 void
 TclAppendBytesToByteArray(
     Tcl_Obj *objPtr,
@@ -607,8 +663,7 @@ TclAppendBytesToByteArray(
 	if (needed <= INT_MAX/2) {
 	    /* Try to allocate double the total space that is needed. */
 	    attempt = 2 * needed;
-	    ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
+	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
 	}
 	if (ptr == NULL) {
 	    /* Try to allocate double the increment that is needed (plus). */
@@ -617,14 +672,12 @@ TclAppendBytesToByteArray(
 	    int growth = (int) ((extra > limit) ? limit : extra);
 
 	    attempt = needed + growth;
-	    ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
+	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
 	}
 	if (ptr == NULL) {
 	    /* Last chance: Try to allocate exactly what is needed. */
 	    attempt = needed;
-	    ptr = (ByteArray *) ckrealloc((void *)byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
+	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
 	}
 	byteArrayPtr = ptr;
 	byteArrayPtr->allocated = attempt;
@@ -641,9 +694,38 @@ TclAppendBytesToByteArray(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_BinaryObjCmd --
+ * TclInitBinaryCmd --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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" Tcl command.
+ *	This procedure implements the "binary format" Tcl command.
  *
  * Results:
  *	A standard Tcl result.
@@ -654,8 +736,8 @@ TclAppendBytesToByteArray(
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_BinaryObjCmd(
+static int
+BinaryFormatCmd(
     ClientData dummy,		/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
@@ -668,7 +750,7 @@ Tcl_BinaryObjCmd(
     int count;			/* Count associated with current format
 				 * character. */
     int flags;			/* Format field flags */
-    char *format;		/* Pointer to current position in format
+    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. */
@@ -676,797 +758,840 @@ Tcl_BinaryObjCmd(
     unsigned char *maxPos;	/* Greatest position within result buffer that
 				 * cursor has visited.*/
     const char *errorString;
-    char *errorValue, *str;
-    int offset, size, length, index;
-    static const char *options[] = {
-	"format",	"scan",		NULL
-    };
-    enum options {
-	BINARY_FORMAT,	BINARY_SCAN
-    };
+    const char *errorValue, *str;
+    int offset, size, length;
 
     if (objc < 2) {
-    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
 	return TCL_ERROR;
     }
 
-    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
-	    &index) != TCL_OK) {
-    	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.
+     */
 
-    switch ((enum options) index) {
-    case BINARY_FORMAT:
-	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
-	    return TCL_ERROR;
+    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.
+	     */
 
-	/*
-	 * 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[2]);
-	arg = 3;
-	offset = 0;
-	length = 0;
-	while (*format != '\0') {
-	    str = format;
-	    flags = 0;
-	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
-		break;
+	    if (arg >= objc) {
+		goto badIndex;
+	    }
+	    if (count == BINARY_ALL) {
+		Tcl_GetByteArrayFromObj(objv[arg], &count);
+	    } else if (count == BINARY_NOCOUNT) {
+		count = 1;
+	    }
+	    arg++;
+	    if (cmd == 'a' || cmd == 'A') {
+		offset += count;
+	    } else if (cmd == 'b' || cmd == 'B') {
+		offset += (count + 7) / 8;
+	    } else {
+		offset += (count + 1) / 2;
+	    }
+	    break;
+	case 'c':
+	    size = 1;
+	    goto doNumbers;
+	case 't':
+	case 's':
+	case 'S':
+	    size = 2;
+	    goto doNumbers;
+	case 'n':
+	case 'i':
+	case 'I':
+	    size = 4;
+	    goto doNumbers;
+	case 'm':
+	case 'w':
+	case 'W':
+	    size = 8;
+	    goto doNumbers;
+	case 'r':
+	case 'R':
+	case 'f':
+	    size = sizeof(float);
+	    goto doNumbers;
+	case 'q':
+	case 'Q':
+	case 'd':
+	    size = sizeof(double);
+
+	doNumbers:
+	    if (arg >= objc) {
+		goto badIndex;
 	    }
-	    switch (cmd) {
-	    case 'a':
-	    case 'A':
-	    case 'b':
-	    case 'B':
-	    case 'h':
-	    case 'H':
-		/*
-		 * For string-type specifiers, the count corresponds to the
-		 * number of bytes in a single argument.
-		 */
 
-		if (arg >= objc) {
-		    goto badIndex;
-		}
-		if (count == BINARY_ALL) {
-		    Tcl_GetByteArrayFromObj(objv[arg], &count);
-		} else if (count == BINARY_NOCOUNT) {
-		    count = 1;
-		}
+	    /*
+	     * 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++;
-		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;
-		}
+		count = 1;
+	    } else {
+		int listc;
+		Tcl_Obj **listv;
 
 		/*
-		 * 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.
+		 * The macro evals its args more than once: avoid arg++
 		 */
 
-		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;
-		    }
+		if (TclListObjGetElements(interp, objv[arg], &listc,
+			&listv) != TCL_OK) {
+		    return TCL_ERROR;
 		}
-		offset += count*size;
-		break;
+		arg++;
 
-	    case 'x':
 		if (count == BINARY_ALL) {
-		    Tcl_AppendResult(interp,
-			    "cannot use \"*\" in format string with \"x\"",
-			    NULL);
+		    count = listc;
+		} else if (count > listc) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "number of elements in list does not match count",
+			    -1));
 		    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;
 	    }
+	    offset += count*size;
+	    break;
+
+	case 'x':
+	    if (count == BINARY_ALL) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot use \"*\" in format string with \"x\"", -1));
+		return TCL_ERROR;
+	    } else if (count == BINARY_NOCOUNT) {
+		count = 1;
+	    }
+	    offset += count;
+	    break;
+	case 'X':
+	    if (count == BINARY_NOCOUNT) {
+		count = 1;
+	    }
+	    if ((count > offset) || (count == BINARY_ALL)) {
+		count = offset;
+	    }
+	    if (offset > length) {
+		length = offset;
+	    }
+	    offset -= count;
+	    break;
+	case '@':
+	    if (offset > length) {
+		length = offset;
+	    }
+	    if (count == BINARY_ALL) {
+		offset = length;
+	    } else if (count == BINARY_NOCOUNT) {
+		goto badCount;
+	    } else {
+		offset = count;
+	    }
+	    break;
+	default:
+	    errorString = str;
+	    goto badField;
 	}
-	if (offset > length) {
-	    length = offset;
-	}
-	if (length == 0) {
-	    return TCL_OK;
-	}
+    }
+    if (offset > length) {
+	length = offset;
+    }
+    if (length == 0) {
+	return TCL_OK;
+    }
 
-	/*
-	 * Prepare the result object by preallocating the caclulated number of
-	 * bytes and filling with nulls.
-	 */
+    /*
+     * Prepare the result object by preallocating the caclulated number of
+     * bytes and filling with nulls.
+     */
 
-	resultPtr = Tcl_NewObj();
-	buffer = Tcl_SetByteArrayLength(resultPtr, length);
-	memset(buffer, 0, (size_t) length);
+    resultPtr = Tcl_NewObj();
+    buffer = Tcl_SetByteArrayLength(resultPtr, length);
+    memset(buffer, 0, (size_t) length);
 
-	/*
-	 * Pack the data into the result object. Note that we can skip the
-	 * error checking during this pass, since we have already parsed the
-	 * string once.
-	 */
+    /*
+     * Pack the data into the result object. Note that we can skip the
+     * error checking during this pass, since we have already parsed the
+     * string once.
+     */
 
-	arg = 3;
-	format = TclGetString(objv[2]);
-	cursor = buffer;
-	maxPos = cursor;
-	while (*format != 0) {
-	    flags = 0;
-	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
-		break;
+    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++;
 	    }
-	    if ((count == 0) && (cmd != '@')) {
-		if (cmd != 'x') {
-		    arg++;
-		}
-		continue;
+	    continue;
+	}
+	switch (cmd) {
+	case 'a':
+	case 'A': {
+	    char pad = (char) (cmd == 'a' ? '\0' : ' ');
+	    unsigned char *bytes;
+
+	    bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
+
+	    if (count == BINARY_ALL) {
+		count = length;
+	    } else if (count == BINARY_NOCOUNT) {
+		count = 1;
 	    }
-	    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;
+	    if (length >= count) {
+		memcpy(cursor, bytes, (size_t) count);
+	    } else {
+		memcpy(cursor, bytes, (size_t) length);
+		memset(cursor + length, pad, (size_t) (count - length));
 	    }
-	    case 'b':
-	    case 'B': {
-		unsigned char *last;
-
-		str = TclGetStringFromObj(objv[arg], &length);
-		arg++;
-		if (count == BINARY_ALL) {
-		    count = length;
-		} else if (count == BINARY_NOCOUNT) {
-		    count = 1;
-		}
-		last = cursor + ((count + 7) / 8);
-		if (count > length) {
-		    count = length;
-		}
-		value = 0;
-		errorString = "binary";
-		if (cmd == 'B') {
-		    for (offset = 0; offset < count; offset++) {
-			value <<= 1;
-			if (str[offset] == '1') {
-			    value |= 1;
-			} else if (str[offset] != '0') {
-			    errorValue = str;
-			    Tcl_DecrRefCount(resultPtr);
-			    goto badValue;
-			}
-			if (((offset + 1) % 8) == 0) {
-			    *cursor++ = (unsigned char) value;
-			    value = 0;
-			}
+	    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;
 		    }
-		} else {
-		    for (offset = 0; offset < count; offset++) {
-			value >>= 1;
-			if (str[offset] == '1') {
-			    value |= 128;
-			} else if (str[offset] != '0') {
-			    errorValue = str;
-			    Tcl_DecrRefCount(resultPtr);
-			    goto badValue;
-			}
-			if (!((offset + 1) % 8)) {
-			    *cursor++ = (unsigned char) value;
-			    value = 0;
-			}
+		    if (((offset + 1) % 8) == 0) {
+			*cursor++ = UCHAR(value);
+			value = 0;
 		    }
 		}
-		if ((offset % 8) != 0) {
-		    if (cmd == 'B') {
-			value <<= 8 - (offset % 8);
-		    } else {
-			value >>= 8 - (offset % 8);
+	    } else {
+		for (offset = 0; offset < count; offset++) {
+		    value >>= 1;
+		    if (str[offset] == '1') {
+			value |= 128;
+		    } else if (str[offset] != '0') {
+			errorValue = str;
+			Tcl_DecrRefCount(resultPtr);
+			goto badValue;
+		    }
+		    if (!((offset + 1) % 8)) {
+			*cursor++ = UCHAR(value);
+			value = 0;
 		    }
-		    *cursor++ = (unsigned char) value;
-		}
-		while (cursor < last) {
-		    *cursor++ = '\0';
 		}
-		break;
 	    }
-	    case 'h':
-	    case 'H': {
-		unsigned char *last;
-		int c;
-
-		str = TclGetStringFromObj(objv[arg], &length);
-		arg++;
-		if (count == BINARY_ALL) {
-		    count = length;
-		} else if (count == BINARY_NOCOUNT) {
-		    count = 1;
-		}
-		last = cursor + ((count + 1) / 2);
-		if (count > length) {
-		    count = length;
+	    if ((offset % 8) != 0) {
+		if (cmd == 'B') {
+		    value <<= 8 - (offset % 8);
+		} else {
+		    value >>= 8 - (offset % 8);
 		}
-		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;
-			}
-			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;
-			}
+		*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;
 		    }
-		} else {
-		    for (offset = 0; offset < count; offset++) {
-			value >>= 4;
-
-			if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
-			    errorValue = str;
-			    Tcl_DecrRefCount(resultPtr);
-			    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;
-			}
+		    c = str[offset] - '0';
+		    if (c > 9) {
+			c += ('0' - 'A') + 10;
 		    }
-		}
-		if (offset % 2) {
-		    if (cmd == 'H') {
-			value <<= 4;
-		    } else {
-			value >>= 4;
+		    if (c > 16) {
+			c += ('A' - 'a');
 		    }
-		    *cursor++ = (unsigned char) value;
-		}
-
-		while (cursor < last) {
-		    *cursor++ = '\0';
-		}
-		break;
-	    }
-	    case 'c':
-	    case 't':
-	    case 's':
-	    case 'S':
-	    case 'n':
-	    case 'i':
-	    case 'I':
-	    case 'm':
-	    case 'w':
-	    case 'W':
-	    case 'r':
-	    case 'R':
-	    case 'd':
-	    case 'q':
-	    case 'Q':
-	    case 'f': {
-		int listc, i;
-		Tcl_Obj **listv;
-
-		if (count == BINARY_NOCOUNT) {
-		    /*
-		     * Note that we are casting away the const-ness of objv,
-		     * but this is safe since we aren't going to modify the
-		     * array.
-		     */
-
-		    listv = (Tcl_Obj**)(objv + arg);
-		    listc = 1;
-		    count = 1;
-		} else {
-		    TclListObjGetElements(interp, objv[arg], &listc, &listv);
-		    if (count == BINARY_ALL) {
-			count = listc;
+		    value |= (c & 0xf);
+		    if (offset % 2) {
+			*cursor++ = (char) value;
+			value = 0;
 		    }
 		}
-		arg++;
-		for (i = 0; i < count; i++) {
-		    if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
+	    } else {
+		for (offset = 0; offset < count; offset++) {
+		    value >>= 4;
+
+		    if (!isxdigit(UCHAR(str[offset]))) {     /* INTL: digit */
+			errorValue = str;
 			Tcl_DecrRefCount(resultPtr);
-			return TCL_ERROR;
+			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++ = UCHAR(value & 0xff);
+			value = 0;
 		    }
 		}
-		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;
+	    if (offset % 2) {
+		if (cmd == 'H') {
+		    value <<= 4;
 		} else {
-		    cursor -= count;
-		}
-		break;
-	    case '@':
-		if (cursor > maxPos) {
-		    maxPos = cursor;
+		    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) {
-		    cursor = maxPos;
-		} else {
-		    cursor = buffer + count;
+		    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;
 	    }
+	    break;
 	}
-	Tcl_SetObjResult(interp, resultPtr);
-	break;
-    case BINARY_SCAN: {
-	int i;
-	Tcl_Obj *valuePtr, *elementPtr;
-	Tcl_HashTable numberCacheHash;
-	Tcl_HashTable *numberCachePtr;
-
-	if (objc < 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "value formatString ?varName varName ...?");
-	    return TCL_ERROR;
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+	    "expected %s string but got \"%s\" instead",
+	    errorString, errorValue));
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad field specifier \"%s\"", buf));
+	return TCL_ERROR;
+    }
+
+ error:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
+    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;
 	}
-	numberCachePtr = &numberCacheHash;
-	Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
-	buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
-	format = TclGetString(objv[3]);
-	cursor = buffer;
-	arg = 4;
-	offset = 0;
-	while (*format != '\0') {
-	    str = format;
-	    flags = 0;
-	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
-		goto done;
-	    }
-	    switch (cmd) {
-	    case 'a':
-	    case 'A': {
-		unsigned char *src;
-
-		if (arg >= objc) {
-		    DeleteScanNumberCache(numberCachePtr);
-		    goto badIndex;
+	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 == BINARY_ALL) {
-		    count = length - offset;
-		} else {
-		    if (count == BINARY_NOCOUNT) {
-			count = 1;
-		    }
-		    if (count > (length - offset)) {
-			goto done;
-		    }
+		if (count > (length - offset)) {
+		    goto done;
 		}
+	    }
 
-		src = buffer + offset;
-		size = count;
+	    src = buffer + offset;
+	    size = count;
 
-		/*
-		 * Trim trailing nulls and spaces, if necessary.
-		 */
+	    /*
+	     * Trim trailing nulls and spaces, if necessary.
+	     */
 
-		if (cmd == 'A') {
-		    while (size > 0) {
-			if (src[size-1] != '\0' && src[size-1] != ' ') {
-			    break;
-			}
-			size--;
+	    if (cmd == 'A') {
+		while (size > 0) {
+		    if (src[size-1] != '\0' && src[size-1] != ' ') {
+			break;
 		    }
+		    size--;
 		}
+	    }
 
-		/*
-		 * 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.
-		 */
+	    /*
+	     * Have to do this #ifdef-fery because (as part of defining
+	     * Tcl_NewByteArrayObj) we removed the #def that hides this stuff
+	     * normally. If this code ever gets copied to another file, it
+	     * should be changed back to the simpler version.
+	     */
 
 #ifdef TCL_MEM_DEBUG
-		valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__,__LINE__);
+	    valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__, __LINE__);
 #else
-		valuePtr = Tcl_NewByteArrayObj(src, size);
+	    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;
+	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+		    TCL_LEAVE_ERR_MSG);
+	    arg++;
+	    if (resultPtr == NULL) {
+		DeleteScanNumberCache(numberCachePtr);
+		return TCL_ERROR;
 	    }
-	    case 'b':
-	    case 'B': {
-		unsigned char *src;
-		char *dest;
+	    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;
-		    }
-		}
-		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++;
-			}
-			*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');
-		    }
+	    if (arg >= objc) {
+		DeleteScanNumberCache(numberCachePtr);
+		goto badIndex;
+	    }
+	    if (count == BINARY_ALL) {
+		count = (length - offset) * 8;
+	    } else {
+		if (count == BINARY_NOCOUNT) {
+		    count = 1;
 		}
-
-		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
-			TCL_LEAVE_ERR_MSG);
-		arg++;
-		if (resultPtr == NULL) {
-		    DeleteScanNumberCache(numberCachePtr);
-		    return TCL_ERROR;
+		if (count > (length - offset) * 8) {
+		    goto done;
 		}
-		offset += (count + 7) / 8;
-		break;
 	    }
-	    case 'h':
-	    case 'H': {
-		char *dest;
-		unsigned char *src;
-		int i;
-		static const char hexdigit[] = "0123456789abcdef";
+	    src = buffer + offset;
+	    valuePtr = Tcl_NewObj();
+	    Tcl_SetObjLength(valuePtr, count);
+	    dest = TclGetString(valuePtr);
 
-		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;
+	    if (cmd == 'b') {
+		for (i = 0; i < count; i++) {
+		    if (i % 8) {
+			value >>= 1;
+		    } else {
+			value = *src++;
 		    }
+		    *dest++ = (char) ((value & 1) ? '1' : '0');
 		}
-		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++;
-			}
-			*dest++ = hexdigit[value & 0xf];
-		    }
-		} else {
-		    for (i = 0; i < count; i++) {
-			if (i % 2) {
-			    value <<= 4;
-			} else {
-			    value = *src++;
-			}
-			*dest++ = hexdigit[(value >> 4) & 0xf];
+	    } else {
+		for (i = 0; i < count; i++) {
+		    if (i % 8) {
+			value <<= 1;
+		    } else {
+			value = *src++;
 		    }
+		    *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 + 1) / 2;
-		break;
+	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
+		    TCL_LEAVE_ERR_MSG);
+	    arg++;
+	    if (resultPtr == NULL) {
+		DeleteScanNumberCache(numberCachePtr);
+		return TCL_ERROR;
 	    }
-	    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;
-		}
+	    offset += (count + 7) / 8;
+	    break;
+	}
+	case 'h':
+	case 'H': {
+	    char *dest;
+	    unsigned char *src;
+	    static const char hexdigit[] = "0123456789abcdef";
 
-		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
-			TCL_LEAVE_ERR_MSG);
-		arg++;
-		if (resultPtr == NULL) {
-		    DeleteScanNumberCache(numberCachePtr);
-		    return TCL_ERROR;
-		}
-		break;
+	    if (arg >= objc) {
+		DeleteScanNumberCache(numberCachePtr);
+		goto badIndex;
 	    }
-	    case 'x':
+	    if (count == BINARY_ALL) {
+		count = (length - offset)*2;
+	    } else {
 		if (count == BINARY_NOCOUNT) {
 		    count = 1;
 		}
-		if ((count == BINARY_ALL) || (count > (length - offset))) {
-		    offset = length;
-		} else {
-		    offset += count;
+		if (count > (length - offset)*2) {
+		    goto done;
 		}
-		break;
-	    case 'X':
-		if (count == BINARY_NOCOUNT) {
-		    count = 1;
+	    }
+	    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++;
+		    }
+		    *dest++ = hexdigit[value & 0xf];
 		}
-		if ((count == BINARY_ALL) || (count > offset)) {
-		    offset = 0;
-		} else {
-		    offset -= count;
+	    } else {
+		for (i = 0; i < count; i++) {
+		    if (i % 2) {
+			value <<= 4;
+		    } else {
+			value = *src++;
+		    }
+		    *dest++ = hexdigit[(value >> 4) & 0xf];
 		}
-		break;
-	    case '@':
-		if (count == BINARY_NOCOUNT) {
-		    DeleteScanNumberCache(numberCachePtr);
-		    goto badCount;
+	    }
+
+	    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;
 		}
-		if ((count == BINARY_ALL) || (count > length)) {
-		    offset = length;
-		} else {
-		    offset = count;
+		valuePtr = ScanNumber(buffer+offset, cmd, flags,
+			&numberCachePtr);
+		offset += size;
+	    } else {
+		if (count == BINARY_ALL) {
+		    count = (length - offset) / size;
 		}
-		break;
-	    default:
+		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;
+	    }
+
+	    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);
-		errorString = str;
-		goto badField;
+		goto badCount;
+	    }
+	    if ((count == BINARY_ALL) || (count > length)) {
+		offset = length;
+	    } else {
+		offset = count;
 	    }
+	    break;
+	default:
+	    DeleteScanNumberCache(numberCachePtr);
+	    errorString = str;
+	    goto badField;
 	}
+    }
 
-	/*
-	 * Set the result to the last position of the cursor.
-	 */
+    /*
+     * Set the result to the last position of the cursor.
+     */
 
-    done:
-	Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4));
-	DeleteScanNumberCache(numberCachePtr);
-	break;
-    }
-    }
-    return TCL_OK;
+ done:
+    Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 3));
+    DeleteScanNumberCache(numberCachePtr);
 
-  badValue:
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "expected ", errorString,
-	    " string but got \"", errorValue, "\" instead", NULL);
-    return TCL_ERROR;
+    return TCL_OK;
 
-  badCount:
+ badCount:
     errorString = "missing count for \"@\" field specifier";
     goto error;
 
-  badIndex:
+ badIndex:
     errorString = "not enough arguments for all format specifiers";
     goto error;
 
-  badField:
+ badField:
     {
 	Tcl_UniChar ch;
 	char buf[TCL_UTF_MAX + 1];
 
 	Tcl_UtfToUniChar(errorString, &ch);
 	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
-	Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad field specifier \"%s\"", buf));
 	return TCL_ERROR;
     }
 
-  error:
-    Tcl_AppendResult(interp, errorString, NULL);
+ error:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
     return TCL_ERROR;
 }
 
@@ -1493,7 +1618,7 @@ Tcl_BinaryObjCmd(
 
 static int
 GetFormatSpec(
-    char **formatPtr,		/* Pointer to format string. */
+    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 */
@@ -1522,23 +1647,23 @@ GetFormatSpec(
     (*formatPtr)++;
     if (**formatPtr == 'u') {
 	(*formatPtr)++;
-	(*flagsPtr) |= BINARY_UNSIGNED;
+	*flagsPtr |= BINARY_UNSIGNED;
     }
     if (**formatPtr == '*') {
 	(*formatPtr)++;
-	(*countPtr) = BINARY_ALL;
+	*countPtr = BINARY_ALL;
     } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
 	unsigned long int count;
 
 	errno = 0;
-	count = strtoul(*formatPtr, formatPtr, 10);
+	count = strtoul(*formatPtr, (char **) formatPtr, 10);
 	if (errno || (count > (unsigned long) INT_MAX)) {
-	    (*countPtr) = INT_MAX;
+	    *countPtr = INT_MAX;
 	} else {
-	    (*countPtr) = (int) count;
+	    *countPtr = (int) count;
 	}
     } else {
-	(*countPtr) = BINARY_NOCOUNT;
+	*countPtr = BINARY_NOCOUNT;
     }
     return 1;
 }
@@ -1661,11 +1786,11 @@ static void
 CopyNumber(
     const void *from,		/* source */
     void *to,			/* destination */
-    unsigned int length,	/* Number of bytes to copy */
+    unsigned length,		/* Number of bytes to copy */
     int type)			/* What type of thing are we copying? */
 {
     switch (NeedReversing(type)) {
-    case 0: 
+    case 0:
 	memcpy(to, from, length);
 	break;
     case 1: {
@@ -1814,23 +1939,23 @@ FormatNumber(
 	    return TCL_ERROR;
 	}
 	if (NeedReversing(type)) {
-	    *(*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);
+	    *(*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);
 	} else {
-	    *(*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;
+	    *(*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);
 	}
 	return TCL_OK;
 
@@ -1844,15 +1969,15 @@ FormatNumber(
 	    return TCL_ERROR;
 	}
 	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = (unsigned char) value;
-	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
-	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
-	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
+	    *(*cursorPtr)++ = UCHAR(value);
+	    *(*cursorPtr)++ = UCHAR(value >> 8);
+	    *(*cursorPtr)++ = UCHAR(value >> 16);
+	    *(*cursorPtr)++ = UCHAR(value >> 24);
 	} else {
-	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
-	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
-	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
-	    *(*cursorPtr)++ = (unsigned char) value;
+	    *(*cursorPtr)++ = UCHAR(value >> 24);
+	    *(*cursorPtr)++ = UCHAR(value >> 16);
+	    *(*cursorPtr)++ = UCHAR(value >> 8);
+	    *(*cursorPtr)++ = UCHAR(value);
 	}
 	return TCL_OK;
 
@@ -1866,11 +1991,11 @@ FormatNumber(
 	    return TCL_ERROR;
 	}
 	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = (unsigned char) value;
-	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
+	    *(*cursorPtr)++ = UCHAR(value);
+	    *(*cursorPtr)++ = UCHAR(value >> 8);
 	} else {
-	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
-	    *(*cursorPtr)++ = (unsigned char) value;
+	    *(*cursorPtr)++ = UCHAR(value >> 8);
+	    *(*cursorPtr)++ = UCHAR(value);
 	}
 	return TCL_OK;
 
@@ -1881,7 +2006,7 @@ FormatNumber(
 	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	*(*cursorPtr)++ = (unsigned char) value;
+	*(*cursorPtr)++ = UCHAR(value);
 	return TCL_OK;
 
     default:
@@ -1986,7 +2111,7 @@ ScanNumber(
 	    value = (long) (buffer[3]
 		    + (buffer[2] << 8)
 		    + (buffer[1] << 16)
-		    + (((long)buffer[0]) << 24));
+		    + (((long) buffer[0]) << 24));
 	}
 
 	/*
@@ -1999,9 +2124,9 @@ ScanNumber(
 	if (flags & BINARY_UNSIGNED) {
 	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
 	}
-	if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
-	    value -= (((unsigned int)1)<<31);
-	    value -= (((unsigned int)1)<<31);
+	if ((value & (((unsigned) 1)<<31)) && (value > 0)) {
+	    value -= (((unsigned) 1)<<31);
+	    value -= (((unsigned) 1)<<31);
 	}
 
     returnNumericObject:
@@ -2014,13 +2139,13 @@ ScanNumber(
 
 	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
 	    if (!isNew) {
-		return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+		return Tcl_GetHashValue(hPtr);
 	    }
 	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
 		register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
 
 		Tcl_IncrRefCount(objPtr);
-		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+		Tcl_SetHashValue(hPtr, objPtr);
 		return objPtr;
 	    }
 
@@ -2147,9 +2272,725 @@ DeleteScanNumberCache(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * 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;
+    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++ = HexDigits[((data[offset] >> 4) & 0x0f)];
+	*cursor++ = HexDigits[(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, "?options? 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) {
+		value <<= 4;
+		break;
+	    }
+
+	    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);
+	}
+	if (i < 2) {
+	    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 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;
+    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;
+	    }
+	    if (maxlen < 0) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"line length out of range", -1));
+		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+			"LINE_LENGTH", NULL);
+		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(B64Digits[d[0] >> 2]);
+	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
+	    if (offset+1 < count) {
+		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
+	    } else {
+		OUTPUT(B64Digits[64]);
+	    }
+	    if (offset+2 < count) {
+		OUTPUT(B64Digits[d[2] & 0x3f]);
+	    } else {
+		OUTPUT(B64Digits[64]);
+	    }
+	}
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+#undef OUTPUT
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BinaryEncodeUu --
+ *
+ *	This implements the uuencode binary encoding. Input is broken into 6
+ *	bit chunks and a lookup table is used to turn these values into output
+ *	characters. This differs from the generic code above in that line
+ *	lengths are also encoded.
+ *
+ * Results:
+ *	Interp result set to an encoded byte array object
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryEncodeUu(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *resultObj;
+    unsigned char *data, *start, *cursor;
+    int offset, count, rawLength, n, i, j, bits, index;
+    int lineLength = 61;
+    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
+    const unsigned char *wrapchar = SingleNewline;
+    int wrapcharlen = sizeof(SingleNewline);
+    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], &lineLength) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (lineLength < 3 || lineLength > 85) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"line length out of range", -1));
+		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+			"LINE_LENGTH", NULL);
+		return TCL_ERROR;
+	    }
+	    break;
+	case OPT_WRAPCHAR:
+	    wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
+	    break;
+	}
+    }
+
+    /*
+     * Allocate the buffer. This is a little bit too long, but is "good
+     * enough".
+     */
+
+    resultObj = Tcl_NewObj();
+    offset = 0;
+    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+    rawLength = (lineLength - 1) * 3 / 4;
+    start = cursor = Tcl_SetByteArrayLength(resultObj,
+	    (lineLength + wrapcharlen) *
+	    ((count + (rawLength - 1)) / rawLength));
+    n = bits = 0;
+
+    /*
+     * Encode the data. Each output line first has the length of raw data
+     * encoded by the output line described in it by one encoded byte, then
+     * the encoded data follows (encoding each 6 bits as one character).
+     * Encoded lines are always terminated by a newline.
+     */
+
+    while (offset < count) {
+	int lineLen = count - offset;
+
+	if (lineLen > rawLength) {
+	    lineLen = rawLength;
+	}
+	*cursor++ = UueDigits[lineLen];
+	for (i=0 ; i<lineLen ; i++) {
+	    n <<= 8;
+	    n |= data[offset++];
+	    for (bits += 8; bits > 6 ; bits -= 6) {
+		*cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
+	    }
+	}
+	if (bits > 0) {
+	    n <<= 8;
+	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
+	    bits = 0;
+	}
+	for (j=0 ; j<wrapcharlen ; ++j) {
+	    *cursor++ = wrapchar[j];
+	}
+    }
+
+    /*
+     * Fix the length of the output bytearray.
+     */
+
+    Tcl_SetByteArrayLength(resultObj, cursor-start);
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, strict = 0, lineLen;
+    unsigned char c;
+    enum {OPT_STRICT };
+    static const char *const optStrings[] = { "-strict", NULL };
+
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?options? 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);
+    lineLen = -1;
+
+    /*
+     * The decoding loop. First, we get the length of line (strictly, the
+     * number of data bytes we expect to generate from the line) we're
+     * processing this time round if it is not already known (i.e., when the
+     * lineLen variable is set to the magic value, -1).
+     */
+
+    while (data < dataend) {
+	char d[4] = {0, 0, 0, 0};
+
+	if (lineLen < 0) {
+	    c = *data++;
+	    if (c < 32 || c > 96) {
+		if (strict || !isspace(c)) {
+		    goto badUu;
+		}
+		i--;
+		continue;
+	    }
+	    lineLen = (c - 32) & 0x3f;
+	}
+
+	/*
+	 * Now we read a four-character grouping.
+	 */
+
+	for (i=0 ; i<4 ; i++) {
+	    if (data < dataend) {
+		d[i] = c = *data++;
+		if (c < 32 || c > 96) {
+		    if (strict) {
+			if (!isspace(c)) {
+			    goto badUu;
+			} else if (c == '\n') {
+			    goto shortUu;
+			}
+		    }
+		    i--;
+		    continue;
+		}
+	    }
+	}
+
+	/*
+	 * Translate that grouping into (up to) three binary bytes output.
+	 */
+
+	if (lineLen > 0) {
+	    *cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
+		    | (((d[1] - 0x20) & 0x3f) >> 4);
+	    if (--lineLen > 0) {
+		*cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
+			| (((d[2] - 0x20) & 0x3f) >> 2);
+		if (--lineLen > 0) {
+		    *cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
+			    | (((d[3] - 0x20) & 0x3f));
+		    lineLen--;
+		}
+	    }
+	}
+
+	/*
+	 * If we've reached the end of the line, skip until we process a
+	 * newline.
+	 */
+
+	if (lineLen == 0 && data < dataend) {
+	    lineLen = -1;
+	    do {
+		c = *data++;
+		if (c == '\n') {
+		    break;
+		} else if (c >= 32 && c <= 96) {
+		    data--;
+		    break;
+		} else if (strict || !isspace(c)) {
+		    goto badUu;
+		}
+	    } while (data < dataend);
+	}
+    }
+
+    /*
+     * Sanity check, clean up and finish.
+     */
+
+    if (lineLen > 0 && strict) {
+	goto shortUu;
+    }
+    Tcl_SetByteArrayLength(resultObj, cursor - begin);
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+
+  shortUu:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
+    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
+    TclDecrRefCount(resultObj);
+    return TCL_ERROR;
+
+  badUu:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "invalid uuencode character \"%c\" at position %d",
+	    c, (int) (data - datastart - 1)));
+    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
+    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 = '\0';
+    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, "?options? 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;
+
+	/*
+	 * Decode the current block. Each base64 block consists of four input
+	 * characters A-Z, a-z, 0-9, +, or /. Each character supplies six bits
+	 * of output data, so each block's output is 24 bits (three bytes) in
+	 * length. The final block can be shorter by one or two bytes, denoted
+	 * by the input ending with one or two ='s, respectively.
+	 */
+
+	for (i = 0; i < 4; i++) {
+	    /*
+	     * Get the next input character. At end of input, pad with at most
+	     * two ='s. If more than two ='s would be needed, instead discard
+	     * the block read thus far.
+	     */
+
+	    if (data < dataend) {
+		c = *data++;
+	    } else if (i > 1) {
+		c = '=';
+	    } else {
+		cut += 3;
+		break;
+	    }
+
+	    /*
+	     * Load the character into the block value. Handle ='s specially
+	     * because they're only valid as the last character or two of the
+	     * final block of input. Unless strict mode is enabled, skip any
+	     * input whitespace characters.
+	     */
+
+	    if (cut) {
+		if (c == '=' && i > 1) {
+		     value <<= 6;
+		     cut++;
+		} else if (!strict && isspace(c)) {
+		     i--;
+		} else {
+		    goto bad64;
+		}
+	    } else 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;
+		cut++;
+	    } else if (strict || !isspace(c)) {
+		goto bad64;
+	    } else {
+		i--;
+	    }
+	}
+	*cursor++ = UCHAR((value >> 16) & 0xff);
+	*cursor++ = UCHAR((value >> 8) & 0xff);
+	*cursor++ = UCHAR(value & 0xff);
+
+	/*
+	 * Since = is only valid within the final block, if it was encountered
+	 * but there are still more input characters, confirm that strict mode
+	 * is off and all subsequent characters are whitespace.
+	 */
+
+	if (cut && data < dataend) {
+	    if (strict) {
+		goto bad64;
+	    }
+	    for (; data < dataend; data++) {
+		if (!isspace(*data)) {
+		    goto bad64;
+		}
+	    }
+	}
+    }
+    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 5263e82..70e64f0 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -20,6 +20,12 @@
 #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
 
 /*
@@ -30,12 +36,12 @@
 typedef struct MemTag {
     int refCount;		/* Number of mem_headers referencing this
 				 * tag. */
-    char string[4];		/* Actual size of string will be as large as
+    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. */
 } MemTag;
 
-#define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
+#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString))
 
 static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
 				 * by "memory tag" command). */
@@ -52,7 +58,7 @@ struct mem_header {
     struct mem_header *blink;
     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];
@@ -126,11 +132,11 @@ static int ckallocInit = 0;
  */
 
 static int		CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
-			    int argc, CONST char *argv[]);
+			    int argc, const char *argv[]);
 static int		MemoryCmd(ClientData clientData, Tcl_Interp *interp,
-			    int argc, CONST char *argv[]);
+			    int argc, const char *argv[]);
 static void		ValidateMemory(struct mem_header *memHeaderP,
-			    CONST char *file, int line, int nukeGuards);
+			    const char *file, int line, int nukeGuards);
 
 /*
  *----------------------------------------------------------------------
@@ -168,11 +174,15 @@ TclInitDbCkalloc(void)
  */
 
 int
-TclDumpMemoryInfo(ClientData clientData, int flags)
+TclDumpMemoryInfo(
+    ClientData clientData,
+    int flags)
 {
     char buf[1024];
 
-    if (clientData == NULL) { return 0; }
+    if (clientData == NULL) {
+        return 0;
+    }
     sprintf(buf,
 	    "total mallocs             %10d\n"
 	    "total frees               %10d\n"
@@ -187,7 +197,7 @@ TclDumpMemoryInfo(ClientData clientData, int flags)
 	    maximum_malloc_packets,
 	    (unsigned long)maximum_bytes_malloced);
     if (flags == 0) {
-	fprintf((FILE *)clientData, buf);
+	fprintf((FILE *)clientData, "%s", buf);
     } else {
 	/* Assume objPtr to append to */
 	Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
@@ -216,7 +226,7 @@ static void
 ValidateMemory(
     struct mem_header *memHeaderP,
 				/* Memory chunk to validate */
-    CONST char *file,		/* File containing the call to
+    const char *file,		/* File containing the call to
 				 * Tcl_ValidateAllMemory */
     int line,			/* Line number of call to
 				 * Tcl_ValidateAllMemory */
@@ -242,7 +252,7 @@ ValidateMemory(
     if (guard_failed) {
 	TclDumpMemoryInfo((ClientData) stderr, 0);
 	fprintf(stderr, "low guard failed at %lx, %s %d\n",
-		(long unsigned int) memHeaderP->body, file, line);
+		(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,
 		memHeaderP->file, memHeaderP->line);
@@ -264,7 +274,7 @@ ValidateMemory(
     if (guard_failed) {
 	TclDumpMemoryInfo((ClientData) stderr, 0);
 	fprintf(stderr, "high guard failed at %lx, %s %d\n",
-		(long unsigned int) memHeaderP->body, file, line);
+		(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, memHeaderP->file,
@@ -297,7 +307,7 @@ ValidateMemory(
 
 void
 Tcl_ValidateAllMemory(
-    CONST char *file,		/* File from which Tcl_ValidateAllMemory was
+    const char *file,		/* File from which Tcl_ValidateAllMemory was
 				 * called. */
     int line)			/* Line number of call to
 				 * Tcl_ValidateAllMemory */
@@ -331,7 +341,7 @@ Tcl_ValidateAllMemory(
 
 int
 Tcl_DumpActiveMemory(
-    CONST char *fileName)	/* Name of the file to write info to */
+    const char *fileName)	/* Name of the file to write info to */
 {
     FILE *fileP;
     struct mem_header *memScanP;
@@ -348,10 +358,10 @@ Tcl_DumpActiveMemory(
 
     Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
-	address = &memScanP->body [0];
+	address = &memScanP->body[0];
 	fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
-		(long unsigned int) address,
-		(long unsigned int) address + memScanP->length - 1,
+		(long unsigned) address,
+		(long unsigned) address + memScanP->length - 1,
 		memScanP->length, memScanP->file, memScanP->line,
 		(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
 	(void) fputc('\n', fileP);
@@ -385,7 +395,7 @@ Tcl_DumpActiveMemory(
 char *
 Tcl_DbCkalloc(
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     struct mem_header *result = NULL;
@@ -455,11 +465,7 @@ Tcl_DbCkalloc(
     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
 	break_on_malloc = 0;
 	(void) fflush(stdout);
-	fprintf(stderr,"reached malloc break limit (%d)\n",
-		total_mallocs);
-	fprintf(stderr, "program will now enter C debugger\n");
-	(void) fflush(stderr);
-	abort();
+	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
     }
 
     current_malloc_packets++;
@@ -479,7 +485,7 @@ Tcl_DbCkalloc(
 char *
 Tcl_AttemptDbCkalloc(
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     struct mem_header *result = NULL;
@@ -548,11 +554,7 @@ Tcl_AttemptDbCkalloc(
     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
 	break_on_malloc = 0;
 	(void) fflush(stdout);
-	fprintf(stderr,"reached malloc break limit (%d)\n",
-		total_mallocs);
-	fprintf(stderr, "program will now enter C debugger\n");
-	(void) fflush(stderr);
-	abort();
+	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
     }
 
     current_malloc_packets++;
@@ -590,7 +592,7 @@ Tcl_AttemptDbCkalloc(
 void
 Tcl_DbCkfree(
     char *ptr,
-    CONST char *file,
+    const char *file,
     int line)
 {
     struct mem_header *memp;
@@ -669,7 +671,7 @@ char *
 Tcl_DbCkrealloc(
     char *ptr,
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     char *newPtr;
@@ -700,7 +702,7 @@ char *
 Tcl_AttemptDbCkrealloc(
     char *ptr,
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     char *newPtr;
@@ -748,12 +750,6 @@ Tcl_AttemptDbCkrealloc(
  *----------------------------------------------------------------------
  */
 
-#undef Tcl_Alloc
-#undef Tcl_Free
-#undef Tcl_Realloc
-#undef Tcl_AttemptAlloc
-#undef Tcl_AttemptRealloc
-
 char *
 Tcl_Alloc(
     unsigned int size)
@@ -818,34 +814,36 @@ MemoryCmd(
     ClientData clientData,
     Tcl_Interp *interp,
     int argc,
-    CONST char *argv[])
+    const char *argv[])
 {
-    CONST char *fileName;
+    const char *fileName;
     FILE *fileP;
     Tcl_DString buffer;
     int result;
     size_t len;
 
     if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option [args..]\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "wrong # args: should be \"%s option [args..]\"", argv[0]));
 	return TCL_ERROR;
     }
 
-    if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
+    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);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "wrong # args: should be \"%s %s file\"",
+                    argv[0], argv[1]));
 	    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_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
+                    argv[2], Tcl_PosixError(interp)));
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
@@ -864,22 +862,22 @@ MemoryCmd(
 		"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
 		"total mallocs", total_mallocs, "total frees", total_frees,
 		"current packets allocated", current_malloc_packets,
-		"current bytes allocated", current_bytes_malloced,
+		"current bytes allocated", (unsigned long)current_bytes_malloced,
 		"maximum packets allocated", maximum_malloc_packets,
-		"maximum bytes allocated", maximum_bytes_malloced));
+		"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
 	return TCL_OK;
     }
-    if (strcmp(argv[1],"init") == 0) {
+    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 (strcmp(argv[1], "objs") == 0) {
 	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " objs file\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "wrong # args: should be \"%s objs file\"", argv[0]));
 	    return TCL_ERROR;
 	}
 	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -888,7 +886,9 @@ MemoryCmd(
 	}
 	fileP = fopen(fileName, "w");
 	if (fileP == NULL) {
-	    Tcl_AppendResult(interp, "cannot open output file", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "cannot open output file: %s",
+                    Tcl_PosixError(interp)));
 	    return TCL_ERROR;
 	}
 	TclDbDumpActiveObjects(fileP);
@@ -898,8 +898,8 @@ MemoryCmd(
     }
     if (strcmp(argv[1],"onexit") == 0) {
 	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " onexit file\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "wrong # args: should be \"%s onexit file\"", argv[0]));
 	    return TCL_ERROR;
 	}
 	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -913,8 +913,8 @@ MemoryCmd(
     }
     if (strcmp(argv[1],"tag") == 0) {
 	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " tag string\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "wrong # args: should be \"%s tag string\"", argv[0]));
 	    return TCL_ERROR;
 	}
 	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
@@ -951,19 +951,20 @@ MemoryCmd(
 	return TCL_OK;
     }
 
-    Tcl_AppendResult(interp, "bad option \"", argv[1],
-	    "\": should be active, break_on_malloc, info, init, onexit, "
-	    "tag, trace, trace_on_at_malloc, or validate", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+            "bad option \"%s\": should be active, break_on_malloc, info, "
+            "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
+            argv[1]));
     return TCL_ERROR;
 
   argError:
-    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " count\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+            "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
     return TCL_ERROR;
 
   bad_suboption:
-    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " on|off\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+            "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
     return TCL_ERROR;
 }
 
@@ -990,11 +991,11 @@ CheckmemCmd(
     ClientData clientData,	/* Not used. */
     Tcl_Interp *interp,		/* Interpreter for evaluation. */
     int argc,			/* Number of arguments. */
-    CONST char *argv[])		/* String values of arguments. */
+    const char *argv[])		/* String values of arguments. */
 {
     if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" fileName\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "wrong # args: should be \"%s fileName\"", argv[0]));
 	return TCL_ERROR;
     }
     tclMemDumpFileName = dumpFile;
@@ -1024,8 +1025,8 @@ Tcl_InitMemory(
 				 * added */
 {
     TclInitDbCkalloc();
-    Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL);
-    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL);
+    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
 }
 
 
@@ -1076,7 +1077,7 @@ Tcl_Alloc(
 char *
 Tcl_DbCkalloc(
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     char *result;
@@ -1114,7 +1115,7 @@ Tcl_AttemptAlloc(
 char *
 Tcl_AttemptDbCkalloc(
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     char *result;
@@ -1153,7 +1154,7 @@ char *
 Tcl_DbCkrealloc(
     char *ptr,
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     char *result;
@@ -1193,7 +1194,7 @@ char *
 Tcl_AttemptDbCkrealloc(
     char *ptr,
     unsigned int size,
-    CONST char *file,
+    const char *file,
     int line)
 {
     char *result;
@@ -1224,7 +1225,7 @@ Tcl_Free(
 void
 Tcl_DbCkfree(
     char *ptr,
-    CONST char *file,
+    const char *file,
     int line)
 {
     TclpFree(ptr);
@@ -1249,20 +1250,22 @@ Tcl_InitMemory(
 
 int
 Tcl_DumpActiveMemory(
-    CONST char *fileName)
+    const char *fileName)
 {
     return TCL_OK;
 }
 
 void
 Tcl_ValidateAllMemory(
-    CONST char *file,
+    const char *file,
     int line)
 {
 }
 
 int
-TclDumpMemoryInfo(ClientData clientData, int flags)
+TclDumpMemoryInfo(
+    ClientData clientData,
+    int flags)
 {
     return 1;
 }
@@ -1319,5 +1322,7 @@ TclFinalizeMemorySubsystem(void)
  * 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 782c681..02b2845 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -7,7 +7,7 @@
  *
  * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
  * Copyright (c) 1995 Sun Microsystems, Inc.
- * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
+ * 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.
@@ -19,7 +19,7 @@
  * Windows has mktime. The configurators do not check.
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #define HAVE_MKTIME 1
 #endif
 
@@ -31,12 +31,12 @@
 #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 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 */
+#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
@@ -58,7 +58,7 @@ static const int daysInPriorMonths[2][13] = {
 typedef enum ClockLiteral {
     LIT__NIL,
     LIT__DEFAULT_FORMAT,
-    LIT_BCE,		LIT_C,			
+    LIT_BCE,		LIT_C,
     LIT_CANNOT_USE_GMT_AND_TIMEZONE,
     LIT_CE,
     LIT_DAYOFMONTH,	LIT_DAYOFWEEK,		LIT_DAYOFYEAR,
@@ -74,7 +74,7 @@ typedef enum ClockLiteral {
 static const char *const literals[] = {
     "",
     "%a %b %d %H:%M:%S %Z %Y",
-    "BCE",		"C",			
+    "BCE",		"C",
     "cannot use -gmt and -timezone in same call",
     "CE",
     "dayOfMonth",	"dayOfWeek",		"dayOfYear",
@@ -92,8 +92,8 @@ static const char *const literals[] = {
  */
 
 typedef struct ClockClientData {
-    int refCount;		/* Number of live references */
-    Tcl_Obj** literals;		/* Pool of object literals */
+    int refCount;		/* Number of live references. */
+    Tcl_Obj **literals;		/* Pool of object literals. */
 } ClockClientData;
 
 /*
@@ -107,7 +107,7 @@ typedef struct TclDateFields {
 				 * from the Posix epoch */
     int tzOffset;		/* Time zone offset in seconds east of
 				 * Greenwich */
-    Tcl_Obj* tzName;		/* Time zone name */
+    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 */
@@ -119,7 +119,7 @@ typedef struct TclDateFields {
     int iso8601Week;		/* ISO8601 week number */
     int dayOfWeek;		/* Day of the week */
 } TclDateFields;
-static const char* eras[] = { "CE", "BCE", NULL };
+static const char *const eras[] = { "CE", "BCE", NULL };
 
 /*
  * Thread specific data block holding a 'struct tm' for the 'gmtime' and
@@ -139,26 +139,26 @@ 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,
+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 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,
@@ -185,7 +185,7 @@ static int		ClockMillisecondsObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		ClockParseformatargsObjCmd(
-			    ClientData clientData, Tcl_Interp* interp,
+			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		ClockSecondsObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
@@ -208,18 +208,14 @@ struct ClockCommand {
 };
 
 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 },
+		ClockGetjuliandayfromerayearweekdayObjCmd },
     { "ParseFormatArgs",	ClockParseformatargsObjCmd },
     { NULL, NULL }
 };
@@ -249,10 +245,23 @@ TclClockInit(
     const struct ClockCommand *clockCmdPtr;
     char cmdName[50];		/* Buffer large enough to hold the string
 				 *::tcl::clock::GetJulianDayFromEraYearMonthDay
-				 * plus a terminating NULL. */
+				 * plus a terminating NUL. */
     ClockClientData *data;
     int i;
 
+    /* Structure of the 'clock' ensemble */
+
+    static const EnsembleImplMap clockImplMap[] = {
+	{"add",          NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL,       0},
+	{"clicks",       ClockClicksObjCmd,       TclCompileClockClicksCmd,  NULL, NULL,       0},
+	{"format",       NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL,       0},
+	{"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0},
+	{"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0},
+	{"scan",         NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL      , 0},
+	{"seconds",      ClockSecondsObjCmd,      TclCompileClockReadingCmd, NULL, INT2PTR(3), 0},
+	{NULL,           NULL,                    NULL,                      NULL, NULL,       0}
+    };
+
     /*
      * Safe interps get [::clock] as alias to a master, so do not need their
      * own copies of the support routines.
@@ -266,9 +275,9 @@ TclClockInit(
      * Create the client data, which is a refcounted literal pool.
      */
 
-    data = (ClockClientData *) ckalloc(sizeof(ClockClientData));
+    data = ckalloc(sizeof(ClockClientData));
     data->refCount = 0;
-    data->literals = (Tcl_Obj**) ckalloc(LIT__END * sizeof(Tcl_Obj*));
+    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]);
@@ -276,16 +285,21 @@ TclClockInit(
 
     /*
      * Install the commands.
+     * TODO - Let Tcl_MakeEnsemble do this?
      */
 
-    strcpy(cmdName, "::tcl::clock::");
 #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);
     }
+
+    /* Make the clock ensemble */
+
+    TclMakeEnsemble(interp, "clock", clockImplMap);
 }
 
 /*
@@ -317,15 +331,15 @@ TclClockInit(
 
 static int
 ClockConvertlocaltoutcObjCmd(
-    ClientData clientData,	/* Client data  */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    ClientData clientData,	/* Client data */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
     Tcl_Obj *const *objv)	/* Parameter vector */
 {
-    ClockClientData* data = (ClockClientData*) clientData;
-    Tcl_Obj* const * literals = data->literals;
-    Tcl_Obj* secondsObj;
-    Tcl_Obj* dict;
+    ClockClientData *data = clientData;
+    Tcl_Obj *const *literals = data->literals;
+    Tcl_Obj *secondsObj;
+    Tcl_Obj *dict;
     int changeover;
     TclDateFields fields;
     int created = 0;
@@ -341,16 +355,16 @@ ClockConvertlocaltoutcObjCmd(
     }
     dict = objv[1];
     if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
-		       &secondsObj)!= TCL_OK) {
+	    &secondsObj)!= TCL_OK) {
 	return TCL_ERROR;
     }
     if (secondsObj == NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
-						  "found in dictionary", -1));
+		"found in dictionary", -1));
 	return TCL_ERROR;
     }
     if ((Tcl_GetWideIntFromObj(interp, secondsObj,
-			      &(fields.localSeconds)) != TCL_OK)
+	    &fields.localSeconds) != TCL_OK)
 	|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
 	|| ConvertLocalToUTC(interp, &fields, objv[2], changeover)) {
 	return TCL_ERROR;
@@ -390,16 +404,16 @@ ClockConvertlocaltoutcObjCmd(
  *
  * 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.
+ *	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.
+ *		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
@@ -410,14 +424,14 @@ ClockConvertlocaltoutcObjCmd(
 int
 ClockGetdatefieldsObjCmd(
     ClientData clientData,	/* Opaque pointer to literal pool, etc. */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
     Tcl_Obj *const *objv)	/* Parameter vector */
 {
     TclDateFields fields;
-    Tcl_Obj* dict;
-    ClockClientData* data = (ClockClientData*) clientData;
-    Tcl_Obj* const * literals = data->literals;
+    Tcl_Obj *dict;
+    ClockClientData *data = clientData;
+    Tcl_Obj *const *literals = data->literals;
     int changeover;
 
     /*
@@ -428,14 +442,14 @@ ClockGetdatefieldsObjCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
 	return TCL_ERROR;
     }
-    if (Tcl_GetWideIntFromObj(interp, objv[1], &(fields.seconds)) != TCL_OK
+    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.
+    /*
+     * fields.seconds could be an unsigned number that overflowed. Make sure
+     * that it isn't.
      */
 
     if (objv[1]->typePtr == &tclBignumType) {
@@ -522,17 +536,56 @@ ClockGetdatefieldsObjCmd(
  */
 
 static int
-ClockGetjuliandayfromerayearmonthdayObjCmd (
+FetchEraField(
+    Tcl_Interp *interp,
+    Tcl_Obj *dict,
+    Tcl_Obj *key,
+    int *storePtr)
+{
+    Tcl_Obj *value = NULL;
+
+    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (value == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"expected key(s) not found in dictionary", -1));
+	return TCL_ERROR;
+    }
+    return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
+}
+
+static int
+FetchIntField(
+    Tcl_Interp *interp,
+    Tcl_Obj *dict,
+    Tcl_Obj *key,
+    int *storePtr)
+{
+    Tcl_Obj *value = NULL;
+
+    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (value == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"expected key(s) not found in dictionary", -1));
+	return TCL_ERROR;
+    }
+    return TclGetIntFromObj(interp, value, storePtr);
+}
+
+static int
+ClockGetjuliandayfromerayearmonthdayObjCmd(
     ClientData clientData,	/* Opaque pointer to literal pool, etc. */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
     Tcl_Obj *const *objv)	/* Parameter vector */
 {
     TclDateFields fields;
-    Tcl_Obj* dict;
-    ClockClientData* data = (ClockClientData*) clientData;
-    Tcl_Obj* const * literals = data->literals;
-    Tcl_Obj* fieldPtr;
+    Tcl_Obj *dict;
+    ClockClientData *data = clientData;
+    Tcl_Obj *const *literals = data->literals;
     int changeover;
     int copied = 0;
     int status;
@@ -547,24 +600,14 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
 	return TCL_ERROR;
     }
     dict = objv[1];
-    if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
-		&era) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],	&fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.dayOfMonth)) != TCL_OK
+    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
+		!= TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
+		!= TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
+		&fields.dayOfMonth) != TCL_OK
 	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
-	if (fieldPtr == NULL) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
-	}
 	return TCL_ERROR;
     }
     fields.era = era;
@@ -617,17 +660,16 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
  */
 
 static int
-ClockGetjuliandayfromerayearweekdayObjCmd (
+ClockGetjuliandayfromerayearweekdayObjCmd(
     ClientData clientData,	/* Opaque pointer to literal pool, etc. */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
     Tcl_Obj *const *objv)	/* Parameter vector */
 {
     TclDateFields fields;
-    Tcl_Obj* dict;
-    ClockClientData* data = (ClockClientData*) clientData;
-    Tcl_Obj* const * literals = data->literals;
-    Tcl_Obj* fieldPtr;
+    Tcl_Obj *dict;
+    ClockClientData *data = clientData;
+    Tcl_Obj *const *literals = data->literals;
     int changeover;
     int copied = 0;
     int status;
@@ -642,23 +684,14 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
 	return TCL_ERROR;
     }
     dict = objv[1];
-    if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
-		&era) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
+    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
+		&fields.iso8601Year) != TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
+		&fields.iso8601Week) != TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
+		&fields.dayOfWeek) != TCL_OK
 	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
-	if (fieldPtr == NULL) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
-	}
 	return TCL_ERROR;
     }
     fields.era = era;
@@ -709,13 +742,13 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
 
 static int
 ConvertLocalToUTC(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    TclDateFields* fields,	/* Fields of the time */
-    Tcl_Obj* tzdata,		/* Time zone data */
+    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 */
+    Tcl_Obj **rowv;		/* Pointers to the rows */
 
     /*
      * Unpack the tz data.
@@ -757,14 +790,14 @@ ConvertLocalToUTC(
 
 static int
 ConvertLocalToUTCUsingTable(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
+    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;
+    Tcl_Obj *row;
     int cellc;
-    Tcl_Obj** cellv;
+    Tcl_Obj **cellv;
     int have[8];
     int nHave = 0;
     int i;
@@ -789,7 +822,7 @@ ConvertLocalToUTCUsingTable(
 		|| TclListObjGetElements(interp, row, &cellc,
 		    &cellv) != TCL_OK
 		|| TclGetIntFromObj(interp, cellv[1],
-		    &(fields->tzOffset)) != TCL_OK) {
+		    &fields->tzOffset) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	found = 0;
@@ -803,8 +836,7 @@ ConvertLocalToUTCUsingTable(
 	    if (nHave == 8) {
 		Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
 	    }
-	    have[nHave] = fields->tzOffset;
-	    ++nHave;
+	    have[nHave++] = fields->tzOffset;
 	}
 	fields->seconds = fields->localSeconds - fields->tzOffset;
     }
@@ -833,8 +865,8 @@ ConvertLocalToUTCUsingTable(
 
 static int
 ConvertLocalToUTCUsingC(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
+    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;
@@ -851,7 +883,7 @@ ConvertLocalToUTCUsingC(
     secondOfDay = (int)(jsec % SECONDS_PER_DAY);
     if (secondOfDay < 0) {
 	secondOfDay += SECONDS_PER_DAY;
-	--fields->julianDay;
+	fields->julianDay--;
     }
     GetGregorianEraYearDay(fields, changeover);
     GetMonthDay(fields);
@@ -888,8 +920,8 @@ ConvertLocalToUTCUsingC(
 
     if (localErrno != 0
 	    || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
-	Tcl_SetResult(interp, "time value too large/small to represent",
-		TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"time value too large/small to represent", -1));
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -913,13 +945,13 @@ ConvertLocalToUTCUsingC(
 
 static int
 ConvertUTCToLocal(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    TclDateFields* fields,	/* Fields of the time */
-    Tcl_Obj* tzdata,		/* Time zone data */
+    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 */
+    Tcl_Obj **rowv;		/* Pointers to the rows */
 
     /*
      * Unpack the tz data.
@@ -961,15 +993,15 @@ ConvertUTCToLocal(
 
 static int
 ConvertUTCToLocalUsingTable(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    TclDateFields* fields,	/* Fields of the date */
+    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 */
+    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 */
+    Tcl_Obj **cellv;		/* Pointers to the cells */
 
     /*
      * Look up the nearest transition time.
@@ -978,7 +1010,7 @@ ConvertUTCToLocalUsingTable(
     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) {
+	    TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -1013,12 +1045,12 @@ ConvertUTCToLocalUsingTable(
 
 static int
 ConvertUTCToLocalUsingC(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
+    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 */
+    struct tm *timeVal;		/* Time after conversion */
     int diff;			/* Time zone diff local-Greenwich */
     char buffer[8];		/* Buffer for time zone name */
 
@@ -1028,17 +1060,17 @@ ConvertUTCToLocalUsingC(
 
     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_SetObjResult(interp, Tcl_NewStringObj(
+		"number too large to represent as a Posix time", -1));
 	Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
 	return TCL_ERROR;
     }
     TzsetIfNecessary();
     timeVal = ThreadSafeLocalTime(&tock);
     if (timeVal == NULL) {
-	Tcl_AppendResult(interp,
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"localtime failed (clock value may be too "
-		"large/small to represent)", NULL);
+		"large/small to represent)", -1));
 	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
 	return TCL_ERROR;
     }
@@ -1099,16 +1131,16 @@ ConvertUTCToLocalUsingC(
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj*
+static Tcl_Obj *
 LookupLastTransition(
-    Tcl_Interp* interp,		/* Interpreter for error messages */
+    Tcl_Interp *interp,		/* Interpreter for error messages */
     Tcl_WideInt tick,		/* Time from the epoch */
     int rowc,			/* Number of rows of tzdata */
     Tcl_Obj *const *rowv)	/* Rows in tzdata */
 {
     int l;
     int u;
-    Tcl_Obj* compObj;
+    Tcl_Obj *compObj;
     Tcl_WideInt compVal;
 
     /*
@@ -1171,7 +1203,7 @@ LookupLastTransition(
 
 static void
 GetYearWeekDay(
-    TclDateFields* fields,	/* Date to convert, must have 'julianDay' */
+    TclDateFields *fields,	/* Date to convert, must have 'julianDay' */
     int changeover)		/* Julian Day Number of the Gregorian
 				 * transition */
 {
@@ -1238,7 +1270,7 @@ GetYearWeekDay(
 
 static void
 GetGregorianEraYearDay(
-    TclDateFields* fields,	/* Date fields containing 'julianDay' */
+    TclDateFields *fields,	/* Date fields containing 'julianDay' */
     int changeover)		/* Gregorian transition date */
 {
     int jday = fields->julianDay;
@@ -1264,7 +1296,7 @@ GetGregorianEraYearDay(
 	day %= FOUR_CENTURIES;
 	if (day < 0) {
 	    day += FOUR_CENTURIES;
-	    --n;
+	    n--;
 	}
 	year += 400 * n;
 
@@ -1284,7 +1316,6 @@ GetGregorianEraYearDay(
 	    day += ONE_CENTURY_GREGORIAN;
 	}
 	year += 100 * n;
-
     } else {
 	/*
 	 * Julian calendar.
@@ -1293,7 +1324,6 @@ GetGregorianEraYearDay(
 	fields->gregorian = 0;
 	year = 1;
 	day = jday - JDAY_1_JAN_1_CE_JULIAN;
-
     }
 
     /*
@@ -1304,7 +1334,7 @@ GetGregorianEraYearDay(
     day %= FOUR_YEARS;
     if (day < 0) {
 	day += FOUR_YEARS;
-	--n;
+	n--;
     }
     year += 4 * n;
 
@@ -1356,11 +1386,11 @@ GetGregorianEraYearDay(
 
 static void
 GetMonthDay(
-    TclDateFields* fields)	/* Date to convert */
+    TclDateFields *fields)	/* Date to convert */
 {
     int day = fields->dayOfYear;
     int month;
-    const int* h = hath[IsGregorianLeapYear(fields)];
+    const int *h = hath[IsGregorianLeapYear(fields)];
 
     for (month = 0; month < 12 && day > h[month]; ++month) {
 	day -= h[month];
@@ -1388,18 +1418,18 @@ GetMonthDay(
 
 static void
 GetJulianDayFromEraYearWeekDay(
-    TclDateFields* fields,	/* Date to convert */
+    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.
      */
 
-    TclDateFields firstWeek;
     firstWeek.era = fields->era;
     firstWeek.year = fields->iso8601Year;
     firstWeek.month = 1;
@@ -1439,13 +1469,10 @@ GetJulianDayFromEraYearWeekDay(
 
 static void
 GetJulianDayFromEraYearMonthDay(
-    TclDateFields* fields,	/* Date to convert */
+    TclDateFields *fields,	/* Date to convert */
     int changeover)		/* Gregorian transition date as a Julian Day */
 {
-    int year;  int ym1;
-    int month; int mm1;
-    int q; int r;
-    int ym1o4; int ym1o100; int ym1o400;
+    int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;
 
     if (fields->era == BCE) {
 	year = 1 - fields->year;
@@ -1486,17 +1513,29 @@ GetJulianDayFromEraYearMonthDay(
      * Try an initial conversion in the Gregorian calendar.
      */
 
+#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */
     ym1o4 = ym1 / 4;
+#else
+    /*
+     * Have to make sure quotient is truncated towards 0 when negative.
+     * See above bug for details. The casts are necessary.
+     */
+    if (ym1 >= 0)
+        ym1o4 = ym1 / 4;
+    else {
+        ym1o4 = - (int) (((unsigned int) -ym1) / 4);
+    }
+#endif
     if (ym1 % 4 < 0) {
-	--ym1o4;
+	ym1o4--;
     }
     ym1o100 = ym1 / 100;
     if (ym1 % 100 < 0) {
-	--ym1o100;
+	ym1o100--;
     }
     ym1o400 = ym1 / 400;
     if (ym1 % 400 < 0) {
-	--ym1o400;
+	ym1o400--;
     }
     fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
 	    + fields->dayOfMonth
@@ -1516,8 +1555,8 @@ GetJulianDayFromEraYearMonthDay(
 	fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1
 		+ fields->dayOfMonth
 		+ daysInPriorMonths[year%4 == 0][month - 1]
-		+ (ONE_YEAR * ym1)
-	        + ym1o4;
+		+ (365 * ym1)
+		+ ym1o4;
     }
 }
 
@@ -1537,7 +1576,7 @@ GetJulianDayFromEraYearMonthDay(
 
 static int
 IsGregorianLeapYear(
-    TclDateFields* fields)	/* Date to test */
+    TclDateFields *fields)	/* Date to test */
 {
     int year;
 
@@ -1609,12 +1648,12 @@ WeekdayOnOrBefore(
 int
 ClockGetenvObjCmd(
     ClientData clientData,
-    Tcl_Interp* interp,
+    Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const objv[])
 {
-    const char* varName;
-    const char* varValue;
+    const char *varName;
+    const char *varValue;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name");
@@ -1655,8 +1694,7 @@ ThreadSafeLocalTime(
      * Get a thread-local buffer to hold the returned time.
      */
 
-    struct tm *tmPtr = (struct tm *)
-	    Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
+    struct tm *tmPtr = Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
 #ifdef HAVE_LOCALTIME_R
     localtime_r(timePtr, tmPtr);
 #else
@@ -1667,10 +1705,9 @@ ThreadSafeLocalTime(
     if (sysTmPtr == NULL) {
 	Tcl_MutexUnlock(&clockMutex);
 	return NULL;
-    } else {
-	memcpy((void *) tmPtr, (void *) localtime(timePtr), sizeof(struct tm));
-	Tcl_MutexUnlock(&clockMutex);
     }
+    memcpy(tmPtr, localtime(timePtr), sizeof(struct tm));
+    Tcl_MutexUnlock(&clockMutex);
 #endif
     return tmPtr;
 }
@@ -1696,18 +1733,19 @@ ThreadSafeLocalTime(
 int
 ClockClicksObjCmd(
     ClientData clientData,	/* Client data is unused */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
-    Tcl_Obj* const* objv)	/* Parameter values */
+    Tcl_Obj *const *objv)	/* Parameter values */
 {
-    static const char *clicksSwitches[] = {
+    static const char *const clicksSwitches[] = {
 	"-milliseconds", "-microseconds", NULL
     };
     enum ClicksSwitch {
-	CLICKS_MILLIS,   CLICKS_MICROS,   CLICKS_NATIVE
+	CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
     };
     int index = CLICKS_NATIVE;
     Tcl_Time now;
+    Tcl_WideInt clicks = 0;
 
     switch (objc) {
     case 1:
@@ -1719,32 +1757,29 @@ ClockClicksObjCmd(
 	}
 	break;
     default:
-	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-switch?");
 	return TCL_ERROR;
     }
 
     switch (index) {
     case CLICKS_MILLIS:
 	Tcl_GetTime(&now);
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		now.sec * 1000 + now.usec / 1000));
+	clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
 	break;
-    case CLICKS_NATIVE: {
-#ifndef TCL_WIDE_CLICKS
-	unsigned long clicks = TclpGetClicks();
+    case CLICKS_NATIVE:
+#ifdef TCL_WIDE_CLICKS
+	clicks = TclpGetWideClicks();
 #else
-	Tcl_WideInt clicks = TclpGetWideClicks();
+	clicks = (Tcl_WideInt) TclpGetClicks();
 #endif
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) clicks));
 	break;
-    }
     case CLICKS_MICROS:
 	Tcl_GetTime(&now);
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
-		((Tcl_WideInt) now.sec * 1000000) + now.usec));
+	clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec;
 	break;
     }
 
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
     return TCL_OK;
 }
 
@@ -1769,9 +1804,9 @@ ClockClicksObjCmd(
 int
 ClockMillisecondsObjCmd(
     ClientData clientData,	/* Client data is unused */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
-    Tcl_Obj* const* objv)	/* Parameter values */
+    Tcl_Obj *const *objv)	/* Parameter values */
 {
     Tcl_Time now;
 
@@ -1780,7 +1815,7 @@ ClockMillisecondsObjCmd(
 	return TCL_ERROR;
     }
     Tcl_GetTime(&now);
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
 	    now.sec * 1000 + now.usec / 1000));
     return TCL_OK;
 }
@@ -1806,9 +1841,9 @@ ClockMillisecondsObjCmd(
 int
 ClockMicrosecondsObjCmd(
     ClientData clientData,	/* Client data is unused */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
-    Tcl_Obj* const* objv)	/* Parameter values */
+    Tcl_Obj *const *objv)	/* Parameter values */
 {
     Tcl_Time now;
 
@@ -1830,12 +1865,12 @@ ClockMicrosecondsObjCmd(
  *	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.
+ *	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.
+ * options is a known performance "hot spot", and is implemented in an effort
+ * to speed that particular code up.
  *
  *-----------------------------------------------------------------------------
  */
@@ -1843,56 +1878,53 @@ ClockMicrosecondsObjCmd(
 static int
 ClockParseformatargsObjCmd(
     ClientData clientData,	/* Client data containing literal pool */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
-    Tcl_Obj *const objv[]	/* Parameter vector */
-) {
-
-    ClockClientData* dataPtr = (ClockClientData*) clientData;
-    Tcl_Obj** litPtr = dataPtr->literals;
-
-    /* Format, locale and timezone */
-
-    Tcl_Obj* results[3];
+    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;
-
-    /* Command line options expected */
-
-    static const char* options[] = {
-	"-format",		"-gmt",			"-locale",
-	"-timezone",		NULL };
+    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 
+	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 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 */
+    /*
+     * 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?");
+		"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 */
+    /*
+     * 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);
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		&optionIndex) != TCL_OK) {
+	    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
+		    Tcl_GetString(objv[i]), NULL);
 	    return TCL_ERROR;
 	}
 	switch (optionIndex) {
@@ -1900,7 +1932,7 @@ ClockParseformatargsObjCmd(
 	    formatObj = objv[i+1];
 	    break;
 	case CLOCK_FORMAT_GMT:
-	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK) {
+	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
 		return TCL_ERROR;
 	    }
 	    break;
@@ -1911,16 +1943,18 @@ ClockParseformatargsObjCmd(
 	    timezoneObj = objv[i+1];
 	    break;
 	}
-	saw |= (1 << optionIndex);
+	saw |= 1 << optionIndex;
     }
 
-    /* Check options */
+    /*
+     * 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))) {
+	    && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
 	Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
 	Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
 	return TCL_ERROR;
@@ -1929,7 +1963,9 @@ ClockParseformatargsObjCmd(
 	timezoneObj = litPtr[LIT_GMT];
     }
 
-    /* Return options as a list */
+    /*
+     * Return options as a list.
+     */
 
     Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
     return TCL_OK;
@@ -1937,7 +1973,6 @@ ClockParseformatargsObjCmd(
 #undef timezoneObj
 #undef localeObj
 #undef formatObj
-
 }
 
 /*----------------------------------------------------------------------
@@ -1961,9 +1996,9 @@ ClockParseformatargsObjCmd(
 int
 ClockSecondsObjCmd(
     ClientData clientData,	/* Client data is unused */
-    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Parameter count */
-    Tcl_Obj* const* objv)	/* Parameter values */
+    Tcl_Obj *const *objv)	/* Parameter values */
 {
     Tcl_Time now;
 
@@ -1998,7 +2033,7 @@ TzsetIfNecessary(void)
 {
     static char* tzWas = INT2PTR(-1);	/* Previous value of TZ, protected by
 				 * clockMutex. */
-    const char* tzIsNow;	/* Current value of TZ */
+    const char *tzIsNow;	/* Current value of TZ */
 
     Tcl_MutexLock(&clockMutex);
     tzIsNow = getenv("TZ");
@@ -2036,16 +2071,16 @@ static void
 ClockDeleteCmdProc(
     ClientData clientData)	/* Opaque pointer to the client data */
 {
-    ClockClientData *data = (ClockClientData*) clientData;
+    ClockClientData *data = clientData;
     int i;
 
-    --(data->refCount);
+    data->refCount--;
     if (data->refCount == 0) {
 	for (i = 0; i < LIT__END; ++i) {
 	    Tcl_DecrRefCount(data->literals[i]);
 	}
-	ckfree((char*) (data->literals));
-	ckfree((char*) data);
+	ckfree(data->literals);
+	ckfree(data);
     }
 }
 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 5484002..a48dfc7 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -12,22 +12,104 @@
  */
 
 #include "tclInt.h"
+#ifdef _WIN32
+#   include "tclWinInt.h"
+#endif
 #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. */
+    Tcl_Obj *resultList;	/* List of result values from the loop body,
+				 * or NULL if we're not collecting them
+				 * ([lmap] vs [foreach]). */
+};
+
+/*
  * Prototypes for local procedures defined in this file:
  */
 
 static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    int mode);
+static int		BadEncodingSubcommand(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		EncodingConvertfromObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		EncodingConverttoObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		EncodingDirsObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		EncodingNamesObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		EncodingSystemObjCmd(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 const char *	GetTypeFromMode(int mode);
 static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
 			    Tcl_StatBuf *statPtr);
+static inline int	EachloopCmd(Tcl_Interp *interp, int collect,
+			    int objc, Tcl_Obj *const objv[]);
+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	BadFileSubcommand;
+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;
 
 /*
  *----------------------------------------------------------------------
@@ -93,13 +175,13 @@ Tcl_CaseObjCmd(
 {
     register int i;
     int body, result, caseObjc;
-    char *stringPtr, *arg;
+    const char *stringPtr, *arg;
     Tcl_Obj *const *caseObjv;
     Tcl_Obj *armPtr;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"string ?in? patList body ... ?default body?");
+		"string ?in? ?pattern body ...? ?default body?");
 	return TCL_ERROR;
     }
 
@@ -130,11 +212,12 @@ Tcl_CaseObjCmd(
     for (i = 0;  i < caseObjc;  i += 2) {
 	int patObjc, j;
 	const char **patObjv;
-	char *pat, *p;
+	const char *pat, *p;
 
-	if (i == (caseObjc - 1)) {
+	if (i == caseObjc-1) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "extra case pattern with no body", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "extra case pattern with no body", -1));
 	    return TCL_ERROR;
 	}
 
@@ -175,7 +258,7 @@ Tcl_CaseObjCmd(
 		break;
 	    }
 	}
-	ckfree((char *) patObjv);
+	ckfree(patObjv);
 	if (j < patObjc) {
 	    break;
 	}
@@ -188,7 +271,7 @@ Tcl_CaseObjCmd(
 	if (result == TCL_ERROR) {
 	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		    "\n    (\"%.50s\" arm line %d)",
-		    TclGetString(armPtr), interp->errorLine));
+		    TclGetString(armPtr), Tcl_GetErrorLine(interp)));
 	}
 	return result;
     }
@@ -225,9 +308,18 @@ Tcl_CatchObjCmd(
     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_Obj *varNamePtr = NULL;
     Tcl_Obj *optionVarNamePtr = NULL;
-    int result;
     Interp *iPtr = (Interp *) interp;
 
     if ((objc < 2) || (objc > 4)) {
@@ -243,38 +335,51 @@ Tcl_CatchObjCmd(
 	optionVarNamePtr = objv[3];
     }
 
+    TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
+	    varNamePtr, optionVarNamePtr, NULL);
+
     /*
      * TIP #280. Make invoking context available to caught script.
      */
 
-    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+    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 (Tcl_LimitExceeded(interp)) {
+    if (rewind || Tcl_LimitExceeded(interp)) {
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"catch\" body line %d)", interp->errorLine));
+		"\n    (\"catch\" body line %d)", Tcl_GetErrorLine(interp)));
 	return TCL_ERROR;
     }
 
     if (objc >= 3) {
 	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
-		Tcl_GetObjResult(interp), 0)) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp,
-		    "couldn't save command result in variable", NULL);
+		Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) {
 	    return TCL_ERROR;
 	}
     }
     if (objc == 4) {
 	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
+
 	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
-		options, 0)) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp,
-		    "couldn't save return options in variable", NULL);
+		options, TCL_LEAVE_ERR_MSG)) {
+	    /* Do not decrRefCount 'options', it was already done by
+	     * Tcl_ObjSetVar2 */
 	    return TCL_ERROR;
 	}
     }
@@ -328,8 +433,9 @@ Tcl_CdObjCmd(
     } else {
 	result = Tcl_FSChdir(dir);
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
-		    TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't change working directory to \"%s\": %s",
+		    TclGetString(dir), Tcl_PosixError(interp)));
 	    result = TCL_ERROR;
 	}
     }
@@ -431,7 +537,7 @@ Tcl_EncodingObjCmd(
 {
     int index;
 
-    static const char *optionStrings[] = {
+    static const char *const optionStrings[] = {
 	"convertfrom", "convertto", "dirs", "names", "system",
 	NULL
     };
@@ -450,81 +556,280 @@ Tcl_EncodingObjCmd(
 
     switch ((enum options) index) {
     case ENC_CONVERTTO:
-    case ENC_CONVERTFROM: {
-	Tcl_Obj *data;
-	Tcl_DString ds;
-	Tcl_Encoding encoding;
-	int length;
-	char *stringPtr;
-
-	if (objc == 3) {
-	    encoding = Tcl_GetEncoding(interp, NULL);
-	    data = objv[2];
-	} else if (objc == 4) {
-	    if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    data = objv[3];
-	} else {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
-	    return TCL_ERROR;
-	}
+	return EncodingConverttoObjCmd(dummy, interp, objc, objv);
+    case ENC_CONVERTFROM:
+	return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
+    case ENC_DIRS:
+	return EncodingDirsObjCmd(dummy, interp, objc, objv);
+    case ENC_NAMES:
+	return EncodingNamesObjCmd(dummy, interp, objc, objv);
+    case ENC_SYSTEM:
+	return EncodingSystemObjCmd(dummy, interp, objc, objv);
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclInitEncodingCmd --
+ *
+ *	This function creates the 'encoding' ensemble.
+ *
+ * Results:
+ *	Returns the Tcl_Command so created.
+ *
+ * Side effects:
+ *	The ensemble is initialized.
+ *
+ * This command is hidden in a safe interpreter.
+ */
 
-	if ((enum options) index == ENC_CONVERTFROM) {
-	    /*
-	     * Treat the string as binary data.
-	     */
+Tcl_Command
+TclInitEncodingCmd(
+    Tcl_Interp* interp)		/* Tcl interpreter */
+{
+    static const EnsembleImplMap encodingImplMap[] = {
+	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
+	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
+    };
 
-	    stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
-	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);
+    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclMakeEncodingCommandSafe --
+ *
+ *	This function hides the unsafe 'dirs' and 'system' subcommands of
+ *	the "encoding" Tcl command ensemble. It must be called only from
+ *	TclHideUnsafeCommands.
+ *
+ * Results:
+ *	A standard Tcl result
+ *
+ * Side effects:
+ *	Adds commands to the table of hidden commands.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
-	    /*
-	     * Note that we cannot use Tcl_DStringResult here because it will
-	     * truncate the string at the first null byte.
-	     */
+int
+TclMakeEncodingCommandSafe(
+    Tcl_Interp* interp)		/* Tcl interpreter */
+{
+    static const struct {
+	const char *cmdName;
+	int unsafe;
+    } unsafeInfo[] = {
+	{"convertfrom", 0},
+	{"convertto",   0},
+	{"dirs",        1},
+	{"names",       0},
+	{"system",      0},
+	{NULL,          0}
+    };
 
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
-	    Tcl_DStringFree(&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);
+    int i;
+    Tcl_DString oldBuf, newBuf;
+
+    Tcl_DStringInit(&oldBuf);
+    TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
+    Tcl_DStringInit(&newBuf);
+    TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
+    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
+	if (unsafeInfo[i].unsafe) {
+	    const char *oldName, *newName;
+
+	    Tcl_DStringSetLength(&oldBuf, 17);
+	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
+	    Tcl_DStringSetLength(&newBuf, 13);
+	    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 'encoding %s' safe: %s",
+			unsafeInfo[i].cmdName,
+			Tcl_GetString(Tcl_GetObjResult(interp)));
+	    }
+	    Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
+		    (ClientData) unsafeInfo[i].cmdName, NULL);
 	}
+    }
+    Tcl_DStringFree(&oldBuf);
+    Tcl_DStringFree(&newBuf);
 
-	Tcl_FreeEncoding(encoding);
-	break;
+    /*
+     * Ugh. The [encoding] command is now actually safe, but it is assumed by
+     * scripts that it is not, which messes up security policies.
+     */
+
+    if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
+	Tcl_Panic("problem making 'encoding' safe: %s",
+		Tcl_GetString(Tcl_GetObjResult(interp)));
     }
-    case ENC_DIRS:
-	return EncodingDirsObjCmd(dummy, interp, objc, objv);
-    case ENC_NAMES:
-	if (objc > 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BadEncodingSubcommand --
+ *
+ *	Command used to act as a backstop implementation when subcommands of
+ *	"encoding" are unsafe (the real implementations of the subcommands are
+ *	hidden). The clientData is always the full official subcommand name.
+ *
+ * Results:
+ *	A standard Tcl result (always a TCL_ERROR).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BadEncodingSubcommand(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char *subcommandName = (const char *) clientData;
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "not allowed to invoke subcommand %s of encoding", subcommandName));
+    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodingConvertfromObjCmd --
+ *
+ *	This command converts a byte array in an external encoding into a
+ *	Tcl string
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+EncodingConvertfromObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *data;		/* Byte array to convert */
+    Tcl_DString ds;		/* Buffer to hold the string */
+    Tcl_Encoding encoding;	/* Encoding to use */
+    int length;			/* Length of the byte array being converted */
+    const char *bytesPtr;	/* Pointer to the first byte of the array */
+
+    if (objc == 2) {
+	encoding = Tcl_GetEncoding(interp, NULL);
+	data = objv[1];
+    } else if (objc == 3) {
+	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	Tcl_GetEncodingNames(interp);
-	break;
-    case ENC_SYSTEM:
-	if (objc > 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
+	data = objv[2];
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Convert the string into a byte array in 'ds'
+     */
+    bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
+    Tcl_ExternalToUtfDString(encoding, bytesPtr, 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));
+
+    /*
+     * We're done with the encoding
+     */
+
+    Tcl_FreeEncoding(encoding);
+    return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodingConverttoObjCmd --
+ *
+ *	This command converts a Tcl string into a byte array that
+ *	encodes the string according to some encoding.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+EncodingConverttoObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *data;		/* String to convert */
+    Tcl_DString ds;		/* Buffer to hold the byte array */
+    Tcl_Encoding encoding;	/* Encoding to use */
+    int length;			/* Length of the string being converted */
+    const char *stringPtr;	/* Pointer to the first byte of the string */
+
+    /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */
+
+    if (objc == 2) {
+	encoding = Tcl_GetEncoding(interp, NULL);
+	data = objv[1];
+    } else if (objc == 3) {
+	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (objc == 2) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    Tcl_GetEncodingName(NULL), -1));
-	} else {
-	    return Tcl_SetSystemEncoding(interp, TclGetString(objv[2]));
-	}
-	break;
+	data = objv[2];
+    } else {
+	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
+	return TCL_ERROR;
     }
+
+    /*
+     * Convert the string to a byte array in 'ds'
+     */
+
+    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);
+
+    /*
+     * We're done with the encoding
+     */
+
+    Tcl_FreeEncoding(encoding);
     return TCL_OK;
+
 }
 
 /*
@@ -552,19 +857,22 @@ EncodingDirsObjCmd(
 {
     Tcl_Obj *dirListObj;
 
-    if (objc > 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
 	return TCL_ERROR;
     }
-    if (objc == 2) {
+    if (objc == 1) {
 	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
 	return TCL_OK;
     }
 
-    dirListObj = objv[2];
+    dirListObj = objv[1];
     if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
-	Tcl_AppendResult(interp, "expected directory list but got \"",
-		TclGetString(dirListObj), "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"expected directory list but got \"%s\"",
+		TclGetString(dirListObj)));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
+		NULL);
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, dirListObj);
@@ -572,6 +880,68 @@ EncodingDirsObjCmd(
 }
 
 /*
+ *-----------------------------------------------------------------------------
+ *
+ * EncodingNamesObjCmd --
+ *
+ *	This command returns a list of the available encoding names
+ *
+ * Results:
+ *	Returns a standard Tcl result
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+EncodingNamesObjCmd(ClientData dummy,       /* Unused */
+		    Tcl_Interp* interp,	    /* Tcl interpreter */
+		    int objc,		    /* Number of command line args */
+		    Tcl_Obj* const objv[])  /* Vector of command line args */
+{
+    if (objc > 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
+    }
+    Tcl_GetEncodingNames(interp);
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * EncodingSystemObjCmd --
+ *
+ *	This command retrieves or changes the system encoding
+ *
+ * Results:
+ *	Returns a standard Tcl result
+ *
+ * Side effects:
+ *	May change the system encoding.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int
+EncodingSystemObjCmd(ClientData dummy,      /* Unused */
+		     Tcl_Interp* interp,    /* Tcl interpreter */
+		     int objc,		    /* Number of command line args */
+		     Tcl_Obj* const objv[]) /* Vector of command line args */
+{
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
+	return TCL_ERROR;
+    }
+    if (objc == 1) {
+	Tcl_SetObjResult(interp,
+			 Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1));
+    } else {
+	return Tcl_SetSystemEncoding(interp, TclGetString(objv[1]));
+    }
+    return TCL_OK;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_ErrorObjCmd --
@@ -639,6 +1009,19 @@ 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. */
@@ -646,9 +1029,20 @@ Tcl_EvalObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int result;
+    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. */
+{
     register Tcl_Obj *objPtr;
     Interp *iPtr = (Interp *) interp;
+    CmdFrame *invoker = NULL;
+    int word = 0;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -660,32 +1054,24 @@ Tcl_EvalObjCmd(
 	 * 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);
+	invoker = iPtr->cmdFramePtr;
+	word = 1;
+	objPtr = objv[1];
+	TclArgumentGet(interp, objPtr, &invoker, &word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
 	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
 	 * object when it decrements its refcount after eval'ing it.
+	 *
+	 * TIP #280. Make invoking context available to eval'd script, done
+	 * with the default values.
 	 */
 
 	objPtr = Tcl_ConcatObj(objc-1, objv+1);
-
-	/*
-	 * TIP #280. Make invoking context available to eval'd script.
-	 */
-
-	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
-    }
-    if (result == TCL_ERROR) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"eval\" body line %d)", interp->errorLine));
     }
-    return result;
+    TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
+    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
 
 /*
@@ -762,41 +1148,67 @@ Tcl_ExprObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Obj *resultPtr;
-    int result;
+    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;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
 	return TCL_ERROR;
     }
 
+    TclNewObj(resultPtr);
+    Tcl_IncrRefCount(resultPtr);
     if (objc == 2) {
-	result = Tcl_ExprObj(interp, objv[1], &resultPtr);
+	objPtr = objv[1];
+	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
     } else {
-	Tcl_Obj *objPtr = Tcl_ConcatObj(objc-1, objv+1);
-	Tcl_IncrRefCount(objPtr);
-	result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
+    }
+
+    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];
+
+    if (objPtr != NULL) {
 	Tcl_DecrRefCount(objPtr);
     }
 
     if (result == TCL_OK) {
 	Tcl_SetObjResult(interp, resultPtr);
-	Tcl_DecrRefCount(resultPtr);	/* Done with the result object */
     }
-
+    Tcl_DecrRefCount(resultPtr);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FileObjCmd --
+ * TclInitFileCmd --
+ *
+ *	This function builds the "file" Tcl command ensemble. See the user
+ *	documentation for details on what that ensemble does.
  *
- *	This procedure is invoked to process the "file" Tcl command. See the
- *	user documentation for details on what it does. PLEASE NOTE THAT THIS
- *	FAILS WITH FILENAMES AND PATHS WITH EMBEDDED NULLS. With the
- *	object-based Tcl_FS APIs, the above NOTE may no longer be true. In any
- *	case this assertion should be tested.
+ *	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.
@@ -807,573 +1219,1226 @@ Tcl_ExprObjCmd(
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_FileObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+Tcl_Command
+TclInitFileCmd(
+    Tcl_Interp *interp)
 {
-    int index, value;
-    Tcl_StatBuf buf;
-    struct utimbuf tval;
-
     /*
-     * This list of constants should match the fileOption string array below.
+     * Note that most subcommands are unsafe because either they manipulate
+     * the native filesystem or because they reveal information about the
+     * native filesystem.
      */
 
-    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",
-	NULL
+    static const EnsembleImplMap initMap[] = {
+	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 0},
+	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 0},
+	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 0},
+	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
+	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 0},
+	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{NULL, NULL, NULL, NULL, NULL, 0}
     };
-    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
+    return TclMakeEnsemble(interp, "file", initMap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMakeFileCommandSafe --
+ *
+ *	This function hides the unsafe subcommands of the "file" Tcl command
+ *	ensemble. It must only be called from TclHideUnsafeCommands.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Adds commands to the table of hidden commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMakeFileCommandSafe(
+    Tcl_Interp *interp)
+{
+    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);
+    TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
+    Tcl_DStringInit(&newBuf);
+    TclDStringAppendLiteral(&newBuf, "tcl:file:");
+    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_CreateObjCommand(interp, oldName, BadFileSubcommand,
+		    (ClientData) unsafeInfo[i].cmdName, NULL);
+	}
+    }
+    Tcl_DStringFree(&oldBuf);
+    Tcl_DStringFree(&newBuf);
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+    /*
+     * 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]
+     */
+
+    if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
+	Tcl_Panic("problem making 'file' safe: %s",
+		Tcl_GetString(Tcl_GetObjResult(interp)));
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BadFileSubcommand --
+ *
+ *	Command used to act as a backstop implementation when subcommands of
+ *	"file" are unsafe (the real implementations of the subcommands are
+ *	hidden). The clientData is always the full official subcommand name.
+ *
+ * Results:
+ *	A standard Tcl result (always a TCL_ERROR).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BadFileSubcommand(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char *subcommandName = (const char *) clientData;
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "not allowed to invoke subcommand %s of file", subcommandName));
+    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileAttrAccessTimeCmd(
+    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 (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
-	    &index) != TCL_OK) {
+    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
 	return TCL_ERROR;
     }
+#if defined(_WIN32)
+    /* We use a value of 0 to indicate the access time not available */
+    if (buf.st_atime == 0) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                             "could not get access time for file \"%s\"",
+                             TclGetString(objv[1])));
+        return TCL_ERROR;
+    }
+#endif
 
-    switch ((enum options) index) {
+    if (objc == 3) {
+	/*
+	 * Need separate variable for reading longs from an object on 64-bit
+	 * platforms. [Bug 698146]
+	 */
 
-    case FCMD_ATIME:
-    case FCMD_MTIME:
-	if ((objc < 3) || (objc > 4)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+	long newTime;
+
+	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+
+	tval.actime = newTime;
+	tval.modtime = buf.st_mtime;
+
+	if (Tcl_FSUtime(objv[1], &tval) != 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not set access time for file \"%s\": %s",
+		    TclGetString(objv[1]), Tcl_PosixError(interp)));
 	    return TCL_ERROR;
 	}
-	if (objc == 4) {
-	    /*
-	     * Need separate variable for reading longs from an object on
-	     * 64-bit platforms. [Bug #698146]
-	     */
 
-	    long newTime;
+	/*
+	 * 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 (TclGetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
-		return TCL_ERROR;
-	    }
+	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
 
-	    if (index == FCMD_ATIME) {
-		tval.actime = newTime;
-		tval.modtime = buf.st_mtime;
-	    } else {	/* index == FCMD_MTIME */
-		tval.actime = buf.st_atime;
-		tval.modtime = newTime;
-	    }
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    if (Tcl_FSUtime(objv[2], &tval) != 0) {
-		Tcl_AppendResult(interp, "could not set ",
-			(index == FCMD_ATIME ? "access" : "modification"),
-			" time for file \"", TclGetString(objv[2]), "\": ",
-			Tcl_PosixError(interp), NULL);
-		return TCL_ERROR;
-	    }
+static int
+FileAttrModifyTimeCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_StatBuf buf;
+    struct utimbuf tval;
 
-	    /*
-	     * 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 (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 defined(_WIN32)
+    /* We use a value of 0 to indicate the modification time not available */
+    if (buf.st_mtime == 0) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                             "could not get modification time for file \"%s\"",
+                             TclGetString(objv[1])));
+        return TCL_ERROR;
+    }
+#endif
+    if (objc == 3) {
+	/*
+	 * Need separate variable for reading longs from an object on 64-bit
+	 * platforms. [Bug 698146]
+	 */
 
-	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	}
+	long newTime;
 
-	Tcl_SetObjResult(interp, Tcl_NewLongObj((long)
-		(index == FCMD_ATIME ? buf.st_atime : buf.st_mtime)));
-	return TCL_OK;
-    case FCMD_ATTRIBUTES:
-	return TclFileAttrsCmd(interp, objc, objv);
-    case FCMD_CHANNELS:
-	if ((objc < 2) || (objc > 3)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	return Tcl_GetChannelNamesEx(interp,
-		((objc == 2) ? NULL : TclGetString(objv[2])));
-    case FCMD_COPY:
-	return TclFileCopyCmd(interp, objc, objv);
-    case FCMD_DELETE:
-	return TclFileDeleteCmd(interp, objc, objv);
-    case FCMD_DIRNAME: {
-	Tcl_Obj *dirPtr;
-
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME);
-	if (dirPtr == NULL) {
+
+	tval.actime = buf.st_atime;
+	tval.modtime = newTime;
+
+	if (Tcl_FSUtime(objv[1], &tval) != 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not set modification time for file \"%s\": %s",
+		    TclGetString(objv[1]), Tcl_PosixError(interp)));
 	    return TCL_ERROR;
-	} else {
-	    Tcl_SetObjResult(interp, dirPtr);
-	    Tcl_DecrRefCount(dirPtr);
-	    return TCL_OK;
 	}
-    }
-    case FCMD_EXECUTABLE:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	return CheckAccess(interp, objv[2], X_OK);
-    case FCMD_EXISTS:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	return CheckAccess(interp, objv[2], F_OK);
-    case FCMD_EXTENSION: {
-	Tcl_Obj *ext;
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION);
-	if (ext != NULL) {
-	    Tcl_SetObjResult(interp, ext);
-	    Tcl_DecrRefCount(ext);
-	    return TCL_OK;
-	} else {
+	/*
+	 * 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_ISDIRECTORY:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	value = 0;
-	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
-	    value = S_ISDIR(buf.st_mode);
-	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
-	return TCL_OK;
-    case FCMD_ISFILE:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	value = 0;
-	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
-	    value = S_ISREG(buf.st_mode);
-	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
-	return TCL_OK;
-    case FCMD_OWNED:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	value = 0;
-	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
-	    /*
-	     * For Windows, there are no user ids associated with a file, so
-	     * we always return 1.
-	     */
-
-#if defined(__WIN32__) || defined(__CYGWIN__)
-	    value = 1;
-#else
-	    value = (geteuid() == buf.st_uid);
-#endif
-	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
-	return TCL_OK;
-    case FCMD_JOIN: {
-	Tcl_Obj *resObj;
 
-	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
-	    return TCL_ERROR;
-	}
-	resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
-	Tcl_SetObjResult(interp, resObj);
-	return TCL_OK;
+    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;
     }
-    case FCMD_LINK: {
-	Tcl_Obj *contents;
-	int index;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc < 3 || objc > 5) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?-linktype? linkname ?target?");
-	    return TCL_ERROR;
-	}
+static int
+FileAttrStatCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_StatBuf buf;
 
-	/*
-	 * Index of the 'source' argument.
-	 */
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc == 5) {
-	    index = 3;
-	} else {
-	    index = 2;
-	}
+static int
+FileAttrTypeCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_StatBuf buf;
 
-	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;
-	    }
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    /*
-	     * 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);
-		} else if (errno == ENOENT) {
-		    /*
-		     * There are two cases here: either the target doesn't
-		     * exist, or the directory of the src doesn't exist.
-		     */
-
-		    int access;
-		    Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
-			    TCL_PATH_DIRNAME);
-
-		    if (dirPtr == NULL) {
-			return TCL_ERROR;
-		    }
-		    access = Tcl_FSAccess(dirPtr, F_OK);
-		    Tcl_DecrRefCount(dirPtr);
-		    if (access != 0) {
-			Tcl_AppendResult(interp,
-				"could not create new link \"",
-				TclGetString(objv[index]),
-				"\": no such file or directory", NULL);
-		    } else {
-			Tcl_AppendResult(interp,
-				"could not create new link \"",
-				TclGetString(objv[index]), "\": target \"",
-				TclGetString(objv[index+1]),
-				"\" doesn't exist", NULL);
-		    }
-		} else {
-		    Tcl_AppendResult(interp,
-			    "could not create new link \"",
-			    TclGetString(objv[index]), "\" pointing to \"",
-			    TclGetString(objv[index+1]), "\": ",
-			    Tcl_PosixError(interp), NULL);
-		}
-		return TCL_ERROR;
-	    }
-	} else {
-	    if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
-		return TCL_ERROR;
-	    }
+static int
+FileAttrSizeCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_StatBuf buf;
 
-	    /*
-	     * Read link
-	     */
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    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 == 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;
+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;
     }
-    case FCMD_LSTAT:
-	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;
-	}
-	return StoreStatData(interp, objv[3], &buf);
-    case FCMD_STAT:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "name varName");
-	    return TCL_ERROR;
-	}
-	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	return StoreStatData(interp, objv[3], &buf);
-    case FCMD_SIZE:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp,
-		Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
-	return TCL_OK;
-    case FCMD_TYPE:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		GetTypeFromMode((unsigned short) buf.st_mode), -1));
-	return TCL_OK;
-    case FCMD_MKDIR:
-	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
-	    return TCL_ERROR;
-	}
-	return TclFileMakeDirsCmd(interp, objc, objv);
-    case FCMD_NATIVENAME: {
-	const char *fileName;
-	Tcl_DString ds;
+    if (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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	fileName = TclGetString(objv[2]);
-	fileName = Tcl_TranslateFileName(interp, fileName, &ds);
-	if (fileName == NULL) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(fileName,
-		Tcl_DStringLength(&ds)));
-	Tcl_DStringFree(&ds);
-	return TCL_OK;
+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;
     }
-    case FCMD_NORMALIZE: {
-	Tcl_Obj *fileName;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "filename");
-	    return TCL_ERROR;
-	}
+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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
-	if (fileName == NULL) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, fileName);
-	return TCL_OK;
+static int
+FileAttrIsFileCmd(
+    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_ISREG(buf.st_mode);
     }
-    case FCMD_PATHTYPE: {
-	Tcl_Obj *typeName;
+    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) {
-	    goto only3Args;
-	}
+static int
+FileAttrIsOwnedCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+#ifdef __CYGWIN__
+#define geteuid() (short)(geteuid)()
+#endif
+#if !defined(_WIN32)
+    Tcl_StatBuf buf;
+#endif
+    int value = 0;
 
-	switch (Tcl_FSGetPathType(objv[2])) {
-	case TCL_PATH_ABSOLUTE:
-	    TclNewLiteralStringObj(typeName, "absolute");
-	    break;
-	case TCL_PATH_RELATIVE:
-	    TclNewLiteralStringObj(typeName, "relative");
-	    break;
-	case TCL_PATH_VOLUME_RELATIVE:
-	    TclNewLiteralStringObj(typeName, "volumerelative");
-	    break;
-	default:
-	    return TCL_OK;
-	}
-	Tcl_SetObjResult(interp, typeName);
-	return TCL_OK;
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
+	return TCL_ERROR;
     }
-    case FCMD_READABLE:
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	return CheckAccess(interp, objv[2], R_OK);
-    case FCMD_READLINK: {
-	Tcl_Obj *contents;
+#if defined(_WIN32)
+    value = TclWinFileOwned(objv[1]);
+#else
+    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
+	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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
+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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	contents = Tcl_FSLink(objv[2], NULL, 0);
+static int
+PathDirNameCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *dirPtr;
 
-	if (contents == NULL) {
-	    Tcl_AppendResult(interp, "could not readlink \"",
-		    TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
-		    NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, contents);
-	Tcl_DecrRefCount(contents);
-	return TCL_OK;
+    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;
     }
-    case FCMD_RENAME:
-	return TclFileRenameCmd(interp, objc, objv);
-    case FCMD_ROOTNAME: {
-	Tcl_Obj *root;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);
-	if (root != NULL) {
-	    Tcl_SetObjResult(interp, root);
-	    Tcl_DecrRefCount(root);
-	    return TCL_OK;
-	} else {
-	    return TCL_ERROR;
-	}
+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;
     }
-    case FCMD_SEPARATOR:
-	if ((objc < 2) || (objc > 3)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?name?");
-	    return TCL_ERROR;
-	}
-	if (objc == 2) {
-	    const char *separator = NULL; /* lint */
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    switch (tclPlatform) {
-	    case TCL_PLATFORM_UNIX:
-		separator = "/";
-		break;
-	    case TCL_PLATFORM_WINDOWS:
-		separator = "\\";
-		break;
-	    }
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
-	} else {
-	    Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
+static int
+PathTailCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *dirPtr;
 
-	    if (separatorObj == NULL) {
-		Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
-		return TCL_ERROR;
-	    }
-	    Tcl_SetObjResult(interp, separatorObj);
-	}
-	return TCL_OK;
-    case FCMD_SPLIT: {
-	Tcl_Obj *res;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	res = Tcl_FSSplitPath(objv[2], NULL);
-	if (res == NULL) {
-	    /* How can the interp be NULL here?! DKF */
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "could not read \"",
-			TclGetString(objv[2]),
-			"\": no such file or directory", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, res);
-	return TCL_OK;
+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_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
+		Tcl_GetString(objv[1]), NULL);
+	return TCL_ERROR;
     }
-    case FCMD_SYSTEM: {
-	Tcl_Obj *fsInfo;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	fsInfo = Tcl_FSFileSystemInfo(objv[2]);
-	if (fsInfo == NULL) {
-	    Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, fsInfo);
-	return TCL_OK;
+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;
     }
-    case FCMD_TAIL: {
-	Tcl_Obj *dirPtr;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	if (objc != 3) {
-	    goto only3Args;
-	}
-	dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
-	if (dirPtr == NULL) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, dirPtr);
-	Tcl_DecrRefCount(dirPtr);
+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;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
+	return TCL_ERROR;
+    }
+    res = Tcl_FSSplitPath(objv[1], NULL);
+    if (res == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"could not read \"%s\": no such file or directory",
+		TclGetString(objv[1])));
+	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PathTypeCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *typeName;
+
+    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;
     }
-    case FCMD_VOLUMES:
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 */
+
+	switch (tclPlatform) {
+	case TCL_PLATFORM_UNIX:
+	    separator = "/";
+	    break;
+	case TCL_PLATFORM_WINDOWS:
+	    separator = "\\";
+	    break;
 	}
-	Tcl_SetObjResult(interp, Tcl_FSListVolumes());
-	return TCL_OK;
-    case FCMD_WRITABLE:
-	if (objc != 3) {
-	    goto only3Args;
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
+    } else {
+	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);
+
+	if (separatorObj == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "unrecognised path", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
+		    Tcl_GetString(objv[1]), NULL);
+	    return TCL_ERROR;
 	}
-	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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-  only3Args:
-    Tcl_WrongNumArgs(interp, 2, objv, "name");
-    return TCL_ERROR;
+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;
 }
 
 /*
@@ -1449,13 +2514,13 @@ GetStatBuf(
 	return TCL_ERROR;
     }
 
-    status = (*statProc)(pathPtr, statPtr);
+    status = statProc(pathPtr, statPtr);
 
     if (status < 0) {
 	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "could not read \"",
-		    TclGetString(pathPtr), "\": ",
-		    Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not read \"%s\": %s",
+		    TclGetString(pathPtr), Tcl_PosixError(interp)));
 	}
 	return TCL_ERROR;
     }
@@ -1512,7 +2577,7 @@ StoreStatData(
 
     /*
      * 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...
+     * cast might fail when there isn't a real arithmetic 'long long' type...
      */
 
     STORE_ARY("dev",	Tcl_NewLongObj((long)statPtr->st_dev));
@@ -1599,6 +2664,25 @@ GetTypeFromMode(
  * 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	     |
+ *					|____________________|
+ *
  *----------------------------------------------------------------------
  */
 
@@ -1610,81 +2694,180 @@ Tcl_ForObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int result, value;
+    return Tcl_NRCallObjProc(interp, TclNRForObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRForObjCmd(
+    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;
 
     if (objc != 5) {
 	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.
      */
 
-    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+}
+
+static int
+ForSetupCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    ForIterData *iterPtr = data[0];
+
     if (result != TCL_OK) {
 	if (result == TCL_ERROR) {
 	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
 	}
+	TclSmallFreeEx(interp, iterPtr);
 	return result;
     }
-    while (1) {
+    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:
 	/*
-	 * 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.
+	 * We need to reset the result before evaluating the expression.
+	 * Otherwise, any error message will be appended to the result of the
+	 * last evaluation.
 	 */
 
 	Tcl_ResetResult(interp);
-	result = Tcl_ExprBooleanObj(interp, objv[2], &value);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if (!value) {
-	    break;
-	}
+	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;
+}
 
-	/*
-	 * TIP #280. Make invoking context available to loop body.
-	 */
+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;
 
-	result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr, 4);
-	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
-	    if (result == TCL_ERROR) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (\"for\" body line %d)", interp->errorLine));
-	    }
-	    break;
+    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.
 	 */
 
-	result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3);
-	if (result == TCL_BREAK) {
-	    break;
-	} else if (result != TCL_OK) {
-	    if (result == TCL_ERROR) {
-		Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
-	    }
-	    return result;
-	}
-    }
-    if (result == TCL_BREAK) {
-	result = TCL_OK;
+	return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
     }
-    if (result == TCL_OK) {
-	Tcl_ResetResult(interp);
+
+    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;
     }
+    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ForeachObjCmd --
+ * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd --
  *
  *	This object-based procedure is invoked to process the "foreach" Tcl
  *	command. See the user documentation for details on what it does.
@@ -1706,21 +2889,51 @@ Tcl_ForeachObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int result = TCL_OK;
-    int i;			/* i selects a value list */
-    int j, maxj;		/* Number of loop iterations */
-    int v;			/* v selects a loop variable */
-    int numLists = (objc-2)/2;	/* Count of value lists */
-    Tcl_Obj *bodyPtr;
-    Interp *iPtr = (Interp *) interp;
+    return Tcl_NRCallObjProc(interp, TclNRForeachCmd, dummy, objc, objv);
+}
+
+int
+TclNRForeachCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
+}
+
+int
+Tcl_LmapObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv);
+}
 
-    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 */
+int
+TclNRLmapCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
+}
+
+static inline int
+EachloopCmd(
+    Tcl_Interp *interp,		/* Our context for variables and script
+				 * evaluation. */
+    int collect,		/* Select collecting or accumulating mode
+				 * (TCL_EACH_*) */
+    int objc,			/* The arguments being passed in... */
+    Tcl_Obj *const objv[])
+{
+    int numLists = (objc-2) / 2;
+    register struct ForeachState *statePtr;
+    int i, j, result;
 
     if (objc < 4 || (objc%2 != 0)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -1730,129 +2943,243 @@ Tcl_ForeachObjCmd(
 
     /*
      * Manage numList parallel value lists.
-     * argvList[i] is a value list counted by argcList[i]l;
-     * varvList[i] is the list of variables associated with the value list;
-     * varcList[i] is the number of variables associated with the value list;
-     * index[i] is the current pointer into the value list argvList[i].
+     * 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.
      */
 
-    index = (int *) TclStackAlloc(interp, 3 * numLists * sizeof(int));
-    varcList = index + numLists;
-    argcList = varcList + numLists;
-    memset(index, 0, 3 * numLists * sizeof(int));
-
-    varvList = (Tcl_Obj ***)
-	    TclStackAlloc(interp, 2 * numLists * sizeof(Tcl_Obj **));
-    argvList = varvList + numLists;
-    memset(varvList, 0, 2 * numLists * sizeof(Tcl_Obj **));
-
-    vCopyList = (Tcl_Obj **)
-	    TclStackAlloc(interp, 2 * numLists * sizeof(Tcl_Obj *));
-    aCopyList = vCopyList + numLists;
-    memset(vCopyList, 0, 2 * numLists * sizeof(Tcl_Obj *));
+    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;
+
+    if (collect == TCL_EACH_COLLECT) {
+	statePtr->resultList = Tcl_NewListObj(0, NULL);
+    } else {
+	statePtr->resultList = NULL;
+    }
 
     /*
      * Break up the value lists and variable lists into elements.
      */
 
-    maxj = 0;
     for (i=0 ; i<numLists ; i++) {
-
-	vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
-	if (vCopyList[i] == NULL) {
+	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
+	if (statePtr->vCopyList[i] == NULL) {
 	    result = TCL_ERROR;
 	    goto done;
 	}
-	TclListObjGetElements(NULL, vCopyList[i], &varcList[i], &varvList[i]);
-	if (varcList[i] < 1) {
-	    Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
+	TclListObjGetElements(NULL, statePtr->vCopyList[i],
+		&statePtr->varcList[i], &statePtr->varvList[i]);
+	if (statePtr->varcList[i] < 1) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s varlist is empty",
+		    (statePtr->resultList != NULL ? "lmap" : "foreach")));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+		    (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
+		    "NEEDVARS", NULL);
 	    result = TCL_ERROR;
 	    goto done;
 	}
 
-	aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
-	if (aCopyList[i] == NULL) {
+	statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
+	if (statePtr->aCopyList[i] == NULL) {
 	    result = TCL_ERROR;
 	    goto done;
 	}
-	TclListObjGetElements(NULL, aCopyList[i], &argcList[i], &argvList[i]);
+	TclListObjGetElements(NULL, statePtr->aCopyList[i],
+		&statePtr->argcList[i], &statePtr->argvList[i]);
 
-	j = argcList[i] / varcList[i];
-	if ((argcList[i] % varcList[i]) != 0) {
+	j = statePtr->argcList[i] / statePtr->varcList[i];
+	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
 	    j++;
 	}
-	if (j > maxj) {
-	    maxj = j;
+	if (j > statePtr->maxj) {
+	    statePtr->maxj = j;
 	}
     }
 
     /*
-     * Iterate maxj times through the lists in parallel. If some value lists
-     * run out of values, set loop vars to ""
+     * If there is any work to do, assign the variables and set things going
+     * non-recursively.
      */
 
-    bodyPtr = objv[objc-1];
-    for (j=0 ; j<maxj ; j++) {
-	for (i=0 ; i<numLists ; i++) {
-	    for (v=0 ; v<varcList[i] ; v++) {
-		int k = index[i]++;
-		Tcl_Obj *valuePtr, *varValuePtr;
-
-		if (k < argcList[i]) {
-		    valuePtr = argvList[i][k];
-		} else {
-		    valuePtr = Tcl_NewObj(); /* Empty string */
-		}
-		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL,
-			valuePtr, TCL_LEAVE_ERR_MSG);
-		if (varValuePtr == NULL) {
-		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			    "\n    (setting foreach loop variable \"%s\")",
-			    TclGetString(varvList[i][v])));
-		    result = TCL_ERROR;
-		    goto done;
-		}
-	    }
+    if (statePtr->maxj > 0) {
+	result = ForeachAssignments(interp, statePtr);
+	if (result == TCL_ERROR) {
+	    goto done;
 	}
 
-	/*
-	 * TIP #280. Make invoking context available to loop body.
-	 */
+	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+	return TclNREvalObjEx(interp, objv[objc-1], 0,
+		((Interp *) interp)->cmdFramePtr, objc-1);
+    }
 
-	result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr, objc-1);
-	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) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (\"foreach\" body line %d)",
-			interp->errorLine));
-		break;
-	    } else {
-		break;
-	    }
+    /*
+     * This cleanup stage is only used when an error occurs during setup or if
+     * there is no work to do.
+     */
+
+    result = TCL_OK;
+  done:
+    ForeachCleanup(interp, statePtr);
+    return result;
+}
+
+/*
+ * Post-body processing handler.
+ */
+
+static int
+ForeachLoopStep(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    register struct ForeachState *statePtr = data[0];
+
+    /*
+     * Process the result code from this run of the [foreach] body. Note that
+     * this switch uses fallthroughs in several places. Maintainer aware!
+     */
+
+    switch (result) {
+    case TCL_CONTINUE:
+	result = TCL_OK;
+	break;
+    case TCL_OK:
+	if (statePtr->resultList != NULL) {
+	    Tcl_ListObjAppendElement(interp, statePtr->resultList,
+		    Tcl_GetObjResult(interp));
 	}
+	break;
+    case TCL_BREAK:
+	result = TCL_OK;
+	goto finish;
+    case TCL_ERROR:
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"%s\" body line %d)",
+		(statePtr->resultList != NULL ? "lmap" : "foreach"),
+		Tcl_GetErrorLine(interp)));
+    default:
+	goto done;
     }
-    if (result == TCL_OK) {
+
+    /*
+     * 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.
+     */
+
+    if (statePtr->maxj > ++statePtr->j) {
+	result = ForeachAssignments(interp, statePtr);
+	if (result == TCL_ERROR) {
+	    goto done;
+	}
+
+	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
+		((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
+    }
+
+    /*
+     * We're done. Tidy up our work space and finish off.
+     */
+
+  finish:
+    if (statePtr->resultList == NULL) {
 	Tcl_ResetResult(interp);
+    } else {
+	Tcl_SetObjResult(interp, statePtr->resultList);
+	statePtr->resultList = NULL;	/* Don't clean it up */
     }
 
   done:
-    for (i=0 ; i<numLists ; i++) {
-	if (vCopyList[i]) {
-	    Tcl_DecrRefCount(vCopyList[i]);
+    ForeachCleanup(interp, statePtr);
+    return result;
+}
+
+/*
+ * Factored out code to do the assignments in [foreach].
+ */
+
+static inline int
+ForeachAssignments(
+    Tcl_Interp *interp,
+    struct ForeachState *statePtr)
+{
+    int i, v, k;
+    Tcl_Obj *valuePtr, *varValuePtr;
+
+    for (i=0 ; i<statePtr->numLists ; i++) {
+	for (v=0 ; v<statePtr->varcList[i] ; v++) {
+	    k = statePtr->index[i]++;
+
+	    if (k < statePtr->argcList[i]) {
+		valuePtr = statePtr->argvList[i][k];
+	    } else {
+		TclNewObj(valuePtr);	/* Empty string */
+	    }
+
+	    varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v],
+		    NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+
+	    if (varValuePtr == NULL) {
+		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+			"\n    (setting %s loop variable \"%s\")",
+			(statePtr->resultList != NULL ? "lmap" : "foreach"),
+			TclGetString(statePtr->varvList[i][v])));
+		return TCL_ERROR;
+	    }
 	}
-	if (aCopyList[i]) {
-	    Tcl_DecrRefCount(aCopyList[i]);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ * Factored out code for cleaning up the state of the foreach.
+ */
+
+static inline void
+ForeachCleanup(
+    Tcl_Interp *interp,
+    struct ForeachState *statePtr)
+{
+    int i;
+
+    for (i=0 ; i<statePtr->numLists ; i++) {
+	if (statePtr->vCopyList[i]) {
+	    TclDecrRefCount(statePtr->vCopyList[i]);
+	}
+	if (statePtr->aCopyList[i]) {
+	    TclDecrRefCount(statePtr->aCopyList[i]);
 	}
     }
-    TclStackFree(interp, vCopyList);	/* Tcl_Obj * arrays */
-    TclStackFree(interp, varvList);	/* Tcl_Obj ** arrays */
-    TclStackFree(interp, index);	/* int arrays */
-    return result;
+    if (statePtr->resultList != NULL) {
+	TclDecrRefCount(statePtr->resultList);
+    }
+    TclStackFree(interp, statePtr);
 }
 
 /*
@@ -1883,7 +3210,7 @@ Tcl_FormatObjCmd(
     Tcl_Obj *resultPtr;		/* Where result is stored finally. */
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b303bb6..9fbb0ad 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -3,7 +3,7 @@
  *
  *	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
+ *	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.
@@ -27,13 +27,16 @@
  */
 
 typedef struct SortElement {
-    union {
-	char *strValuePtr;
-	long   intValue;
+    union {			/* The value that we sorting by. */
+	const char *strValuePtr;
+	Tcl_WideInt wideValue;
 	double doubleValue;
 	Tcl_Obj *objValuePtr;
-    } index;
-    Tcl_Obj *objPtr;	        /* Object being sorted, or its index. */
+    } 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. */
 } SortElement;
@@ -101,7 +104,8 @@ typedef struct SortInfo {
  * Forward declarations for procedures defined in this file:
  */
 
-static int		DictionaryCompare(char *left, char *right);
+static int		DictionaryCompare(const char *left, const char *right);
+static Tcl_NRPostProc	IfConditionCallback;
 static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
@@ -114,6 +118,9 @@ 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[]);
 /* TIP #280 - New 'info' subcommand 'frame' */
 static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
@@ -140,7 +147,7 @@ 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,
+static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
 			    SortInfo *infoPtr);
 static int		SortCompare(SortElement *firstPtr, SortElement *second,
 			    SortInfo *infoPtr);
@@ -153,29 +160,31 @@ static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
  */
 
 static const EnsembleImplMap defaultInfoMap[] = {
-    {"args",		   InfoArgsCmd,		    NULL},
-    {"body",		   InfoBodyCmd,		    NULL},
-    {"cmdcount",	   InfoCmdCountCmd,	    NULL},
-    {"commands",	   InfoCommandsCmd,	    NULL},
-    {"complete",	   InfoCompleteCmd,	    NULL},
-    {"default",		   InfoDefaultCmd,	    NULL},
-    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd},
-    {"frame",		   InfoFrameCmd,	    NULL},
-    {"functions",	   InfoFunctionsCmd,	    NULL},
-    {"globals",		   TclInfoGlobalsCmd,	    NULL},
-    {"hostname",	   InfoHostnameCmd,	    NULL},
-    {"level",		   InfoLevelCmd,	    NULL},
-    {"library",		   InfoLibraryCmd,	    NULL},
-    {"loaded",		   InfoLoadedCmd,	    NULL},
-    {"locals",		   TclInfoLocalsCmd,	    NULL},
-    {"nameofexecutable",   InfoNameOfExecutableCmd, NULL},
-    {"patchlevel",	   InfoPatchLevelCmd,	    NULL},
-    {"procs",		   InfoProcsCmd,	    NULL},
-    {"script",		   InfoScriptCmd,	    NULL},
-    {"sharedlibextension", InfoSharedlibCmd,	    NULL},
-    {"tclversion",	   InfoTclVersionCmd,	    NULL},
-    {"vars",		   TclInfoVarsCmd,	    NULL},
-    {NULL, NULL, NULL}
+    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
+    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
+    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
+    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
+    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"level",		   InfoLevelCmd,	    TclCompileInfoLevelCmd, NULL, NULL, 0},
+    {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {NULL, NULL, NULL, NULL, NULL, 0}
 };
 
 /*
@@ -206,40 +215,66 @@ Tcl_IfObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int thenScriptIndex = 0;	/* "then" script to be evaled after syntax
-				 * check. */
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"wrong # args: no expression after \"%s\" argument",
+		TclGetString(objv[0])));
+	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)
+{
     Interp *iPtr = (Interp *) interp;
-    int i, result, value;
-    char *clause;
+    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;
 
-    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 (result != TCL_OK) {
+	TclDecrRefCount(boolObj);
+	return result;
+    }
+    if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
+	TclDecrRefCount(boolObj);
+	return TCL_ERROR;
+    }
+    TclDecrRefCount(boolObj);
 
-	if (i >= objc) {
-	    clause = TclGetString(objv[i-1]);
-	    Tcl_AppendResult(interp, "wrong # args: ",
-		    "no expression after \"", clause, "\" argument", NULL);
-	    return TCL_ERROR;
-	}
-	if (!thenScriptIndex) {
-	    result = Tcl_ExprBooleanObj(interp, objv[i], &value);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	}
+    while (1) {
 	i++;
 	if (i >= objc) {
-	missingScript:
-	    clause = TclGetString(objv[i-1]);
-	    Tcl_AppendResult(interp, "wrong # args: ",
-		    "no script following \"", clause, "\" argument", NULL);
-	    return TCL_ERROR;
+	    goto missingScript;
 	}
 	clause = TclGetString(objv[i]);
 	if ((i < objc) && (strcmp(clause, "then") == 0)) {
@@ -265,17 +300,37 @@ Tcl_IfObjCmd(
 		 * TIP #280. Make invoking context available to branch.
 		 */
 
-		return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
+		return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
 			iPtr->cmdFramePtr, thenScriptIndex);
 	    }
 	    return TCL_OK;
 	}
 	clause = TclGetString(objv[i]);
-	if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
-	    i++;
-	    continue;
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "wrong # args: no expression after \"%s\" argument",
+		    clause));
+	    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);
 	}
-	break;
     }
 
     /*
@@ -287,14 +342,14 @@ Tcl_IfObjCmd(
     if (strcmp(clause, "else") == 0) {
 	i++;
 	if (i >= objc) {
-	    Tcl_AppendResult(interp, "wrong # args: ",
-		    "no script following \"else\" argument", NULL);
-	    return TCL_ERROR;
+	    goto missingScript;
 	}
     }
     if (i < objc - 1) {
-	Tcl_AppendResult(interp, "wrong # args: ",
-		"extra words after \"else\" clause in \"if\" command", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"wrong # args: extra words after \"else\" clause in \"if\" command",
+		-1));
+	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
 	return TCL_ERROR;
     }
     if (thenScriptIndex) {
@@ -302,10 +357,17 @@ Tcl_IfObjCmd(
 	 * TIP #280. Make invoking context available to branch/else.
 	 */
 
-	return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
+	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
 		iPtr->cmdFramePtr, thenScriptIndex);
     }
-    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
+    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
+
+  missingScript:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "wrong # args: no script following \"%s\" argument",
+	    TclGetString(objv[i-1])));
+    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+    return TCL_ERROR;
 }
 
 /*
@@ -375,7 +437,7 @@ Tcl_IncrObjCmd(
  *	documentation for details on what it does.
  *
  * Results:
- *	FIXME
+ *	Handle for the info command, or NULL on failure.
  *
  * Side effects:
  *	none
@@ -418,7 +480,7 @@ InfoArgsCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    char *name;
+    const char *name;
     Proc *procPtr;
     CompiledLocal *localPtr;
     Tcl_Obj *listObjPtr;
@@ -431,7 +493,9 @@ InfoArgsCmd(
     name = TclGetString(objv[1]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't a procedure", name));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
 	return TCL_ERROR;
     }
 
@@ -479,7 +543,7 @@ InfoBodyCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    char *name;
+    const char *name;
     Proc *procPtr;
     Tcl_Obj *bodyPtr, *resultPtr;
 
@@ -491,7 +555,9 @@ InfoBodyCmd(
     name = TclGetString(objv[1]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't a procedure", name));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
 	return TCL_ERROR;
     }
 
@@ -511,7 +577,7 @@ InfoBodyCmd(
 	 * run before. [Bug #545644]
 	 */
 
-	(void) TclGetString(bodyPtr);
+	TclGetString(bodyPtr);
     }
     resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
 
@@ -589,7 +655,7 @@ InfoCommandsCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *cmdName, *pattern;
+    const char *cmdName, *pattern;
     const char *simplePattern;
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
@@ -622,8 +688,8 @@ InfoCommandsCmd(
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
 	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
-		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+	TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr,
+		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
 
 	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
@@ -659,7 +725,7 @@ InfoCommandsCmd(
 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
 	if (entryPtr != NULL) {
 	    if (specificNsInPattern) {
-		cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+		cmd = Tcl_GetHashValue(entryPtr);
 		elemObjPtr = Tcl_NewObj();
 		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
 	    } else {
@@ -710,7 +776,7 @@ InfoCommandsCmd(
 	    if ((simplePattern == NULL)
 		    || Tcl_StringMatch(cmdName, simplePattern)) {
 		if (specificNsInPattern) {
-		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+		    cmd = Tcl_GetHashValue(entryPtr);
 		    elemObjPtr = Tcl_NewObj();
 		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
 		} else {
@@ -769,7 +835,7 @@ InfoCommandsCmd(
 		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
 		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
 		(void) Tcl_CreateHashEntry(&addedCommandsTable,
-			(char *)elemObjPtr, &isNew);
+			elemObjPtr, &isNew);
 	    }
 	    entryPtr = Tcl_NextHashEntry(&search);
 	}
@@ -794,7 +860,7 @@ InfoCommandsCmd(
 			|| Tcl_StringMatch(cmdName, simplePattern)) {
 		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
 		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
-			    (char *) elemObjPtr, &isNew);
+			    elemObjPtr, &isNew);
 		    if (isNew) {
 			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
 		    } else {
@@ -904,7 +970,7 @@ InfoDefaultCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    char *procName, *argName, *varName;
+    const char *procName, *argName;
     Proc *procPtr;
     CompiledLocal *localPtr;
     Tcl_Obj *valueObjPtr;
@@ -919,7 +985,10 @@ InfoDefaultCmd(
 
     procPtr = TclFindProc(iPtr, procName);
     if (procPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't a procedure", procName));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
+		NULL);
 	return TCL_ERROR;
     }
 
@@ -929,17 +998,18 @@ InfoDefaultCmd(
 		&& (strcmp(argName, localPtr->name) == 0)) {
 	    if (localPtr->defValuePtr != NULL) {
 		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
-			localPtr->defValuePtr, 0);
+			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
 		if (valueObjPtr == NULL) {
-		    goto defStoreError;
+		    return TCL_ERROR;
 		}
 		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
 	    } else {
 		Tcl_Obj *nullObjPtr = Tcl_NewObj();
+
 		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
-			nullObjPtr, 0);
+			nullObjPtr, TCL_LEAVE_ERR_MSG);
 		if (valueObjPtr == NULL) {
-		    goto defStoreError;
+		    return TCL_ERROR;
 		}
 		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
 	    }
@@ -947,15 +1017,60 @@ InfoDefaultCmd(
 	}
     }
 
-    Tcl_AppendResult(interp, "procedure \"", procName,
-	    "\" doesn't have an argument \"", argName, "\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "procedure \"%s\" doesn't have an argument \"%s\"",
+	    procName, argName));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
     return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoErrorStackCmd --
+ *
+ *	Called to implement the "info errorstack" command that returns information
+ *	about the last error's call stack. Handles the following syntax:
+ *
+ *	    info errorstack ?interp?
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-  defStoreError:
-    varName = TclGetString(objv[3]);
-    Tcl_AppendResult(interp, "couldn't store default value in variable \"",
-	    varName, "\"", NULL);
-    return TCL_ERROR;
+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;
 }
 
 /*
@@ -985,7 +1100,7 @@ TclInfoExistsCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *varName;
+    const char *varName;
     Var *varPtr;
 
     if (objc != 2) {
@@ -1031,22 +1146,47 @@ InfoFrameCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    int level;
-    CmdFrame *framePtr;
+    int level, code = TCL_OK;
+    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
+    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+    int topLevel = 0;
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
+	return TCL_ERROR;
+    }
+
+    while (corPtr) {
+	while (*cmdFramePtrPtr) {
+	    topLevel++;
+	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+	}
+	if (corPtr->caller.cmdFramePtr) {
+	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+	}
+	corPtr = corPtr->callerEEPtr->corPtr;
+    }
+    topLevel += (*cmdFramePtrPtr)->level;
+
+    if (topLevel != iPtr->cmdFramePtr->level) {
+	framePtr = iPtr->cmdFramePtr;
+	while (framePtr) {
+	    framePtr->level = topLevel--;
+	    framePtr = framePtr->nextPtr;
+	}
+	if (topLevel) {
+	    Tcl_Panic("Broken frame level calculation");
+	}
+	topLevel = iPtr->cmdFramePtr->level;
+    }
 
     if (objc == 1) {
 	/*
 	 * Just "info frame".
 	 */
 
-	int levels =
-		(iPtr->cmdFramePtr == NULL ? 0 : iPtr->cmdFramePtr->level);
-
-	Tcl_SetObjResult(interp, Tcl_NewIntObj (levels));
-	return TCL_OK;
-    } else if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
-	return TCL_ERROR;
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
+	goto done;
     }
 
     /*
@@ -1054,40 +1194,62 @@ InfoFrameCmd(
      */
 
     if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
-	return TCL_ERROR;
+	code = TCL_ERROR;
+	goto done;
     }
-    if (level <= 0) {
-	/*
-	 * Negative levels are adressing relative to the current frame's
-	 * depth.
-	 */
 
-	if (iPtr->cmdFramePtr == NULL) {
-	levelError:
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"",
-		    TclGetString(objv[1]), "\"", NULL);
-	    return TCL_ERROR;
-	}
+    if ((level > topLevel) || (level <= - topLevel)) {
+    levelError:
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad level \"%s\"", TclGetString(objv[1])));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
+		TclGetString(objv[1]), NULL);
+	code = TCL_ERROR;
+	goto done;
+    }
 
-	/*
-	 * Convert to absolute.
-	 */
+    /*
+     * Let us convert to relative so that we know how many levels to go back
+     */
 
-	level += iPtr->cmdFramePtr->level;
+    if (level > 0) {
+	level -= topLevel;
     }
 
-    for (framePtr = iPtr->cmdFramePtr; framePtr != NULL;
-	    framePtr = framePtr->nextPtr) {
-	if (framePtr->level == level) {
-	    break;
+    framePtr = iPtr->cmdFramePtr;
+    while (++level <= 0) {
+	framePtr = framePtr->nextPtr;
+	if (!framePtr) {
+	    goto levelError;
 	}
     }
-    if (framePtr == NULL) {
-	goto levelError;
-    }
 
     Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
-    return TCL_OK;
+
+  done:
+    cmdFramePtrPtr = &iPtr->cmdFramePtr;
+    corPtr = iPtr->execEnvPtr->corPtr;
+    while (corPtr) {
+	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
+
+	if (endPtr) {
+	    if (*cmdFramePtrPtr == endPtr) {
+		*cmdFramePtrPtr = NULL;
+	    } else {
+		CmdFrame *runPtr = *cmdFramePtrPtr;
+
+		while (runPtr->nextPtr != endPtr) {
+		    runPtr->level -= endPtr->level;
+		    runPtr = runPtr->nextPtr;
+		}
+		runPtr->level = 1;
+		runPtr->nextPtr = NULL;
+	    }
+	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
+	}
+	corPtr = corPtr->callerEEPtr->corPtr;
+    }
+    return code;
 }
 
 /*
@@ -1112,6 +1274,7 @@ TclInfoFrame(
     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;
@@ -1119,14 +1282,13 @@ TclInfoFrame(
      * This array is indexed by the TCL_LOCATION_... values, except
      * for _LAST.
      */
-    static const char *typeString[TCL_LOCATION_LAST] = {
+    static const char *const typeString[TCL_LOCATION_LAST] = {
 	"eval", "eval", "eval", "precompiled", "source", "proc"
     };
-    Tcl_Obj *tmpObj;
-    Proc *procPtr =
-	framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+    Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+    int needsFree = -1;
 
-   /*
+    /*
      * Pull the information and construct the dictionary to return, as list.
      * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
      */
@@ -1144,28 +1306,12 @@ TclInfoFrame(
 	 */
 
 	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.
-	 */
-
-	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.
-	 */
-
-	ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
+	if (framePtr->line) {
+	    ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+	} else {
+	    ADD_PAIR("line", Tcl_NewIntObj(1));
+	}
+	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
 	break;
 
     case TCL_LOCATION_PREBC:
@@ -1181,9 +1327,8 @@ TclInfoFrame(
 	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
 	 */
 
-	CmdFrame *fPtr;
+	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
 
-	fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
 	*fPtr = *framePtr;
 
 	/*
@@ -1214,8 +1359,10 @@ TclInfoFrame(
 	    Tcl_DecrRefCount(fPtr->data.eval.path);
 	}
 
-	ADD_PAIR("cmd",
-		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
+	ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
+	if (fPtr->cmdObj && framePtr->cmdObj == NULL) {
+	    needsFree = lc - 1;
+	}
 	TclStackFree(interp, fPtr);
 	break;
     }
@@ -1234,8 +1381,7 @@ TclInfoFrame(
 	 * the result list object.
 	 */
 
-	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
-		framePtr->cmd.str.len));
+	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
 	break;
 
     case TCL_LOCATION_PROC:
@@ -1252,19 +1398,16 @@ TclInfoFrame(
 	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
 
 	if (namePtr) {
+	    Tcl_Obj *procNameObj;
+
 	    /*
 	     * This is a regular command.
 	     */
 
-	    char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
-	    char *nsName = procPtr->cmdPtr->nsPtr->fullName;
-
-	    ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));
-
-	    if (strcmp(nsName, "::") != 0) {
-		Tcl_AppendToObj(lv[lc-1], "::", -1);
-	    }
-	    Tcl_AppendToObj(lv[lc-1], procName, -1);
+	    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;
@@ -1307,7 +1450,11 @@ TclInfoFrame(
 	}
     }
 
-    return Tcl_NewListObj(lc, lv);
+    tmpObj = Tcl_NewListObj(lc, lv);
+    if (needsFree >= 0) {
+	Tcl_DecrRefCount(lv[needsFree]);
+    }
+    return tmpObj;
 }
 
 /*
@@ -1415,7 +1562,10 @@ InfoHostnameCmd(
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
 	return TCL_OK;
     }
-    Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "unable to determine name of host", -1));
+    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
     return TCL_ERROR;
 }
 
@@ -1485,8 +1635,10 @@ InfoLevelCmd(
     return TCL_ERROR;
 
   levelError:
-    Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
-	    NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "bad level \"%s\"", TclGetString(objv[1])));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
+	    TclGetString(objv[1]), NULL);
     return TCL_ERROR;
 }
 
@@ -1530,7 +1682,10 @@ InfoLibraryCmd(
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
 	return TCL_OK;
     }
-    Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "no library has been specified for Tcl", -1));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
     return TCL_ERROR;
 }
 
@@ -1562,7 +1717,7 @@ InfoLoadedCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *interpName;
+    const char *interpName;
 
     if ((objc != 1) && (objc != 2)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
@@ -1688,7 +1843,7 @@ InfoProcsCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *cmdName, *pattern;
+    const char *cmdName, *pattern;
     const char *simplePattern;
     Namespace *nsPtr;
 #ifdef INFO_PROCS_SEARCH_GLOBAL_NS
@@ -1722,9 +1877,8 @@ InfoProcsCmd(
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
 	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
-		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
-		&simplePattern);
+	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr,
+		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
 
 	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
@@ -1750,7 +1904,7 @@ InfoProcsCmd(
     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
 	if (entryPtr != NULL) {
-	    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+	    cmdPtr = Tcl_GetHashValue(entryPtr);
 
 	    if (!TclIsProc(cmdPtr)) {
 		realCmdPtr = (Command *)
@@ -1778,7 +1932,7 @@ InfoProcsCmd(
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
 	    if ((simplePattern == NULL)
 		    || Tcl_StringMatch(cmdName, simplePattern)) {
-		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+		cmdPtr = Tcl_GetHashValue(entryPtr);
 
 		if (!TclIsProc(cmdPtr)) {
 		    realCmdPtr = (Command *)
@@ -1825,7 +1979,7 @@ InfoProcsCmd(
 		if ((simplePattern == NULL)
 			|| Tcl_StringMatch(cmdName, simplePattern)) {
 		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
-			cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+			cmdPtr = Tcl_GetHashValue(entryPtr);
 			realCmdPtr = (Command *) TclGetOriginalCommand(
 				(Tcl_Command) cmdPtr);
 
@@ -2071,8 +2225,8 @@ Tcl_LassignObjCmd(
     int listObjc;		/* The length of the list. */
     int code = TCL_OK;
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list varName ?varName ...?");
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
 	return TCL_ERROR;
     }
 
@@ -2086,20 +2240,22 @@ Tcl_LassignObjCmd(
     objc -= 2;
     objv += 2;
     while (code == TCL_OK && objc > 0 && listObjc > 0) {
-	if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
-		*listObjv++, TCL_LEAVE_ERR_MSG)) {
+	if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
+		TCL_LEAVE_ERR_MSG) == NULL) {
 	    code = TCL_ERROR;
 	}
-	objc--; listObjc--;
+	objc--;
+	listObjc--;
     }
 
     if (code == TCL_OK && objc > 0) {
 	Tcl_Obj *emptyObj;
+
 	TclNewObj(emptyObj);
 	Tcl_IncrRefCount(emptyObj);
 	while (code == TCL_OK && objc-- > 0) {
-	    if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
-		    emptyObj, TCL_LEAVE_ERR_MSG)) {
+	    if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj,
+		    TCL_LEAVE_ERR_MSG) == NULL) {
 		code = TCL_ERROR;
 	    }
 	}
@@ -2142,7 +2298,7 @@ Tcl_LindexObjCmd(
     Tcl_Obj *elemPtr;		/* Pointer to the element being extracted. */
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
 	return TCL_ERROR;
     }
 
@@ -2165,11 +2321,11 @@ Tcl_LindexObjCmd(
 
     if (elemPtr == NULL) {
 	return TCL_ERROR;
-    } else {
-	Tcl_SetObjResult(interp, elemPtr);
-	Tcl_DecrRefCount(elemPtr);
-	return TCL_OK;
     }
+
+    Tcl_SetObjResult(interp, elemPtr);
+    Tcl_DecrRefCount(elemPtr);
+    return TCL_OK;
 }
 
 /*
@@ -2200,8 +2356,8 @@ Tcl_LinsertObjCmd(
     Tcl_Obj *listPtr;
     int index, len, result;
 
-    if (objc < 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
 	return TCL_ERROR;
     }
 
@@ -2286,7 +2442,7 @@ Tcl_ListObjCmd(
      */
 
     if (objc > 1) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1])));
+	Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
     }
     return TCL_OK;
 }
@@ -2362,52 +2518,74 @@ Tcl_LrangeObjCmd(
     register Tcl_Obj *const objv[])
 				/* Argument objects. */
 {
-    Tcl_Obj *listPtr, **elemPtrs;
-    int listLen, first, result;
+    Tcl_Obj **elemPtrs;
+    int listLen, first, last, result;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
 	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.
-     */
-
-    listPtr = TclListObjCopy(interp, objv[1]);
-    if (listPtr == NULL) {
-	return TCL_ERROR;
+    result = TclListObjLength(interp, objv[1], &listLen);
+    if (result != TCL_OK) {
+	return result;
     }
-    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
 
     result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
 	    &first);
-    if (result == TCL_OK) {
-	int last;
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (first < 0) {
+	first = 0;
+    }
 
-	if (first < 0) {
-	    first = 0;
-	}
+    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
+	    &last);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (last >= listLen) {
+	last = listLen - 1;
+    }
 
-	result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
-		&last);
-	if (result == TCL_OK) {
-	    if (last >= listLen) {
-		last = (listLen - 1);
-	    }
+    if (first > last) {
+	/*
+	 * Returning an empty list is easy.
+	 */
 
-	    if (first <= last) {
-		int numElems = (last - first + 1);
+	return TCL_OK;
+    }
 
-		Tcl_SetObjResult(interp,
-			Tcl_NewListObj(numElems, &(elemPtrs[first])));
-	    }
+    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]);
     }
 
-    Tcl_DecrRefCount(listPtr);
-    return result;
+    return TCL_OK;
 }
 
 /*
@@ -2436,23 +2614,25 @@ Tcl_LrepeatObjCmd(
 				/* The argument objects. */
 {
     int elementCount, i, totalElems;
-    Tcl_Obj *listPtr, **dataArray;
-    List *listRepPtr;
+    Tcl_Obj *listPtr, **dataArray = NULL;
 
     /*
      * Check arguments for legality:
-     *		lrepeat posInt value ?value ...?
+     *		lrepeat count ?value ...?
      */
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?");
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
 	return TCL_ERROR;
     }
-    if (TCL_ERROR == TclGetIntFromObj(interp, objv[1], &elementCount)) {
+    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
 	return TCL_ERROR;
     }
-    if (elementCount < 1) {
-	Tcl_AppendResult(interp, "must have a count of at least 1", NULL);
+    if (elementCount < 0) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad count \"%d\": must be integer >= 0", elementCount));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
+		NULL);
 	return TCL_ERROR;
     }
 
@@ -2465,9 +2645,10 @@ Tcl_LrepeatObjCmd(
 
     /* Final sanity check. Do not exceed limits on max list length. */
 
-    if (objc > LIST_MAX/elementCount) {
+    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;
@@ -2478,9 +2659,12 @@ Tcl_LrepeatObjCmd(
      */
 
     listPtr = Tcl_NewListObj(totalElems, NULL);
-    listRepPtr = ListRepPtr(listPtr);
-    listRepPtr->elemCount = elementCount*objc;
-    dataArray = &listRepPtr->elements;
+    if (totalElems) {
+	List *listRepPtr = ListRepPtr(listPtr);
+
+	listRepPtr->elemCount = elementCount*objc;
+	dataArray = &listRepPtr->elements;
+    }
 
     /*
      * Set the elements. Note that we handle the common degenerate case of a
@@ -2489,6 +2673,7 @@ Tcl_LrepeatObjCmd(
      * number of times.
      */
 
+    CLANG_ASSERT(dataArray || totalElems == 0 );
     if (objc == 1) {
 	register Tcl_Obj *tmpPtr = objv[0];
 
@@ -2541,7 +2726,7 @@ Tcl_LreplaceObjCmd(
 
     if (objc < 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"list first last ?element element ...?");
+		"list first last ?element ...?");
 	return TCL_ERROR;
     }
 
@@ -2567,7 +2752,7 @@ Tcl_LreplaceObjCmd(
     }
 
     if (first < 0) {
-    	first = 0;
+	first = 0;
     }
 
     /*
@@ -2577,16 +2762,18 @@ Tcl_LreplaceObjCmd(
      * (to allow for replacing the last elem).
      */
 
-    if ((first >= listLen) && (listLen > 0)) {
-	Tcl_AppendResult(interp, "list doesn't contain element ",
-		TclGetString(objv[2]), NULL);
+    if ((first > listLen) && (listLen > 0)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"list doesn't contain element %s", TclGetString(objv[2])));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
+		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;
     }
@@ -2610,7 +2797,7 @@ Tcl_LreplaceObjCmd(
      */
 
     if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
-	    objc-4, &(objv[4]))) {
+	    objc-4, objv+4)) {
 	return TCL_ERROR;
     }
 
@@ -2658,7 +2845,7 @@ Tcl_LreverseObjCmd(
     }
 
     /*
-     * If the list is empty, just return it [Bug 1876793]
+     * If the list is empty, just return it. [Bug 1876793]
      */
 
     if (!elemc) {
@@ -2725,28 +2912,29 @@ Tcl_LsearchObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument values. */
 {
-    char *bytes, *patternBytes;
-    int i, match, mode, index, result, listc, length, elemLen;
-    int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+    const char *bytes, *patternBytes;
+    int i, match, index, result, listc, length, elemLen, bisect;
+    int dataType, isIncreasing, lower, upper, offset;
+    Tcl_WideInt patWide, objWide;
     int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
     double patDouble, objDouble;
     SortInfo sortInfo;
     Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
     SortStrCmpFn_t strCmpFn = strcmp;
     Tcl_RegExp regexp = NULL;
-    static const char *options[] = {
-	"-all",	    "-ascii",   "-decreasing", "-dictionary",
+    static const char *const options[] = {
+	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
 	"-exact",   "-glob",    "-increasing", "-index",
 	"-inline",  "-integer", "-nocase",     "-not",
 	"-real",    "-regexp",  "-sorted",     "-start",
 	"-subindices", NULL
     };
     enum options {
-	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
-	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
-	LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
-	LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
-	LSEARCH_SUBINDICES
+	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
     };
     enum datatypes {
 	ASCII, DICTIONARY, INTEGER, REAL
@@ -2754,6 +2942,7 @@ Tcl_LsearchObjCmd(
     enum modes {
 	EXACT, GLOB, REGEXP, SORTED
     };
+    enum modes mode;
 
     mode = GLOB;
     dataType = ASCII;
@@ -2762,6 +2951,7 @@ Tcl_LsearchObjCmd(
     inlineReturn = 0;
     returnSubindices = 0;
     negatedMatch = 0;
+    bisect = 0;
     listPtr = NULL;
     startPtr = NULL;
     offset = 0;
@@ -2775,7 +2965,7 @@ Tcl_LsearchObjCmd(
     sortInfo.indexc = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
 	return TCL_ERROR;
     }
 
@@ -2785,10 +2975,8 @@ Tcl_LsearchObjCmd(
 	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    return TCL_ERROR;
+	    result = TCL_ERROR;
+	    goto done;
 	}
 	switch ((enum options) index) {
 	case LSEARCH_ALL:		/* -all */
@@ -2797,6 +2985,10 @@ 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;
@@ -2849,11 +3041,11 @@ Tcl_LsearchObjCmd(
 		Tcl_DecrRefCount(startPtr);
 	    }
 	    if (i > objc-4) {
-		if (sortInfo.indexc > 1) {
-		    ckfree((char *) sortInfo.indexv);
-		}
-		Tcl_AppendResult(interp, "missing starting index", NULL);
-		return TCL_ERROR;
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"missing starting index", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+		result = TCL_ERROR;
+		goto done;
 	    }
 	    i++;
 	    if (objv[i] == objv[objc - 2]) {
@@ -2875,15 +3067,16 @@ Tcl_LsearchObjCmd(
 	    int j;
 
 	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
+		TclStackFree(interp, sortInfo.indexv);
 	    }
 	    if (i > objc-4) {
 		if (startPtr != NULL) {
 		    Tcl_DecrRefCount(startPtr);
 		}
-		Tcl_AppendResult(interp,
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"\"-index\" option must be followed by list index",
-			NULL);
+			-1));
+		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
 		return TCL_ERROR;
 	    }
 
@@ -2909,8 +3102,8 @@ Tcl_LsearchObjCmd(
 		sortInfo.indexv = &sortInfo.singleIndex;
 		break;
 	    default:
-		sortInfo.indexv = (int *)
-			ckalloc(sizeof(int) * sortInfo.indexc);
+		sortInfo.indexv =
+			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
 	    }
 
 	    /*
@@ -2922,12 +3115,10 @@ Tcl_LsearchObjCmd(
 	    for (j=0 ; j<sortInfo.indexc ; j++) {
 		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
 			&sortInfo.indexv[j]) != TCL_OK) {
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
 		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 			    "\n    (-index option item number %d)", j));
-		    return TCL_ERROR;
+		    result = TCL_ERROR;
+		    goto done;
 		}
 	    }
 	    break;
@@ -2943,12 +3134,22 @@ Tcl_LsearchObjCmd(
 	if (startPtr != NULL) {
 	    Tcl_DecrRefCount(startPtr);
 	}
-	Tcl_AppendResult(interp,
-		"-subindices cannot be used without -index option", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"-subindices cannot be used without -index option", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+		"BAD_OPTION_MIX", NULL);
+	return TCL_ERROR;
+    }
+
+    if (bisect && (allMatches || negatedMatch)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"-bisect is not compatible with -all or -not", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+		"BAD_OPTION_MIX", NULL);
 	return TCL_ERROR;
     }
 
-    if ((enum modes) mode == REGEXP) {
+    if (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
@@ -2974,10 +3175,8 @@ Tcl_LsearchObjCmd(
 	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    return TCL_ERROR;
+	    result = TCL_ERROR;
+	    goto done;
 	}
     }
 
@@ -2991,10 +3190,7 @@ Tcl_LsearchObjCmd(
 	if (startPtr != NULL) {
 	    Tcl_DecrRefCount(startPtr);
 	}
-	if (sortInfo.indexc > 1) {
-	    ckfree((char *) sortInfo.indexv);
-	}
-	return result;
+	goto done;
     }
 
     /*
@@ -3005,10 +3201,7 @@ Tcl_LsearchObjCmd(
 	result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
 	Tcl_DecrRefCount(startPtr);
 	if (result != TCL_OK) {
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    return result;
+	    goto done;
 	}
 	if (offset < 0) {
 	    offset = 0;
@@ -3021,7 +3214,7 @@ Tcl_LsearchObjCmd(
 
 	if (offset > listc-1) {
 	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
+		TclStackFree(interp, sortInfo.indexv);
 	    }
 	    if (allMatches || inlineReturn) {
 		Tcl_ResetResult(interp);
@@ -3034,19 +3227,16 @@ Tcl_LsearchObjCmd(
 
     patObj = objv[objc - 1];
     patternBytes = NULL;
-    if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
+    if (mode == EXACT || mode == SORTED) {
 	switch ((enum datatypes) dataType) {
 	case ASCII:
 	case DICTIONARY:
 	    patternBytes = TclGetStringFromObj(patObj, &length);
 	    break;
 	case INTEGER:
-	    result = TclGetIntFromObj(interp, patObj, &patInt);
+	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
 	    if (result != TCL_OK) {
-		if (sortInfo.indexc > 1) {
-		    ckfree((char *) sortInfo.indexv);
-		}
-		return result;
+		goto done;
 	    }
 
 	    /*
@@ -3059,10 +3249,7 @@ Tcl_LsearchObjCmd(
 	case REAL:
 	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
 	    if (result != TCL_OK) {
-		if (sortInfo.indexc > 1) {
-		    ckfree((char *) sortInfo.indexv);
-		}
-		return result;
+		goto done;
 	    }
 
 	    /*
@@ -3085,7 +3272,7 @@ Tcl_LsearchObjCmd(
     index = -1;
     match = 0;
 
-    if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
+    if (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
@@ -3100,10 +3287,8 @@ Tcl_LsearchObjCmd(
 	    if (sortInfo.indexc != 0) {
 		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
 		if (sortInfo.resultCode != TCL_OK) {
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
-		    return sortInfo.resultCode;
+		    result = sortInfo.resultCode;
+		    goto done;
 		}
 	    } else {
 		itemPtr = listv[i];
@@ -3118,16 +3303,13 @@ Tcl_LsearchObjCmd(
 		match = DictionaryCompare(patternBytes, bytes);
 		break;
 	    case INTEGER:
-		result = TclGetIntFromObj(interp, itemPtr, &objInt);
+		result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
 		if (result != TCL_OK) {
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
-		    return result;
+		    goto done;
 		}
-		if (patInt == objInt) {
+		if (patWide == objWide) {
 		    match = 0;
-		} else if (patInt < objInt) {
+		} else if (patWide < objWide) {
 		    match = -1;
 		} else {
 		    match = 1;
@@ -3136,10 +3318,7 @@ Tcl_LsearchObjCmd(
 	    case REAL:
 		result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
 		if (result != TCL_OK) {
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
-		    return result;
+		    goto done;
 		}
 		if (patDouble == objDouble) {
 		    match = 0;
@@ -3163,10 +3342,16 @@ Tcl_LsearchObjCmd(
 		 * 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.
 		 */
 
 		index = i;
-		upper = i;
+		if (bisect) {
+		    lower = i;
+		} else {
+		    upper = i;
+		}
 	    } else if (match > 0) {
 		if (isIncreasing) {
 		    lower = i;
@@ -3181,7 +3366,9 @@ Tcl_LsearchObjCmd(
 		}
 	    }
 	}
-
+	if (bisect && index < 0) {
+	    index = lower;
+	}
     } else {
 	/*
 	 * We need to do a linear search, because (at least one) of:
@@ -3195,22 +3382,20 @@ Tcl_LsearchObjCmd(
 	}
 	for (i = offset; i < listc; i++) {
 	    match = 0;
-	    if (sortInfo.indexc != 0) {	    
+	    if (sortInfo.indexc != 0) {
 		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
 		if (sortInfo.resultCode != TCL_OK) {
 		    if (listPtr != NULL) {
 			Tcl_DecrRefCount(listPtr);
 		    }
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
-		    return sortInfo.resultCode;
+		    result = sortInfo.resultCode;
+		    goto done;
 		}
 	    } else {
 		itemPtr = listv[i];
 	    }
-		
-	    switch ((enum modes) mode) {
+
+	    switch (mode) {
 	    case SORTED:
 	    case EXACT:
 		switch ((enum datatypes) dataType) {
@@ -3237,17 +3422,14 @@ Tcl_LsearchObjCmd(
 		    break;
 
 		case INTEGER:
-		    result = TclGetIntFromObj(interp, itemPtr, &objInt);
+		    result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
 		    if (result != TCL_OK) {
 			if (listPtr != NULL) {
 			    Tcl_DecrRefCount(listPtr);
 			}
-			if (sortInfo.indexc > 1) {
-			    ckfree((char *) sortInfo.indexv);
-			}
-			return result;
+			goto done;
 		    }
-		    match = (objInt == patInt);
+		    match = (objWide == patWide);
 		    break;
 
 		case REAL:
@@ -3256,10 +3438,7 @@ Tcl_LsearchObjCmd(
 			if (listPtr) {
 			    Tcl_DecrRefCount(listPtr);
 			}
-			if (sortInfo.indexc > 1) {
-			    ckfree((char *) sortInfo.indexv);
-			}
-			return result;
+			goto done;
 		    }
 		    match = (objDouble == patDouble);
 		    break;
@@ -3278,10 +3457,8 @@ Tcl_LsearchObjCmd(
 		    if (listPtr != NULL) {
 			Tcl_DecrRefCount(listPtr);
 		    }
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
-		    return TCL_ERROR;
+		    result = TCL_ERROR;
+		    goto done;
 		}
 		break;
 	    }
@@ -3354,15 +3531,17 @@ Tcl_LsearchObjCmd(
     } else {
 	Tcl_SetObjResult(interp, listv[index]);
     }
+    result = TCL_OK;
 
     /*
      * Cleanup the index list array.
      */
 
+  done:
     if (sortInfo.indexc > 1) {
-	ckfree((char *) sortInfo.indexv);
+	TclStackFree(interp, sortInfo.indexv);
     }
-    return TCL_OK;
+    return result;
 }
 
 /*
@@ -3397,7 +3576,8 @@ Tcl_LsetObjCmd(
      */
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "listVar ?index? ?index...? value");
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"listVar ?index? ?index ...? value");
 	return TCL_ERROR;
     }
 
@@ -3405,8 +3585,7 @@ Tcl_LsetObjCmd(
      * Look up the list variable's value.
      */
 
-    listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
-	    TCL_LEAVE_ERR_MSG);
+    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
     if (listPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -3476,29 +3655,30 @@ Tcl_LsortObjCmd(
 {
     int i, j, index, indices, length, nocase = 0, indexc;
     int sortMode = SORTMODE_ASCII;
+    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. */
-    static const char *switches[] = {
+#   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[] = {
 	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
-	"-index", "-indices", "-integer", "-nocase", "-real", "-unique", NULL
+	"-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_UNIQUE
+	LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE
     };
 
-    /*
-     * The subList array below holds pointers to temporary lists built during
-     * the merge sort. Element i of the array holds a list of length 2**i.
-     */
-#   define NUM_LISTS 30
-    SortElement *subList[NUM_LISTS+1];
-
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
 	return TCL_ERROR;
     }
 
@@ -3512,30 +3692,31 @@ Tcl_LsortObjCmd(
     sortInfo.indexc = 0;
     sortInfo.unique = 0;
     sortInfo.interp = interp;
-    sortInfo.resultCode = TCL_OK;    
+    sortInfo.resultCode = TCL_OK;
     cmdPtr = NULL;
     indices = 0;
+    group = 0;
+    groupSize = 1;
+    groupOffset = 0;
+    indexPtr = NULL;
     for (i = 1; i < objc-1; i++) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
 		&index) != TCL_OK) {
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    return TCL_ERROR;
+	    sortInfo.resultCode = TCL_ERROR;
+	    goto done2;
 	}
 	switch ((enum Lsort_Switches) index) {
 	case LSORT_ASCII:
 	    sortInfo.sortMode = SORTMODE_ASCII;
 	    break;
 	case LSORT_COMMAND:
-	    if (i == (objc-2)) {
-		if (sortInfo.indexc > 1) {
-		    ckfree((char *) sortInfo.indexv);
-		}
-		Tcl_AppendResult(interp,
+	    if (i == objc-2) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"\"-command\" option must be followed "
-			"by comparison command", NULL);
-		return TCL_ERROR;
+			"by comparison command", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+		sortInfo.resultCode = TCL_ERROR;
+		goto done2;
 	    }
 	    sortInfo.sortMode = SORTMODE_COMMAND;
 	    cmdPtr = objv[i+1];
@@ -3551,54 +3732,41 @@ Tcl_LsortObjCmd(
 	    sortInfo.isIncreasing = 1;
 	    break;
 	case LSORT_INDEX: {
-	    Tcl_Obj **indices;
+	    int indexc, dummy;
+	    Tcl_Obj **indexv;
 
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    if (i == (objc-2)) {
-		Tcl_AppendResult(interp, "\"-index\" option must be "
-			"followed by list index", NULL);
-		return TCL_ERROR;
-	    }
-
-	    /*
-	     * Take copy to prevent shimmering problems.
-	     */
-
-	    if (TclListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
-		    &indices) != TCL_OK) {
-		return TCL_ERROR;
+	    if (i == objc-2) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-index\" option must be followed by list index",
+			-1));
+		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+		sortInfo.resultCode = TCL_ERROR;
+		goto done2;
 	    }
-	    switch (sortInfo.indexc) {
-	    case 0:
-		sortInfo.indexv = NULL;
-		break;
-	    case 1:
-		sortInfo.indexv = &sortInfo.singleIndex;
-		break;
-	    default:
-		sortInfo.indexv = (int *)
-			ckalloc(sizeof(int) * sortInfo.indexc);
+	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
+		    &indexv) != TCL_OK) {
+		sortInfo.resultCode = TCL_ERROR;
+		goto done2;
 	    }
 
 	    /*
-	     * 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.
+	     * 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<sortInfo.indexc ; j++) {
-		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
-			&sortInfo.indexv[j]) != TCL_OK) {
-		    if (sortInfo.indexc > 1) {
-			ckfree((char *) sortInfo.indexv);
-		    }
+	    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));
-		    return TCL_ERROR;
+		    sortInfo.resultCode = TCL_ERROR;
+		    goto done2;
 		}
 	    }
+	    indexPtr = objv[i+1];
 	    i++;
 	    break;
 	}
@@ -3617,12 +3785,65 @@ Tcl_LsortObjCmd(
 	case LSORT_INDICES:
 	    indices = 1;
 	    break;
+	case LSORT_STRIDE:
+	    if (i == objc-2) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-stride\" option must be "
+			"followed by stride length", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+			"stride length must be at least 2", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+			"BADSTRIDE", NULL);
+		sortInfo.resultCode = TCL_ERROR;
+		goto done2;
+	    }
+	    group = 1;
+	    i++;
+	    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) {
@@ -3637,10 +3858,8 @@ Tcl_LsortObjCmd(
 
 	listObj = TclListObjCopy(interp, listObj);
 	if (listObj == NULL) {
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    return TCL_ERROR;
+	    sortInfo.resultCode = TCL_ERROR;
+	    goto done2;
 	}
 
 	/*
@@ -3657,10 +3876,8 @@ Tcl_LsortObjCmd(
 	    TclDecrRefCount(listObj);
 	    Tcl_IncrRefCount(newObjPtr);
 	    TclDecrRefCount(newObjPtr);
-	    if (sortInfo.indexc > 1) {
-		ckfree((char *) sortInfo.indexv);
-	    }
-	    return TCL_ERROR;
+	    sortInfo.resultCode = TCL_ERROR;
+	    goto done2;
 	}
 	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
 	sortInfo.compareCmdPtr = newCommandPtr;
@@ -3671,8 +3888,62 @@ Tcl_LsortObjCmd(
     if (sortInfo.resultCode != TCL_OK || length <= 0) {
 	goto done;
     }
+
+    /*
+     * Check for sanity when grouping elements of the overall list together
+     * because of the -stride option. [TIP #326]
+     */
+
+    if (group) {
+	if (length % groupSize) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "list size must be a multiple of the stride length",
+		    -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+			"when used with \"-stride\", the leading \"-index\""
+			" value must be within the group", -1));
+		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)
@@ -3680,7 +3951,7 @@ Tcl_LsortObjCmd(
 	/*
 	 * For this function's purpose all string-based modes are equivalent
 	 */
-	
+
 	sortMode = SORTMODE_ASCII;
     }
 
@@ -3689,7 +3960,7 @@ Tcl_LsortObjCmd(
      * 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;
     }
@@ -3699,57 +3970,65 @@ Tcl_LsortObjCmd(
      * begins sorting it into the sublists as it appears.
      */
 
-    elementArray = (SortElement *) ckalloc( length * sizeof(SortElement));
+    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[i], &sortInfo);
+	    indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
 	    if (sortInfo.resultCode != TCL_OK) {
 		goto done1;
 	    }
 	} else {
-	    indexPtr = listObjPtrs[i];
+	    indexPtr = listObjPtrs[idx];
 	}
 
 	/*
 	 * Determine the "value" of this object for sorting purposes
 	 */
-	
+
 	if (sortMode == SORTMODE_ASCII) {
-	    elementArray[i].index.strValuePtr = TclGetString(indexPtr);
+	    elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
 	} else if (sortMode == SORTMODE_INTEGER) {
-	    long a;
-	    if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+	    Tcl_WideInt a;
+
+	    if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
 		sortInfo.resultCode = TCL_ERROR;
 		goto done1;
 	    }
-	    elementArray[i].index.intValue = a;
+	    elementArray[i].collationKey.wideValue = a;
 	} else if (sortMode == SORTMODE_REAL) {
 	    double a;
-	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+
+	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
+		    &a) != TCL_OK) {
 		sortInfo.resultCode = TCL_ERROR;
 		goto done1;
 	    }
-	    elementArray[i].index.doubleValue = a;
+	    elementArray[i].collationKey.doubleValue = a;
 	} else {
-	    elementArray[i].index.objValuePtr = indexPtr;
+	    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.
 	 */
-	
-	elementArray[i].objPtr = (indices ? INT2PTR(i) : listObjPtrs[i]);
+
+	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++) {
@@ -3765,34 +4044,47 @@ Tcl_LsortObjCmd(
     /*
      * Merge all sublists
      */
-    
+
     elementPtr = subList[0];
     for (j=1 ; j<NUM_LISTS ; j++) {
 	elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
     }
 
-
     /*
      * Now store the sorted elements in the result list.
      */
-    
+
     if (sortInfo.resultCode == TCL_OK) {
 	List *listRepPtr;
 	Tcl_Obj **newArray, *objPtr;
-	int i;
-	
-	resultPtr = Tcl_NewListObj(sortInfo.numElements, NULL);
+
+	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
 	listRepPtr = ListRepPtr(resultPtr);
 	newArray = &listRepPtr->elements;
-	if (indices) {
-	    for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){
-		objPtr = Tcl_NewIntObj(PTR2INT(elementPtr->objPtr));
+	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->objPtr;
+	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
+		objPtr = elementPtr->payload.objPtr;
 		newArray[i++] = objPtr;
 		Tcl_IncrRefCount(objPtr);
 	    }
@@ -3802,7 +4094,7 @@ Tcl_LsortObjCmd(
     }
 
   done1:
-    ckfree((char *)elementArray);
+    TclStackFree(interp, elementArray);
 
   done:
     if (sortMode == SORTMODE_COMMAND) {
@@ -3810,8 +4102,9 @@ Tcl_LsortObjCmd(
 	TclDecrRefCount(listObj);
 	sortInfo.compareCmdPtr = NULL;
     }
-    if (sortInfo.indexc > 1) {
-	ckfree((char *) sortInfo.indexv);
+  done2:
+    if (allocatedIndexVector) {
+	TclStackFree(interp, sortInfo.indexv);
     }
     return sortInfo.resultCode;
 }
@@ -3828,21 +4121,23 @@ Tcl_LsortObjCmd(
  *	The unified list of SortElement structures.
  *
  * Side effects:
- *      If infoPtr->unique is set then infoPtr->numElements may be updated.
+ *	If infoPtr->unique is set then infoPtr->numElements may be updated.
  *	Possibly others, if a user-defined comparison command does something
- *      weird. 
+ *	weird.
  *
  * Note:
- *      If infoPtr->unique is set, the merge assumes that there are no
+ *	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. 
+ *
+ *	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.
+ *
  *----------------------------------------------------------------------
  */
 
@@ -3944,25 +4239,25 @@ SortCompare(
     int order = 0;
 
     if (infoPtr->sortMode == SORTMODE_ASCII) {
-	order = strcmp(elemPtr1->index.strValuePtr,
-		elemPtr2->index.strValuePtr);
+	order = strcmp(elemPtr1->collationKey.strValuePtr,
+		elemPtr2->collationKey.strValuePtr);
     } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
-	order = TclUtfCasecmp(elemPtr1->index.strValuePtr,
-		elemPtr2->index.strValuePtr);
+	order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
+		elemPtr2->collationKey.strValuePtr);
     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
-	order = DictionaryCompare(elemPtr1->index.strValuePtr,
-		elemPtr2->index.strValuePtr);
+	order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
+		elemPtr2->collationKey.strValuePtr);
     } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
-	long a, b;
+	Tcl_WideInt a, b;
 
-	a = elemPtr1->index.intValue;
-	b = elemPtr2->index.intValue;
+	a = elemPtr1->collationKey.wideValue;
+	b = elemPtr2->collationKey.wideValue;
 	order = ((a >= b) - (a <= b));
     } else if (infoPtr->sortMode == SORTMODE_REAL) {
 	double a, b;
 
-	a = elemPtr1->index.doubleValue;
-	b = elemPtr2->index.doubleValue;
+	a = elemPtr1->collationKey.doubleValue;
+	b = elemPtr2->collationKey.doubleValue;
 	order = ((a >= b) - (a <= b));
     } else {
 	Tcl_Obj **objv, *paramObjv[2];
@@ -3974,14 +4269,14 @@ SortCompare(
 	     * Once an error has occurred, skip any future comparisons so as
 	     * to preserve the error message in sortInterp->result.
 	     */
-	    
+
 	    return 0;
 	}
 
 
-	objPtr1 = elemPtr1->index.objValuePtr;
-	objPtr2 = elemPtr2->index.objValuePtr;
-	
+	objPtr1 = elemPtr1->collationKey.objValuePtr;
+	objPtr2 = elemPtr2->collationKey.objValuePtr;
+
 	paramObjv[0] = objPtr1;
 	paramObjv[1] = objPtr2;
 
@@ -3999,8 +4294,7 @@ SortCompare(
 	infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
 
 	if (infoPtr->resultCode != TCL_OK) {
-	    Tcl_AddErrorInfo(infoPtr->interp,
-		    "\n    (-compare command)");
+	    Tcl_AddErrorInfo(infoPtr->interp, "\n    (-compare command)");
 	    return 0;
 	}
 
@@ -4010,9 +4304,10 @@ SortCompare(
 
 	if (TclGetIntFromObj(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_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
+		    "-compare command returned non-integer result", -1));
+	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
+		    "COMPARISONFAILED", NULL);
 	    infoPtr->resultCode = TCL_ERROR;
 	    return 0;
 	}
@@ -4049,7 +4344,7 @@ SortCompare(
 
 static int
 DictionaryCompare(
-    char *left, char *right)	/* The strings to compare. */
+    const char *left, const char *right)	/* The strings to compare. */
 {
     Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
     int diff, zeros;
@@ -4066,11 +4361,11 @@ DictionaryCompare(
 	     */
 
 	    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++;
 	    }
@@ -4223,12 +4518,11 @@ SelectObjFromSublist(
 	    return NULL;
 	}
 	if (currentObj == NULL) {
-	    char buffer[TCL_INTEGER_SPACE];
-
-	    TclFormatInt(buffer, index);
-	    Tcl_AppendResult(infoPtr->interp, "element ", buffer,
-		    " missing from sublist \"", TclGetString(objPtr), "\"",
-		    NULL);
+	    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;
 	}
@@ -4242,5 +4536,6 @@ SelectObjFromSublist(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
  * End:
  */
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 30586b1..885a0bc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -10,7 +10,7 @@
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 Scriptics Corporation.
  * Copyright (c) 2002 ActiveState Corporation.
- * Copyright (c) 2003 Donal K. Fellows.
+ * 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.
@@ -18,9 +18,49 @@
 
 #include "tclInt.h"
 #include "tclRegexp.h"
-
+#include "tclStringTrim.h"
+
+static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
+			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
+static Tcl_NRPostProc	SwitchPostProc;
+static Tcl_NRPostProc	TryPostBody;
+static Tcl_NRPostProc	TryPostFinal;
+static Tcl_NRPostProc	TryPostHandler;
 static int		UniCharIsAscii(int character);
 static int		UniCharIsHexDigit(int character);
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters [TIP #413]
+ */
+
+const char tclDefaultTrimSet[] =
+	"\x09\x0a\x0b\x0c\x0d " /* ASCII */
+	"\xc0\x80" /*     nul (U+0000) */
+	"\xc2\x85" /*     next line (U+0085) */
+	"\xc2\xa0" /*     non-breaking space (U+00a0) */
+	"\xe1\x9a\x80" /* ogham space mark (U+1680) */
+	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
+	"\xe2\x80\x80" /* en quad (U+2000) */
+	"\xe2\x80\x81" /* em quad (U+2001) */
+	"\xe2\x80\x82" /* en space (U+2002) */
+	"\xe2\x80\x83" /* em space (U+2003) */
+	"\xe2\x80\x84" /* three-per-em space (U+2004) */
+	"\xe2\x80\x85" /* four-per-em space (U+2005) */
+	"\xe2\x80\x86" /* six-per-em space (U+2006) */
+	"\xe2\x80\x87" /* figure space (U+2007) */
+	"\xe2\x80\x88" /* punctuation space (U+2008) */
+	"\xe2\x80\x89" /* thin space (U+2009) */
+	"\xe2\x80\x8a" /* hair space (U+200a) */
+	"\xe2\x80\x8b" /* zero width space (U+200b) */
+	"\xe2\x80\xa8" /* line separator (U+2028) */
+	"\xe2\x80\xa9" /* paragraph separator (U+2029) */
+	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
+	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
+	"\xe2\x81\xa0" /* word joiner (U+2060) */
+	"\xe3\x80\x80" /* ideographic space (U+3000) */
+	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+;
 
 /*
  *----------------------------------------------------------------------
@@ -91,7 +131,7 @@ Tcl_RegexpObjCmd(
     Tcl_RegExp regExpr;
     Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
     Tcl_RegExpInfo info;
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-all",		"-about",	"-indices",	"-inline",
 	"-expanded",	"-line",	"-linestop",	"-lineanchor",
 	"-nocase",	"-start",	"--",		NULL
@@ -105,20 +145,19 @@ Tcl_RegexpObjCmd(
     indices = 0;
     about = 0;
     cflags = TCL_REG_ADVANCED;
-    eflags = 0;
     offset = 0;
     all = 0;
     doinline = 0;
 
     for (i = 1; i < objc; i++) {
-	char *name;
+	const char *name;
 	int index;
 
 	name = TclGetString(objv[i]);
 	if (name[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
 		&index) != TCL_OK) {
 	    goto optionError;
 	}
@@ -174,7 +213,7 @@ Tcl_RegexpObjCmd(
   endOfForLoop:
     if ((objc - i) < (2 - about)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-	    "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+		"?-option ...? exp string ?matchVar? ?subMatchVar ...?");
 	goto optionError;
     }
     objc -= i;
@@ -186,8 +225,10 @@ Tcl_RegexpObjCmd(
      */
 
     if (doinline && ((objc - 2) != 0)) {
-	Tcl_AppendResult(interp, "regexp match variables not allowed"
-		" when using -inline", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"regexp match variables not allowed when using -inline", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP",
+		"MIX_VAR_INLINE", NULL);
 	goto optionError;
     }
 
@@ -368,11 +409,8 @@ Tcl_RegexpObjCmd(
 		    return TCL_ERROR;
 		}
 	    } else {
-		Tcl_Obj *valuePtr;
-		valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
-		if (valuePtr == NULL) {
-		    Tcl_AppendResult(interp, "couldn't set variable \"",
-			    TclGetString(objv[i]), "\"", NULL);
+		if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
+			TCL_LEAVE_ERR_MSG) == NULL) {
 		    return TCL_ERROR;
 		}
 	    }
@@ -392,7 +430,8 @@ Tcl_RegexpObjCmd(
 	 * offset never changes).
 	 */
 
-	matchLength = info.matches[0].end - info.matches[0].start;
+	matchLength = (info.matches[0].end - info.matches[0].start);
+
 	offset += info.matches[0].end;
 
 	/*
@@ -454,7 +493,7 @@ Tcl_RegsubObjCmd(
     Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
     Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
 
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-all",		"-nocase",	"-expanded",
 	"-line",	"-linestop",	"-lineanchor",	"-start",
 	"--",		NULL
@@ -471,14 +510,14 @@ Tcl_RegsubObjCmd(
     resultPtr = NULL;
 
     for (idx = 1; idx < objc; idx++) {
-	char *name;
+	const char *name;
 	int index;
 
 	name = TclGetString(objv[idx]);
 	if (name[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
+	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
 		TCL_EXACT, &index) != TCL_OK) {
 	    goto optionError;
 	}
@@ -525,7 +564,7 @@ Tcl_RegsubObjCmd(
   endOfForLoop:
     if (objc-idx < 3 || objc-idx > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?switches? exp string subSpec ?varName?");
+		"?-option ...? exp string subSpec ?varName?");
     optionError:
 	if (startIndex) {
 	    Tcl_DecrRefCount(startIndex);
@@ -799,9 +838,8 @@ Tcl_RegsubObjCmd(
 	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
     }
     if (objc == 4) {
-	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
-	    Tcl_AppendResult(interp, "couldn't set variable \"",
-		    TclGetString(objv[3]), "\"", NULL);
+	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
+		TCL_LEAVE_ERR_MSG) == NULL) {
 	    result = TCL_ERROR;
 	} else {
 	    /*
@@ -856,7 +894,7 @@ Tcl_RenameObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *oldName, *newName;
+    const char *oldName, *newName;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
@@ -939,6 +977,16 @@ Tcl_SourceObjCmd(
     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. */
+{
     const char *encodingName = NULL;
     Tcl_Obj *fileName;
 
@@ -950,7 +998,7 @@ Tcl_SourceObjCmd(
     fileName = objv[objc-1];
 
     if (objc == 4) {
-	static const char *options[] = {
+	static const char *const options[] = {
 	    "-encoding", NULL
 	};
 	int index;
@@ -962,7 +1010,7 @@ Tcl_SourceObjCmd(
 	encodingName = TclGetString(objv[2]);
     }
 
-    return Tcl_FSEvalFileEx(interp, fileName, encodingName);
+    return TclNREvalFile(interp, fileName, encodingName);
 }
 
 /*
@@ -992,7 +1040,8 @@ Tcl_SplitObjCmd(
     Tcl_UniChar ch;
     int len;
     const char *splitChars;
-    char *stringPtr, *end;
+    const char *stringPtr;
+    const char *end;
     int splitCharLen, stringLen;
     Tcl_Obj *listPtr, *objPtr;
 
@@ -1037,7 +1086,8 @@ Tcl_SplitObjCmd(
 	     * Assume Tcl_UniChar is an integral type...
 	     */
 
-	    hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0+ch, &isNew);
+	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
+		    &isNew);
 	    if (isNew) {
 		TclNewStringObj(objPtr, stringPtr, len);
 
@@ -1045,9 +1095,9 @@ Tcl_SplitObjCmd(
 		 * Don't need to fiddle with refcount...
 		 */
 
-		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+		Tcl_SetHashValue(hPtr, objPtr);
 	    } else {
-		objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+		objPtr = Tcl_GetHashValue(hPtr);
 	    }
 	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
 	}
@@ -1070,8 +1120,7 @@ Tcl_SplitObjCmd(
 	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
 	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
     } else {
-	char *element;
-	const char *p, *splitEnd;
+	const char *element, *p, *splitEnd;
 	int splitLen;
 	Tcl_UniChar splitChar;
 
@@ -1108,7 +1157,8 @@ Tcl_SplitObjCmd(
  * StringFirstCmd --
  *
  *	This procedure is invoked to process the "string first" Tcl command.
- *	See the user documentation for details on what it does.
+ *	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.
@@ -1126,8 +1176,8 @@ StringFirstCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_UniChar *ustring1, *ustring2;
-    int match, start, length1, length2;
+    Tcl_UniChar *needleStr, *haystackStr;
+    int match, start, needleLen, haystackLen;
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -1136,15 +1186,15 @@ StringFirstCmd(
     }
 
     /*
-     * We are searching string2 for the sequence string1.
+     * We are searching haystackStr for the sequence needleStr.
      */
 
     match = -1;
     start = 0;
-    length2 = -1;
+    haystackLen = -1;
 
-    ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
-    ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
+    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
 
     if (objc == 4) {
 	/*
@@ -1152,7 +1202,8 @@ StringFirstCmd(
 	 * point in the string before we think about a match.
 	 */
 
-	if (TclGetIntForIndexM(interp, objv[3], length2-1, &start) != TCL_OK){
+	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
+		&start) != TCL_OK){
 	    return TCL_ERROR;
 	}
 
@@ -1160,14 +1211,14 @@ StringFirstCmd(
 	 * Reread to prevent shimmering problems.
 	 */
 
-	ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
-	ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
+	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
 
-	if (start >= length2) {
+	if (start >= haystackLen) {
 	    goto str_first_done;
 	} else if (start > 0) {
-	    ustring2 += start;
-	    length2 -= start;
+	    haystackStr += start;
+	    haystackLen -= start;
 	} else if (start < 0) {
 	    /*
 	     * Invalid start index mapped to string start; Bug #423581
@@ -1182,18 +1233,18 @@ StringFirstCmd(
      * cannot be contained in there so we can avoid searching. [Bug 2960021]
      */
 
-    if (length1 > 0 && length1 <= length2) {
+    if (needleLen > 0 && needleLen <= haystackLen) {
 	register Tcl_UniChar *p, *end;
 
-	end = ustring2 + length2 - length1 + 1;
-	for (p = ustring2;  p < end;  p++) {
+	end = haystackStr + haystackLen - needleLen + 1;
+	for (p = haystackStr;  p < end;  p++) {
 	    /*
 	     * Scan forward to find the first character.
 	     */
 
-	    if ((*p == *ustring1) && (TclUniCharNcmp(ustring1, p,
-		    (unsigned long) length1) == 0)) {
-		match = p - ustring2;
+	    if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
+		    (unsigned long) needleLen) == 0)) {
+		match = p - haystackStr;
 		break;
 	    }
 	}
@@ -1219,7 +1270,8 @@ StringFirstCmd(
  * StringLastCmd --
  *
  *	This procedure is invoked to process the "string last" Tcl command.
- *	See the user documentation for details on what it does.
+ *	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.
@@ -1237,8 +1289,8 @@ StringLastCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_UniChar *ustring1, *ustring2, *p;
-    int match, start, length1, length2;
+    Tcl_UniChar *needleStr, *haystackStr, *p;
+    int match, start, needleLen, haystackLen;
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -1247,15 +1299,15 @@ StringLastCmd(
     }
 
     /*
-     * We are searching string2 for the sequence string1.
+     * We are searching haystackString for the sequence needleString.
      */
 
     match = -1;
     start = 0;
-    length2 = -1;
+    haystackLen = -1;
 
-    ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
-    ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
+    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
 
     if (objc == 4) {
 	/*
@@ -1263,7 +1315,8 @@ StringLastCmd(
 	 * range to that char index in the string
 	 */
 
-	if (TclGetIntForIndexM(interp, objv[3], length2-1, &start) != TCL_OK){
+	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
+		&start) != TCL_OK){
 	    return TCL_ERROR;
 	}
 
@@ -1271,18 +1324,18 @@ StringLastCmd(
 	 * Reread to prevent shimmering problems.
 	 */
 
-	ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
-	ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);
+	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
+	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
 
 	if (start < 0) {
 	    goto str_last_done;
-	} else if (start < length2) {
-	    p = ustring2 + start + 1 - length1;
+	} else if (start < haystackLen) {
+	    p = haystackStr + start + 1 - needleLen;
 	} else {
-	    p = ustring2 + length2 - length1;
+	    p = haystackStr + haystackLen - needleLen;
 	}
     } else {
-	p = ustring2 + length2 - length1;
+	p = haystackStr + haystackLen - needleLen;
     }
 
     /*
@@ -1290,15 +1343,15 @@ StringLastCmd(
      * cannot be contained in there so we can avoid searching. [Bug 2960021]
      */
 
-    if (length1 > 0 && length1 <= length2) {
-	for (; p >= ustring2; p--) {
+    if (needleLen > 0 && needleLen <= haystackLen) {
+	for (; p >= haystackStr; p--) {
 	    /*
 	     * Scan backwards to find the first character.
 	     */
 
-	    if ((*p == *ustring1) && !memcmp(ustring1, p,
-		    sizeof(Tcl_UniChar) * (size_t)length1)) {
-		match = p - ustring2;
+	    if ((*p == *needleStr) && !memcmp(needleStr, p,
+		    sizeof(Tcl_UniChar) * (size_t)needleLen)) {
+		match = p - haystackStr;
 		break;
 	    }
 	}
@@ -1342,37 +1395,29 @@ StringIndexCmd(
     }
 
     /*
-     * 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 (TclIsPureByteArray(objv[1])) {
-	const unsigned char *string =
-		Tcl_GetByteArrayFromObj(objv[1], &length);
+    length = Tcl_GetCharLength(objv[1]);
+    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if ((index >= 0) && (index < length)) {
+	Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
 
-	if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK){
-	    return TCL_ERROR;
-	}
-	string = Tcl_GetByteArrayFromObj(objv[1], &length);
-	if ((index >= 0) && (index < length)) {
-	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(string + index, 1));
-	}
-    } else {
 	/*
-	 * Get Unicode char length to calulate what 'end' means.
+	 * If we have a ByteArray object, we're careful to generate a new
+	 * bytearray for a result.
 	 */
 
-	length = Tcl_GetCharLength(objv[1]);
+	if (TclIsPureByteArray(objv[1])) {
+	    unsigned char uch = (unsigned char) ch;
 
-	if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK){
-	    return TCL_ERROR;
-	}
-	if ((index >= 0) && (index < length)) {
+	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
+	} else {
 	    char buf[TCL_UTF_MAX];
-	    Tcl_UniChar ch;
 
-	    ch = Tcl_GetUniChar(objv[1], index);
 	    length = Tcl_UniCharToUtf(ch, buf);
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
 	}
@@ -1412,22 +1457,23 @@ StringIsCmd(
     Tcl_Obj *objPtr, *failVarObj = NULL;
     Tcl_WideInt w;
 
-    static const char *isClasses[] = {
+    static const char *const isClasses[] = {
 	"alnum",	"alpha",	"ascii",	"control",
-	"boolean",	"digit",	"double",	"false",
-	"graph",	"integer",	"list",		"lower",
-	"print",	"punct",	"space",	"true",
-	"upper",	"wideinteger",	"wordchar",	"xdigit",
-	NULL
+	"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_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
+	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 *isOptions[] = {
+    static const char *const isOptions[] = {
 	"-strict", "-failindex", NULL
     };
     enum isOptions {
@@ -1494,7 +1540,8 @@ StringIsCmd(
     case STR_IS_BOOL:
     case STR_IS_TRUE:
     case STR_IS_FALSE:
-	if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, &tclBooleanType)) {
+	if ((objPtr->typePtr != &tclBooleanType)
+		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
 	    if (strict) {
 		result = 0;
 	    } else {
@@ -1518,7 +1565,7 @@ StringIsCmd(
 	/* TODO */
 	if ((objPtr->typePtr == &tclDoubleType) ||
 		(objPtr->typePtr == &tclIntType) ||
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 		(objPtr->typePtr == &tclWideIntType) ||
 #endif
 		(objPtr->typePtr == &tclBignumType)) {
@@ -1541,7 +1588,6 @@ StringIsCmd(
 	    if (stop < end) {
 		result = 0;
 		TclFreeIntRep(objPtr);
-		objPtr->typePtr = NULL;
 	    }
 	}
 	break;
@@ -1554,6 +1600,51 @@ StringIsCmd(
 	    break;
 	}
 	goto failedIntParse;
+    case STR_IS_ENTIER:
+	if ((objPtr->typePtr == &tclIntType) ||
+#ifndef TCL_WIDE_INT_IS_LONG
+		(objPtr->typePtr == &tclWideIntType) ||
+#endif
+		(objPtr->typePtr == &tclBignumType)) {
+	    break;
+	}
+	string1 = TclGetStringFromObj(objPtr, &length1);
+	if (length1 == 0) {
+	    if (strict) {
+		result = 0;
+	    }
+	    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;
+	    } 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.
+		 */
+
+		result = 0;
+		failat = stop - string1;
+		TclFreeIntRep(objPtr);
+	    }
+	} 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)) {
 	    break;
@@ -1598,7 +1689,6 @@ StringIsCmd(
 
 		failat = stop - string1;
 		TclFreeIntRep(objPtr);
-		objPtr->typePtr = NULL;
 	    }
 	} else {
 	    /*
@@ -1773,8 +1863,10 @@ StringMapCmd(
 		strncmp(string, "-nocase", (size_t) length2) == 0) {
 	    nocase = 1;
 	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string,
-		    "\": must be -nocase", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\": must be -nocase", string));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+		    string, NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -1811,8 +1903,7 @@ StringMapCmd(
 	 * adapt this code...
 	 */
 
-	mapElemv = (Tcl_Obj **)
-		TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
+	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) {
@@ -1838,6 +1929,8 @@ StringMapCmd(
 
 	    Tcl_SetObjResult(interp,
 		    Tcl_NewStringObj("char map list unbalanced", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
+		    "UNBALANCED", NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -1921,12 +2014,10 @@ StringMapCmd(
 	 * case.
 	 */
 
-	mapStrings = (Tcl_UniChar **) TclStackAlloc(interp,
-		mapElemc * 2 * sizeof(Tcl_UniChar *));
-	mapLens = (int *) TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
+	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
+	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
 	if (nocase) {
-	    u2lc = (Tcl_UniChar *) TclStackAlloc(interp,
-		    mapElemc * sizeof(Tcl_UniChar));
+	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
 	}
 	for (index = 0; index < mapElemc; index++) {
 	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
@@ -2039,8 +2130,10 @@ StringMatchCmd(
 	    strncmp(string, "-nocase", (size_t) length) == 0) {
 	    nocase = TCL_MATCH_NOCASE;
 	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string,
-		    "\": must be -nocase", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\": must be -nocase", string));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+		    string, NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -2074,7 +2167,6 @@ StringRangeCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    const unsigned char *string;
     int length, first, last;
 
     if (objc != 4) {
@@ -2083,22 +2175,11 @@ StringRangeCmd(
     }
 
     /*
-     * 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.
+     * Get the length in actual characters; Then reduce it by one because
+     * 'end' refers to the last character, not one past it.
      */
 
-    if (TclIsPureByteArray(objv[1])) {
-	string = Tcl_GetByteArrayFromObj(objv[1], &length);
-	length--;
-    } else {
-	/*
-	 * Get the length in actual characters.
-	 */
-
-	string = NULL;
-	length = Tcl_GetCharLength(objv[1]) - 1;
-    }
+    length = Tcl_GetCharLength(objv[1]) - 1;
 
     if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
 	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
@@ -2112,17 +2193,7 @@ StringRangeCmd(
 	last = length;
     }
     if (last >= first) {
-	if (string != NULL) {
-	    /*
-	     * Reread the string to prevent shimmering nasties.
-	     */
-
-	    string = Tcl_GetByteArrayFromObj(objv[1], &length);
-	    Tcl_SetObjResult(interp,
-		    Tcl_NewByteArrayObj(string+first, last - first + 1));
-	} else {
-	    Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
-	}
+	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
     }
     return TCL_OK;
 }
@@ -2191,9 +2262,11 @@ StringReptCmd(
      * We need to keep 2 <= length2 <= INT_MAX.
      */
 
-    if (count > (INT_MAX / length1)) {
+    if (count > INT_MAX/length1) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"result exceeds max size for a Tcl value (%d bytes)", INT_MAX));
+		"result exceeds max size for a Tcl value (%d bytes)",
+		INT_MAX));
+	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 	return TCL_ERROR;
     }
     length2 = length1 * count;
@@ -2214,6 +2287,7 @@ StringReptCmd(
 	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++) {
@@ -2491,7 +2565,7 @@ StringEqualCmd(
      * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
      */
 
-    char *string1, *string2;
+    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;
@@ -2512,13 +2586,16 @@ StringEqualCmd(
 	    if (i+1 >= objc-2) {
 		goto str_cmp_args;
 	    }
-	    ++i;
+	    i++;
 	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string2,
-		    "\": must be -nocase or -length", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\": must be -nocase or -length",
+		    string2));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+		    string2, NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -2638,7 +2715,7 @@ StringCmpCmd(
      * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
      */
 
-    char *string1, *string2;
+    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;
@@ -2659,13 +2736,16 @@ StringCmpCmd(
 	    if (i+1 >= objc-2) {
 		goto str_cmp_args;
 	    }
-	    ++i;
+	    i++;
 	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string2,
-		    "\": must be -nocase or -length", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\": must be -nocase or -length",
+		    string2));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+		    string2, NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -2754,6 +2834,59 @@ StringCmpCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * StringCatCmd --
+ *
+ *	This procedure is invoked to process the "string cat" 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
+StringCatCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int i;
+    Tcl_Obj *objResultPtr;
+
+    if (objc < 2) {
+	/*
+	 * If there are no args, the result is an empty object.
+	 * Just leave the preset empty interp result.
+	 */
+	return TCL_OK;
+    }
+    if (objc == 2) {
+	/*
+	 * Other trivial case, single arg, just return it.
+	 */
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    }
+    objResultPtr = objv[1];
+    if (Tcl_IsShared(objResultPtr)) {
+	objResultPtr = Tcl_DuplicateObj(objResultPtr);
+    }
+    for(i = 2;i < objc;i++) {
+	Tcl_AppendObjToObj(objResultPtr, objv[i]);
+    }
+    Tcl_SetObjResult(interp, objResultPtr);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * StringBytesCmd --
  *
  *	This procedure is invoked to process the "string bytelength" Tcl
@@ -2814,25 +2947,12 @@ StringLenCmd(
     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;
     }
 
-    /*
-     * 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.
-     */
-
-    if (objv[1]->typePtr == &tclByteArrayType) {
-	(void) Tcl_GetByteArrayFromObj(objv[1], &length);
-    } else {
-	length = Tcl_GetCharLength(objv[1]);
-    }
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1])));
     return TCL_OK;
 }
 
@@ -2862,7 +2982,8 @@ StringLowerCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int length1, length2;
-    char *string1, *string2;
+    const char *string1;
+    char *string2;
 
     if (objc < 2 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
@@ -2946,7 +3067,8 @@ StringUpperCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int length1, length2;
-    char *string1, *string2;
+    const char *string1;
+    char *string2;
 
     if (objc < 2 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
@@ -3030,7 +3152,8 @@ StringTitleCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int length1, length2;
-    char *string1, *string2;
+    const char *string1;
+    char *string2;
 
     if (objc < 2 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
@@ -3119,8 +3242,8 @@ StringTrimCmd(
     if (objc == 3) {
 	string2 = TclGetStringFromObj(objv[2], &length2);
     } else if (objc == 2) {
-	string2 = " \t\n\r";
-	length2 = strlen(string2);
+	string2 = tclDefaultTrimSet;
+	length2 = strlen(tclDefaultTrimSet);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
 	return TCL_ERROR;
@@ -3167,8 +3290,8 @@ StringTrimLCmd(
     if (objc == 3) {
 	string2 = TclGetStringFromObj(objv[2], &length2);
     } else if (objc == 2) {
-	string2 = " \t\n\r";
-	length2 = strlen(string2);
+	string2 = tclDefaultTrimSet;
+	length2 = strlen(tclDefaultTrimSet);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
 	return TCL_ERROR;
@@ -3213,8 +3336,8 @@ StringTrimRCmd(
     if (objc == 3) {
 	string2 = TclGetStringFromObj(objv[2], &length2);
     } else if (objc == 2) {
-	string2 = " \t\n\r";
-	length2 = strlen(string2);
+	string2 = tclDefaultTrimSet;
+	length2 = strlen(tclDefaultTrimSet);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
 	return TCL_ERROR;
@@ -3255,29 +3378,30 @@ TclInitStringCmd(
     Tcl_Interp *interp)		/* Current interpreter. */
 {
     static const EnsembleImplMap stringImplMap[] = {
-	{"bytelength",	StringBytesCmd,	NULL},
-	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd},
-	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd},
-	{"first",	StringFirstCmd,	NULL},
-	{"index",	StringIndexCmd,	TclCompileStringIndexCmd},
-	{"is",		StringIsCmd,	NULL},
-	{"last",	StringLastCmd,	NULL},
-	{"length",	StringLenCmd,	TclCompileStringLenCmd},
-	{"map",		StringMapCmd,	NULL},
-	{"match",	StringMatchCmd,	TclCompileStringMatchCmd},
-	{"range",	StringRangeCmd,	NULL},
-	{"repeat",	StringReptCmd,	NULL},
-	{"replace",	StringRplcCmd,	NULL},
-	{"reverse",	StringRevCmd,	NULL},
-	{"tolower",	StringLowerCmd,	NULL},
-	{"toupper",	StringUpperCmd,	NULL},
-	{"totitle",	StringTitleCmd,	NULL},
-	{"trim",	StringTrimCmd,	NULL},
-	{"trimleft",	StringTrimLCmd,	NULL},
-	{"trimright",	StringTrimRCmd,	NULL},
-	{"wordend",	StringEndCmd,	NULL},
-	{"wordstart",	StringStartCmd,	NULL},
-	{NULL, NULL, NULL}
+	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
+	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
+	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
+	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
+	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
+	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
+	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
+	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
+	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
+	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
+	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
+	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"replace",	StringRplcCmd,	TclCompileStringReplaceCmd, NULL, NULL, 0},
+	{"reverse",	StringRevCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"tolower",	StringLowerCmd,	TclCompileStringToLowerCmd, NULL, NULL, 0},
+	{"toupper",	StringUpperCmd,	TclCompileStringToUpperCmd, NULL, NULL, 0},
+	{"totitle",	StringTitleCmd,	TclCompileStringToTitleCmd, NULL, NULL, 0},
+	{"trim",	StringTrimCmd,	TclCompileStringTrimCmd, NULL, NULL, 0},
+	{"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd, NULL, NULL, 0},
+	{"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd, NULL, NULL, 0},
+	{"wordend",	StringEndCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"wordstart",	StringStartCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{NULL, NULL, NULL, NULL, NULL, 0}
     };
 
     return TclMakeEnsemble(interp, "string", stringImplMap);
@@ -3302,30 +3426,24 @@ TclInitStringCmd(
  */
 
 int
-Tcl_SubstObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+TclSubstOptions(
+    Tcl_Interp *interp,
+    int numOpts,
+    Tcl_Obj *const opts[],
+    int *flagPtr)
 {
-    static const char *substOptions[] = {
+    static const char *const substOptions[] = {
 	"-nobackslashes", "-nocommands", "-novariables", NULL
     };
-    enum substOptions {
+    enum {
 	SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
     };
-    Tcl_Obj *resultPtr;
-    int flags, i;
+    int i, flags = TCL_SUBST_ALL;
 
-    /*
-     * Parse command-line options.
-     */
-
-    flags = TCL_SUBST_ALL;
-    for (i = 1; i < (objc-1); i++) {
+    for (i = 0; i < numOpts; i++) {
 	int optionIndex;
 
-	if (Tcl_GetIndexFromObj(interp, objv[i], substOptions, "switch", 0,
+	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
 		&optionIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -3343,23 +3461,39 @@ Tcl_SubstObjCmd(
 	    Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
 	}
     }
-    if (i != objc-1) {
+    *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;
+
+    if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"?-nobackslashes? ?-nocommands? ?-novariables? string");
 	return TCL_ERROR;
     }
 
-    /*
-     * Perform the substitution.
-     */
-
-    resultPtr = Tcl_SubstObj(interp, objv[i], flags);
-
-    if (resultPtr == NULL) {
+    if (TclSubstOptions(interp, objc-2, objv+1, &flags) != TCL_OK) {
 	return TCL_ERROR;
     }
-    Tcl_SetObjResult(interp, resultPtr);
-    return TCL_OK;
+    return Tcl_NRSubstObj(interp, objv[objc-1], flags);
 }
 
 /*
@@ -3386,9 +3520,18 @@ Tcl_SwitchObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved;
+    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. */
+{
+    int i,j, index, mode, foundmode, splitObjs, numMatchesSaved;
     int noCase, patternLength;
-    char *pattern;
+    const char *pattern;
     Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
     Tcl_Obj *const *savedObjv = objv;
     Tcl_RegExp regExpr = NULL;
@@ -3404,7 +3547,7 @@ Tcl_SwitchObjCmd(
      * -glob, you *must* fix TclCompileSwitchCmd's option parser as well.
      */
 
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
 	"--", NULL
     };
@@ -3452,15 +3595,16 @@ Tcl_SwitchObjCmd(
 		 * Mode already set via -exact, -glob, or -regexp.
 		 */
 
-		Tcl_AppendResult(interp, "bad option \"",
-			TclGetString(objv[i]), "\": ", options[mode],
-			" option already found", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad option \"%s\": %s option already found",
+			TclGetString(objv[i]), options[mode]));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+			"DOUBLEOPT", NULL);
 		return TCL_ERROR;
-	    } else {
-		foundmode = 1;
-		mode = index;
-		break;
 	    }
+	    foundmode = 1;
+	    mode = index;
+	    break;
 
 	    /*
 	     * Check for TIP#75 options specifying the variables to write
@@ -3470,8 +3614,11 @@ Tcl_SwitchObjCmd(
 	case OPT_INDEXV:
 	    i++;
 	    if (i >= objc-2) {
-		Tcl_AppendResult(interp, "missing variable name argument to ",
-			"-indexvar", " option", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"missing variable name argument to %s option",
+			"-indexvar"));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+			"NOVAR", NULL);
 		return TCL_ERROR;
 	    }
 	    indexVarObj = objv[i];
@@ -3480,8 +3627,11 @@ Tcl_SwitchObjCmd(
 	case OPT_MATCHV:
 	    i++;
 	    if (i >= objc-2) {
-		Tcl_AppendResult(interp, "missing variable name argument to ",
-			"-matchvar", " option", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"missing variable name argument to %s option",
+			"-matchvar"));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+			"NOVAR", NULL);
 		return TCL_ERROR;
 	    }
 	    matchVarObj = objv[i];
@@ -3493,17 +3643,21 @@ Tcl_SwitchObjCmd(
   finishedOptions:
     if (objc - i < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?switches? string pattern body ... ?default body?");
+		"?-option ...? string ?pattern body ...? ?default body?");
 	return TCL_ERROR;
     }
     if (indexVarObj != NULL && mode != OPT_REGEXP) {
-	Tcl_AppendResult(interp,
-		"-indexvar option requires -regexp option", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s option requires -regexp option", "-indexvar"));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s option requires -regexp option", "-matchvar"));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+		"MODERESTRICTION", NULL);
 	return TCL_ERROR;
     }
 
@@ -3524,8 +3678,8 @@ Tcl_SwitchObjCmd(
     splitObjs = 0;
     if (objc == 1) {
 	Tcl_Obj **listv;
-	blist = objv[0];
 
+	blist = objv[0];
 	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
 	    return TCL_ERROR;
 	}
@@ -3536,7 +3690,7 @@ Tcl_SwitchObjCmd(
 
 	if (objc < 1) {
 	    Tcl_WrongNumArgs(interp, 1, savedObjv,
-		    "?switches? string {pattern body ... ?default body?}");
+		    "?-option ...? string {?pattern body ...? ?default body?}");
 	    return TCL_ERROR;
 	}
 	objv = listv;
@@ -3550,7 +3704,10 @@ Tcl_SwitchObjCmd(
 
     if (objc % 2) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"extra switch pattern with no body", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
+		NULL);
 
 	/*
 	 * Check if this can be due to a badly placed comment in the switch
@@ -3563,10 +3720,12 @@ Tcl_SwitchObjCmd(
 	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_AppendToObj(Tcl_GetObjResult(interp),
+			    ", this may be due to a comment incorrectly"
+			    " placed outside of a switch body - see the"
+			    " \"switch\" documentation", -1);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
+			    "BADARM", "COMMENT?", NULL);
 		    break;
 		}
 	    }
@@ -3581,9 +3740,11 @@ Tcl_SwitchObjCmd(
      */
 
     if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "no body specified for pattern \"",
-		TclGetString(objv[objc-2]), "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"no body specified for pattern \"%s\"",
+		TclGetString(objv[objc-2])));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
+		"FALLTHROUGH", NULL);
 	return TCL_ERROR;
     }
 
@@ -3622,36 +3783,35 @@ Tcl_SwitchObjCmd(
 		}
 	    }
 	    goto matchFound;
-	} else {
-	    switch (mode) {
-	    case OPT_EXACT:
-		if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
-		    goto matchFound;
-		}
-		break;
-	    case OPT_GLOB:
-		if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern,
-			noCase)) {
-		    goto matchFound;
-		}
-		break;
-	    case OPT_REGEXP:
-		regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
-			TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
-		if (regExpr == NULL) {
-		    return TCL_ERROR;
-		} else {
-		    int matched = Tcl_RegExpExecObj(interp, regExpr,
-			    stringObj, 0, numMatchesSaved, 0);
+	}
 
-		    if (matched < 0) {
-			return TCL_ERROR;
-		    } else if (matched) {
-			goto matchFoundRegexp;
-		    }
+	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;
 	    }
+	    break;
 	}
     }
     return TCL_OK;
@@ -3747,7 +3907,7 @@ Tcl_SwitchObjCmd(
      */
 
   matchFound:
-    ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
     *ctxPtr = *iPtr->cmdFramePtr;
 
     if (splitObjs) {
@@ -3762,7 +3922,7 @@ Tcl_SwitchObjCmd(
 	if (ctxPtr->type == TCL_LOCATION_BC) {
 	    /*
 	     * Type BC => ctxPtr->data.eval.path    is not used.
-	     *            ctxPtr->data.tebc.codePtr is used instead.
+	     *		  ctxPtr->data.tebc.codePtr is used instead.
 	     */
 
 	    TclGetSrcInfoForPc(ctxPtr);
@@ -3777,7 +3937,7 @@ Tcl_SwitchObjCmd(
 	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
 	    int bline = ctxPtr->line[bidx];
 
-	    ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
+	    ctxPtr->line = ckalloc(objc * sizeof(int));
 	    ctxPtr->nline = objc;
 	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
 	} else {
@@ -3791,7 +3951,7 @@ Tcl_SwitchObjCmd(
 
 	    int k;
 
-	    ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
+	    ctxPtr->line = ckalloc(objc * sizeof(int));
 	    ctxPtr->nline = objc;
 	    for (k=0; k < objc; k++) {
 		ctxPtr->line[k] = -1;
@@ -3817,9 +3977,31 @@ Tcl_SwitchObjCmd(
      * TIP #280: Make invoking context available to switch branch.
      */
 
-    result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
+    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
+     */
+
     if (splitObjs) {
-	ckfree((char *) ctxPtr->line);
+	ckfree(ctxPtr->line);
 	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
 	    /*
 	     * Death of SrcInfo reference.
@@ -3840,7 +4022,7 @@ Tcl_SwitchObjCmd(
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (\"%.*s%s\" arm line %d)",
 		(overflow ? limit : patternLength), pattern,
-		(overflow ? "..." : ""), interp->errorLine));
+		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
     }
     TclStackFree(interp, ctxPtr);
     return result;
@@ -3849,6 +4031,69 @@ Tcl_SwitchObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_ThrowObjCmd --
+ *
+ *	This procedure is invoked to process the "throw" 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_ThrowObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    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_SetObjResult(interp, Tcl_NewStringObj(
+		"type must be non-empty list", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
+		NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_TimeObjCmd --
  *
  *	This object-based procedure is invoked to process the "time" Tcl
@@ -3941,6 +4186,578 @@ Tcl_TimeObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_TryObjCmd, TclNRTryObjCmd --
+ *
+ *	This procedure is invoked to process the "try" Tcl command. See the
+ *	user documentation (or TIP #329) for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    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
+    };
+
+    /*
+     * 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.
+     */
+
+    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_SetObjResult(interp, Tcl_NewStringObj(
+			"finally clause must be last", -1));
+		Tcl_DecrRefCount(handlersObj);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
+			"NONTERMINAL", NULL);
+		return TCL_ERROR;
+	    } else if (i == objc-1) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"wrong # args to finally clause: must be"
+			" \"... finally script\"", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+			"wrong # args to on clause: must be \"... on code"
+			" variableList script\"", -1));
+		Tcl_DecrRefCount(handlersObj);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
+			"ARGUMENT", NULL);
+		return TCL_ERROR;
+	    }
+	    if (TclGetCompletionCodeFromObj(interp, objv[i+1],
+		    &code) != TCL_OK) {
+		Tcl_DecrRefCount(handlersObj);
+		return TCL_ERROR;
+	    }
+	    info[2] = NULL;
+	    goto commonHandler;
+
+	case TryTrap:		/* trap pattern variableList script */
+	    if (i > objc-4) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"wrong # args to trap clause: "
+			"must be \"... trap pattern variableList script\"",
+			-1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+		"last non-finally clause must not have a body of \"-\"", -1));
+	Tcl_DecrRefCount(handlersObj);
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
+		NULL);
+	return TCL_ERROR;
+    }
+    if (!haveHandlers) {
+	Tcl_DecrRefCount(handlersObj);
+	handlersObj = NULL;
+    }
+
+    /*
+     * Execute the body.
+     */
+
+    Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
+	    (ClientData)objv, INT2PTR(objc));
+    return TclNREvalObjEx(interp, bodyObj, 0,
+	    ((Interp *) interp)->cmdFramePtr, 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * During --
+ *
+ *	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.
+ *
+ * Returns:
+ *	The new option dictionary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+    }
+    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 --
+ *
+ *	Callback to handle the outcome of the execution of the body of a 'try'
+ *	command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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)));
+    }
+    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;
+
+	    Tcl_ListObjGetElements(NULL, handlers[i], &dummy, &info);
+	    if (!found) {
+		Tcl_GetIntFromObj(NULL, info[1], &code);
+		if (code != result) {
+		    continue;
+		}
+
+		/*
+		 * 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;
+			}
+		    }
+		}
+
+		found = 1;
+	    }
+
+	    /*
+	     * 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.
+	     */
+
+	    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_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);
+	    }
+
+	    /*
+	     * 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.
+	     */
+
+	    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;
+	}
+
+	/*
+	 * No handler matched; get rid of the list of handlers.
+	 */
+
+	Tcl_DecrRefCount(handlersObj);
+    }
+
+    /*
+     * 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);
+    }
+
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TryPostHandler --
+ *
+ *	Callback to handle the outcome of the execution of a handler of a
+ *	'try' command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TryPostHandler(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    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.
+     */
+
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TryPostFinal(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_Obj *resultObj, *options, *cmdObj;
+
+    resultObj = data[0];
+    options = data[1];
+    cmdObj = data[2];
+
+    /*
+     * If the result wasn't OK, we need to adjust the result options.
+     */
+
+    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;
+
+	    options = Tcl_GetReturnOptions(interp, result);
+	    Tcl_IncrRefCount(options);
+	    Tcl_DecrRefCount(origOptions);
+	}
+    }
+
+    /*
+     * 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);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_WhileObjCmd --
  *
  *	This procedure is invoked to process the "while" Tcl command. See the
@@ -3966,40 +4783,37 @@ Tcl_WhileObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int result, value;
-    Interp *iPtr = (Interp *) interp;
+    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. */
+{
+    ForIterData *iterPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
 	return TCL_ERROR;
     }
 
-    while (1) {
-	result = Tcl_ExprBooleanObj(interp, objv[1], &value);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	if (!value) {
-	    break;
-	}
+    /*
+     * We reuse [for]'s callback, passing a NULL for the 'next' script.
+     */
 
-	/* TIP #280. */
-        result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr, 2);
-	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
-	    if (result == TCL_ERROR) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (\"while\" body line %d)", interp->errorLine));
-	    }
-	    break;
-	}
-    }
-    if (result == TCL_BREAK) {
-	result = TCL_OK;
-    }
-    if (result == TCL_OK) {
-	Tcl_ResetResult(interp);
-    }
-    return result;
+    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;
+
+    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+	    NULL, NULL);
+    return TCL_OK;
 }
 
 /*
@@ -4020,32 +4834,30 @@ Tcl_WhileObjCmd(
 
 void
 TclListLines(
-    Tcl_Obj* listObj,          /* Pointer to obj holding a string with list
-				* structure.  Assumed to be valid. Assumed to
-				* contain n elements.
-				*/
+    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
+    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;
+    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);
+    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);
+	TclAdvanceContinuations(&line, &clNext, element - listHead);
 	if (elems && clNext) {
-	    TclContinuationsEnterDerived (elems[i], element - listHead,
-					  clNext);
+	    TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
 	}
 	lines[i] = line;
 	length -= (next - listStr);
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3b234b0..c2b4bdb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -7,7 +7,7 @@
  * 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.
+ * Copyright (c) 2004-2013 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.
@@ -15,123 +15,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
-
-/*
- * 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)]
-
-/*
- * Convenience macro for use when compiling bodies of commands. The ANSI C
- * "prototype" for this macro is:
- *
- * static void		CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- *			    Tcl_Interp *interp);
- */
-
-#define CompileBody(envPtr, tokenPtr, interp) \
-    TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
-	    (envPtr))
-
-/*
- * Convenience macro for use when compiling tokens to be pushed. The ANSI C
- * "prototype" for this macro is:
- *
- * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- *			    Tcl_Interp *interp);
- */
-
-#define CompileTokens(envPtr, tokenPtr, interp) \
-    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
-            (envPtr));
-/*
- * Convenience macro for use when pushing literals. The ANSI C "prototype" for
- * this macro is:
- *
- * static void		PushLiteral(CompileEnv *envPtr,
- *			    const char *string, int length);
- */
-
-#define PushLiteral(envPtr, string, length) \
-    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
-
-/*
- * Macro to advance to the next token; it is more mnemonic than the address
- * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
- *
- * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
- */
-
-#define TokenAfter(tokenPtr) \
-    ((tokenPtr) + ((tokenPtr)->numComponents + 1))
-
-/*
- * Macro to get the offset to the next instruction to be issued. The ANSI C
- * "prototype" for this macro is:
- *
- * static int	CurrentOffset(CompileEnv *envPtr);
- */
-
-#define CurrentOffset(envPtr) \
-    ((envPtr)->codeNext - (envPtr)->codeStart)
-
-/*
- * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
- * maximal depth of nested CATCH ranges in order to alloc runtime
- * memory. These macros should compute precisely that? OTOH, the nesting depth
- * of LOOP ranges is an interesting datum for debugging purposes, and that is
- * what we compute now.
- *
- * static int	DeclareExceptionRange(CompileEnv *envPtr, int type);
- * static int	ExceptionRangeStarts(CompileEnv *envPtr, int index);
- * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
- * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
- */
-
-#define DeclareExceptionRange(envPtr, type) \
-    (TclCreateExceptRange((type), (envPtr)))
-#define ExceptionRangeStarts(envPtr, index) \
-    (((envPtr)->exceptDepth++), \
-    ((envPtr)->maxExceptDepth = \
-	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
-    ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
-#define ExceptionRangeEnds(envPtr, index) \
-    (((envPtr)->exceptDepth--), \
-    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
-	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
-#define ExceptionRangeTarget(envPtr, index, targetType) \
-    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+#include <assert.h>
 
 /*
  * Prototypes for procedures defined later in this file:
@@ -142,88 +26,101 @@ static void		FreeDictUpdateInfo(ClientData clientData);
 static void		PrintDictUpdateInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
+static void		DisassembleDictUpdateInfo(ClientData clientData,
+			    Tcl_Obj *dictObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
 static ClientData	DupForeachInfo(ClientData clientData);
 static void		FreeForeachInfo(ClientData clientData);
 static void		PrintForeachInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
-static ClientData	DupJumptableInfo(ClientData clientData);
-static void		FreeJumptableInfo(ClientData clientData);
-static void		PrintJumptableInfo(ClientData clientData,
+static void		DisassembleForeachInfo(ClientData clientData,
+			    Tcl_Obj *dictObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
+static void		PrintNewForeachInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
-static int		LocalScalarFromToken(Tcl_Token *tokenPtr,
-			    CompileEnv *envPtr);
-static int		LocalScalar(const char *bytes, int numBytes,
-			    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);
-static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, const char *identity,
-			    int instruction, CompileEnv *envPtr);
-static int		CompileComparisonOpCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, int instruction,
-			    CompileEnv *envPtr);
-static int		CompileStrictlyBinaryOpCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, int instruction,
-			    CompileEnv *envPtr);
-static int		CompileUnaryOpCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, int instruction,
-			    CompileEnv *envPtr);
-static void		CompileReturnInternal(CompileEnv *envPtr,
-			    unsigned char op, int code, int level,
-			    Tcl_Obj *returnOpts);
-
-#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
-    PushVarName (i,v,e,f,l,s,sc,                       \
-                    mapPtr->loc [eclIndex].line [(word)], \
-	            mapPtr->loc [eclIndex].next [(word)])
-
-/*
- * Flags bits used by PushVarName.
- */
-
-#define TCL_CREATE_VAR     1	/* Create a compiled local if none is found */
-#define TCL_NO_LARGE_INDEX 2	/* Do not return localIndex value > 255 */
+static void		DisassembleNewForeachInfo(ClientData clientData,
+			    Tcl_Obj *dictObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
+static int		CompileEachloopCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    CompileEnv *envPtr, int collect);
+static int		CompileDictEachCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr, int collect);
 
 /*
  * The structures below define the AuxData types defined in this file.
  */
 
-AuxDataType tclForeachInfoType = {
+static const AuxDataType foreachInfoType = {
     "ForeachInfo",		/* name */
     DupForeachInfo,		/* dupProc */
     FreeForeachInfo,		/* freeProc */
-    PrintForeachInfo		/* printProc */
+    PrintForeachInfo,		/* printProc */
+    DisassembleForeachInfo	/* disassembleProc */
 };
 
-AuxDataType tclJumptableInfoType = {
-    "JumptableInfo",		/* name */
-    DupJumptableInfo,		/* dupProc */
-    FreeJumptableInfo,		/* freeProc */
-    PrintJumptableInfo		/* printProc */
+static const AuxDataType newForeachInfoType = {
+    "NewForeachInfo",		/* name */
+    DupForeachInfo,		/* dupProc */
+    FreeForeachInfo,		/* freeProc */
+    PrintNewForeachInfo,	/* printProc */
+    DisassembleNewForeachInfo	/* disassembleProc */
 };
 
-AuxDataType tclDictUpdateInfoType = {
+static const AuxDataType dictUpdateInfoType = {
     "DictUpdateInfo",		/* name */
     DupDictUpdateInfo,		/* dupProc */
     FreeDictUpdateInfo,		/* freeProc */
-    PrintDictUpdateInfo		/* printProc */
+    PrintDictUpdateInfo,	/* printProc */
+    DisassembleDictUpdateInfo	/* disassembleProc */
 };
 
 /*
  *----------------------------------------------------------------------
  *
+ * TclGetAuxDataType --
+ *
+ *	This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ *	If an AuxData type with name matching "typeName" is found, a pointer
+ *	to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const AuxDataType *
+TclGetAuxDataType(
+    const char *typeName)	/* Name of AuxData type to look up. */
+{
+    if (!strcmp(typeName, foreachInfoType.name)) {
+	return &foreachInfoType;
+    } else if (!strcmp(typeName, newForeachInfoType.name)) {
+	return &newForeachInfoType;
+    } else if (!strcmp(typeName, dictUpdateInfoType.name)) {
+	return &dictUpdateInfoType;
+    } else if (!strcmp(typeName, tclJumptableInfoType.name)) {
+	return &tclJumptableInfoType;
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileAppendCmd --
  *
  *	Procedure called to compile the "append" command.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "append" command at
@@ -242,9 +139,10 @@ TclCompileAppendCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords;
+    int isScalar, localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
 
+    /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
     if (numWords == 1) {
 	return TCL_ERROR;
@@ -256,10 +154,11 @@ TclCompileAppendCmd(
 	return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
     } else if (numWords > 3) {
 	/*
-	 * APPEND instructions currently only handle one value.
+	 * APPEND instructions currently only handle one value, but we can
+	 * handle some multi-value cases by stringing them together.
 	 */
 
-	return TCL_ERROR;
+	goto appendMultiple;
     }
 
     /*
@@ -272,8 +171,8 @@ TclCompileAppendCmd(
 
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-		    &localIndex, &simpleVarName, &isScalar, 1);
+    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar, 1);
 
     /*
      * We are doing an assignment, otherwise TclCompileSetCmd was called, so
@@ -281,37 +180,313 @@ TclCompileAppendCmd(
      * each argument.
      */
 
-    if (numWords > 2) {
 	valueTokenPtr = TokenAfter(varTokenPtr);
 	CompileWord(envPtr, valueTokenPtr, interp, 2);
-    }
 
     /*
      * Emit instructions to set/get the variable.
      */
 
-    if (simpleVarName) {
 	if (isScalar) {
 	    if (localIndex < 0) {
 		TclEmitOpcode(INST_APPEND_STK, envPtr);
-	    } else if (localIndex <= 255) {
-		TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
 	    } else {
-		TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
+		Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr);
 	    }
 	} else {
 	    if (localIndex < 0) {
 		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
-	    } else if (localIndex <= 255) {
-		TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
 	    } else {
-		TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
+		Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr);
 	    }
 	}
+
+    return TCL_OK;
+
+  appendMultiple:
+    /*
+     * Can only handle the case where we are appending to a local scalar when
+     * there are multiple values to append.  Fortunately, this is common.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+    if (localIndex < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Definitely appending to a local scalar; generate the words and append
+     * them.
+     */
+
+    valueTokenPtr = TokenAfter(varTokenPtr);
+    for (i = 2 ; i < numWords ; i++) {
+	CompileWord(envPtr, valueTokenPtr, interp, i);
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    TclEmitInstInt4(	  INST_REVERSE, numWords-2,		envPtr);
+    for (i = 2 ; i < numWords ;) {
+	Emit14Inst(	  INST_APPEND_SCALAR, localIndex,	envPtr);
+	if (++i < numWords) {
+	    TclEmitOpcode(INST_POP,				envPtr);
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileArray*Cmd --
+ *
+ *	Functions called to compile "array" 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 "array" subcommand at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileArrayExistsCmd(
+    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 isScalar, localIndex;
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
+	    &localIndex, &isScalar, 1);
+    if (!isScalar) {
+	return TCL_ERROR;
+    }
+
+    if (localIndex >= 0) {
+	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
     } else {
-	TclEmitOpcode(INST_APPEND_STK, envPtr);
+	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
+    }
+    return TCL_OK;
+}
+
+int
+TclCompileArraySetCmd(
+    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, *dataTokenPtr;
+    int isScalar, localIndex, code = TCL_OK;
+    int isDataLiteral, isDataValid, isDataEven, len;
+    int keyVar, valVar, infoIndex;
+    int fwd, offsetBack, offsetFwd;
+    Tcl_Obj *literalObj;
+    ForeachInfo *infoPtr;
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    dataTokenPtr = TokenAfter(varTokenPtr);
+    literalObj = Tcl_NewObj();
+    isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
+    isDataValid = (isDataLiteral
+	    && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK);
+    isDataEven = (isDataValid && (len & 1) == 0);
+
+    /*
+     * Special case: literal odd-length argument is always an error.
+     */
+
+    if (isDataValid && !isDataEven) {
+	PushStringLiteral(envPtr, "list must have an even number of elements");
+	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
+	TclEmitInt4(		0,				envPtr);
+	goto done;
+    }
+
+    /*
+     * Except for the special "ensure array" case below, when we're not in
+     * a proc, we cannot do a better compile than generic.
+     */
+
+    if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
+	    (envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
+	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+	goto done;
+    }
+
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+	    &localIndex, &isScalar, 1);
+    if (!isScalar) {
+	code = TCL_ERROR;
+	goto done;
+    }
+
+    /*
+     * Special case: literal empty value argument is just an "ensure array"
+     * operation.
+     */
+
+    if (isDataEven && len == 0) {
+	if (localIndex >= 0) {
+	    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+	    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
+	    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
+	} else {
+	    TclEmitOpcode(  INST_DUP,				envPtr);
+	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
+	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);
+	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
+	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);
+	    /* Each branch decrements stack depth, but we only take one. */
+	    TclAdjustStackDepth(1, envPtr);
+	    TclEmitOpcode(  INST_POP,				envPtr);
+	}
+	PushStringLiteral(envPtr, "");
+	goto done;
+    }
+
+    if (localIndex < 0) {
+	/*
+	 * a non-local variable: upvar from a local one! This consumes the
+	 * variable name that was left at stacktop.
+	 */
+
+	localIndex = TclFindCompiledLocal(varTokenPtr->start,
+		varTokenPtr->size, 1, envPtr);
+	PushStringLiteral(envPtr, "0");
+	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
+	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
+	TclEmitOpcode(INST_POP,          			envPtr);
+    }
+
+    /*
+     * Prepare for the internal foreach.
+     */
+
+    keyVar = AnonymousLocal(envPtr);
+    valVar = AnonymousLocal(envPtr);
+
+    infoPtr = ckalloc(sizeof(ForeachInfo));
+    infoPtr->numLists = 1;
+    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
+    infoPtr->varLists[0]->numVars = 2;
+    infoPtr->varLists[0]->varIndexes[0] = keyVar;
+    infoPtr->varLists[0]->varIndexes[1] = valVar;
+    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
+
+    /*
+     * Start issuing instructions to write to the array.
+     */
+
+    CompileWord(envPtr, dataTokenPtr, interp, 2);
+    if (!isDataLiteral || !isDataValid) {
+	/*
+	 * Only need this safety check if we're handling a non-literal or list
+	 * containing an invalid literal; with valid list literals, we've
+	 * already checked (worth it because literals are a very common
+	 * use-case with [array set]).
+	 */
+
+	TclEmitOpcode(	INST_DUP,				envPtr);
+	TclEmitOpcode(	INST_LIST_LENGTH,			envPtr);
+	PushStringLiteral(envPtr, "1");
+	TclEmitOpcode(	INST_BITAND,				envPtr);
+	offsetFwd = CurrentOffset(envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
+	PushStringLiteral(envPtr, "list must have an even number of elements");
+	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
+	TclEmitInt4(		0,				envPtr);
+	TclAdjustStackDepth(-1, envPtr);
+	fwd = CurrentOffset(envPtr) - offsetFwd;
+	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+    }
+
+    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
+    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
+    TclEmitInstInt4(INST_FOREACH_START, infoIndex,	envPtr);
+    offsetBack = CurrentOffset(envPtr);
+    Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
+    Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
+    Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
+    TclEmitOpcode(	INST_POP,			envPtr);
+    infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */
+    TclEmitOpcode( INST_FOREACH_STEP,			envPtr);
+    TclEmitOpcode( INST_FOREACH_END,			envPtr);
+    TclAdjustStackDepth(-3, envPtr);
+    PushStringLiteral(envPtr,	"");
+
+    done:
+    Tcl_DecrRefCount(literalObj);
+    return code;
+}
+
+int
+TclCompileArrayUnsetCmd(
+    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 = TokenAfter(parsePtr->tokenPtr);
+    int isScalar, localIndex;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
+	    &localIndex, &isScalar, 1);
+    if (!isScalar) {
+	return TCL_ERROR;
     }
 
+    if (localIndex >= 0) {
+	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 8,			envPtr);
+	TclEmitInstInt1(INST_UNSET_SCALAR, 1,			envPtr);
+	TclEmitInt4(		localIndex,			envPtr);
+    } else {
+	TclEmitOpcode(	INST_DUP,				envPtr);
+	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
+	TclEmitInstInt1(INST_JUMP_FALSE1, 6,			envPtr);
+	TclEmitInstInt1(INST_UNSET_STK, 1,			envPtr);
+	TclEmitInstInt1(INST_JUMP1, 3,				envPtr);
+	/* Each branch decrements stack depth, but we only take one. */
+	TclAdjustStackDepth(1, envPtr);
+	TclEmitOpcode(	INST_POP,				envPtr);
+    }
+    PushStringLiteral(envPtr,	"");
     return TCL_OK;
 }
 
@@ -323,8 +498,8 @@ TclCompileAppendCmd(
  *	Procedure called to compile the "break" command.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "break" command at
@@ -342,15 +517,34 @@ TclCompileBreakCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    ExceptionRange *rangePtr;
+    ExceptionAux *auxPtr;
+
     if (parsePtr->numWords != 1) {
 	return TCL_ERROR;
     }
 
     /*
-     * Emit a break instruction.
+     * Find the innermost exception range that contains this command.
      */
 
-    TclEmitOpcode(INST_BREAK, envPtr);
+    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr);
+    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+	/*
+	 * Found the target! No need for a nasty INST_BREAK here.
+	 */
+
+	TclCleanupStackForBreakContinue(envPtr, auxPtr);
+	TclAddLoopBreakFixup(envPtr, auxPtr);
+    } else {
+	/*
+	 * Emit a real break.
+	 */
+
+	TclEmitOpcode(INST_BREAK, envPtr);
+    }
+    TclAdjustStackDepth(1, envPtr);
+
     return TCL_OK;
 }
 
@@ -383,10 +577,9 @@ TclCompileCatchCmd(
 {
     JumpFixup jumpFixup;
     Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
-    int resultIndex, optsIndex, range;
-    int initStackDepth = envPtr->currStackDepth;
-    int savedStackDepth;
+    int resultIndex, optsIndex, range, dropScript = 0;
     DefineLineInformation;	/* TIP #280 */
+    int depth = TclGetStackDepth(envPtr);
 
     /*
      * If syntax does not match what we expect for [catch], do not compile.
@@ -398,6 +591,15 @@ TclCompileCatchCmd(
     }
 
     /*
+     * If variables were specified and the catch command is at global level
+     * (not in a procedure), don't compile it inline: the payoff is too small.
+     */
+
+    if ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) {
+	return TCL_ERROR;
+    }
+
+    /*
      * Make sure the variable names, if any, have no substitutions and just
      * refer to local scalars.
      */
@@ -406,11 +608,13 @@ TclCompileCatchCmd(
     cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
     if (parsePtr->numWords >= 3) {
 	resultNameTokenPtr = TokenAfter(cmdTokenPtr);
+	/* DGP */
 	resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
 	if (resultIndex < 0) {
 	    return TCL_ERROR;
 	}
 
+	/* DKF */
 	if (parsePtr->numWords == 4) {
 	    optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
 	    optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
@@ -421,148 +625,298 @@ TclCompileCatchCmd(
     }
 
     /*
-     * We will compile the catch command. Declare the exception range
-     * that it uses.
-     */
-
-    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-
-    /*
+     * We will compile the catch command. Declare the exception range that it
+     * uses.
+     *
      * 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.
+     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
+     * substituted body.
+     * Care has to be taken to make sure that substitution happens outside the
+     * catch range so that errors in the substitution are not caught.
      * [Bug 219184]
      * The reason for duplicating the script is that EVAL_STK would otherwise
      * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
      */
 
-    SetLineInformation(1);
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	savedStackDepth = envPtr->currStackDepth;
-	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
-	CompileBody(envPtr, cmdTokenPtr, interp);
+	BODY(cmdTokenPtr, 1);
     } else {
+	SetLineInformation(1);
 	CompileTokens(envPtr, cmdTokenPtr, interp);
-	savedStackDepth = envPtr->currStackDepth;
-	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
-	TclEmitOpcode(INST_DUP, envPtr);
-	TclEmitOpcode(INST_EVAL_STK, envPtr);
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitInvoke(envPtr,	INST_EVAL_STK);
+	/* drop the script */
+	dropScript = 1;
+	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
-    /* Stack at this point:
-     *    nonsimple:  script <mark> result
-     *    simple:            <mark> result
-     */
+    ExceptionRangeEnds(envPtr, range);
+
 
     /*
-     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch
-     * result, and jump around the "error case" code.
+     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
+     * and jump around the "error case" code.
      */
 
-    PushLiteral(envPtr, "0", 1);
+    TclCheckStackDepth(depth+1, envPtr);
+    PushStringLiteral(envPtr, "0");
     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.
+     * 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);
+    TclSetStackDepth(depth + dropScript, envPtr);
 
-    /*
-     * Update the target of the jump after the "no errors" code.
-     */
+    if (dropScript) {
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+
+
+    /* Stack at this point is empty */
+    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
+    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
+
+    /* Stack at this point on both branches: result returnCode */
 
-    /* Stack at this point: ?script? result returnCode */
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
-		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
-    /* Push the return options if the caller wants them */
+    /*
+     * Push the return options if the caller wants them. This needs to happen
+     * before INST_END_CATCH
+     */
 
     if (optsIndex != -1) {
-	TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
+	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
     }
 
     /*
      * End the catch
      */
 
-    ExceptionRangeEnds(envPtr, range);
-    TclEmitOpcode(INST_END_CATCH, envPtr);
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
-     * At this point, the top of the stack is inconveniently ordered:
-     *		?script? result returnCode ?returnOptions?
-     * Reverse the stack to bring the result to the top.
+     * Save the result and return options if the caller wants them. This needs
+     * to happen after INST_END_CATCH (compile-3.6/7).
      */
 
     if (optsIndex != -1) {
-	TclEmitInstInt4(INST_REVERSE, 3, envPtr);
-    } else {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
-     * Store the result if requested, and remove it from the stack
+     * At this point, the top of the stack is inconveniently ordered:
+     *		result returnCode
+     * Reverse the stack to store the result.
      */
 
+    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
     if (resultIndex != -1) {
-	if (resultIndex <= 255) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
-	}
+	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
     }
-    TclEmitOpcode(INST_POP, 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.
-     */
+    TclCheckStackDepth(depth+1, envPtr);
+    return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TclCompileClockClicksCmd --
+ *
+ *	Procedure called to compile the "tcl::clock::clicks" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to run time.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "clock clicks"
+ *	command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if (optsIndex != -1) {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	if (optsIndex <= 255) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
+int
+TclCompileClockClicksCmd(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    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;
+
+    switch (parsePtr->numWords) {
+    case 1:
+	/*
+	 * No args
+	 */
+	TclEmitInstInt1(INST_CLOCK_READ, 0, envPtr);
+	break;
+    case 2:
+	/*
+	 * -milliseconds or -microseconds
+	 */
+	tokenPtr = TokenAfter(parsePtr->tokenPtr);
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD
+	    || tokenPtr[1].size < 4
+	    || tokenPtr[1].size > 13) {
+	    return TCL_ERROR;
+	} else if (!strncmp(tokenPtr[1].start, "-microseconds",
+			    tokenPtr[1].size)) {
+	    TclEmitInstInt1(INST_CLOCK_READ, 1, envPtr);
+	    break;
+	} else if (!strncmp(tokenPtr[1].start, "-milliseconds",
+			    tokenPtr[1].size)) {
+	    TclEmitInstInt1(INST_CLOCK_READ, 2, envPtr);
+	    break;
 	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
+	    return TCL_ERROR;
 	}
-	TclEmitOpcode(INST_POP, envPtr);
+    default:
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+
+/*----------------------------------------------------------------------
+ *
+ * TclCompileClockReadingCmd --
+ *
+ *	Procedure called to compile the "tcl::clock::microseconds",
+ *	"tcl::clock::milliseconds" and "tcl::clock::seconds" commands.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to run time.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "clock clicks"
+ *	command at runtime.
+ *
+ * Client data is 1 for microseconds, 2 for milliseconds, 3 for seconds.
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileClockReadingCmd(
+    Tcl_Interp* interp,		/* Tcl interpreter */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    if (parsePtr->numWords != 1) {
+	return TCL_ERROR;
+    }
+
+    TclEmitInstInt1(INST_CLOCK_READ, PTR2INT(cmdPtr->objClientData), envPtr);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileConcatCmd --
+ *
+ *	Procedure called to compile the "concat" 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 "concat" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileConcatCmd(
+    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_Obj *objPtr, *listObj;
+    Tcl_Token *tokenPtr;
+    int i;
+
+    /* TODO: Consider compiling expansion case. */
+    if (parsePtr->numWords == 1) {
+	/*
+	 * [concat] without arguments just pushes an empty object.
+	 */
+
+	PushStringLiteral(envPtr, "");
+	return TCL_OK;
     }
 
     /*
-     * Stack is now ?script? result. Get rid of the subst'ed script
-     * if it's hanging arond.
+     * Test if all arguments are compile-time known. If they are, we can
+     * implement with a simple push.
      */
 
-    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	TclEmitOpcode(INST_POP, envPtr);
+    listObj = Tcl_NewObj();
+    for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	objPtr = Tcl_NewObj();
+	if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	    Tcl_DecrRefCount(objPtr);
+	    Tcl_DecrRefCount(listObj);
+	    listObj = NULL;
+	    break;
+	}
+	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+    }
+    if (listObj != NULL) {
+	Tcl_Obj **objs;
+	const char *bytes;
+	int len;
+
+	Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+	objPtr = Tcl_ConcatObj(len, objs);
+	Tcl_DecrRefCount(listObj);
+	bytes = Tcl_GetStringFromObj(objPtr, &len);
+	PushLiteral(envPtr, bytes, len);
+	Tcl_DecrRefCount(objPtr);
+	return TCL_OK;
     }
 
     /*
-     * Result of all this, on either branch, should have been to leave
-     * one operand -- the return code -- on the stack.
+     * General case: runtime concat.
      */
 
-    if (envPtr->currStackDepth != initStackDepth + 1) {
-	Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
-		  envPtr->currStackDepth, initStackDepth+1);
+    for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
     }
+
+    TclEmitInstInt4(	INST_CONCAT_STK, i-1,		envPtr);
+
     return TCL_OK;
 }
 
@@ -574,8 +928,8 @@ TclCompileCatchCmd(
  *	Procedure called to compile the "continue" command.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "continue" command at
@@ -593,6 +947,9 @@ TclCompileContinueCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    ExceptionRange *rangePtr;
+    ExceptionAux *auxPtr;
+
     /*
      * There should be no argument after the "continue".
      */
@@ -602,10 +959,27 @@ TclCompileContinueCmd(
     }
 
     /*
-     * Emit a continue instruction.
+     * See if we can find a valid continueOffset (i.e., not -1) in the
+     * innermost containing exception range.
      */
 
-    TclEmitOpcode(INST_CONTINUE, envPtr);
+    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr);
+    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+	/*
+	 * Found the target! No need for a nasty INST_CONTINUE here.
+	 */
+
+	TclCleanupStackForBreakContinue(envPtr, auxPtr);
+	TclAddLoopContinueFixup(envPtr, auxPtr);
+    } else {
+	/*
+	 * Emit a real continue.
+	 */
+
+	TclEmitOpcode(INST_CONTINUE, envPtr);
+    }
+    TclAdjustStackDepth(1, envPtr);
+
     return TCL_OK;
 }
 
@@ -617,32 +991,13 @@ TclCompileContinueCmd(
  *	Functions called to compile "dict" sucommands.
  *
  * Results:
- * 	All return TCL_OK for a successful compile, and TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	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!)
- *
  *----------------------------------------------------------------------
  */
 
@@ -655,12 +1010,13 @@ TclCompileDictSetCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *tokenPtr, *varTokenPtr;
+    Tcl_Token *tokenPtr;
     int i, dictVarIndex;
     DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr;
 
     /*
-     * There must be at least three arguments after the (sub-)command.
+     * There must be at least one argument after the command.
      */
 
     if (parsePtr->numWords < 4) {
@@ -695,6 +1051,7 @@ TclCompileDictSetCmd(
 
     TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3,	envPtr);
     TclEmitInt4(     dictVarIndex,			envPtr);
+    TclAdjustStackDepth(-1, envPtr);
     return TCL_OK;
 }
 
@@ -707,9 +1064,9 @@ TclCompileDictIncrCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *varTokenPtr, *keyTokenPtr;
     int dictVarIndex, incrAmount;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * There must be at least two arguments after the command.
@@ -718,19 +1075,7 @@ TclCompileDictIncrCmd(
     if (parsePtr->numWords < 3 || 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);
-    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
-    if (dictVarIndex < 0) {
-	return TCL_ERROR;
-    }
-
     keyTokenPtr = TokenAfter(varTokenPtr);
 
     /*
@@ -738,19 +1083,41 @@ TclCompileDictIncrCmd(
      */
 
     if (parsePtr->numWords == 4) {
-	Tcl_Token *incrTokenPtr = TokenAfter(keyTokenPtr);
-	Tcl_Obj *intObj = Tcl_NewObj();
-	int fail = (!TclWordKnownAtCompileTime(incrTokenPtr, intObj)
-		|| TCL_ERROR == TclGetIntFromObj(NULL, intObj, &incrAmount));
-	Tcl_DecrRefCount(intObj);
-	if (fail) {
-	    return TCL_ERROR;
+	const char *word;
+	int numBytes, code;
+	Tcl_Token *incrTokenPtr;
+	Tcl_Obj *intObj;
+
+	incrTokenPtr = TokenAfter(keyTokenPtr);
+	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
+	}
+	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 TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
 	}
     } 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.
+     */
+
+    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+    if (dictVarIndex < 0) {
+	return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
      * Emit the key and the code to actually do the increment.
      */
 
@@ -778,6 +1145,7 @@ TclCompileDictGetCmd(
      * case is legal, but too special and magic for us to deal with here).
      */
 
+    /* TODO: Consider support for compiling expanded args. */
     if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
@@ -792,6 +1160,304 @@ TclCompileDictGetCmd(
 	tokenPtr = TokenAfter(tokenPtr);
     }
     TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
+    TclAdjustStackDepth(-1, envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictExistsCmd(
+    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 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).
+     */
+
+    /* TODO: Consider support for compiling expanded args. */
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * Now we do the code generation.
+     */
+
+    for (i=1 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr);
+    TclAdjustStackDepth(-1, envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictUnsetCmd(
+    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;
+    DefineLineInformation;	/* TIP #280 */
+    int i, dictVarIndex;
+
+    /*
+     * There must be at least one argument after the variable name for us to
+     * compile to bytecode.
+     */
+
+    /* TODO: Consider support for compiling expanded args. */
+    if (parsePtr->numWords < 3) {
+	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.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
+    if (dictVarIndex < 0) {
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
+     * Remaining words (the key path) can be handled normally.
+     */
+
+    for (i=2 ; i<parsePtr->numWords ; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+
+    /*
+     * Now emit the instruction to do the dict manipulation.
+     */
+
+    TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2,	envPtr);
+    TclEmitInt4(	dictVarIndex,				envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictCreateCmd(
+    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 worker;			/* Temp var for building the value in. */
+    Tcl_Token *tokenPtr;
+    Tcl_Obj *keyObj, *valueObj, *dictObj;
+    const char *bytes;
+    int i, len;
+
+    if ((parsePtr->numWords & 1) == 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * See if we can build the value at compile time...
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    dictObj = Tcl_NewObj();
+    Tcl_IncrRefCount(dictObj);
+    for (i=1 ; i<parsePtr->numWords ; i+=2) {
+	keyObj = Tcl_NewObj();
+	Tcl_IncrRefCount(keyObj);
+	if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) {
+	    Tcl_DecrRefCount(keyObj);
+	    Tcl_DecrRefCount(dictObj);
+	    goto nonConstant;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+	valueObj = Tcl_NewObj();
+	Tcl_IncrRefCount(valueObj);
+	if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) {
+	    Tcl_DecrRefCount(keyObj);
+	    Tcl_DecrRefCount(valueObj);
+	    Tcl_DecrRefCount(dictObj);
+	    goto nonConstant;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+	Tcl_DictObjPut(NULL, dictObj, keyObj, valueObj);
+	Tcl_DecrRefCount(keyObj);
+	Tcl_DecrRefCount(valueObj);
+    }
+
+    /*
+     * We did! Excellent. The "verifyDict" is to do type forcing.
+     */
+
+    bytes = Tcl_GetStringFromObj(dictObj, &len);
+    PushLiteral(envPtr, bytes, len);
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
+    Tcl_DecrRefCount(dictObj);
+    return TCL_OK;
+
+    /*
+     * Otherwise, we've got to issue runtime code to do the building, which we
+     * do by [dict set]ting into an unnamed local variable. This requires that
+     * we are in a context with an LVT.
+     */
+
+  nonConstant:
+    worker = AnonymousLocal(envPtr);
+    if (worker < 0) {
+	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    PushStringLiteral(envPtr,		"");
+    Emit14Inst(			INST_STORE_SCALAR, worker,	envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (i=1 ; i<parsePtr->numWords ; i+=2) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i+1);
+	tokenPtr = TokenAfter(tokenPtr);
+	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
+	TclEmitInt4(			worker,			envPtr);
+	TclAdjustStackDepth(-1, envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+    Emit14Inst(			INST_LOAD_SCALAR, worker,	envPtr);
+    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
+    TclEmitInt4(			worker,			envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileDictMergeCmd(
+    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, workerIndex, infoIndex, outLoop;
+
+    /*
+     * Deal with some special edge cases. Note that in the case with one
+     * argument, the only thing to do is to verify the dict-ness.
+     */
+
+    /* TODO: Consider support for compiling expanded args. (less likely) */
+    if (parsePtr->numWords < 2) {
+	PushStringLiteral(envPtr, "");
+	return TCL_OK;
+    } else if (parsePtr->numWords == 2) {
+	tokenPtr = TokenAfter(parsePtr->tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 1);
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
+	return TCL_OK;
+    }
+
+    /*
+     * There's real merging work to do.
+     *
+     * Allocate some working space. This means we'll only ever compile this
+     * command when there's an LVT present.
+     */
+
+    workerIndex = AnonymousLocal(envPtr);
+    if (workerIndex < 0) {
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+    infoIndex = AnonymousLocal(envPtr);
+
+    /*
+     * Get the first dictionary and verify that it is so.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
+    Emit14Inst(			INST_STORE_SCALAR, workerIndex,	envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+
+    /*
+     * For each of the remaining dictionaries...
+     */
+
+    outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    TclEmitInstInt4(		INST_BEGIN_CATCH4, outLoop,	envPtr);
+    ExceptionRangeStarts(envPtr, outLoop);
+    for (i=2 ; i<parsePtr->numWords ; i++) {
+	/*
+	 * Get the dictionary, and merge its pairs into the first dict (using
+	 * a small loop).
+	 */
+
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+	TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,	envPtr);
+	TclEmitInstInt1(	INST_JUMP_TRUE1, 24,		envPtr);
+	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
+	TclEmitInt4(			workerIndex,		envPtr);
+	TclAdjustStackDepth(-1, envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,	envPtr);
+	TclEmitInstInt1(	INST_JUMP_FALSE1, -20,		envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	TclEmitInstInt1(	INST_UNSET_SCALAR, 0,		envPtr);
+	TclEmitInt4(			infoIndex,		envPtr);
+    }
+    ExceptionRangeEnds(envPtr, outLoop);
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+
+    /*
+     * Clean up any state left over.
+     */
+
+    Emit14Inst(			INST_LOAD_SCALAR, workerIndex,	envPtr);
+    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
+    TclEmitInt4(			workerIndex,		envPtr);
+    TclEmitInstInt1(		INST_JUMP1, 18,			envPtr);
+
+    /*
+     * If an exception happens when starting to iterate over the second (and
+     * subsequent) dicts. This is strictly not necessary, but it is nice.
+     */
+
+    TclAdjustStackDepth(-1, envPtr);
+    ExceptionRangeTarget(envPtr, outLoop, catchOffset);
+    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
+    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
+    TclEmitInt4(			workerIndex,		envPtr);
+    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
+    TclEmitInt4(			infoIndex,		envPtr);
+    TclEmitOpcode(		INST_RETURN_STK,		envPtr);
+
     return TCL_OK;
 }
 
@@ -804,32 +1470,71 @@ TclCompileDictForCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Proc *procPtr = envPtr->procPtr;
+    return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+	    TCL_EACH_KEEP_NONE);
+}
+
+int
+TclCompileDictMapCmd(
+    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. */
+{
+    return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+	    TCL_EACH_COLLECT);
+}
+
+int
+CompileDictEachCmd(
+    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. */
+    int collect)		/* Flag == TCL_EACH_COLLECT to collect and
+				 * construct a new dictionary with the loop
+				 * body result. */
+{
+    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
-    int keyVarIndex, valueVarIndex, loopRange, catchRange;
+    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
     int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
-    int numVars, endTargetOffset, numBytes;
-    const char *bytes;
-    int savedStackDepth = envPtr->currStackDepth;
-				/* Needed because jumps confuse the stack
-				 * space calculator. */
-    Tcl_Obj *varNameObj, *varListObj = NULL;
-    DefineLineInformation;	/* TIP #280 */
+    int numVars, endTargetOffset;
+    int collectVar = -1;	/* Index of temp var holding the result
+				 * dict. */
+    const char **argv;
+    Tcl_DString buffer;
 
     /*
-     * There must be exactly three arguments after the command.
+     * There must be three arguments after the command.
      */
 
-    if (parsePtr->numWords != 4 || procPtr == NULL) {
-	return TCL_ERROR;
+    if (parsePtr->numWords != 4) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
     varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
     dictTokenPtr = TokenAfter(varsTokenPtr);
     bodyTokenPtr = TokenAfter(dictTokenPtr);
+    if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+	    bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
 
-    if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+    /*
+     * Create temporary variable to capture return values from loop body when
+     * we're collecting results.
+     */
+
+    if (collect == TCL_EACH_COLLECT) {
+	collectVar = AnonymousLocal(envPtr);
+	if (collectVar < 0) {
+	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+	}
     }
 
     /*
@@ -837,31 +1542,28 @@ TclCompileDictForCmd(
      * Then extract their indices in the LVT.
      */
 
-    varListObj = Tcl_NewObj();
-    if (!TclWordKnownAtCompileTime(varsTokenPtr, varListObj) ||
-	    TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
-	    numVars != 2) {
-	Tcl_DecrRefCount(varListObj);
-	return TCL_ERROR;
+    Tcl_DStringInit(&buffer);
+    TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
+    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
+	    &argv) != TCL_OK) {
+	Tcl_DStringFree(&buffer);
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
-
-    Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj);
-    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
-    keyVarIndex = LocalScalar(bytes, numBytes, envPtr);
-    if (keyVarIndex < 0) {
-	Tcl_DecrRefCount(varListObj);
-	return TCL_ERROR;
+    Tcl_DStringFree(&buffer);
+    if (numVars != 2) {
+	ckfree(argv);
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
 
-    Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj);
-    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
-    valueVarIndex = LocalScalar(bytes, numBytes, envPtr);
-    if (valueVarIndex < 0) {
-	Tcl_DecrRefCount(varListObj);
-	return TCL_ERROR;
-    }
+    nameChars = strlen(argv[0]);
+    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
+    nameChars = strlen(argv[1]);
+    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
+    ckfree(argv);
 
-    Tcl_DecrRefCount(varListObj);
+    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
 
     /*
      * Allocate a temporary variable to store the iterator reference. The
@@ -870,54 +1572,75 @@ TclCompileDictForCmd(
      * (at which point it should also have been finished with).
      */
 
-    infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
+    infoIndex = AnonymousLocal(envPtr);
+    if (infoIndex < 0) {
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
 
     /*
      * 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.
+     * First up, initialize the accumulator dictionary if needed.
+     */
+
+    if (collect == TCL_EACH_COLLECT) {
+	PushStringLiteral(envPtr, "");
+	Emit14Inst(	INST_STORE_SCALAR, collectVar,		envPtr);
+	TclEmitOpcode(	INST_POP,				envPtr);
+    }
+
+    /*
+     * Get the dictionary and start the iteration. No catching of errors at
+     * this point.
      */
 
     CompileWord(envPtr, dictTokenPtr, interp, 2);
-    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);
+    catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    TclEmitInstInt4(	INST_BEGIN_CATCH4, catchRange,		envPtr);
     ExceptionRangeStarts(envPtr, catchRange);
 
+    TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,		envPtr);
+    emptyTargetOffset = CurrentOffset(envPtr);
+    TclEmitInstInt4(	INST_JUMP_TRUE4, 0,			envPtr);
+
     /*
      * Inside the iteration, write the loop variables.
      */
 
     bodyTargetOffset = CurrentOffset(envPtr);
-    TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex,		envPtr);
-    TclEmitOpcode(   INST_POP,					envPtr);
-    TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex,		envPtr);
-    TclEmitOpcode(   INST_POP,					envPtr);
+    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);
+    loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     ExceptionRangeStarts(envPtr, loopRange);
 
     /*
      * Compile the loop body itself. It should be stack-neutral.
      */
 
-    SetLineInformation(3);
-    CompileBody(envPtr, bodyTokenPtr, interp);
-    TclEmitOpcode(   INST_POP,					envPtr);
+    BODY(bodyTokenPtr, 3);
+    if (collect == TCL_EACH_COLLECT) {
+	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
+	TclEmitInstInt4(INST_OVER, 1,				envPtr);
+	TclEmitInstInt4(INST_DICT_SET, 1,			envPtr);
+	TclEmitInt4(		collectVar,			envPtr);
+	TclAdjustStackDepth(-1, envPtr);
+	TclEmitOpcode(	INST_POP,				envPtr);
+    }
+    TclEmitOpcode(	INST_POP,				envPtr);
 
     /*
      * Both exception target ranges (error and loop) end here.
@@ -933,37 +1656,29 @@ TclCompileDictForCmd(
      */
 
     ExceptionRangeTarget(envPtr, loopRange, continueOffset);
-    TclEmitInstInt4( INST_DICT_NEXT, infoIndex,			envPtr);
+    TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,		envPtr);
     jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
-    TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
-    TclEmitOpcode(   INST_POP,					envPtr);
-    TclEmitOpcode(   INST_POP,					envPtr);
-
-    /*
-     * Now do the final cleanup for the no-error case (this is where we break
-     * out of the loop to) by force-terminating the iteration (if not already
-     * terminated), ditching the exception info and jumping to the last
-     * instruction for this command. In theory, this could be done using the
-     * "finally" clause (next generated) but this is faster.
-     */
-
-    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
-    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
-    TclEmitOpcode(   INST_END_CATCH,				envPtr);
+    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
     endTargetOffset = CurrentOffset(envPtr);
-    TclEmitInstInt4( INST_JUMP4, 0,				envPtr);
+    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);
 
     /*
      * Error handler "finally" clause, which force-terminates the iteration
      * and rethrows the error.
      */
 
+    TclAdjustStackDepth(-1, envPtr);
     ExceptionRangeTarget(envPtr, catchRange, catchOffset);
-    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
-    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
-    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
-    TclEmitOpcode(   INST_END_CATCH,				envPtr);
-    TclEmitOpcode(   INST_RETURN_STK,				envPtr);
+    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
+    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
+    TclEmitOpcode(	INST_END_CATCH,				envPtr);
+    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
+    TclEmitInt4(		infoIndex,			envPtr);
+    if (collect == TCL_EACH_COLLECT) {
+	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
+	TclEmitInt4(		collectVar,			envPtr);
+    }
+    TclEmitOpcode(	INST_RETURN_STK,			envPtr);
 
     /*
      * Otherwise we're done (the jump after the DICT_FIRST points here) and we
@@ -971,24 +1686,33 @@ TclCompileDictForCmd(
      * easy!) Note that we skip the END_CATCH. [Bug 1382528]
      */
 
-    envPtr->currStackDepth = savedStackDepth+2;
     jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
     TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
 	    envPtr->codeStart + emptyTargetOffset);
-    TclEmitOpcode(   INST_POP,					envPtr);
-    TclEmitOpcode(   INST_POP,					envPtr);
-    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
+    jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
+    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement,
+	    envPtr->codeStart + endTargetOffset);
+    TclEmitOpcode(	INST_POP,				envPtr);
+    TclEmitOpcode(	INST_POP,				envPtr);
+    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+    TclFinalizeLoopExceptionRange(envPtr, loopRange);
+    TclEmitOpcode(	INST_END_CATCH,				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.
+     * object (or push the accumulator as the result 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);
+    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
+    TclEmitInt4(		infoIndex,			envPtr);
+    if (collect == TCL_EACH_COLLECT) {
+	Emit14Inst(	INST_LOAD_SCALAR, collectVar,		envPtr);
+	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
+	TclEmitInt4(		collectVar,			envPtr);
+    } else {
+	PushStringLiteral(envPtr, "");
+    }
     return TCL_OK;
 }
 
@@ -1001,11 +1725,19 @@ TclCompileDictUpdateCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    DefineLineInformation;	/* TIP #280 */
     int i, dictIndex, numVars, range, infoIndex;
     Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
     DictUpdateInfo *duiPtr;
     JumpFixup jumpFixup;
-    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * There must be at least one argument after the command.
+     */
+
+    if (parsePtr->numWords < 5) {
+	return TCL_ERROR;
+    }
 
     /*
      * Parse the command. Expect the following:
@@ -1016,9 +1748,6 @@ TclCompileDictUpdateCmd(
 	return TCL_ERROR;
     }
     numVars = (parsePtr->numWords - 3) / 2;
-    if (numVars < 1) {
-	return TCL_ERROR;
-    }
 
     /*
      * The dictionary variable must be a local scalar that is knowable at
@@ -1029,7 +1758,7 @@ TclCompileDictUpdateCmd(
     dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
     dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr);
     if (dictIndex < 0) {
-	return TCL_ERROR;
+	goto issueFallback;
     }
 
     /*
@@ -1038,45 +1767,32 @@ TclCompileDictUpdateCmd(
      * that are to be used.
      */
 
-    duiPtr = (DictUpdateInfo *)
-	    ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
+    duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
     duiPtr->length = numVars;
-    keyTokenPtrs = (Tcl_Token **) TclStackAlloc(interp,
-	    sizeof(Tcl_Token *) * numVars);
+    keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
     tokenPtr = TokenAfter(dictVarTokenPtr);
 
     for (i=0 ; i<numVars ; i++) {
-	int index;
-
 	/*
 	 * Put keys to one side for later compilation to bytecode.
 	 */
 
 	keyTokenPtrs[i] = tokenPtr;
-
-	/*
-	 * Variables first need to be checked for sanity.
-	 */
-
 	tokenPtr = TokenAfter(tokenPtr);
-	index = LocalScalarFromToken(tokenPtr, envPtr);
-	if (index < 0) {
-	    ckfree((char *) duiPtr);
-	    TclStackFree(interp, keyTokenPtrs);
-	    return TCL_ERROR;
-	}
 
 	/*
-	 * Stash the index in the auxiliary data.
+	 * Stash the index in the auxiliary data (if it is indeed a local
+	 * scalar that is resolvable at compile-time).
 	 */
 
-	duiPtr->varIndices[i] = index;
+	duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr);
+	if (duiPtr->varIndices[i] < 0) {
+	    goto failedUpdateInfoAssembly;
+	}
 	tokenPtr = TokenAfter(tokenPtr);
     }
     if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	ckfree((char *) duiPtr);
-	TclStackFree(interp, keyTokenPtrs);
-	return TCL_ERROR;
+	goto failedUpdateInfoAssembly;
     }
     bodyTokenPtr = tokenPtr;
 
@@ -1085,21 +1801,20 @@ TclCompileDictUpdateCmd(
      * can't be snagged by literal sharing and forced to shimmer dangerously.
      */
 
-    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
+    infoIndex = TclCreateAuxData(duiPtr, &dictUpdateInfoType, envPtr);
 
     for (i=0 ; i<numVars ; i++) {
 	CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2);
     }
-    TclEmitInstInt4( INST_LIST, numVars,			envPtr);
-    TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex,		envPtr);
-    TclEmitInt4(     infoIndex,					envPtr);
+    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);
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);
 
     ExceptionRangeStarts(envPtr, range);
-    SetLineInformation(parsePtr->numWords - 1);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, parsePtr->numWords - 1);
     ExceptionRangeEnds(envPtr, range);
 
     /*
@@ -1107,10 +1822,10 @@ TclCompileDictUpdateCmd(
      * 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);
+    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.
@@ -1125,14 +1840,14 @@ TclCompileDictUpdateCmd(
      */
 
     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);
+    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);
+    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
+    TclEmitInt4(		infoIndex,			envPtr);
+    TclEmitInvoke(envPtr,INST_RETURN_STK);
 
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
@@ -1140,6 +1855,16 @@ TclCompileDictUpdateCmd(
     }
     TclStackFree(interp, keyTokenPtrs);
     return TCL_OK;
+
+    /*
+     * Clean up after a failure to create the DictUpdateInfo structure.
+     */
+
+  failedUpdateInfoAssembly:
+    ckfree(duiPtr);
+    TclStackFree(interp, keyTokenPtrs);
+  issueFallback:
+    return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 }
 
 int
@@ -1151,17 +1876,18 @@ TclCompileDictAppendCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr;
     int i, dictVarIndex;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
-     * There must be at least two argument after the command. Since we
-     * implement using INST_CONCAT1, make sure the number of arguments
-     * stays within its range.
+     * 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>258) {
+    /* TODO: Consider support for compiling expanded args. */
+    if (parsePtr->numWords<4 || parsePtr->numWords>100) {
 	return TCL_ERROR;
     }
 
@@ -1172,7 +1898,7 @@ TclCompileDictAppendCmd(
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
     if (dictVarIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
     }
 
     /*
@@ -1185,7 +1911,7 @@ TclCompileDictAppendCmd(
 	tokenPtr = TokenAfter(tokenPtr);
     }
     if (parsePtr->numWords > 4) {
-	TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
     }
 
     /*
@@ -1205,28 +1931,290 @@ TclCompileDictLappendCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
     int dictVarIndex;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * There must be three arguments after the command.
      */
 
+    /* TODO: Consider support for compiling expanded args. */
+    /* Probably not.  Why is INST_DICT_LAPPEND limited to one value? */
     if (parsePtr->numWords != 4) {
 	return TCL_ERROR;
     }
 
+    /*
+     * Parse the arguments.
+     */
+
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
     keyTokenPtr = TokenAfter(varTokenPtr);
     valueTokenPtr = TokenAfter(keyTokenPtr);
     dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
     if (dictVarIndex < 0) {
-	return TCL_ERROR;
+	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
     }
+
+    /*
+     * Issue the implementation.
+     */
+
     CompileWord(envPtr, keyTokenPtr, interp, 2);
     CompileWord(envPtr, valueTokenPtr, interp, 3);
-    TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
+    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 = -1, pathTmp = -1, keysTmp, gotPath;
+    int dictVar, bodyIsEmpty = 1;
+    Tcl_Token *varTokenPtr, *tokenPtr;
+    JumpFixup jumpFixup;
+    const char *ptr, *end;
+
+    /*
+     * There must be at least one argument after the command.
+     */
+
+    /* TODO: Consider support for compiling expanded args. */
+    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 TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
+     * 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 TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr,
+			envPtr);
+	    }
+	    bodyIsEmpty = 0;
+	    break;
+	}
+    }
+
+    /*
+     * Determine if we're manipulating a dict in a simple local variable.
+     */
+
+    gotPath = (parsePtr->numWords > 3);
+    dictVar = LocalScalarFromToken(varTokenPtr, 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);
+		    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);
+	    } else {
+		/*
+		 * Case: Direct dict in LVT with empty body.
+		 */
+
+		PushStringLiteral(envPtr, "");
+		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
+		PushStringLiteral(envPtr, "");
+		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
+		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+	    }
+	} 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);
+		    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);
+	    } else {
+		/*
+		 * Case: Direct dict in non-simple var with empty body.
+		 */
+
+		CompileWord(envPtr, varTokenPtr, interp, 1);
+		TclEmitOpcode(	INST_DUP,			envPtr);
+		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
+		PushStringLiteral(envPtr, "");
+		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
+		PushStringLiteral(envPtr, "");
+		TclEmitInstInt4(INST_REVERSE, 2,		envPtr);
+		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
+	    }
+	}
+	PushStringLiteral(envPtr, "");
+	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 = AnonymousLocal(envPtr);
+    }
+    if (gotPath) {
+	pathTmp = AnonymousLocal(envPtr);
+    }
+    keysTmp = AnonymousLocal(envPtr);
+
+    /*
+     * Issue instructions. First, the part to expand the dictionary.
+     */
+
+    if (dictVar == -1) {
+	CompileWord(envPtr, varTokenPtr, interp, 1);
+	Emit14Inst(		INST_STORE_SCALAR, varNameTmp,	envPtr);
+    }
+    tokenPtr = TokenAfter(varTokenPtr);
+    if (gotPath) {
+	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
+	    CompileWord(envPtr, tokenPtr, interp, i);
+	    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 {
+	PushStringLiteral(envPtr, "");
+    }
+    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
+    Emit14Inst(			INST_STORE_SCALAR, keysTmp,	envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+
+    /*
+     * Now the body of the [dict with].
+     */
+
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);
+
+    ExceptionRangeStarts(envPtr, range);
+    BODY(tokenPtr, parsePtr->numWords - 1);
+    ExceptionRangeEnds(envPtr, range);
+
+    /*
+     * Now fold the results back into the dictionary in the OK case.
+     */
+
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    if (dictVar == -1) {
+	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
+    }
+    if (gotPath) {
+	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
+    } else {
+	PushStringLiteral(envPtr, "");
+    }
+    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.
+     */
+
+    TclAdjustStackDepth(-1, envPtr);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
+    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    if (dictVar == -1) {
+	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
+    }
+    if (parsePtr->numWords > 3) {
+	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
+    } else {
+	PushStringLiteral(envPtr, "");
+    }
+    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
+    if (dictVar == -1) {
+	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
+    } else {
+	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+    }
+    TclEmitInvoke(envPtr,	INST_RETURN_STK);
+
+    /*
+     * 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;
 }
 
@@ -1242,11 +2230,13 @@ TclCompileDictLappendCmd(
  *	DupDictUpdateInfo: a copy of the auxiliary data
  *	FreeDictUpdateInfo: none
  *	PrintDictUpdateInfo: none
+ *	DisassembleDictUpdateInfo: none
  *
  * Side effects:
  *	DupDictUpdateInfo: allocates memory
  *	FreeDictUpdateInfo: releases memory
  *	PrintDictUpdateInfo: none
+ *	DisassembleDictUpdateInfo: none
  *
  *----------------------------------------------------------------------
  */
@@ -1260,7 +2250,7 @@ DupDictUpdateInfo(
 
     dui1Ptr = clientData;
     len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
-    dui2Ptr = (DictUpdateInfo *) ckalloc(len);
+    dui2Ptr = ckalloc(len);
     memcpy(dui2Ptr, dui1Ptr, len);
     return dui2Ptr;
 }
@@ -1289,6 +2279,99 @@ PrintDictUpdateInfo(
 	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
     }
 }
+
+static void
+DisassembleDictUpdateInfo(
+    ClientData clientData,
+    Tcl_Obj *dictObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    DictUpdateInfo *duiPtr = clientData;
+    int i;
+    Tcl_Obj *variables = Tcl_NewObj();
+
+    for (i=0 ; i<duiPtr->length ; i++) {
+	Tcl_ListObjAppendElement(NULL, variables,
+		Tcl_NewIntObj(duiPtr->varIndices[i]));
+    }
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
+	    variables);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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?]
+     */
+
+    Tcl_Token *tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Handle the message.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+
+    /*
+     * Construct the options. Note that -code and -level are not here.
+     */
+
+    if (parsePtr->numWords == 2) {
+	PushStringLiteral(envPtr, "");
+    } else {
+	PushStringLiteral(envPtr, "-errorinfo");
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	if (parsePtr->numWords == 3) {
+	    TclEmitInstInt4(	INST_LIST, 2,			envPtr);
+	} else {
+	    PushStringLiteral(envPtr, "-errorcode");
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp, 3);
+	    TclEmitInstInt4(	INST_LIST, 4,			envPtr);
+	}
+    }
+
+    /*
+     * Issue the error via 'returnImm error 0'.
+     */
+
+    TclEmitInstInt4(		INST_RETURN_IMM, TCL_ERROR,	envPtr);
+    TclEmitInt4(			0,			envPtr);
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -1298,8 +2381,8 @@ PrintDictUpdateInfo(
  *	Procedure called to compile the "expr" command.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "expr" command at
@@ -1343,8 +2426,8 @@ TclCompileExprCmd(
  *	Procedure called to compile the "for" command.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "for" command at
@@ -1364,9 +2447,8 @@ TclCompileForCmd(
 {
     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
-    int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
+    int bodyCodeOffset, nextCodeOffset, jumpDist;
     int bodyRange, nextRange;
-    int savedStackDepth = envPtr->currStackDepth;
     DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 5) {
@@ -1398,20 +2480,10 @@ TclCompileForCmd(
     }
 
     /*
-     * 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);
-    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
-    /*
      * Inline compile the initial command.
      */
 
-    SetLineInformation (1);
-    CompileBody(envPtr, startTokenPtr, interp);
+    BODY(startTokenPtr, 1);
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
@@ -1432,44 +2504,37 @@ TclCompileForCmd(
      * Compile the loop body.
      */
 
+    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
-    SetLineInformation (4);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, 4);
     ExceptionRangeEnds(envPtr, bodyRange);
-    envPtr->currStackDepth = savedStackDepth + 1;
     TclEmitOpcode(INST_POP, envPtr);
 
     /*
-     * Compile the "next" subcommand.
+     * Compile the "next" subcommand. Note that this exception range will not
+     * have a continueOffset (other than -1) connected to it; it won't trap
+     * TCL_CONTINUE but rather just TCL_BREAK.
      */
 
-    envPtr->currStackDepth = savedStackDepth;
+    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+    envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
     nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
-    SetLineInformation (3);
-    CompileBody(envPtr, nextTokenPtr, interp);
+    BODY(nextTokenPtr, 3);
     ExceptionRangeEnds(envPtr, nextRange);
-    envPtr->currStackDepth = savedStackDepth + 1;
     TclEmitOpcode(INST_POP, envPtr);
-    envPtr->currStackDepth = savedStackDepth;
 
     /*
      * Compile the test expression then emit the conditional jump that
      * terminates the for.
      */
 
-    testCodeOffset = CurrentOffset(envPtr);
-
-    jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+    if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
 	bodyCodeOffset += 3;
 	nextCodeOffset += 3;
-	testCodeOffset += 3;
     }
 
-    SetLineInformation (2);
-    envPtr->currStackDepth = savedStackDepth;
+    SetLineInformation(2);
     TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-    envPtr->currStackDepth = savedStackDepth + 1;
 
     jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
     if (jumpDist > 127) {
@@ -1490,13 +2555,14 @@ TclCompileForCmd(
 
     ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
     ExceptionRangeTarget(envPtr, nextRange, breakOffset);
+    TclFinalizeLoopExceptionRange(envPtr, bodyRange);
+    TclFinalizeLoopExceptionRange(envPtr, nextRange);
 
     /*
      * The for command's result is an empty string.
      */
 
-    envPtr->currStackDepth = savedStackDepth;
-    PushLiteral(envPtr, "", 0);
+    PushStringLiteral(envPtr, "");
 
     return TCL_OK;
 }
@@ -1509,8 +2575,8 @@ TclCompileForCmd(
  *	Procedure called to compile the "foreach" command.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "foreach" command at
@@ -1528,16 +2594,78 @@ TclCompileForeachCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+	    TCL_EACH_KEEP_NONE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLmapCmd --
+ *
+ *	Procedure called to compile the "lmap" 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 "lmap" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLmapCmd(
+    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. */
+{
+    return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+	    TCL_EACH_COLLECT);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompileEachloopCmd --
+ *
+ *	Procedure called to compile the "foreach" and "lmap" 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 "foreach" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompileEachloopCmd(
+    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 collect)		/* Select collecting or accumulating mode
+				 * (TCL_EACH_*) */
+{
     Proc *procPtr = envPtr->procPtr;
-    ForeachInfo *infoPtr = NULL;/* Points to the structure describing this
+    ForeachInfo *infoPtr=NULL;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
+
     Tcl_Token *tokenPtr, *bodyTokenPtr;
-    unsigned char *jumpPc;
-    JumpFixup jumpFalseFixup;
-    int jumpBackDist, jumpBackOffset, infoIndex, range;
-    int numWords, numLists, tempVar, i, j, code = TCL_OK;
-    int savedStackDepth = envPtr->currStackDepth;
+    int jumpBackOffset, infoIndex, range;
+    int numWords, numLists, i, j, code = TCL_OK;
     Tcl_Obj *varListObj = NULL;
     DefineLineInformation;	/* TIP #280 */
 
@@ -1575,12 +2703,12 @@ TclCompileForeachCmd(
      */
 
     numLists = (numWords - 2)/2;
-    infoPtr = (ForeachInfo *) ckalloc((unsigned)
-	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
+    infoPtr = ckalloc(sizeof(ForeachInfo)
+	    + (numLists - 1) * sizeof(ForeachVarList *));
     infoPtr->numLists = 0;	/* Count this up as we go */
 
     /*
-     * Parse each var list into sequence of var names. Don't
+     * Parse each var list into sequence of var names.  Don't
      * compile the foreach inline if any var name needs substitutions or isn't
      * a scalar, or if any var list needs substitutions.
      */
@@ -1598,8 +2726,8 @@ TclCompileForeachCmd(
 
 	/*
 	 * 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]
+	 * the interpreted version would not.  Take care to ensure this does
+	 * not happen.  [Bug 1671138]
 	 */
 
 	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
@@ -1609,162 +2737,108 @@ TclCompileForeachCmd(
 	    goto done;
 	}
 
-	varListPtr = (ForeachVarList *) ckalloc((unsigned)
-		sizeof(ForeachVarList) + numVars*sizeof(int));
+	varListPtr = ckalloc(sizeof(ForeachVarList)
+		+ (numVars - 1) * sizeof(int));
 	varListPtr->numVars = numVars;
 	infoPtr->varLists[i/2] = varListPtr;
 	infoPtr->numLists++;
 
 	for (j = 0;  j < numVars;  j++) {
 	    Tcl_Obj *varNameObj;
-	    int numBytes;
 	    const char *bytes;
+	    int numBytes, varIndex;
 
 	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
 	    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
-	    varListPtr->varIndexes[j] = LocalScalar(bytes, numBytes, envPtr);
-	    if (varListPtr->varIndexes[j] < 0) {
+	    varIndex = LocalScalar(bytes, numBytes, envPtr);
+	    if (varIndex < 0) {
 		code = TCL_ERROR;
 		goto done;
 	    }
+	    varListPtr->varIndexes[j] = varIndex;
 	}
 	Tcl_SetObjLength(varListObj, 0);
     }
 
     /*
-     * 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.
+     * We will compile the foreach command.
      */
 
-    tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr);
-    infoPtr->firstValueTemp = tempVar;
-    for (i= 1;  i < numLists;  i++) {
-	TclFindCompiledLocal(NULL, 0, 1, procPtr);
-    }
-    infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr);
-
-    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
 
     /*
-     * Create an exception record to handle [break] and [continue].
+     * Create the collecting object, unshared.
      */
 
-    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+    if (collect == TCL_EACH_COLLECT) {
+	TclEmitInstInt4(INST_LIST, 0, envPtr);
+    }
 
     /*
-     * Evaluate then store each value list in the associated temporary.
+     * Evaluate each value list and leave it on stack.
      */
 
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
 	    i < numWords-1;
 	    i++, tokenPtr = TokenAfter(tokenPtr)) {
 	if ((i%2 == 0) && (i > 0)) {
-	    SetLineInformation (i);
-	    CompileTokens(envPtr, tokenPtr, interp);
-	    if (tempVar <= 255) {
-		TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
-	    } else {
-		TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
-	    }
-	    TclEmitOpcode(INST_POP, envPtr);
-	    tempVar++;
+	    CompileWord(envPtr, tokenPtr, interp, i);
 	}
     }
 
-    /*
-     * Initialize the temporary var that holds the count of loop iterations.
-     */
-
-    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);
-    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+    TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
 
     /*
      * Inline compile the loop body.
      */
 
-    SetLineInformation (numWords - 1);
+    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
     ExceptionRangeStarts(envPtr, range);
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, numWords - 1);
     ExceptionRangeEnds(envPtr, range);
-    envPtr->currStackDepth = savedStackDepth + 1;
-    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
-     * 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;
-    if (jumpBackDist > 120) {
-	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+    if (collect == TCL_EACH_COLLECT) {
+	TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
     } else {
-	TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
-     * Fix the target of the jump after the foreach_step test.
+     * Bottom of loop code: assign each loop variable and check whether
+     * to terminate the loop. Set the loop's break target.
      */
 
-    if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
-	/*
-	 * Update the loop body's starting PC offset since it moved down.
-	 */
-
-	envPtr->exceptArrayPtr[range].codeOffset += 3;
-
-	/*
-	 * Update the jump back to the test at the top of the loop since it
-	 * also moved down 3 bytes.
-	 */
-
-	jumpBackOffset += 3;
-	jumpPc = (envPtr->codeStart + jumpBackOffset);
-	jumpBackDist += 3;
-	if (jumpBackDist > 120) {
-	    TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
-	} else {
-	    TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
-	}
-    }
+    ExceptionRangeTarget(envPtr, range, continueOffset);
+    TclEmitOpcode(INST_FOREACH_STEP, envPtr);
+    ExceptionRangeTarget(envPtr, range, breakOffset);
+    TclFinalizeLoopExceptionRange(envPtr, range);
+    TclEmitOpcode(INST_FOREACH_END, envPtr);
+    TclAdjustStackDepth(-(numLists+2), envPtr);
 
     /*
-     * Set the loop's break target.
+     * Set the jumpback distance from INST_FOREACH_STEP to the start of the
+     * body's code. Misuse loopCtTemp for storing the jump size.
      */
 
-    ExceptionRangeTarget(envPtr, range, breakOffset);
+    jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
+	    envPtr->exceptArrayPtr[range].codeOffset;
+    infoPtr->loopCtTemp = -jumpBackOffset;
 
     /*
-     * The foreach command's result is an empty string.
+     * The command's result is an empty string if not collecting. If
+     * collecting, it is automatically left on stack after FOREACH_END.
      */
 
-    envPtr->currStackDepth = savedStackDepth;
-    PushLiteral(envPtr, "", 0);
-    envPtr->currStackDepth = savedStackDepth + 1;
+    if (collect != TCL_EACH_COLLECT) {
+	PushStringLiteral(envPtr, "");
+    }
 
-  done:
+    done:
     if (code == TCL_ERROR) {
-	if (infoPtr) {
-	    FreeForeachInfo(infoPtr);
-	}
-    }
-    if (varListObj) {
-	Tcl_DecrRefCount(varListObj);
+	FreeForeachInfo(infoPtr);
     }
+    Tcl_DecrRefCount(varListObj);
     return code;
 }
 
@@ -1799,8 +2873,8 @@ DupForeachInfo(
     register ForeachVarList *srcListPtr, *dupListPtr;
     int numVars, i, j, numLists = srcPtr->numLists;
 
-    dupPtr = (ForeachInfo *) ckalloc((unsigned)
-	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
+    dupPtr = ckalloc(sizeof(ForeachInfo)
+	    + numLists * sizeof(ForeachVarList *));
     dupPtr->numLists = numLists;
     dupPtr->firstValueTemp = srcPtr->firstValueTemp;
     dupPtr->loopCtTemp = srcPtr->loopCtTemp;
@@ -1808,8 +2882,8 @@ DupForeachInfo(
     for (i = 0;  i < numLists;  i++) {
 	srcListPtr = srcPtr->varLists[i];
 	numVars = srcListPtr->numVars;
-	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
-		sizeof(ForeachVarList) + numVars*sizeof(int));
+	dupListPtr = ckalloc(sizeof(ForeachVarList)
+		+ numVars * sizeof(int));
 	dupListPtr->numVars = numVars;
 	for (j = 0;  j < numVars;  j++) {
 	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
@@ -1850,18 +2924,18 @@ FreeForeachInfo(
 
     for (i = 0;  i < numLists;  i++) {
 	listPtr = infoPtr->varLists[i];
-	ckfree((char *) listPtr);
+	ckfree(listPtr);
     }
-    ckfree((char *) infoPtr);
+    ckfree(infoPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * PrintForeachInfo --
+ * PrintForeachInfo, DisassembleForeachInfo --
  *
- *	Function to write a human-readable representation of a ForeachInfo
- *	structure to stdout for debugging.
+ *	Functions to write a human-readable or script-readablerepresentation
+ *	of a ForeachInfo structure to a Tcl_Obj for debugging.
  *
  * Results:
  *	None.
@@ -1911,846 +2985,141 @@ PrintForeachInfo(
 	Tcl_AppendToObj(appendObj, "]", -1);
     }
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileIfCmd --
- *
- *	Procedure called to compile the "if" 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 "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. */
-{
-    JumpFixupArray jumpFalseFixupArray;
-    				/* Used to fix the ifFalse jump after each
-				 * test when its target PC is determined. */
-    JumpFixupArray jumpEndFixupArray;
-				/* Used to fix the jump after each "then" body
-				 * to the end of the "if" when that PC is
-				 * determined. */
-    Tcl_Token *tokenPtr, *testTokenPtr;
-    int jumpIndex = 0;		/* Avoid compiler warning. */
-    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
-    const char *word;
-    int savedStackDepth = envPtr->currStackDepth;
-				/* Saved stack depth at the start of the first
-				 * 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 */
-
-    /*
-     * Only compile the "if" command if all arguments are simple words, in
-     * order to insure correct substitution [Bug 219166]
-     */
-
-    tokenPtr = parsePtr->tokenPtr;
-    wordIdx = 0;
-    numWords = parsePtr->numWords;
-
-    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TCL_ERROR;
-	}
-	tokenPtr = TokenAfter(tokenPtr);
-    }
-
-    TclInitJumpFixupArray(&jumpFalseFixupArray);
-    TclInitJumpFixupArray(&jumpEndFixupArray);
-    code = TCL_OK;
-
-    /*
-     * Each iteration of this loop compiles one "if expr ?then? body" or
-     * "elseif expr ?then? body" clause.
-     */
-
-    tokenPtr = parsePtr->tokenPtr;
-    wordIdx = 0;
-    while (wordIdx < numWords) {
-	/*
-	 * Stop looping if the token isn't "if" or "elseif".
-	 */
-
-	word = tokenPtr[1].start;
-	numBytes = tokenPtr[1].size;
-	if ((tokenPtr == parsePtr->tokenPtr)
-		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
-	    tokenPtr = TokenAfter(tokenPtr);
-	    wordIdx++;
-	} else {
-	    break;
-	}
-	if (wordIdx >= numWords) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
-
-	/*
-	 * 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.
-	     */
-
-	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
-		    testTokenPtr[1].size);
-	    Tcl_IncrRefCount(boolObj);
-	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
-	    TclDecrRefCount(boolObj);
-	    if (code == TCL_OK) {
-		/*
-		 * A static condition.
-		 */
-
-		realCond = 0;
-		if (!boolVal) {
-		    compileScripts = 0;
-		}
-	    } else {
-		SetLineInformation (wordIdx);
-		Tcl_ResetResult(interp);
-		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
-		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
-		}
-		jumpIndex = jumpFalseFixupArray.next;
-		jumpFalseFixupArray.next++;
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
-			jumpFalseFixupArray.fixup+jumpIndex);
-	    }
-	    code = TCL_OK;
-	}
-
-	/*
-	 * Skip over the optional "then" before the then clause.
-	 */
-
-	tokenPtr = TokenAfter(testTokenPtr);
-	wordIdx++;
-	if (wordIdx >= numWords) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
-	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    word = tokenPtr[1].start;
-	    numBytes = tokenPtr[1].size;
-	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
-		tokenPtr = TokenAfter(tokenPtr);
-		wordIdx++;
-		if (wordIdx >= numWords) {
-		    code = TCL_ERROR;
-		    goto done;
-		}
-	    }
-	}
-
-	/*
-	 * Compile the "then" command body.
-	 */
-
-	if (compileScripts) {
-	    SetLineInformation (wordIdx);
-	    envPtr->currStackDepth = savedStackDepth;
-	    CompileBody(envPtr, tokenPtr, interp);
-	}
-
-	if (realCond) {
-	    /*
-	     * 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);
-
-	    /*
-	     * 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)) {
-		/*
-		 * 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.
-	     */
-
-	    compileScripts = 0;
-	} else {
-	    /*
-	     * We were processing an "if 0 {...}"; reset so that the rest
-	     * (elseif, else) is compiled correctly.
-	     */
-
-	    realCond = 1;
-	    compileScripts = 1;
-	}
-
-	tokenPtr = TokenAfter(tokenPtr);
-	wordIdx++;
-    }
-
-    /*
-     * 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.
-     */
-
-    if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
-	/*
-	 * There is an else clause. Skip over the optional "else" word.
-	 */
-
-	word = tokenPtr[1].start;
-	numBytes = tokenPtr[1].size;
-	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
-	    tokenPtr = TokenAfter(tokenPtr);
-	    wordIdx++;
-	    if (wordIdx >= numWords) {
-		code = TCL_ERROR;
-		goto done;
-	    }
-	}
-
-	if (compileScripts) {
-	    /*
-	     * Compile the else command body.
-	     */
-
-	    SetLineInformation (wordIdx);
-	    CompileBody(envPtr, tokenPtr, interp);
-	}
-
-	/*
-	 * Make sure there are no words after the else clause.
-	 */
-
-	wordIdx++;
-	if (wordIdx < numWords) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
-    } else {
-	/*
-	 * No else clause: the "if" command's result is an empty string.
-	 */
-
-	if (compileScripts) {
-	    PushLiteral(envPtr, "", 0);
-	}
-    }
-
-    /*
-     * Fix the unconditional jumps to the end of the "if" command.
-     */
-
-    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
-	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
-	if (TclFixupForwardJumpToHere(envPtr,
-		jumpEndFixupArray.fixup+jumpIndex, 127)) {
-	    /*
-	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
-	     * target (just after this jump) down three bytes.
-	     */
-
-	    unsigned char *ifFalsePc = envPtr->codeStart
-		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
-	    unsigned char opCode = *ifFalsePc;
-
-	    if (opCode == INST_JUMP_FALSE1) {
-		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
-		jumpFalseDist += 3;
-		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
-	    } else if (opCode == INST_JUMP_FALSE4) {
-		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
-		jumpFalseDist += 3;
-		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
-	    } else {
-		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
-	    }
-	}
-    }
-
-    /*
-     * Free the jumpFixupArray array if malloc'ed storage was used.
-     */
-
-  done:
-    envPtr->currStackDepth = savedStackDepth + 1;
-    TclFreeJumpFixupArray(&jumpFalseFixupArray);
-    TclFreeJumpFixupArray(&jumpEndFixupArray);
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileIncrCmd --
- *
- *	Procedure called to compile the "incr" 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 "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. */
+static void
+PrintNewForeachInfo(
+    ClientData clientData,
+    Tcl_Obj *appendObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
 {
-    Tcl_Token *varTokenPtr, *incrTokenPtr;
-    int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
-    DefineLineInformation;	/* TIP #280 */
-
-    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
-	return TCL_ERROR;
-    }
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
-		    &localIndex, &simpleVarName, &isScalar, 1);
-
-    /*
-     * If an increment is given, push it, but see first if it's a small
-     * integer.
-     */
-
-    haveImmValue = 0;
-    immValue = 1;
-    if (parsePtr->numWords == 3) {
-	incrTokenPtr = TokenAfter(varTokenPtr);
-	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    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;
-	    }
-	    if (!haveImmValue) {
-		PushLiteral(envPtr, word, numBytes);
-	    }
-	} else {
-	    SetLineInformation (2);
-	    CompileTokens(envPtr, incrTokenPtr, interp);
-	}
-    } else {			/* No incr amount given so use 1. */
-	haveImmValue = 1;
-    }
-
-    /*
-     * Emit the instruction to increment the variable.
-     */
+    register ForeachInfo *infoPtr = clientData;
+    register ForeachVarList *varsPtr;
+    int i, j;
 
-    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 {
-		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
-		} else {
-		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
-		}
-	    }
-	} else {
-	    if (localIndex >= 0) {
-		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
-		    TclEmitInt1(immValue, envPtr);
-		} else {
-		    TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
-		}
-	    } else {
-		if (haveImmValue) {
-		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
-		} else {
-		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
-		}
-	    }
-	}
-    } else {			/* Non-simple variable name. */
-	if (haveImmValue) {
-	    TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
-	} else {
-	    TclEmitOpcode(INST_INCR_STK, envPtr);
+    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
+	    infoPtr->loopCtTemp);
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	if (i) {
+	    Tcl_AppendToObj(appendObj, ",", -1);
 	}
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLappendCmd --
- *
- *	Procedure called to compile the "lappend" 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 "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. */
-{
-    Tcl_Token *varTokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords;
-    DefineLineInformation;	/* TIP #280 */
-
-    /*
-     * If we're not in a procedure, don't compile.
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    numWords = parsePtr->numWords;
-    if (numWords == 1) {
-	return TCL_ERROR;
-    }
-    if (numWords != 3) {
-	/*
-	 * LAPPEND instructions currently only handle one value appends.
-	 */
-
-	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.
-     */
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-		    &localIndex, &simpleVarName, &isScalar, 1);
-
-    /*
-     * If we are doing an assignment, push the new value. In the no values
-     * case, create an empty object.
-     */
-
-    if (numWords > 2) {
-	Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
-	CompileWord(envPtr, valueTokenPtr, interp, 2);
-    }
-
-    /*
-     * Emit instructions to set/get the variable.
-     */
-
-    /*
-     * The *_STK opcodes should be refactored to make better use of existing
-     * LOAD/STORE instructions.
-     */
-
-    if (simpleVarName) {
-	if (isScalar) {
-	    if (localIndex < 0) {
-		TclEmitOpcode(INST_LAPPEND_STK, envPtr);
-	    } else if (localIndex <= 255) {
-		TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
-	    } else {
-		TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
-	    }
-	} else {
-	    if (localIndex < 0) {
-		TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
-	    } else if (localIndex <= 255) {
-		TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
-	    } else {
-		TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
+	Tcl_AppendToObj(appendObj, "[", -1);
+	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]);
 	}
-    } else {
-	TclEmitOpcode(INST_LAPPEND_STK, envPtr);
+	Tcl_AppendToObj(appendObj, "]", -1);
     }
-
-    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. */
+static void
+DisassembleForeachInfo(
+    ClientData clientData,
+    Tcl_Obj *dictObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
 {
-    Tcl_Token *tokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords, idx;
-    DefineLineInformation;	/* TIP #280 */
-
-    numWords = parsePtr->numWords;
+    register ForeachInfo *infoPtr = clientData;
+    register ForeachVarList *varsPtr;
+    int i, j;
+    Tcl_Obj *objPtr, *innerPtr;
 
     /*
-     * Check for command syntax error, but we'll punt that to runtime.
+     * Data stores.
      */
 
-    if (numWords < 3) {
-	return TCL_ERROR;
+    objPtr = Tcl_NewObj();
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	Tcl_ListObjAppendElement(NULL, objPtr,
+		Tcl_NewIntObj(infoPtr->firstValueTemp + i));
     }
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
 
     /*
-     * Generate code to push list being taken apart by [lassign].
+     * Loop counter.
      */
 
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    CompileWord(envPtr, tokenPtr, interp, 1);
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
+	   Tcl_NewIntObj(infoPtr->loopCtTemp));
 
     /*
-     * Generate code to assign values from the list to variables.
+     * Assignment targets.
      */
 
-    for (idx=0 ; idx<numWords-2 ; idx++) {
-	tokenPtr = TokenAfter(tokenPtr);
-
-	/*
-	 * Generate the next variable name.
-	 */
-
-	PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
-			&simpleVarName, &isScalar, idx+2);
-
-	/*
-	 * Emit instructions to get the idx'th item out of the list value on
-	 * the stack and assign it to the variable.
-	 */
-
-	if (simpleVarName) {
-	    if (isScalar) {
-		if (localIndex >= 0) {
-		    TclEmitOpcode(INST_DUP, envPtr);
-		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
-		    if (localIndex <= 255) {
-			TclEmitInstInt1(INST_STORE_SCALAR1,localIndex,envPtr);
-		    } else {
-			TclEmitInstInt4(INST_STORE_SCALAR4,localIndex,envPtr);
-		    }
-		} else {
-		    TclEmitInstInt4(INST_OVER, 1, envPtr);
-		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
-		    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
-		}
-	    } else {
-		if (localIndex >= 0) {
-		    TclEmitInstInt4(INST_OVER, 1, envPtr);
-		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
-		    if (localIndex <= 255) {
-			TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
-		    } else {
-			TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
-		    }
-		} else {
-		    TclEmitInstInt4(INST_OVER, 2, envPtr);
-		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
-		    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
-		}
-	    }
-	} else {
-	    TclEmitInstInt4(INST_OVER, 1, envPtr);
-	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
-	    TclEmitOpcode(INST_STORE_STK, envPtr);
+    objPtr = Tcl_NewObj();
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	innerPtr = Tcl_NewObj();
+	varsPtr = infoPtr->varLists[i];
+	for (j=0 ; j<varsPtr->numVars ; j++) {
+	    Tcl_ListObjAppendElement(NULL, innerPtr,
+		    Tcl_NewIntObj(varsPtr->varIndexes[j]));
 	}
-	TclEmitOpcode(INST_POP, envPtr);
+	Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
     }
-
-    /*
-     * Generate code to leave the rest of the list on the stack.
-     */
-
-    TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
-    TclEmitInt4(-2, envPtr);	/* -2 == "end" */
-
-    return TCL_OK;
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLindexCmd --
- *
- *	Procedure called to compile the "lindex" command.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "lindex" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
 
-int
-TclCompileLindexCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
+static void
+DisassembleNewForeachInfo(
+    ClientData clientData,
+    Tcl_Obj *dictObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
 {
-    Tcl_Token *idxTokenPtr, *valTokenPtr;
-    int i, numWords = parsePtr->numWords;
-    DefineLineInformation;	/* TIP #280 */
-
-    /*
-     * Quit if too few args.
-     */
-
-    if (numWords <= 1) {
-	return TCL_ERROR;
-    }
-
-    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if (numWords != 3) {
-	goto emitComplexLindex;
-    }
-
-    idxTokenPtr = TokenAfter(valTokenPtr);
-    if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	Tcl_Obj *tmpObj;
-	int idx, result;
-
-	tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
-	result = TclGetIntFromObj(NULL, tmpObj, &idx);
-	TclDecrRefCount(tmpObj);
-
-	if (result == TCL_OK && idx >= 0) {
-	    /*
-	     * All checks have been completed, and we have exactly this
-	     * construct:
-	     *	 lindex <arbitraryValue> <posInt>
-	     * This is best compiled as a push of the arbitrary value followed
-	     * by an "immediate lindex" which is the most efficient variety.
-	     */
-
-	    CompileWord(envPtr, valTokenPtr, interp, 1);
-	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
-	    return TCL_OK;
-	}
-
-	/*
-	 * If the conversion failed or the value was negative, we just keep on
-	 * going with the more complex compilation.
-	 */
-    }
-
-    /*
-     * Push the operands onto the stack.
-     */
-
-  emitComplexLindex:
-    for (i=1 ; i<numWords ; i++) {
-	CompileWord(envPtr, valTokenPtr, interp, i);
-	valTokenPtr = TokenAfter(valTokenPtr);
-    }
+    register ForeachInfo *infoPtr = clientData;
+    register ForeachVarList *varsPtr;
+    int i, j;
+    Tcl_Obj *objPtr, *innerPtr;
 
     /*
-     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
-     * multiple index args.
+     * Jump offset.
      */
 
-    if (numWords == 3) {
-	TclEmitOpcode(INST_LIST_INDEX, envPtr);
-    } else {
- 	TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileListCmd --
- *
- *	Procedure called to compile the "list" 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 "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. */
-{
-    DefineLineInformation;	/* TIP #280 */
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
+	   Tcl_NewIntObj(infoPtr->loopCtTemp));
 
     /*
-     * If we're not in a procedure, don't compile.
+     * Assignment targets.
      */
 
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (parsePtr->numWords == 1) {
-	/*
-	 * [list] without arguments just pushes an empty object.
-	 */
-
-	PushLiteral(envPtr, "", 0);
-    } else {
-	/*
-	 * Push the all values onto the stack.
-	 */
-
-	Tcl_Token *valueTokenPtr;
-	int i, numWords;
-
-	numWords = parsePtr->numWords;
-
-	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
-	for (i = 1; i < numWords; i++) {
-	    CompileWord(envPtr, valueTokenPtr, interp, i);
-	    valueTokenPtr = TokenAfter(valueTokenPtr);
+    objPtr = Tcl_NewObj();
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	innerPtr = Tcl_NewObj();
+	varsPtr = infoPtr->varLists[i];
+	for (j=0 ; j<varsPtr->numVars ; j++) {
+	    Tcl_ListObjAppendElement(NULL, innerPtr,
+		    Tcl_NewIntObj(varsPtr->varIndexes[j]));
 	}
-	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
+	Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
     }
-
-    return TCL_OK;
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLlengthCmd --
+ * TclCompileFormatCmd --
  *
- *	Procedure called to compile the "llength" command.
+ *	Procedure called to compile the "format" command. Handles cases that
+ *	can be done as constants or simple string concatenation only.
  *
  * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "llength" command at
+ *	Instructions are added to envPtr to execute the "format" command at
  *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLlengthCmd(
+TclCompileFormatCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
 				 * created by Tcl_ParseCommand. */
@@ -2758,2029 +3127,273 @@ TclCompileLlengthCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Tcl_Token *varTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-
-    if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
-    }
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    CompileWord(envPtr, varTokenPtr, interp, 1);
-    TclEmitOpcode(INST_LIST_LENGTH, envPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLsetCmd --
- *
- *	Procedure called to compile the "lset" 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 "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
-TclCompileLsetCmd(
-    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
-				 * command. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds the resulting instructions. */
-{
-    int tempDepth;		/* Depth used for emitting one part of the
-				 * code burst. */
-    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
-				 * parse of the variable name. */
-    int 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 */
-
-    /*
-     * Check argument count.
-     */
-
-    if (parsePtr->numWords < 3) {
-	/*
-	 * Fail at run time, not in compilation.
-	 */
-
-	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.
-     */
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-		    &localIndex, &simpleVarName, &isScalar, 1);
-
-    /*
-     * Push the "index" args and the new element value.
-     */
-
-    for (i=2 ; i<parsePtr->numWords ; ++i) {
-	varTokenPtr = TokenAfter(varTokenPtr);
-	CompileWord(envPtr, varTokenPtr, interp, i);
-    }
-
-    /*
-     * Duplicate the variable name if it's been pushed.
-     */
-
-    if (!simpleVarName || localIndex < 0) {
-	if (!simpleVarName || isScalar) {
-	    tempDepth = parsePtr->numWords - 2;
-	} else {
-	    tempDepth = parsePtr->numWords - 1;
-	}
-	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
-    }
-
-    /*
-     * Duplicate an array index if one's been pushed.
-     */
-
-    if (simpleVarName && !isScalar) {
-	if (localIndex < 0) {
-	    tempDepth = parsePtr->numWords - 1;
-	} else {
-	    tempDepth = parsePtr->numWords - 2;
-	}
-	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
-    }
-
-    /*
-     * Emit code to load the variable's value.
-     */
-
-    if (!simpleVarName) {
-	TclEmitOpcode(INST_LOAD_STK, envPtr);
-    } else if (isScalar) {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
-	} else if (localIndex < 0x100) {
-	    TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
-	}
-    } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
-	} else if (localIndex < 0x100) {
-	    TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
-	}
-    }
-
-    /*
-     * Emit the correct variety of 'lset' instruction.
-     */
-
-    if (parsePtr->numWords == 4) {
-	TclEmitOpcode(INST_LSET_LIST, envPtr);
-    } else {
-	TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
-    }
-
-    /*
-     * Emit code to put the value back in the variable.
-     */
-
-    if (!simpleVarName) {
-	TclEmitOpcode(INST_STORE_STK, envPtr);
-    } else if (isScalar) {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
-	} else if (localIndex < 0x100) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
-	}
-    } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
-	} else if (localIndex < 0x100) {
-	    TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
-	}
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileRegexpCmd --
- *
- *	Procedure called to compile the "regexp" 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 "regexp" 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. */
-{
-    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
-				 * parse of the RE or string. */
-    int i, len, nocase, exact, sawLast, simple;
-    char *str;
     DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    Tcl_Obj **objv, *formatObj, *tmpObj;
+    char *bytes, *start;
+    int i, j, len;
 
     /*
-     * We are only interested in compiling simple regexp cases. Currently
-     * supported compile cases are:
-     *   regexp ?-nocase? ?--? staticString $var
-     *   regexp ?-nocase? ?--? {^staticString$} $var
+     * Don't handle any guaranteed-error cases.
      */
 
-    if (parsePtr->numWords < 3) {
+    if (parsePtr->numWords < 2) {
 	return TCL_ERROR;
     }
 
-    simple = 0;
-    nocase = 0;
-    sawLast = 0;
-    varTokenPtr = parsePtr->tokenPtr;
-
     /*
-     * We only look for -nocase and -- as options. Everything else gets pushed
-     * to runtime execution. This is different than regexp's runtime option
-     * handling, but satisfies our stricter needs.
+     * Check if the argument words are all compile-time-known literals; that's
+     * a case we can handle by compiling to a constant.
      */
 
-    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 = (char *) varTokenPtr[1].start;
-	len = varTokenPtr[1].size;
-	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
-	    sawLast++;
-	    i++;
-	    break;
-	} else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
-	    nocase = 1;
-	} else {
-	    /*
-	     * Not an option we recognize.
-	     */
-
-	    return TCL_ERROR;
-	}
-    }
-
-    if ((parsePtr->numWords - i) != 2) {
-	/*
-	 * We don't support capturing to variables.
-	 */
-
+    formatObj = Tcl_NewObj();
+    Tcl_IncrRefCount(formatObj);
+    tokenPtr = TokenAfter(tokenPtr);
+    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
+	Tcl_DecrRefCount(formatObj);
 	return TCL_ERROR;
     }
 
-    /*
-     * Get the regexp string. If it is not a simple string or can't be
-     * converted to a glob pattern, push the word for the INST_REGEXP.
-     * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
-     */
-
-    varTokenPtr = TokenAfter(varTokenPtr);
-
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	Tcl_DString ds;
-
-	str = (char *) 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 (!simple) {
-	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
-    }
-
-    /*
-     * Push the string arg.
-     */
-
-    varTokenPtr = TokenAfter(varTokenPtr);
-    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
-
-    if (simple) {
-	if (exact && !nocase) {
-	    TclEmitOpcode(INST_STR_EQ, envPtr);
-	} else {
-	    TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
-	}
-    } else {
-	/*
-	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
-	 * that handles all the flags we want to pass.
-	 * Don't use TCL_REG_NOSUB as we may have backrefs.
-	 */
-	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
-	TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileReturnCmd --
- *
- *	Procedure called to compile the "return" 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 "return" 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. */
-{
-    /*
-     * 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);
-
-	CompileWord(envPtr, optsTokenPtr, interp, 2);
-	CompileWord(envPtr, msgTokenPtr,  interp, 3);
-	TclEmitOpcode(INST_RETURN_STK, envPtr);
-	return TCL_OK;
-    }
-
-    /*
-     * Allocate some working space.
-     */
-
-    objv = (Tcl_Obj **) TclStackAlloc(interp,
-	    numOptionWords * sizeof(Tcl_Obj *));
-
-    /*
-     * Scan through the return options. If any are unknown at compile time,
-     * there is no value in bytecompiling. Save the option values known in an
-     * objv array for merging into a return options dictionary.
-     */
-
-    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;
+    objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
+    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	objv[i] = Tcl_NewObj();
+	Tcl_IncrRefCount(objv[i]);
+	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
+	    goto checkForStringConcatCase;
 	}
-	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.
-	 */
-
-	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.
+     * Everything is a literal, so the result is constant too (or an error if
+     * the format is broken). Do the format now.
      */
 
-    if (explicitResult) {
-	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
-    } else {
-	/*
-	 * No explict result argument, so default result is empty string.
-	 */
-
-	PushLiteral(envPtr, "", 0);
+    tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj),
+	    parsePtr->numWords-2, objv);
+    for (; --i>=0 ;) {
+	Tcl_DecrRefCount(objv[i]);
     }
-
-    /*
-     * Check for optimization: When [return] is in a proc, and there's no
-     * enclosing [catch], and there are no return options, then the INST_DONE
-     * instruction is equivalent, and may be more efficient.
-     */
-
-    if (numOptionWords == 0 && envPtr->procPtr != NULL) {
-	/*
-	 * We have default return options and we're in a proc ...
-	 */
-
-	int index = envPtr->exceptArrayNext - 1;
-	int enclosingCatch = 0;
-
-	while (index >= 0) {
-	    ExceptionRange range = envPtr->exceptArrayPtr[index];
-	    if ((range.type == CATCH_EXCEPTION_RANGE)
-		    && (range.catchOffset == -1)) {
-		enclosingCatch = 1;
-		break;
-	    }
-	    index--;
-	}
-	if (!enclosingCatch) {
-	    /*
-	     * ... and there is no enclosing catch. Issue the maximally
-	     * efficient exit instruction.
-	     */
-
-	    Tcl_DecrRefCount(returnOpts);
-	    TclEmitOpcode(INST_DONE, envPtr);
-	    return TCL_OK;
-	}
-    }
-
-    /* Optimize [return -level 0 $x]. */
-    Tcl_DictObjSize(NULL, returnOpts, &size);
-    if (size == 0 && level == 0 && code == TCL_OK) {
-	Tcl_DecrRefCount(returnOpts);
+    ckfree(objv);
+    Tcl_DecrRefCount(formatObj);
+    if (tmpObj == NULL) {
+	TclCompileSyntaxError(interp, envPtr);
 	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);
-
-    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
-    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
-	    Tcl_GetReturnOptions(interp, TCL_ERROR));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, TCL_CREATE_VAR,
-		    &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.
+     * Not an error, always a constant result, so just push the result as a
+     * literal. Job done.
      */
 
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    CompileWord(envPtr, tokenPtr, interp, 1);
-    tokenPtr = TokenAfter(tokenPtr);
-    CompileWord(envPtr, tokenPtr, interp, 2);
-    TclEmitOpcode(INST_STR_EQ, envPtr);
+    bytes = Tcl_GetStringFromObj(tmpObj, &len);
+    PushLiteral(envPtr, bytes, len);
+    Tcl_DecrRefCount(tmpObj);
     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);
-    }
 
+  checkForStringConcatCase:
     /*
-     * Push the strings to match against each other.
-     */
-
-    for (i = 0; i < 2; i++) {
-	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    str = tokenPtr[1].start;
-	    length = tokenPtr[1].size;
-	    if (!nocase && (i == 0)) {
-		/*
-		 * Trivial matches can be done by 'string equal'. If -nocase
-		 * was specified, we can't do this because INST_STR_EQ has no
-		 * support for nocase.
-		 */
-
-		Tcl_Obj *copy = Tcl_NewStringObj(str, length);
-
-		Tcl_IncrRefCount(copy);
-		exactMatch = TclMatchIsTrivial(TclGetString(copy));
-		TclDecrRefCount(copy);
-	    }
-	    PushLiteral(envPtr, str, length);
-	} else {
-	    SetLineInformation (i+1+nocase);
-	    CompileTokens(envPtr, tokenPtr, interp);
-	}
-	tokenPtr = TokenAfter(tokenPtr);
-    }
-
-    /*
-     * Push the matcher.
-     */
-
-    if (exactMatch) {
-	TclEmitOpcode(INST_STR_EQ, envPtr);
-    } else {
-	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileStringLenCmd --
- *
- *	Procedure called to compile the simplest and most common form of the
- *	"string length" command.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "string length"
- *	command at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileStringLenCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Token *tokenPtr;
-
-    if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
-    }
-
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	/*
-	 * Here someone is asking for the length of a static string. Just push
-	 * the actual character (not byte) length.
-	 */
-
-	char buf[TCL_INTEGER_SPACE];
-	int len = Tcl_NumUtfChars(tokenPtr[1].start, tokenPtr[1].size);
-
-	len = sprintf(buf, "%d", len);
-	PushLiteral(envPtr, buf, len);
-    } else {
-	SetLineInformation (1);
-	CompileTokens(envPtr, tokenPtr, interp);
-	TclEmitOpcode(INST_STR_LEN, envPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileSwitchCmd --
- *
- *	Procedure called to compile the "switch" command.
- *
- * Results:
- * 	Returns TCL_OK for successful compile, or TCL_ERROR to defer
- * 	evaluation to runtime (either when it is too complex to get the
- * 	semantics right, or when we know for sure that it is an error but need
- * 	the error to happen at the right time).
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "switch" command at
- *	runtime.
- *
- * FIXME:
- *	Stack depths are probably not calculated correctly.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileSwitchCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *tokenPtr;	/* Pointer to tokens in command. */
-    int numWords;		/* Number of words in command. */
-
-    Tcl_Token *valueTokenPtr;	/* Token for the value to switch on. */
-    enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
-				/* What kind of switch are we doing? */
-
-    Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
-    Tcl_Token **bodyToken;	/* Array of pointers to pattern list items. */
-    int *bodyLines;		/* Array of line numbers for body list
-				 * items. */
-    int** bodyNext;
-    int foundDefault;		/* Flag to indicate whether a "default" clause
-				 * is present. */
-
-    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
-    int *fixupTargetArray;	/* Array of places for fixups to point at. */
-    int fixupCount;		/* Number of places to fix up. */
-    int contFixIndex;		/* Where the first of the jumps due to a group
-				 * of continuation bodies starts, or -1 if
-				 * there aren't any. */
-    int contFixCount;		/* Number of continuation bodies pointing to
-				 * the current (or next) real body. */
-
-    int savedStackDepth = envPtr->currStackDepth;
-    int noCase;			/* Has the -nocase flag been given? */
-    int foundMode = 0;		/* Have we seen a mode flag yet? */
-    int i, valueIndex;
-    DefineLineInformation;	/* TIP #280 */
-    int* clNext = envPtr->clNext;
-
-    /*
-     * Only handle the following versions:
-     *   switch         ?--? word {pattern body ...}
-     *   switch -exact  ?--? word {pattern body ...}
-     *   switch -glob   ?--? word {pattern body ...}
-     *   switch -regexp ?--? word {pattern body ...}
-     *   switch         --   word simpleWordPattern simpleWordBody ...
-     *   switch -exact  --   word simpleWordPattern simpleWordBody ...
-     *   switch -glob   --   word simpleWordPattern simpleWordBody ...
-     *   switch -regexp --   word simpleWordPattern simpleWordBody ...
-     * When the mode is -glob, can also handle a -nocase flag.
+     * See if we can generate a sequence of things to concatenate. This
+     * requires that all the % sequences be %s or %%, as everything else is
+     * sufficiently complex that we don't bother.
      *
-     * First off, we don't care how the command's word was generated; we're
-     * compiling it anyway! So skip it...
+     * First, get the state of the system relatively sensible (cleaning up
+     * after our attempt to spot a literal).
      */
 
-    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;
+    for (; i>=0 ; i--) {
+	Tcl_DecrRefCount(objv[i]);
     }
-    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. */
+    ckfree(objv);
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
     tokenPtr = TokenAfter(tokenPtr);
-    numWords--;
+    i = 0;
 
     /*
-     * 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.
+     * Now scan through and check for non-%s and non-%% substitutions.
      */
 
-    if (numWords == 1) {
-	CONST char *bytes;
-	int maxLen, numBytes;
-	int bline;		/* TIP #280: line of the pattern/action list,
-				 * and start of list for when tracking the
-				 * location. This list comes immediately after
-				 * the value we switch on. */
-
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TCL_ERROR;
-	}
-	bytes = tokenPtr[1].start;
-	numBytes = tokenPtr[1].size;
-
-	/* Allocate enough space to work in. */
-	maxLen = TclMaxListLength(bytes, numBytes, NULL);
-	if (maxLen < 2) {
-	    return TCL_ERROR;
-	}
-	bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * maxLen);
-	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * maxLen);
-	bodyLines = (int *) ckalloc(sizeof(int) * maxLen);
-	bodyNext  = (int **) ckalloc(sizeof(int*) * maxLen);
-
-	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
-	numWords = 0;
-
-	while (numBytes > 0) {
-	    CONST char *prevBytes = bytes;
-	    int literal;
-
-	    if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
-		    &(bodyTokenArray[numWords].start), &bytes,
-		    &(bodyTokenArray[numWords].size), &literal) || !literal) {
-		goto abort;
+    for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) {
+	if (*bytes == '%') {
+	    bytes++;
+	    if (*bytes == 's') {
+		i++;
+		continue;
+	    } else if (*bytes == '%') {
+		continue;
 	    }
-
-	    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;
-	    bodyNext[numWords] = clNext;
-	    TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
-	    TclAdvanceContinuations (&bline, &clNext, bytes - envPtr->source);
-
-	    numBytes -= (bytes - prevBytes);
-	    numWords++;
-	}
-	if (numWords % 2) {
-	abort:
-	    ckfree((char *) bodyToken);
-	    ckfree((char *) bodyTokenArray);
-	    ckfree((char *) bodyLines);
-	    ckfree((char *) bodyNext);
+	    Tcl_DecrRefCount(formatObj);
 	    return TCL_ERROR;
 	}
-    } else if (numWords % 2 || numWords == 0) {
-	/*
-	 * Odd number of words (>1) available, or no words at all available.
-	 * Both are error cases, so punt and let the interpreted-version
-	 * generate the error message. Note that the second case probably
-	 * should get caught earlier, but it's easy to check here again anyway
-	 * because it'd cause a nasty crash otherwise.
-	 */
-
-	return TCL_ERROR;
-    } else {
-	/*
-	 * Multi-word definition of patterns & actions.
-	 */
-
-	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
-	bodyLines = (int *) ckalloc(sizeof(int) * numWords);
-	bodyNext  = (int **) ckalloc(sizeof(int*) * numWords);
-	bodyTokenArray = NULL;
-	for (i=0 ; i<numWords ; i++) {
-	    /*
-	     * 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) {
-		ckfree((char *) bodyToken);
-		ckfree((char *) bodyLines);
-		ckfree((char *) bodyNext);
-		return TCL_ERROR;
-	    }
-	    bodyToken[i] = tokenPtr+1;
-
-	    /*
-	     * TIP #280: Copy line information from regular cmd info.
-	     */
-
-	    bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
-	    bodyNext[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).
+     * Check if the number of things to concatenate will fit in a byte.
      */
 
-    if (bodyToken[numWords-1]->size == 1 &&
-	    bodyToken[numWords-1]->start[0] == '-') {
-	ckfree((char *) bodyToken);
-	ckfree((char *) bodyLines);
-	ckfree((char *) bodyNext);
-	if (bodyTokenArray != NULL) {
-	    ckfree((char *) bodyTokenArray);
-	}
+    if (i+2 != parsePtr->numWords || i > 125) {
+	Tcl_DecrRefCount(formatObj);
 	return TCL_ERROR;
     }
 
     /*
-     * Now we commit to generating code; the parsing stage per se is done.
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation (valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
-     * Check if we can generate a jump table, since if so that's faster than
-     * doing an explicit compare with each body. Note that we're definitely
-     * over-conservative with determining whether we can do the jump table,
-     * but it handles the most common case well enough.
+     * Generate the pushes of the things to concatenate, a sequence of
+     * literals and compiled tokens (of which at least one is non-literal or
+     * we'd have the case in the first half of this function) which we will
+     * concatenate.
      */
 
-    if (mode == Switch_Exact) {
-	JumptableInfo *jtPtr;
-	int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
-	int mustGenerate, jumpToDefault;
-	Tcl_DString buffer;
-	Tcl_HashEntry *hPtr;
-
-	/*
-	 * Compile the switch by using a jump table, which is basically a
-	 * hashtable that maps from literal values to match against to the
-	 * offset (relative to the INST_JUMP_TABLE instruction) to jump to.
-	 * The jump table itself is independent of any invokation of the
-	 * bytecode, and as such is stored in an auxData block.
-	 *
-	 * Start by allocating the jump table itself, plus some workspace.
-	 */
-
-	jtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo));
-	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
-	infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
-	finalFixups = (int *) ckalloc(sizeof(int) * (numWords/2));
-	foundDefault = 0;
-	mustGenerate = 1;
-
-	/*
-	 * Next, issue the instruction to do the jump, together with what we
-	 * want to do if things do not work out (jump to either the default
-	 * clause or the "default" default, which just sets the result to
-	 * empty). Note that we will come back and rewrite the jump's offset
-	 * parameter when we know what it should be, and that all jumps we
-	 * issue are of the wide kind because that makes the code much easier
-	 * to debug!
-	 */
-
-	jumpLocation = CurrentOffset(envPtr);
-	TclEmitInstInt4(INST_JUMP_TABLE, infoIndex, envPtr);
-	jumpToDefault = CurrentOffset(envPtr);
-	TclEmitInstInt4(INST_JUMP4, 0, envPtr);
-
-	for (i=0 ; i<numWords ; i+=2) {
-	    /*
-	     * For each arm, we must first work out what to do with the match
-	     * term.
-	     */
-
-	    if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
-		    memcmp(bodyToken[numWords-2]->start, "default", 7)) {
-		/*
-		 * This is not a default clause, so insert the current
-		 * location as a target in the jump table (assuming it isn't
-		 * already there, which would indicate that this clause is
-		 * probably masked by an earlier one). Note that we use a
-		 * Tcl_DString here simply because the hash API does not let
-		 * us specify the string length.
-		 */
-
-		Tcl_DStringInit(&buffer);
-		Tcl_DStringAppend(&buffer, bodyToken[i]->start,
-			bodyToken[i]->size);
-		hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
-			Tcl_DStringValue(&buffer), &isNew);
-		if (isNew) {
-		    /*
-		     * First time we've encountered this match clause, so it
-		     * must point to here.
-		     */
-
-		    Tcl_SetHashValue(hPtr, (ClientData)
-			    (CurrentOffset(envPtr) - jumpLocation));
-		}
-		Tcl_DStringFree(&buffer);
+    i = 0;			/* The count of things to concat. */
+    j = 2;			/* The index into the argument tokens, for
+				 * TIP#280 handling. */
+    start = Tcl_GetString(formatObj);
+				/* The start of the currently-scanned literal
+				 * in the format string. */
+    tmpObj = Tcl_NewObj();	/* The buffer used to accumulate the literal
+				 * being built. */
+    for (bytes = start ; *bytes ; bytes++) {
+	if (*bytes == '%') {
+	    Tcl_AppendToObj(tmpObj, start, bytes - start);
+	    if (*++bytes == '%') {
+		Tcl_AppendToObj(tmpObj, "%", 1);
 	    } 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 = bodyNext[i+1];	/* TIP #280 */
-	    TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
-
-	    /*
-	     * Compile a jump in to the end of the command if this body is
-	     * anything other than a user-supplied default arm (to either skip
-	     * over the remaining bodies or the code that generates an empty
-	     * result).
-	     */
-
-	    if (i+2 < numWords || !foundDefault) {
-		finalFixups[numRealBodies++] = CurrentOffset(envPtr);
+		char *b = Tcl_GetStringFromObj(tmpObj, &len);
 
 		/*
-		 * Easier by far to issue this jump as a fixed-width jump.
-		 * Otherwise we'd need to do a lot more (and more awkward)
-		 * rewriting when we fixed this all up.
+		 * If there is a non-empty literal from the format string,
+		 * push it and reset.
 		 */
 
-		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.
-	 */
-
-	ckfree((char *) finalFixups);
-	ckfree((char *) bodyToken);
-	ckfree((char *) bodyLines);
-	ckfree((char *) bodyNext);
-	if (bodyTokenArray != NULL) {
-	    ckfree((char *) bodyTokenArray);
-	}
-	return TCL_OK;
-    }
-
-    /*
-     * Generate a test for each arm.
-     */
-
-    contFixIndex = -1;
-    contFixCount = 0;
-    fixupArray = (JumpFixup *) ckalloc(sizeof(JumpFixup) * numWords);
-    fixupTargetArray = (int *) ckalloc(sizeof(int) * numWords);
-    memset(fixupTargetArray, 0, numWords * sizeof(int));
-    fixupCount = 0;
-    foundDefault = 0;
-    for (i=0 ; i<numWords ; i+=2) {
-	int nextArmFixupIndex = -1;
-
-	envPtr->currStackDepth = savedStackDepth + 1;
-	if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
-		memcmp(bodyToken[numWords-2]->start, "default", 7)) {
-	    /*
-	     * Generate the test for the arm.
-	     */
-
-	    switch (mode) {
-	    case Switch_Exact:
-		TclEmitOpcode(INST_DUP, envPtr);
-		TclCompileTokens(interp, bodyToken[i], 1, envPtr);
-		TclEmitOpcode(INST_STR_EQ, envPtr);
-		break;
-	    case Switch_Glob:
-		TclCompileTokens(interp, bodyToken[i], 1, envPtr);
-		TclEmitInstInt4(INST_OVER, 1, envPtr);
-		TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
-		break;
-	    case Switch_Regexp: {
-		int simple = 0, exact = 0;
+		if (len > 0) {
+		    PushLiteral(envPtr, b, len);
+		    Tcl_DecrRefCount(tmpObj);
+		    tmpObj = Tcl_NewObj();
+		    i++;
+		}
 
 		/*
-		 * Keep in sync with TclCompileRegexpCmd.
+		 * Push the code to produce the string that would be
+		 * substituted with %s, except we'll be concatenating
+		 * directly.
 		 */
 
-		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) {
-		    if (exact && !noCase) {
-			TclEmitOpcode(INST_STR_EQ, envPtr);
-		    } else {
-			TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
-		    }
-		} else {
-		    /*
-		     * Pass correct RE compile flags. We use only Int1
-		     * (8-bit), but that handles all the flags we want to
-		     * pass. Don't use TCL_REG_NOSUB as we may have backrefs
-		     * or capture vars.
-		     */
-
-		    int cflags = TCL_REG_ADVANCED
-			    | (noCase ? TCL_REG_NOCASE : 0);
-
-		    TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
-		}
-		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 = bodyNext[i+1];		/* TIP #280 */
-	TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
-
-	if (!foundDefault) {
-	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-		    fixupArray+fixupCount);
-	    fixupCount++;
-	    fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr);
-	}
-    }
-
-    /*
-     * Clean up all our temporary space and return.
-     */
-
-    ckfree((char *) bodyToken);
-    ckfree((char *) bodyLines);
-    ckfree((char *) bodyNext);
-    if (bodyTokenArray != NULL) {
-	ckfree((char *) bodyTokenArray);
-    }
-
-    /*
-     * Discard the value we are matching against unless we've had a default
-     * clause (in which case it will already be gone due to the code at the
-     * start of processing an arm, guaranteed) and make the result of the
-     * command an empty string.
-     */
-
-    if (!foundDefault) {
-	TclEmitOpcode(INST_POP, envPtr);
-	PushLiteral(envPtr, "", 0);
-    }
-
-    /*
-     * Do jump fixups for arms that were executed. First, fill in the jumps of
-     * all jumps that don't point elsewhere to point to here.
-     */
-
-    for (i=0 ; i<fixupCount ; i++) {
-	if (fixupTargetArray[i] == 0) {
-	    fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart;
-	}
-    }
-
-    /*
-     * Now scan backwards over all the jumps (all of which are forward jumps)
-     * doing each one. When we do one and there is a size changes, we must
-     * scan back over all the previous ones and see if they need adjusting
-     * before proceeding with further jump fixups (the interleaved nature of
-     * all the jumps makes this impossible to do without nested loops).
-     */
-
-    for (i=fixupCount-1 ; i>=0 ; i--) {
-	if (TclFixupForwardJump(envPtr, &fixupArray[i],
-		fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) {
-	    int j;
-
-	    for (j=i-1 ; j>=0 ; j--) {
-		if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
-		    fixupTargetArray[j] += 3;
-		}
-	    }
-	}
-    }
-    ckfree((char *) fixupArray);
-    ckfree((char *) fixupTargetArray);
-
-    envPtr->currStackDepth = savedStackDepth + 1;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = (JumptableInfo *)
-	    ckalloc(sizeof(JumptableInfo));
-    Tcl_HashEntry *hPtr, *newHPtr;
-    Tcl_HashSearch search;
-    int isNew;
-
-    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
-    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
-    while (hPtr != NULL) {
-	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
-		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
-	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
-    }
-    return newJtPtr;
-}
-
-static void
-FreeJumptableInfo(
-    ClientData clientData)
-{
-    JumptableInfo *jtPtr = clientData;
-
-    Tcl_DeleteHashTable(&jtPtr->hashTable);
-    ckfree((char *) jtPtr);
-}
-
-static void
-PrintJumptableInfo(
-    ClientData clientData,
-    Tcl_Obj *appendObj,
-    ByteCode *codePtr,
-    unsigned int pcOffset)
-{
-    register JumptableInfo *jtPtr = clientData;
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch search;
-    const char *keyPtr;
-    int offset, i = 0;
-
-    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
-    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
-	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
-	offset = PTR2INT(Tcl_GetHashValue(hPtr));
-
-	if (i++) {
-	    Tcl_AppendToObj(appendObj, ", ", -1);
-	    if (i%4==0) {
-		Tcl_AppendToObj(appendObj, "\n\t\t", -1);
+		CompileWord(envPtr, tokenPtr, interp, j);
+		tokenPtr = TokenAfter(tokenPtr);
+		j++;
+		i++;
 	    }
+	    start = bytes + 1;
 	}
-	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
-		keyPtr, pcOffset + offset);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
+     * Handle the case of a trailing literal.
      */
 
-    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;
-	}
+    Tcl_AppendToObj(tmpObj, start, bytes - start);
+    bytes = Tcl_GetStringFromObj(tmpObj, &len);
+    if (len > 0) {
+	PushLiteral(envPtr, bytes, len);
+	i++;
     }
+    Tcl_DecrRefCount(tmpObj);
+    Tcl_DecrRefCount(formatObj);
 
-    /*
-     * 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 {
+    if (i > 1) {
 	/*
-	 * Make sure that the first command in the body is preceded by an
-	 * INST_START_CMD, and hence counted properly. [Bug 1752146]
+	 * Do the concatenation, which produces the result.
 	 */
 
-	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);
-	}
+	TclEmitInstInt1(INST_STR_CONCAT1, i, 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;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * LocalScalar(FromToken) --
+ * TclLocalScalarFromToken --
  *
  *	Get the index into the table of compiled locals that corresponds
  *	to a local scalar variable name.
  *
  * Results:
  * 	Returns the non-negative integer index value into the table of
- *	compiled locals corresponding to a local scalar variable name.
- *	If the arguments passed in do not identify a local scalar variable
- *	then return -1.
+ * 	compiled locals corresponding to a local scalar variable name.
+ * 	If the arguments passed in do not identify a local scalar variable
+ * 	then return -1.
  *
  * Side effects:
- *	May add an entry into the table of compiled locals.
+ *	May add an entery into the table of compiled locals.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-LocalScalarFromToken(
+int
+TclLocalScalarFromToken(
     Tcl_Token *tokenPtr,
     CompileEnv *envPtr)
 {
-    int isSimple, isScalar, index;
+    int isScalar, index;
 
-    PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &index,
-	    &isSimple, &isScalar, 0 /* ignored */, NULL /* ignored */);
+    TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
     if (!isScalar) {
 	index = -1;
     }
     return index;
 }
 
-static int
-LocalScalar(
+int
+TclLocalScalar(
     const char *bytes,
     int numBytes,
     CompileEnv *envPtr)
 {
-    Tcl_Token token[2] =	{{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
-				 {TCL_TOKEN_TEXT, NULL, 0, 0}};
+    Tcl_Token token[2] =        {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
+                                 {TCL_TOKEN_TEXT, NULL, 0, 0}};
 
     token[1].start = bytes;
     token[1].size = numBytes;
-    return LocalScalarFromToken(token, envPtr);
+    return TclLocalScalarFromToken(token, envPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * PushVarName --
+ * TclPushVarName --
  *
  *	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 values written to *localIndexPtr and *isScalarPtr signal to
+ *	the caller what the instructions emitted by this routine will do:
+ *
+ *	*isScalarPtr	(*localIndexPtr < 0)
+ *	1		1	Push the varname on the stack. (Stack +1)
+ *	1		0	*localIndexPtr is the index of the compiled
+ *				local for this varname.  No instructions
+ *				emitted.	(Stack +0)
+ *	0		1	Push part1 and part2 names of array element
+ *				on the stack.	(Stack +2)
+ *	0		0	*localIndexPtr is the index of the compiled
+ *				local for this array.  Element name is pushed
+ *				on the stack.	(Stack +1)
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "set" command at
- *	runtime.
+ *	Instructions are added to envPtr.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-PushVarName(
+void
+TclPushVarName(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Token *varTokenPtr,	/* Points to a variable token. */
     CompileEnv *envPtr,		/* Holds resulting instructions. */
-    int flags,			/* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX. */
+    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
     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 */
+    int *isScalarPtr)		/* Must not be NULL. */
 {
     register const char *p;
     const char *name, *elName;
@@ -4826,14 +3439,13 @@ PushVarName(
 		}
 	    }
 
-	    if (interp && (elName != NULL) && elNameChars) {
+	    if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
 		/*
 		 * An array element, the element name is a simple string:
 		 * assemble the corresponding token.
 		 */
 
-		elemTokenPtr = (Tcl_Token *) TclStackAlloc(interp,
-			sizeof(Tcl_Token));
+		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -4846,7 +3458,6 @@ PushVarName(
 	    && (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.
 	 */
@@ -4869,9 +3480,9 @@ PushVarName(
 	     */
 
 	    if (varTokenPtr[n].size == 1) {
-		--n;
+		n--;
 	    } else {
-		--varTokenPtr[n].size;
+		varTokenPtr[n].size--;
 		removedParen = n;
 	    }
 
@@ -4881,14 +3492,14 @@ PushVarName(
 	    remainingChars = (varTokenPtr[2].start - p) - 1;
 	    elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
 
-	    if (remainingChars) {
+	    if (!(flags & TCL_NO_ELEMENT)) {
+	      if (remainingChars) {
 		/*
 		 * Make a first token with the extra characters in the first
 		 * token.
 		 */
 
-		elemTokenPtr = (Tcl_Token *) TclStackAlloc(interp,
-			n * sizeof(Tcl_Token));
+		elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -4902,13 +3513,14 @@ PushVarName(
 
 		memcpy(elemTokenPtr+1, varTokenPtr+2,
 			(n-1) * sizeof(Tcl_Token));
-	    } else {
+	      } else {
 		/*
 		 * Use the already available tokens.
 		 */
 
 		elemTokenPtr = &varTokenPtr[2];
 		elemTokenCount = n - 1;
+	      }
 	    }
 	}
     }
@@ -4919,6 +3531,7 @@ PushVarName(
 	 */
 
 	int hasNsQualifiers = 0;
+
 	for (i = 0, p = name;  i < nameChars;  i++, p++) {
 	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
 		hasNsQualifiers = 1;
@@ -4932,10 +3545,8 @@ PushVarName(
 	 * push its name and look it up at runtime.
 	 */
 
-	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
-	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    /*create*/ flags & TCL_CREATE_VAR,
-		    envPtr->procPtr);
+	if (!hasNsQualifiers) {
+	    localIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
 	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
 		/*
 		 * We'll push the name.
@@ -4949,16 +3560,16 @@ PushVarName(
 	}
 
 	/*
-	 * Compile the element script, if any.
+	 * Compile the element script, if any, and only if not inhibited. [Bug
+	 * 3600328]
 	 */
 
-	if (interp && elName != NULL) {
+	if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
 	    if (elNameChars) {
-		envPtr->line = line;
-		envPtr->clNext = clNext;
-		TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
+		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
+			envPtr);
 	    } else {
-		PushLiteral(envPtr, "", 0);
+		PushStringLiteral(envPtr, "");
 	    }
 	}
     } else if (interp) {
@@ -4966,1415 +3577,17 @@ PushVarName(
 	 * 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;
+	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->procPtr);
-	int words;
-
-	tokenPtr = TokenAfter(parsePtr->tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, 1);
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, 2);
-	if (tmpIndex <= 255) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
-	}
-	TclEmitOpcode(instruction, envPtr);
-	for (words=3 ; words<parsePtr->numWords ;) {
-	    if (tmpIndex <= 255) {
-		TclEmitInstInt1(INST_LOAD_SCALAR1, tmpIndex, envPtr);
-	    } else {
-		TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr);
-	    }
-	    tokenPtr = TokenAfter(tokenPtr);
-	    CompileWord(envPtr, tokenPtr, interp, words);
-	    if (++words < parsePtr->numWords) {
-		if (tmpIndex <= 255) {
-		    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
-		}
-	    }
-	    TclEmitOpcode(instruction, envPtr);
-	}
-	for (; words>3 ; words--) {
-	    TclEmitOpcode(INST_BITAND, envPtr);
-	}
-
-	/*
-	 * Drop the value from the temp variable; retaining that reference
-	 * might be expensive elsewhere.
-	 */
-
-	PushLiteral(envPtr, "", 0);
-	if (tmpIndex <= 255) {
-	    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
-	} else {
-	    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
-	}
-	TclEmitOpcode(INST_POP, envPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompile*OpCmd --
- *
- *	Procedures called to compile the corresponding "::tcl::mathop::*"
- *	commands. These are all wrappers around the utility operator command
- *	compiler functions, except for the compilers for subtraction and
- *	division, which are special.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the compiled command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileInvertOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
-}
-
-int
-TclCompileNotOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
-}
-
-int
-TclCompileAddOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
-	    envPtr);
-}
-
-int
-TclCompileMulOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
-	    envPtr);
-}
-
-int
-TclCompileAndOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
-	    envPtr);
-}
-
-int
-TclCompileOrOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
-	    envPtr);
-}
-
-int
-TclCompileXorOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
-	    envPtr);
-}
-
-int
-TclCompilePowOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    /*
-     * This one has its own implementation because the ** operator is
-     * the only one with right associativity.
-     */
-    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-    int words;
-
-    for (words=1 ; words<parsePtr->numWords ; words++) {
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, words);
-    }
-    if (parsePtr->numWords <= 2) {
-	PushLiteral(envPtr, "1", 1);
-	words++;
-    }
-    while (--words > 1) {
-	TclEmitOpcode(INST_EXPON, envPtr);
-    }
-    return TCL_OK;
-}
-
-int
-TclCompileLshiftOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
-}
-
-int
-TclCompileRshiftOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
-}
-
-int
-TclCompileModOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
-}
-
-int
-TclCompileNeqOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
-}
-
-int
-TclCompileStrneqOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
-}
-
-int
-TclCompileInOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
-}
-
-int
-TclCompileNiOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
-	    envPtr);
-}
-
-int
-TclCompileLessOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
-}
-
-int
-TclCompileLeqOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
-}
-
-int
-TclCompileGreaterOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
-}
-
-int
-TclCompileGeqOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
-}
-
-int
-TclCompileEqOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
-}
-
-int
-TclCompileStreqOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
-}
-
-int
-TclCompileMinusOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-    int words;
-
-    if (parsePtr->numWords == 1) {
-	/* Fallback to direct eval to report syntax error */
-	return TCL_ERROR;
-    }
-    for (words=1 ; words<parsePtr->numWords ; words++) {
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, words);
-    }
-    if (words == 2) {
-	TclEmitOpcode(INST_UMINUS, envPtr);
-	return TCL_OK;
-    }
-    if (words == 3) {
-	TclEmitOpcode(INST_SUB, envPtr);
-	return TCL_OK;
-    }
-    /*
-     * Reverse order of arguments to get precise agreement with
-     * [expr] in calcuations, including roundoff errors.
-     */
-    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
-    while (--words > 1) {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	TclEmitOpcode(INST_SUB, envPtr);
-    }
-    return TCL_OK;
-}
-
-int
-TclCompileDivOpCmd(
-    Tcl_Interp *interp,
-    Tcl_Parse *parsePtr,
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)
-{
-    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-    int words;
-
-    if (parsePtr->numWords == 1) {
-	/* Fallback to direct eval to report syntax error */
-	return TCL_ERROR;
-    }
-    if (parsePtr->numWords == 2) {
-	PushLiteral(envPtr, "1.0", 3);
-    }
-    for (words=1 ; words<parsePtr->numWords ; words++) {
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, words);
-    }
-    if (words <= 3) {
-	TclEmitOpcode(INST_DIV, envPtr);
-	return TCL_OK;
-    }
-    /*
-     * Reverse order of arguments to get precise agreement with
-     * [expr] in calcuations, including roundoff errors.
-     */
-    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
-    while (--words > 1) {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	TclEmitOpcode(INST_DIV, envPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * IndexTailVarIfKnown --
- *
- *	Procedure used in compiling [global] and [variable] commands. It
- *	inspects the variable name described by varTokenPtr and, if the tail
- *	is known at compile time, defines a corresponding local variable.
- *
- * Results:
- * 	Returns the variable's index in the table of compiled locals if the
- *      tail is known at compile time, or -1 otherwise.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-IndexTailVarIfKnown(
-    Tcl_Interp *interp,
-    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Obj *tailPtr;
-    const char *tailName, *p;
-    int len, n = varTokenPtr->numComponents;
-    Tcl_Token *lastTokenPtr;
-    int full, localIndex;
-
-    /*
-     * Determine if the tail is (a) known at compile time, and (b) not an
-     * array element. Should any of these fail, return an error so that
-     * the non-compiled command will be called at runtime.
-     * In order for the tail to be known at compile time, the last token
-     * in the word has to be constant and contain "::" if it is not the
-     * only one.
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return -1;
-    }
-
-    TclNewObj(tailPtr);
-    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
-	full = 1;
-	lastTokenPtr = varTokenPtr;
-    } else {
-	full = 0;
-	lastTokenPtr = varTokenPtr + n;
-	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
-	    Tcl_DecrRefCount(tailPtr);
-	    return -1;
-	}
-    }
-
-    tailName = TclGetStringFromObj(tailPtr, &len);
-
-    if (len) {
-	if (*(tailName+len-1) == ')') {
-	    /*
-	     * Possible array: bail out
-	     */
-
-	    Tcl_DecrRefCount(tailPtr);
-	    return -1;
-	}
-
-	/*
-	 * Get the tail: immediately after the last '::'
-	 */
-
-	for(p = tailName + len -1; p > tailName; p--) {
-	    if ((*p == ':') && (*(p-1) == ':')) {
-		p++;
-		break;
-	    }
-	}
-	if (!full && (p == tailName)) {
-	    /*
-	     * No :: in the last component
-	     */
-	    Tcl_DecrRefCount(tailPtr);
-	    return -1;
-	}
-	len -= p - tailName;
-	tailName = p;
-    }
-
-    localIndex = TclFindCompiledLocal(tailName, len,
-	    /*create*/ TCL_CREATE_VAR,
-	    envPtr->procPtr);
-    Tcl_DecrRefCount(tailPtr);
-    return localIndex;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileUpvarCmd --
- *
- *	Procedure called to compile the "upvar" command.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "upvar" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileUpvarCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
-    int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Obj *objPtr;
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    numWords = parsePtr->numWords;
-    if (numWords < 3) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Push the frame index if it is known at compile time
-     */
-
-    objPtr = Tcl_NewObj();
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if(TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
-	CallFrame *framePtr;
-	Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr;
-
-	/*
-	 * Attempt to convert to a level reference. Note that TclObjGetFrame
-	 * only changes the obj type when a conversion was successful.
-	 */
-
-	TclObjGetFrame(interp, objPtr, &framePtr);
-	newTypePtr = objPtr->typePtr;
-	Tcl_DecrRefCount(objPtr);
-
-	if (newTypePtr != typePtr) {
-	    if(numWords%2) {
-		return TCL_ERROR;
-	    }
-	    /* TODO: Push the known value instead? */
-	    CompileWord(envPtr, tokenPtr, interp, 1);
-	    otherTokenPtr = TokenAfter(tokenPtr);
-	    i = 2;
-	} else {
-	    if(!(numWords%2)) {
-		return TCL_ERROR;
-	    }
-	    PushLiteral(envPtr, "1", 1);
-	    otherTokenPtr = tokenPtr;
-	    i = 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, i);
-	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
-	if (localIndex < 0) {
-	    return TCL_ERROR;
-	}
-	TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
-    }
-
-    /*
-     * Pop the frame index, and set the result to empty
-     */
-
-    TclEmitOpcode(INST_POP, envPtr);
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileNamespaceCmd --
- *
- *	Procedure called to compile the "namespace" command; currently, only
- *	the subcommand "namespace upvar" is compiled to bytecodes.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "namespace upvar"
- *      command at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileNamespaceCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
-    int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Only compile [namespace upvar ...]: needs an odd number of args, >=5
-     */
-
-    numWords = parsePtr->numWords;
-    if (!(numWords%2) || (numWords < 5)) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Check if the second argument is "upvar"
-     */
-
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if ((tokenPtr->size != 5)  /* 5 == strlen("upvar") */
-	    || strncmp(tokenPtr->start, "upvar", 5)) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Push the namespace
-     */
-
-    tokenPtr = TokenAfter(tokenPtr);
-    CompileWord(envPtr, tokenPtr, interp, 2);
-
-    /*
-     * 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, i);
-	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
-	if (localIndex < 0) {
-	    return TCL_ERROR;
-	}
-	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
-    }
-
-    /*
-     * Pop the namespace, and set the result to empty
-     */
-
-    TclEmitOpcode(INST_POP, envPtr);
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileGlobalCmd --
- *
- *	Procedure called to compile the "global" command.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "global" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileGlobalCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *varTokenPtr;
-    int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
-
-    numWords = parsePtr->numWords;
-    if (numWords < 2) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 'global' has no effect outside of proc bodies; handle that at runtime
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Push the namespace
-     */
-
-    PushLiteral(envPtr, "::", 2);
-
-    /*
-     * Loop over the variables.
-     */
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    for(i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
-	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
-
-	if(localIndex < 0) {
-	    return TCL_ERROR;
-	}
-
-	/* TODO: Consider what values can pass through the
-	 * IndexTailVarIfKnown() screen.  Full CompileWord()
-	 * likely does not apply here.  Push known value instead. */
-	CompileWord(envPtr, varTokenPtr, interp, i);
-	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
-    }
-
-    /*
-     * Pop the namespace, and set the result to empty
-     */
-
-    TclEmitOpcode(INST_POP, envPtr);
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileVariableCmd --
- *
- *	Procedure called to compile the "variable" command.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "variable" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileVariableCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *varTokenPtr, *valueTokenPtr;
-    int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
-
-    numWords = parsePtr->numWords;
-    if (numWords < 2) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Bail out if not compiling a proc body
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Loop over the (var, value) pairs.
-     */
-
-    valueTokenPtr = parsePtr->tokenPtr;
-    for(i=1; i<numWords; i+=2) {
-	varTokenPtr = TokenAfter(valueTokenPtr);
-	valueTokenPtr = TokenAfter(varTokenPtr);
-
-	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
-
-	if(localIndex < 0) {
-	    return TCL_ERROR;
-	}
-
-	/* TODO: Consider what values can pass through the
-	 * IndexTailVarIfKnown() screen.  Full CompileWord()
-	 * likely does not apply here.  Push known value instead. */
-	CompileWord(envPtr, varTokenPtr, interp, i);
-	TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr);
-
-	if (i != numWords-1) {
-	    /*
-	     * A value has been given: set the variable, pop the value
-	     */
-
-	    CompileWord(envPtr, valueTokenPtr, interp, i+1);
-	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
-	    TclEmitOpcode(INST_POP, envPtr);
-	}
-    }
-
-    /*
-     * Set the result to empty
-     */
-
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileEnsemble --
- *
- *	Procedure called to compile an ensemble command. Note that most
- *	ensembles are not compiled, since modifying a compiled ensemble causes
- *	a invalidation of all existing bytecode (expensive!) which is not
- *	normally warranted.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the subcommands of the
- *	ensemble at runtime if a compile-time mapping is possible.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileEnsemble(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *tokenPtr;
-    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
-    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
-    Tcl_Parse synthetic;
-    int len, numBytes, result, flags = 0, i;
-    const char *word;
-    DefineLineInformation;
-
-    if (parsePtr->numWords < 2) {
-	return TCL_ERROR;
-    }
-
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	/*
-	 * Too hard.
-	 */
-
-	return TCL_ERROR;
-    }
-
-    word = tokenPtr[1].start;
-    numBytes = tokenPtr[1].size;
-
-    /*
-     * There's a sporting chance we'll be able to compile this. But now we
-     * must check properly. To do that, check that we're compiling an ensemble
-     * that has a compilable command as its appropriate subcommand.
-     */
-
-    if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
-	    || mapObj == NULL) {
-	/*
-	 * Either not an ensemble or a mapping isn't installed. Crud. Too hard
-	 * to proceed.
-	 */
-
-	return TCL_ERROR;
-    }
-
-    /*
-     * Next, get the flags. We need them on several code paths.
-     */
-
-    (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags);
-
-    /*
-     * Check to see if there's also a subcommand list; must check to see if
-     * the subcommand we are calling is in that list if it exists, since that
-     * list filters the entries in the map.
-     */
-
-    (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
-    if (listObj != NULL) {
-	int sclen;
-	const char *str;
-	Tcl_Obj *matchObj = NULL;
-
-	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	for (i=0 ; i<len ; i++) {
-	    str = Tcl_GetStringFromObj(elems[i], &sclen);
-	    if (sclen==numBytes && !memcmp(word, str, (unsigned) numBytes)) {
-		/*
-		 * Exact match! Excellent!
-		 */
-
-		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
-		if (result != TCL_OK || targetCmdObj == NULL) {
-		    return TCL_ERROR;
-		}
-		goto doneMapLookup;
-	    }
-
-	    /*
-	     * Check to see if we've got a prefix match. A single prefix match
-	     * is fine, and allows us to refine our dictionary lookup, but
-	     * multiple prefix matches is a Bad Thing and will prevent us from
-	     * making progress. Note that we cannot do the lookup immediately
-	     * in the prefix case; might be another entry later in the list
-	     * that causes things to fail.
-	     */
-
-	    if ((flags & TCL_ENSEMBLE_PREFIX)
-		    && strncmp(word, str, (unsigned) numBytes) == 0) {
-		if (matchObj != NULL) {
-		    return TCL_ERROR;
-		}
-		matchObj = elems[i];
-	    }
-	}
-	if (matchObj != NULL) {
-	    result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
-	    if (result != TCL_OK || targetCmdObj == NULL) {
-		return TCL_ERROR;
-	    }
-	    goto doneMapLookup;
-	}
-	return TCL_ERROR;
-    } else {
-	/*
-	 * No map, so check the dictionary directly.
-	 */
-
-	TclNewStringObj(subcmdObj, word, numBytes);
-	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
-	TclDecrRefCount(subcmdObj);
-	if (result == TCL_OK && targetCmdObj != NULL) {
-	    /*
-	     * Got it. Skip the fiddling around with prefixes.
-	     */
-
-	    goto doneMapLookup;
-	}
-
-	/*
-	 * We've not literally got a valid subcommand. But maybe we have a
-	 * prefix. Check if prefix matches are allowed.
-	 */
-
-	if (flags & TCL_ENSEMBLE_PREFIX) {
-	    Tcl_DictSearch s;
-	    int done, matched;
-	    Tcl_Obj *tmpObj;
-
-	    /*
-	     * Iterate over the keys in the dictionary, checking to see if
-	     * we're a prefix.
-	     */
-
-	    Tcl_DictObjFirst(NULL,mapObj,&s,&subcmdObj,&tmpObj,&done);
-	    matched = 0;
-	    while (!done) {
-		if (strncmp(TclGetString(subcmdObj), word,
-			(unsigned) numBytes) == 0) {
-		    if (matched++) {
-			/*
-			 * Must have matched twice! Not unique, so no point
-			 * looking further.
-			 */
-
-			break;
-		    }
-		    targetCmdObj = tmpObj;
-		}
-		Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
-	    }
-	    Tcl_DictObjDone(&s);
-
-	    /*
-	     * If we have anything other than a single match, we've failed the
-	     * unique prefix check.
-	     */
-
-	    if (matched != 1) {
-		return TCL_ERROR;
-	    }
-	} else {
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * OK, we definitely map to something. But what?
-     *
-     * The command we map to is the first word out of the map element. Note
-     * that we also reject dealing with multi-element rewrites if we are in a
-     * safe interpreter, as there is otherwise a (highly gnarly!) way to make
-     * Tcl crash open to exploit.
-     */
-
-  doneMapLookup:
-    if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (len > 1 && Tcl_IsSafe(interp)) {
-	return TCL_ERROR;
-    }
-    targetCmdObj = elems[0];
-
-    Tcl_IncrRefCount(targetCmdObj);
-    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
-    TclDecrRefCount(targetCmdObj);
-    if (cmdPtr == NULL || cmdPtr->compileProc == NULL
-	    || cmdPtr->flags & CMD_HAS_EXEC_TRACES
-	    || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
-	/*
-	 * Maps to an undefined command or a command without a compiler.
-	 * Cannot compile.
-	 */
-
-	return TCL_ERROR;
-    }
-
-    /*
-     * Now we've done the mapping process, can now actually try to compile.
-     * We do this by handing off to the subcommand's actual compiler. But to
-     * do that, we have to perform some trickery to rewrite the arguments.
-     */
-
-    TclParseInit(interp, NULL, 0, &synthetic);
-    synthetic.numWords = parsePtr->numWords - 2 + len;
-    TclGrowParseTokenArray(&synthetic, 2*len);
-    synthetic.numTokens = 2*len;
-
-    /*
-     * Now we have the space to work in, install something rewritten. Note
-     * that we are here praying for all our might that none of these words are
-     * a script; the error detection code will crash if that happens and there
-     * is nothing we can do to avoid it!
-     */
-
-    for (i=0 ; i<len ; i++) {
-	int sclen;
-	const char *str = Tcl_GetStringFromObj(elems[i], &sclen);
-
-	synthetic.tokenPtr[2*i].type = TCL_TOKEN_SIMPLE_WORD;
-	synthetic.tokenPtr[2*i].start = str;
-	synthetic.tokenPtr[2*i].size = sclen;
-	synthetic.tokenPtr[2*i].numComponents = 1;
-
-	synthetic.tokenPtr[2*i+1].type = TCL_TOKEN_TEXT;
-	synthetic.tokenPtr[2*i+1].start = str;
-	synthetic.tokenPtr[2*i+1].size = sclen;
-	synthetic.tokenPtr[2*i+1].numComponents = 0;
-    }
-
-    /*
-     * Copy over the real argument tokens.
-     */
-
-    for (i=len; i<synthetic.numWords; i++) {
-	int toCopy;
-	tokenPtr = TokenAfter(tokenPtr);
-	toCopy = tokenPtr->numComponents + 1;
-	TclGrowParseTokenArray(&synthetic, toCopy);
-	memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
-		sizeof(Tcl_Token) * toCopy);
-	synthetic.numTokens += toCopy;
-    }
-
-    /*
-     * Hand off compilation to the subcommand compiler. At last!
-     */
-
-    mapPtr->loc[eclIndex].line++;
-    mapPtr->loc[eclIndex].next++;
-
-    result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
-
-    mapPtr->loc[eclIndex].line--;
-    mapPtr->loc[eclIndex].next--;
-
-    /*
-     * Clean up if necessary.
-     */
-
-    Tcl_FreeParse(&synthetic);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileInfoExistsCmd --
- *
- *	Procedure called to compile the "info exists" subcommand.
- *
- * Results:
- * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- * 	evaluation to runtime.
- *
- * Side effects:
- *	Instructions are added to envPtr to execute the "info exists"
- *	subcommand at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileInfoExistsCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    Command *cmdPtr,		/* Points to defintion of command being
-				 * compiled. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *tokenPtr;
-    int isScalar, simpleVarName, localIndex;
-    DefineLineInformation;	/* TIP #280 */
-
-    if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Decide if we can use a frame slot for the var/array name or if we need
-     * to emit code to compute and push the name at runtime. We use a frame
-     * slot (entry in the array of local vars) if we are compiling a procedure
-     * body and if the name is simple text that does not include namespace
-     * qualifiers.
-     */
-
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
-		    &simpleVarName, &isScalar, 1);
-
-    /*
-     * Emit instruction to check the variable for existence.
-     */
-
-    if (simpleVarName) {
-	if (isScalar) {
-	    if (localIndex < 0) {
-		TclEmitOpcode(INST_EXIST_STK, envPtr);
-	    } else {
-		TclEmitInstInt4(INST_EXIST_SCALAR, localIndex, envPtr);
-	    }
-	} else {
-	    if (localIndex < 0) {
-		TclEmitOpcode(INST_EXIST_ARRAY_STK, envPtr);
-	    } else {
-		TclEmitInstInt4(INST_EXIST_ARRAY, localIndex, envPtr);
-	    }
-	}
-    } else {
-	TclEmitOpcode(INST_EXIST_STK, envPtr);
-    }
-
-    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
new file mode 100644
index 0000000..ffe39ba
--- /dev/null
+++ b/generic/tclCompCmdsGR.c
@@ -0,0 +1,3188 @@
+/*
+ * tclCompCmdsGR.c --
+ *
+ *	This file contains compilation procedures that compile various Tcl
+ *	commands (beginning with the letters 'g' through 'r') 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-2013 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"
+#include <assert.h>
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+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);
+
+#define INDEX_END	(-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ *	Parse a token and get the encoded version of the index (as understood
+ *	by TEBC), assuming it is at all knowable at compile time. Only handles
+ *	indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ *	Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+    Tcl_Token *tokenPtr,
+    int *index)
+{
+    Tcl_Obj *tmpObj = Tcl_NewObj();
+    int result, idx;
+
+    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+	Tcl_DecrRefCount(tmpObj);
+	return TCL_ERROR;
+    }
+
+    result = TclGetIntFromObj(NULL, tmpObj, &idx);
+    if (result == TCL_OK) {
+	if (idx < 0) {
+	    result = TCL_ERROR;
+	}
+    } else {
+	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+	if (result == TCL_OK && idx > INDEX_END) {
+	    result = TCL_ERROR;
+	}
+    }
+    Tcl_DecrRefCount(tmpObj);
+
+    if (result == TCL_OK) {
+	*index = idx;
+    }
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+
+    /* TODO: Consider support for compiling expanded args. */
+    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
+     */
+
+    PushStringLiteral(envPtr, "::");
+
+    /*
+     * Loop over the variables.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
+	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+	if (localIndex < 0) {
+	    return TCL_ERROR;
+	}
+
+	/* TODO: Consider what value can pass throug the
+	 * IndexTailVarIfKnown() screen.  Full CompileWord()
+	 * likely does not apply here.  Push known value instead. */
+	CompileWord(envPtr, varTokenPtr, interp, i);
+	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
+    }
+
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(		INST_POP,			envPtr);
+    PushStringLiteral(envPtr, "");
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIfCmd --
+ *
+ *	Procedure called to compile the "if" 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 "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. */
+{
+    JumpFixupArray jumpFalseFixupArray;
+				/* Used to fix the ifFalse jump after each
+				 * test when its target PC is determined. */
+    JumpFixupArray jumpEndFixupArray;
+				/* Used to fix the jump after each "then" body
+				 * to the end of the "if" when that PC is
+				 * determined. */
+    Tcl_Token *tokenPtr, *testTokenPtr;
+    int jumpIndex = 0;		/* Avoid compiler warning. */
+    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
+    const char *word;
+    int realCond = 1;		/* Set to 0 for static conditions:
+				 * "if 0 {..}" */
+    int boolVal;		/* Value of static condition. */
+    int compileScripts = 1;
+    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * Only compile the "if" command if all arguments are simple words, in
+     * order to insure correct substitution [Bug 219166]
+     */
+
+    tokenPtr = parsePtr->tokenPtr;
+    wordIdx = 0;
+    numWords = parsePtr->numWords;
+
+    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+
+    TclInitJumpFixupArray(&jumpFalseFixupArray);
+    TclInitJumpFixupArray(&jumpEndFixupArray);
+    code = TCL_OK;
+
+    /*
+     * Each iteration of this loop compiles one "if expr ?then? body" or
+     * "elseif expr ?then? body" clause.
+     */
+
+    tokenPtr = parsePtr->tokenPtr;
+    wordIdx = 0;
+    while (wordIdx < numWords) {
+	/*
+	 * Stop looping if the token isn't "if" or "elseif".
+	 */
+
+	word = tokenPtr[1].start;
+	numBytes = tokenPtr[1].size;
+	if ((tokenPtr == parsePtr->tokenPtr)
+		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+	    tokenPtr = TokenAfter(tokenPtr);
+	    wordIdx++;
+	} else {
+	    break;
+	}
+	if (wordIdx >= numWords) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+
+	/*
+	 * Compile the test expression then emit the conditional jump around
+	 * the "then" part.
+	 */
+
+	testTokenPtr = tokenPtr;
+
+	if (realCond) {
+	    /*
+	     * 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);
+	    if (code == TCL_OK) {
+		/*
+		 * A static condition.
+		 */
+
+		realCond = 0;
+		if (!boolVal) {
+		    compileScripts = 0;
+		}
+	    } else {
+		SetLineInformation(wordIdx);
+		Tcl_ResetResult(interp);
+		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
+		}
+		jumpIndex = jumpFalseFixupArray.next;
+		jumpFalseFixupArray.next++;
+		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+			jumpFalseFixupArray.fixup+jumpIndex);
+	    }
+	    code = TCL_OK;
+	}
+
+	/*
+	 * Skip over the optional "then" before the then clause.
+	 */
+
+	tokenPtr = TokenAfter(testTokenPtr);
+	wordIdx++;
+	if (wordIdx >= numWords) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    word = tokenPtr[1].start;
+	    numBytes = tokenPtr[1].size;
+	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
+		tokenPtr = TokenAfter(tokenPtr);
+		wordIdx++;
+		if (wordIdx >= numWords) {
+		    code = TCL_ERROR;
+		    goto done;
+		}
+	    }
+	}
+
+	/*
+	 * Compile the "then" command body.
+	 */
+
+	if (compileScripts) {
+	    BODY(tokenPtr, wordIdx);
+	}
+
+	if (realCond) {
+	    /*
+	     * 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);
+
+	    /*
+	     * 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.
+	     */
+
+	    TclAdjustStackDepth(-1, envPtr);
+	    if (TclFixupForwardJumpToHere(envPtr,
+		    jumpFalseFixupArray.fixup+jumpIndex, 120)) {
+		/*
+		 * Adjust the code offset for the proceeding jump to the end
+		 * of the "if" command.
+		 */
+
+		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+	    }
+	} else if (boolVal) {
+	    /*
+	     * We were processing an "if 1 {...}"; stop compiling scripts.
+	     */
+
+	    compileScripts = 0;
+	} else {
+	    /*
+	     * We were processing an "if 0 {...}"; reset so that the rest
+	     * (elseif, else) is compiled correctly.
+	     */
+
+	    realCond = 1;
+	    compileScripts = 1;
+	}
+
+	tokenPtr = TokenAfter(tokenPtr);
+	wordIdx++;
+    }
+
+    /*
+     * 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)) {
+	/*
+	 * There is an else clause. Skip over the optional "else" word.
+	 */
+
+	word = tokenPtr[1].start;
+	numBytes = tokenPtr[1].size;
+	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
+	    tokenPtr = TokenAfter(tokenPtr);
+	    wordIdx++;
+	    if (wordIdx >= numWords) {
+		code = TCL_ERROR;
+		goto done;
+	    }
+	}
+
+	if (compileScripts) {
+	    /*
+	     * Compile the else command body.
+	     */
+
+	    BODY(tokenPtr, wordIdx);
+	}
+
+	/*
+	 * Make sure there are no words after the else clause.
+	 */
+
+	wordIdx++;
+	if (wordIdx < numWords) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+    } else {
+	/*
+	 * No else clause: the "if" command's result is an empty string.
+	 */
+
+	if (compileScripts) {
+	    PushStringLiteral(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)) {
+	    /*
+	     * 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;
+	    unsigned char opCode = *ifFalsePc;
+
+	    if (opCode == INST_JUMP_FALSE1) {
+		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
+	    } else if (opCode == INST_JUMP_FALSE4) {
+		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
+		jumpFalseDist += 3;
+		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
+	    } else {
+		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
+	    }
+	}
+    }
+
+    /*
+     * Free the jumpFixupArray array if malloc'ed storage was used.
+     */
+
+  done:
+    TclFreeJumpFixupArray(&jumpFalseFixupArray);
+    TclFreeJumpFixupArray(&jumpEndFixupArray);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIncrCmd --
+ *
+ *	Procedure called to compile the "incr" 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 "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. */
+{
+    Tcl_Token *varTokenPtr, *incrTokenPtr;
+    int isScalar, localIndex, haveImmValue, immValue;
+    DefineLineInformation;	/* TIP #280 */
+
+    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+	return TCL_ERROR;
+    }
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
+	    &localIndex, &isScalar, 1);
+
+    /*
+     * If an increment is given, push it, but see first if it's a small
+     * integer.
+     */
+
+    haveImmValue = 0;
+    immValue = 1;
+    if (parsePtr->numWords == 3) {
+	incrTokenPtr = TokenAfter(varTokenPtr);
+	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    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;
+	    }
+	    if (!haveImmValue) {
+		PushLiteral(envPtr, word, numBytes);
+	    }
+	} else {
+	    SetLineInformation(2);
+	    CompileTokens(envPtr, incrTokenPtr, interp);
+	}
+    } else {			/* No incr amount given so use 1. */
+	haveImmValue = 1;
+    }
+
+    /*
+     * Emit the instruction to increment the variable.
+     */
+
+    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_STK_IMM, immValue, envPtr);
+	    } else {
+		TclEmitOpcode(	INST_INCR_STK,		envPtr);
+	    }
+	}
+    } else {			/* Simple array variable. */
+	if (localIndex >= 0) {
+	    if (haveImmValue) {
+		TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
+		TclEmitInt1(immValue, envPtr);
+	    } else {
+		TclEmitInstInt1(INST_INCR_ARRAY1, localIndex,	envPtr);
+	    }
+	} else {
+	    if (haveImmValue) {
+		TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
+	    } else {
+		TclEmitOpcode(	INST_INCR_ARRAY_STK,		envPtr);
+	    }
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileInfo*Cmd --
+ *
+ *	Procedures called to compile "info" subcommands.
+ *
+ * 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" subcommand at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileInfoCommandsCmd(
+    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)
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    Tcl_Obj *objPtr;
+    char *bytes;
+
+    /*
+     * We require one compile-time known argument for the case we can compile.
+     */
+
+    if (parsePtr->numWords == 1) {
+	return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    } else if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    objPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(objPtr);
+    if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	goto notCompilable;
+    }
+    bytes = Tcl_GetString(objPtr);
+
+    /*
+     * We require that the argument start with "::" and not have any of "*\[?"
+     * in it. (Theoretically, we should look in only the final component, but
+     * the difference is so slight given current naming practices.)
+     */
+
+    if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
+	goto notCompilable;
+    }
+    Tcl_DecrRefCount(objPtr);
+
+    /*
+     * Confirmed as a literal that will not frighten the horses. Compile. Note
+     * that the result needs to be list-ified.
+     */
+
+    /* TODO: Just push the known value */
+    CompileWord(envPtr, tokenPtr,		interp, 1);
+    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
+    TclEmitOpcode(	INST_DUP,		envPtr);
+    TclEmitOpcode(	INST_STR_LEN,		envPtr);
+    TclEmitInstInt1(	INST_JUMP_FALSE1, 7,	envPtr);
+    TclEmitInstInt4(	INST_LIST, 1,		envPtr);
+    return TCL_OK;
+
+  notCompilable:
+    Tcl_DecrRefCount(objPtr);
+    return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileInfoCoroutineCmd(
+    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. */
+{
+    /*
+     * Only compile [info coroutine] without arguments.
+     */
+
+    if (parsePtr->numWords != 1) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Not much to do; we compile to a single instruction...
+     */
+
+    TclEmitOpcode(		INST_COROUTINE_NAME,		envPtr);
+    return TCL_OK;
+}
+
+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, 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, &isScalar, 1);
+
+    /*
+     * Emit instruction to check the variable for existence.
+     */
+
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(	INST_EXIST_STK,			envPtr);
+	} else {
+	    TclEmitInstInt4(	INST_EXIST_SCALAR, localIndex,	envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(	INST_EXIST_ARRAY_STK,		envPtr);
+	} else {
+	    TclEmitInstInt4(	INST_EXIST_ARRAY, localIndex,	envPtr);
+	}
+    }
+
+    return TCL_OK;
+}
+
+int
+TclCompileInfoLevelCmd(
+    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. */
+{
+    /*
+     * Only compile [info level] without arguments or with a single argument.
+     */
+
+    if (parsePtr->numWords == 1) {
+	/*
+	 * Not much to do; we compile to a single instruction...
+	 */
+
+	TclEmitOpcode(		INST_INFO_LEVEL_NUM,		envPtr);
+    } else if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    } else {
+	DefineLineInformation;	/* TIP #280 */
+
+	/*
+	 * Compile the argument, then add the instruction to convert it into a
+	 * list of arguments.
+	 */
+
+	CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
+	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
+    }
+    return TCL_OK;
+}
+
+int
+TclCompileInfoObjectClassCmd(
+    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)
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    CompileWord(envPtr,		tokenPtr,		interp, 1);
+    TclEmitOpcode(		INST_TCLOO_CLASS,	envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileInfoObjectIsACmd(
+    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)
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * We only handle [info object isa object <somevalue>]. The first three
+     * words are compressed to a single token by the ensemble compilation
+     * engine.
+     */
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1
+	    || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(tokenPtr);
+
+    /*
+     * Issue the code.
+     */
+
+    CompileWord(envPtr,		tokenPtr,		interp, 2);
+    TclEmitOpcode(		INST_TCLOO_IS_OBJECT,	envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileInfoObjectNamespaceCmd(
+    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)
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    CompileWord(envPtr,		tokenPtr,		interp, 1);
+    TclEmitOpcode(		INST_TCLOO_NS,		envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLappendCmd --
+ *
+ *	Procedure called to compile the "lappend" 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 "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. */
+{
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    int isScalar, localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    /* TODO: Consider support for compiling expanded args. */
+    numWords = parsePtr->numWords;
+    if (numWords < 3) {
+	return TCL_ERROR;
+    }
+
+    if (numWords != 3 || envPtr->procPtr == NULL) {
+	goto lappendMultiple;
+    }
+
+    /*
+     * 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, &isScalar, 1);
+
+    /*
+     * 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);
+    }
+
+    /*
+     * Emit instructions to set/get the variable.
+     */
+
+    /*
+     * The *_STK opcodes should be refactored to make better use of existing
+     * LOAD/STORE instructions.
+     */
+
+    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;
+
+  lappendMultiple:
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar, 1);
+    valueTokenPtr = TokenAfter(varTokenPtr);
+    for (i = 2 ; i < numWords ; i++) {
+	CompileWord(envPtr, valueTokenPtr, interp, i);
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    TclEmitInstInt4(	    INST_LIST, numWords-2,		envPtr);
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(  INST_LAPPEND_LIST_STK,		envPtr);
+	} else {
+	    TclEmitInstInt4(INST_LAPPEND_LIST, localIndex,	envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(  INST_LAPPEND_LIST_ARRAY_STK,	envPtr);
+	} else {
+	    TclEmitInstInt4(INST_LAPPEND_LIST_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 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,
+		&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 (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);
+	    } else {
+		TclEmitInstInt4(INST_OVER, 1,			envPtr);
+		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
+		TclEmitOpcode(	INST_STORE_STK,			envPtr);
+		TclEmitOpcode(	INST_POP,			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);
+	    } else {
+		TclEmitInstInt4(INST_OVER, 2,			envPtr);
+		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
+		TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
+		TclEmitOpcode(	INST_POP,			envPtr);
+	    }
+	}
+    }
+
+    /*
+     * Generate code to leave the rest of the list on the stack.
+     */
+
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
+    TclEmitInt4(			INDEX_END,		envPtr);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLindexCmd --
+ *
+ *	Procedure called to compile the "lindex" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "lindex" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLindexCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *idxTokenPtr, *valTokenPtr;
+    int i, idx, numWords = parsePtr->numWords;
+    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * Quit if too few args.
+     */
+
+    /* TODO: Consider support for compiling expanded args. */
+    if (numWords <= 1) {
+	return TCL_ERROR;
+    }
+
+    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (numWords != 3) {
+	goto emitComplexLindex;
+    }
+
+    idxTokenPtr = TokenAfter(valTokenPtr);
+    if (GetIndexFromToken(idxTokenPtr, &idx) == 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 value was not known at compile time, the conversion failed or
+     * the value was negative, we just keep on going with the more complex
+     * compilation.
+     */
+
+    /*
+     * Push the operands onto the stack.
+     */
+
+  emitComplexLindex:
+    for (i=1 ; i<numWords ; i++) {
+	CompileWord(envPtr, valTokenPtr, interp, i);
+	valTokenPtr = TokenAfter(valTokenPtr);
+    }
+
+    /*
+     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
+     * multiple index args.
+     */
+
+    if (numWords == 3) {
+	TclEmitOpcode(		INST_LIST_INDEX,		envPtr);
+    } else {
+	TclEmitInstInt4(	INST_LIST_INDEX_MULTI, numWords-1, envPtr);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileListCmd --
+ *
+ *	Procedure called to compile the "list" 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 "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. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *valueTokenPtr;
+    int i, numWords, concat, build;
+    Tcl_Obj *listObj, *objPtr;
+
+    if (parsePtr->numWords == 1) {
+	/*
+	 * [list] without arguments just pushes an empty object.
+	 */
+
+	PushStringLiteral(envPtr, "");
+	return TCL_OK;
+    }
+
+    /*
+     * Test if all arguments are compile-time known. If they are, we can
+     * implement with a simple push.
+     */
+
+    numWords = parsePtr->numWords;
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    listObj = Tcl_NewObj();
+    for (i = 1; i < numWords && listObj != NULL; i++) {
+	objPtr = Tcl_NewObj();
+	if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
+	    (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+	} else {
+	    Tcl_DecrRefCount(objPtr);
+	    Tcl_DecrRefCount(listObj);
+	    listObj = NULL;
+	}
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    if (listObj != NULL) {
+	TclEmitPush(TclAddLiteralObj(envPtr, listObj, NULL), envPtr);
+	return TCL_OK;
+    }
+
+    /*
+     * Push the all values onto the stack.
+     */
+
+    numWords = parsePtr->numWords;
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    concat = build = 0;
+    for (i = 1; i < numWords; i++) {
+	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
+	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
+	    if (concat) {
+		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	    }
+	    build = 0;
+	    concat = 1;
+	}
+	CompileWord(envPtr, valueTokenPtr, interp, i);
+	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+	    if (concat) {
+		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	    } else {
+		concat = 1;
+	    }
+	} else {
+	    build++;
+	}
+	valueTokenPtr = TokenAfter(valueTokenPtr);
+    }
+    if (build > 0) {
+	TclEmitInstInt4(	INST_LIST, build,	envPtr);
+	if (concat) {
+	    TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	}
+    }
+
+    /*
+     * If there was just one expanded word, we must ensure that it is a list
+     * at this point. We use an [lrange ... 0 end] for this (instead of
+     * [llength], as with literals) as we must drop any string representation
+     * that might be hanging around.
+     */
+
+    if (concat && numWords == 2) {
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
+	TclEmitInt4(			INDEX_END,	envPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLlengthCmd --
+ *
+ *	Procedure called to compile the "llength" 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 "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. */
+{
+    Tcl_Token *varTokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    CompileWord(envPtr, varTokenPtr, interp, 1);
+    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLrangeCmd --
+ *
+ *	How to compile the "lrange" command. We only bother because we needed
+ *	the opcode anyway for "lassign".
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    Tcl_Token *tokenPtr, *listTokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int idx1, idx2;
+
+    if (parsePtr->numWords != 4) {
+	return TCL_ERROR;
+    }
+    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * Parse the indices. Will only compile if both are constants and not an
+     * _integer_ less than zero (since we reserve negative indices here for
+     * end-relative indexing) or an end-based index greater than 'end' itself.
+     */
+
+    tokenPtr = TokenAfter(listTokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx2) != 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.
+     */
+
+    CompileWord(envPtr, listTokenPtr, interp, 1);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(		idx2,				envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLinsertCmd --
+ *
+ *	How to compile the "linsert" command. We only bother with the case
+ *	where the index is constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLinsertCmd(
+    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 */
+    int idx, i;
+
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * Parse the 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) or an end-based index greater than 'end' itself.
+     */
+
+    tokenPtr = TokenAfter(listTokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * There are four main cases. If there are no values to insert, this is
+     * just a confirm-listiness check. If the index is '0', this is a prepend.
+     * If the index is 'end' (== INDEX_END), this is an append. Otherwise,
+     * this is a splice (== split, insert values as list, concat-3).
+     */
+
+    CompileWord(envPtr, listTokenPtr, interp, 1);
+    if (parsePtr->numWords == 3) {
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
+	TclEmitInt4(			INDEX_END,		envPtr);
+	return TCL_OK;
+    }
+
+    for (i=3 ; i<parsePtr->numWords ; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+    TclEmitInstInt4(		INST_LIST, i-3,			envPtr);
+
+    if (idx == 0 /*start*/) {
+	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    } else if (idx == INDEX_END /*end*/) {
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    } else {
+	if (idx < 0) {
+	    idx++;
+	}
+	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
+	TclEmitInt4(			idx-1,			envPtr);
+	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
+	TclEmitInt4(			INDEX_END,		envPtr);
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLreplaceCmd --
+ *
+ *	How to compile the "lreplace" command. We only bother with the case
+ *	where the indices are constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, i, offset, offset2;
+
+    if (parsePtr->numWords < 4) {
+	return TCL_ERROR;
+    }
+    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * Parse the indices. Will only compile if both are constants and not an
+     * _integer_ less than zero (since we reserve negative indices here for
+     * end-relative indexing) or an end-based index greater than 'end' itself.
+     */
+
+    tokenPtr = TokenAfter(listTokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * idx1, idx2 are now in canonical form:
+     *
+     *  - integer:	[0,len+1]
+     *  - end index:    INDEX_END
+     *  - -ive offset:  INDEX_END-[len-1,0]
+     *  - +ive offset:  INDEX_END+1
+     */
+
+    /*
+     * Compilation fails when one index is end-based but the other isn't.
+     * Fixing this will require more bytecodes, but this is a workaround for
+     * now. [Bug 47ac84309b]
+     */
+
+    if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
+	return TCL_ERROR;
+    }
+
+    if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
+	idx2 = idx1 - 1;
+    }
+
+    /*
+     * Work out what this [lreplace] is actually doing.
+     */
+
+    tmpObj = NULL;
+    CompileWord(envPtr, listTokenPtr, interp, 1);
+    if (parsePtr->numWords == 4) {
+	if (idx1 == 0) {
+	    if (idx2 == INDEX_END) {
+		goto dropAll;
+	    }
+	    idx1 = idx2 + 1;
+	    idx2 = INDEX_END;
+	    goto dropEnd;
+	} else if (idx2 == INDEX_END) {
+	    idx2 = idx1 - 1;
+	    idx1 = 0;
+	    goto dropEnd;
+	} else {
+	    if (idx2 < idx1) {
+		idx2 = idx1 - 1;
+	    }
+	    if (idx1 > 0) {
+		tmpObj = Tcl_NewIntObj(idx1);
+		Tcl_IncrRefCount(tmpObj);
+	    }
+	    goto dropRange;
+	}
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    for (i=4 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt4(		INST_LIST, i - 4,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    if (idx1 == 0) {
+	if (idx2 == INDEX_END) {
+	    goto replaceAll;
+	}
+	idx1 = idx2 + 1;
+	idx2 = INDEX_END;
+	goto replaceHead;
+    } else if (idx2 == INDEX_END) {
+	idx2 = idx1 - 1;
+	idx1 = 0;
+	goto replaceTail;
+    } else {
+	if (idx2 < idx1) {
+	    idx2 = idx1 - 1;
+	}
+	if (idx1 > 0) {
+	    tmpObj = Tcl_NewIntObj(idx1);
+	    Tcl_IncrRefCount(tmpObj);
+	}
+	goto replaceRange;
+    }
+
+    /*
+     * Issue instructions to perform the operations relating to configurations
+     * that just drop. The only argument pushed on the stack is the list to
+     * operate on.
+     */
+
+  dropAll:			/* This just ensures the arg is a list. */
+    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    PushStringLiteral(envPtr,	"");
+    goto done;
+
+  dropEnd:
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(			idx2,			envPtr);
+    goto done;
+
+  dropRange:
+    if (tmpObj != NULL) {
+	/*
+	 * Emit bytecode to check the list length.
+	 */
+
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
+	TclEmitOpcode(		INST_GE,			envPtr);
+	offset = CurrentOffset(envPtr);
+	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+
+	/*
+	 * Emit an error if we've been given an empty list.
+	 */
+
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+	offset2 = CurrentOffset(envPtr);
+	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
+	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+		"list doesn't contain element %d", idx1), NULL), envPtr);
+	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+		envPtr->codeStart + offset + 1);
+	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+		envPtr->codeStart + offset2 + 1);
+	TclAdjustStackDepth(-1, envPtr);
+    }
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
+    TclEmitInt4(			idx1 - 1,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
+    TclEmitInt4(			INDEX_END,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+    /*
+     * Issue instructions to perform the operations relating to configurations
+     * that do real replacement. All arguments are pushed and assembled into a
+     * pair: the list of values to replace with, and the list to do the
+     * surgery on.
+     */
+
+  replaceAll:
+    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    goto done;
+
+  replaceHead:
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(			idx2,			envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+  replaceTail:
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(			idx2,			envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+  replaceRange:
+    if (tmpObj != NULL) {
+	/*
+	 * Emit bytecode to check the list length.
+	 */
+
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+
+	/*
+	 * Check the list length vs idx1.
+	 */
+
+	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
+	TclEmitOpcode(		INST_GE,			envPtr);
+	offset = CurrentOffset(envPtr);
+	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+
+	/*
+	 * Emit an error if we've been given an empty list.
+	 */
+
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+	offset2 = CurrentOffset(envPtr);
+	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
+	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
+		"list doesn't contain element %d", idx1), NULL), envPtr);
+	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
+		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
+	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+		envPtr->codeStart + offset + 1);
+	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+		envPtr->codeStart + offset2 + 1);
+	TclAdjustStackDepth(-1, envPtr);
+    }
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
+    TclEmitInt4(			idx1 - 1,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
+    TclEmitInt4(			INDEX_END,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 3,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+    /*
+     * Clean up the allocated memory.
+     */
+
+  done:
+    if (tmpObj != NULL) {
+	Tcl_DecrRefCount(tmpObj);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLsetCmd --
+ *
+ *	Procedure called to compile the "lset" 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 "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
+TclCompileLsetCmd(
+    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
+				 * command. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
+{
+    int tempDepth;		/* Depth used for emitting one part of the
+				 * code burst. */
+    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
+				 * parse of the variable name. */
+    int localIndex;		/* Index of var in local var table. */
+    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
+    int i;
+    DefineLineInformation;	/* TIP #280 */
+
+    /*
+     * Check argument count.
+     */
+
+    /* TODO: Consider support for compiling expanded args. */
+    if (parsePtr->numWords < 3) {
+	/*
+	 * Fail at run time, not in compilation.
+	 */
+
+	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.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar, 1);
+
+    /*
+     * Push the "index" args and the new element value.
+     */
+
+    for (i=2 ; i<parsePtr->numWords ; ++i) {
+	varTokenPtr = TokenAfter(varTokenPtr);
+	CompileWord(envPtr, varTokenPtr, interp, i);
+    }
+
+    /*
+     * Duplicate the variable name if it's been pushed.
+     */
+
+    if (localIndex < 0) {
+	if (isScalar) {
+	    tempDepth = parsePtr->numWords - 2;
+	} else {
+	    tempDepth = parsePtr->numWords - 1;
+	}
+	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
+    }
+
+    /*
+     * Duplicate an array index if one's been pushed.
+     */
+
+    if (!isScalar) {
+	if (localIndex < 0) {
+	    tempDepth = parsePtr->numWords - 1;
+	} else {
+	    tempDepth = parsePtr->numWords - 2;
+	}
+	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
+    }
+
+    /*
+     * Emit code to load the variable's value.
+     */
+
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(	INST_LOAD_STK,			envPtr);
+	} else {
+	    Emit14Inst(		INST_LOAD_SCALAR, localIndex,	envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(	INST_LOAD_ARRAY_STK,		envPtr);
+	} else {
+	    Emit14Inst(		INST_LOAD_ARRAY, localIndex,	envPtr);
+	}
+    }
+
+    /*
+     * Emit the correct variety of 'lset' instruction.
+     */
+
+    if (parsePtr->numWords == 4) {
+	TclEmitOpcode(		INST_LSET_LIST,			envPtr);
+    } else {
+	TclEmitInstInt4(	INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
+    }
+
+    /*
+     * Emit code to put the value back in the variable.
+     */
+
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(	INST_STORE_STK,			envPtr);
+	} else {
+	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
+	} else {
+	    Emit14Inst(		INST_STORE_ARRAY, localIndex,	envPtr);
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNamespace*Cmd --
+ *
+ *	Procedures called to compile the "namespace" command; currently, only
+ *	the subcommands "namespace current" and "namespace upvar" are compiled
+ *	to bytecodes, and the latter only inside a procedure(-like) context.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "namespace upvar"
+ *	command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNamespaceCurrentCmd(
+    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. */
+{
+    /*
+     * Only compile [namespace current] without arguments.
+     */
+
+    if (parsePtr->numWords != 1) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Not much to do; we compile to a single instruction...
+     */
+
+    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileNamespaceCodeCmd(
+    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;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * The specification of [namespace code] is rather shocking, in that it is
+     * supposed to check if the argument is itself the result of [namespace
+     * code] and not apply itself in that case. Which is excessively cautious,
+     * but what the test suite checks for.
+     */
+
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20
+	    && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) {
+	/*
+	 * Technically, we could just pass a literal '::namespace inscope '
+	 * term through, but that's something which really shouldn't be
+	 * occurring as something that the user writes so we'll just punt it.
+	 */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now we can compile using the same strategy as [namespace code]'s normal
+     * implementation does internally. Note that we can't bind the namespace
+     * name directly here, because TclOO plays complex games with namespaces;
+     * the value needs to be determined at runtime for safety.
+     */
+
+    PushStringLiteral(envPtr,		"::namespace");
+    PushStringLiteral(envPtr,		"inscope");
+    TclEmitOpcode(		INST_NS_CURRENT,	envPtr);
+    CompileWord(envPtr,		tokenPtr,		interp, 1);
+    TclEmitInstInt4(		INST_LIST, 4,		envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileNamespaceOriginCmd(
+    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;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    CompileWord(envPtr,	tokenPtr,			interp, 1);
+    TclEmitOpcode(	INST_ORIGIN_COMMAND,		envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileNamespaceQualifiersCmd(
+    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 = TokenAfter(parsePtr->tokenPtr);
+    DefineLineInformation;	/* TIP #280 */
+    int off;
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    PushStringLiteral(envPtr, "0");
+    PushStringLiteral(envPtr, "::");
+    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
+    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
+    off = CurrentOffset(envPtr);
+    PushStringLiteral(envPtr, "1");
+    TclEmitOpcode(	INST_SUB,			envPtr);
+    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
+    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
+    TclEmitOpcode(	INST_STR_INDEX,			envPtr);
+    PushStringLiteral(envPtr, ":");
+    TclEmitOpcode(	INST_STR_EQ,			envPtr);
+    off = off - CurrentOffset(envPtr);
+    TclEmitInstInt1(	INST_JUMP_TRUE1, off,		envPtr);
+    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileNamespaceTailCmd(
+    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 = TokenAfter(parsePtr->tokenPtr);
+    DefineLineInformation;	/* TIP #280 */
+    JumpFixup jumpFixup;
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Take care; only add 2 to found index if the string was actually found.
+     */
+
+    CompileWord(envPtr, tokenPtr, interp, 1);
+    PushStringLiteral(envPtr, "::");
+    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
+    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
+    TclEmitOpcode(	INST_DUP,			envPtr);
+    PushStringLiteral(envPtr, "0");
+    TclEmitOpcode(	INST_GE,			envPtr);
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
+    PushStringLiteral(envPtr, "2");
+    TclEmitOpcode(	INST_ADD,			envPtr);
+    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+    PushStringLiteral(envPtr, "end");
+    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
+    return TCL_OK;
+}
+
+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. */
+{
+    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+    int localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Only compile [namespace upvar ...]: needs an even number of args, >=4
+     */
+
+    numWords = parsePtr->numWords;
+    if ((numWords % 2) || (numWords < 4)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the namespace
+     */
+
+    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=2; i<numWords; i+=2) {
+	otherTokenPtr = TokenAfter(localTokenPtr);
+	localTokenPtr = TokenAfter(otherTokenPtr);
+
+	CompileWord(envPtr, otherTokenPtr, interp, i);
+	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+	if (localIndex < 0) {
+	    return TCL_ERROR;
+	}
+	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
+    }
+
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(		INST_POP,			envPtr);
+    PushStringLiteral(envPtr, "");
+    return TCL_OK;
+}
+
+int
+TclCompileNamespaceWhichCmd(
+    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, *opt;
+    int idx;
+
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 3) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    idx = 1;
+
+    /*
+     * If there's an option, check that it's "-command". We don't handle
+     * "-variable" (currently) and anything else is an error.
+     */
+
+    if (parsePtr->numWords == 3) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    return TCL_ERROR;
+	}
+	opt = tokenPtr + 1;
+	if (opt->size < 2 || opt->size > 8
+		|| strncmp(opt->start, "-command", opt->size) != 0) {
+	    return TCL_ERROR;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+	idx++;
+    }
+
+    /*
+     * Issue the bytecode.
+     */
+
+    CompileWord(envPtr,		tokenPtr,		interp, idx);
+    TclEmitOpcode(		INST_RESOLVE_COMMAND,	envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileRegexpCmd --
+ *
+ *	Procedure called to compile the "regexp" 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 "regexp" 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. */
+{
+    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 */
+
+    /*
+     * We are only interested in compiling simple regexp cases. Currently
+     * supported compile cases are:
+     *   regexp ?-nocase? ?--? staticString $var
+     *   regexp ?-nocase? ?--? {^staticString$} $var
+     */
+
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+
+    simple = 0;
+    nocase = 0;
+    sawLast = 0;
+    varTokenPtr = parsePtr->tokenPtr;
+
+    /*
+     * We only look for -nocase and -- as options. Everything else gets pushed
+     * to runtime execution. This is different than regexp's runtime option
+     * handling, but satisfies our stricter needs.
+     */
+
+    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.
+	 */
+
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the regexp string. If it is not a simple string or can't be
+     * converted to a glob pattern, push the word for the INST_REGEXP.
+     * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
+     */
+
+    varTokenPtr = 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 == "".
+	     */
+
+	    PushStringLiteral(envPtr, "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, NULL)
+		== TCL_OK) {
+	    simple = 1;
+	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+	    Tcl_DStringFree(&ds);
+	}
+    }
+
+    if (!simple) {
+	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
+    }
+
+    /*
+     * Push the string arg.
+     */
+
+    varTokenPtr = TokenAfter(varTokenPtr);
+    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
+
+    if (simple) {
+	if (exact && !nocase) {
+	    TclEmitOpcode(	INST_STR_EQ,			envPtr);
+	} else {
+	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
+	}
+    } else {
+	/*
+	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
+	 * that handles all the flags we want to pass.
+	 * Don't use TCL_REG_NOSUB as we may have backrefs.
+	 */
+
+	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
+
+	TclEmitInstInt1(	INST_REGEXP, cflags,		envPtr);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileRegsubCmd --
+ *
+ *	Procedure called to compile the "regsub" 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 "regsub" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileRegsubCmd(
+    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. */
+{
+    /*
+     * We only compile the case with [regsub -all] where the pattern is both
+     * known at compile time and simple (i.e., no RE metacharacters). That is,
+     * the pattern must be translatable into a glob like "*foo*" with no other
+     * glob metacharacters inside it; there must be some "foo" in there too.
+     * The substitution string must also be known at compile time and free of
+     * metacharacters ("\digit" and "&"). Finally, there must not be a
+     * variable mentioned in the [regsub] to write the result back to (because
+     * we can't get the count of substitutions that would be the result in
+     * that case). The key is that these are the conditions under which a
+     * [string map] could be used instead, in particular a [string map] of the
+     * form we can compile to bytecode.
+     *
+     * In short, we look for:
+     *
+     *   regsub -all [--] simpleRE string simpleReplacement
+     *
+     * The only optional part is the "--", and no other options are handled.
+     */
+
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr, *stringTokenPtr;
+    Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
+    Tcl_DString pattern;
+    const char *bytes;
+    int len, exact, quantified, result = TCL_ERROR;
+
+    if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse the "-all", which must be the first argument (other options not
+     * supported, non-"-all" substitution we can't compile).
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4
+	    || strncmp(tokenPtr[1].start, "-all", 4)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the pattern into patternObj, checking for "--" in the process.
+     */
+
+    Tcl_DStringInit(&pattern);
+    tokenPtr = TokenAfter(tokenPtr);
+    patternObj = Tcl_NewObj();
+    if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
+	goto done;
+    }
+    if (Tcl_GetString(patternObj)[0] == '-') {
+	if (strcmp(Tcl_GetString(patternObj), "--") != 0
+		|| parsePtr->numWords == 5) {
+	    goto done;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+	Tcl_DecrRefCount(patternObj);
+	patternObj = Tcl_NewObj();
+	if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
+	    goto done;
+	}
+    } else if (parsePtr->numWords == 6) {
+	goto done;
+    }
+
+    /*
+     * Identify the code which produces the string to apply the substitution
+     * to (stringTokenPtr), and the replacement string (into replacementObj).
+     */
+
+    stringTokenPtr = TokenAfter(tokenPtr);
+    tokenPtr = TokenAfter(stringTokenPtr);
+    replacementObj = Tcl_NewObj();
+    if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) {
+	goto done;
+    }
+
+    /*
+     * Next, higher-level checks. Is the RE a very simple glob? Is the
+     * replacement "simple"?
+     */
+
+    bytes = Tcl_GetStringFromObj(patternObj, &len);
+    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
+	    != TCL_OK || exact || quantified) {
+	goto done;
+    }
+    bytes = Tcl_DStringValue(&pattern);
+    if (*bytes++ != '*') {
+	goto done;
+    }
+    while (1) {
+	switch (*bytes) {
+	case '*':
+	    if (bytes[1] == '\0') {
+		/*
+		 * OK, we've proved there are no metacharacters except for the
+		 * '*' at each end.
+		 */
+
+		len = Tcl_DStringLength(&pattern) - 2;
+		if (len > 0) {
+		    goto isSimpleGlob;
+		}
+
+		/*
+		 * The pattern is "**"! I believe that should be impossible,
+		 * but we definitely can't handle that at all.
+		 */
+	    }
+	case '\0': case '?': case '[': case '\\':
+	    goto done;
+	}
+	bytes++;
+    }
+  isSimpleGlob:
+    for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) {
+	switch (*bytes) {
+	case '\\': case '&':
+	    goto done;
+	}
+    }
+
+    /*
+     * Proved the simplicity constraints! Time to issue the code.
+     */
+
+    result = TCL_OK;
+    bytes = Tcl_DStringValue(&pattern) + 1;
+    PushLiteral(envPtr,	bytes, len);
+    bytes = Tcl_GetStringFromObj(replacementObj, &len);
+    PushLiteral(envPtr,	bytes, len);
+    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords-2);
+    TclEmitOpcode(	INST_STR_MAP,	envPtr);
+
+  done:
+    Tcl_DStringFree(&pattern);
+    if (patternObj) {
+	Tcl_DecrRefCount(patternObj);
+    }
+    if (replacementObj) {
+	Tcl_DecrRefCount(replacementObj);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileReturnCmd --
+ *
+ *	Procedure called to compile the "return" 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 "return" 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. */
+{
+    /*
+     * 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);
+
+	CompileWord(envPtr, optsTokenPtr, interp, 2);
+	CompileWord(envPtr, msgTokenPtr,  interp, 3);
+	TclEmitInvoke(envPtr, INST_RETURN_STK);
+	return TCL_OK;
+    }
+
+    /*
+     * Allocate some working space.
+     */
+
+    objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));
+
+    /*
+     * Scan through the return options. If any are unknown at compile time,
+     * there is no value in bytecompiling. Save the option values known in an
+     * objv array for merging into a return options dictionary.
+     *
+     * TODO: There is potential for improvement if all option keys are known
+     * at compile time and all option values relating to '-code' and '-level'
+     * are known at compile time.
+     */
+
+    for (objc = 0; objc < numOptionWords; objc++) {
+	objv[objc] = Tcl_NewObj();
+	Tcl_IncrRefCount(objv[objc]);
+	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
+	    /*
+	     * Non-literal, so punt to run-time assembly of the dictionary.
+	     */
+
+	    for (; objc>=0 ; objc--) {
+		TclDecrRefCount(objv[objc]);
+	    }
+	    TclStackFree(interp, objv);
+	    goto issueRuntimeReturn;
+	}
+	wordTokenPtr = TokenAfter(wordTokenPtr);
+    }
+    status = TclMergeReturnOptions(interp, objc, objv,
+	    &returnOpts, &code, &level);
+    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.
+	 */
+
+	Tcl_ResetResult(interp);
+	return TCL_ERROR;
+    }
+
+    /*
+     * All options are known at compile time, so we're going to bytecompile.
+     * Emit instructions to push the result on the stack.
+     */
+
+    if (explicitResult) {
+	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+    } else {
+	/*
+	 * No explict result argument, so default result is empty string.
+	 */
+
+	PushStringLiteral(envPtr, "");
+    }
+
+    /*
+     * Check for optimization: When [return] is in a proc, and there's no
+     * enclosing [catch], and there are no return options, then the INST_DONE
+     * instruction is equivalent, and may be more efficient.
+     */
+
+    if (numOptionWords == 0 && envPtr->procPtr != NULL) {
+	/*
+	 * We have default return options and we're in a proc ...
+	 */
+
+	int index = envPtr->exceptArrayNext - 1;
+	int enclosingCatch = 0;
+
+	while (index >= 0) {
+	    ExceptionRange range = envPtr->exceptArrayPtr[index];
+
+	    if ((range.type == CATCH_EXCEPTION_RANGE)
+		    && (range.catchOffset == -1)) {
+		enclosingCatch = 1;
+		break;
+	    }
+	    index--;
+	}
+	if (!enclosingCatch) {
+	    /*
+	     * ... and there is no enclosing catch. Issue the maximally
+	     * efficient exit instruction.
+	     */
+
+	    Tcl_DecrRefCount(returnOpts);
+	    TclEmitOpcode(INST_DONE, envPtr);
+	    TclAdjustStackDepth(1, 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;
+
+  issueRuntimeReturn:
+    /*
+     * Assemble the option dictionary (as a list as that's good enough).
+     */
+
+    wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (objc=1 ; objc<=numOptionWords ; objc++) {
+	CompileWord(envPtr, wordTokenPtr, interp, objc);
+	wordTokenPtr = TokenAfter(wordTokenPtr);
+    }
+    TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);
+
+    /*
+     * Push the result.
+     */
+
+    if (explicitResult) {
+	CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+    } else {
+	PushStringLiteral(envPtr, "");
+    }
+
+    /*
+     * Issue the RETURN itself.
+     */
+
+    TclEmitInvoke(envPtr, INST_RETURN_STK);
+    return TCL_OK;
+}
+
+static void
+CompileReturnInternal(
+    CompileEnv *envPtr,
+    unsigned char op,
+    int code,
+    int level,
+    Tcl_Obj *returnOpts)
+{
+    if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) {
+	ExceptionRange *rangePtr;
+	ExceptionAux *exceptAux;
+
+	rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux);
+	if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
+	    if (code == TCL_BREAK) {
+		TclAddLoopBreakFixup(envPtr, exceptAux);
+	    } else {
+		TclAddLoopContinueFixup(envPtr, exceptAux);
+	    }
+	    Tcl_DecrRefCount(returnOpts);
+	    return;
+	}
+    }
+
+    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)));
+    Tcl_ResetResult(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileUpvarCmd --
+ *
+ *	Procedure called to compile the "upvar" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "upvar" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileUpvarCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+    int localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Obj *objPtr;
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    numWords = parsePtr->numWords;
+    if (numWords < 3) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the frame index if it is known at compile time
+     */
+
+    objPtr = Tcl_NewObj();
+    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;
+	    }
+	    /* TODO: Push the known value instead? */
+	    CompileWord(envPtr, tokenPtr, interp, 1);
+	    otherTokenPtr = TokenAfter(tokenPtr);
+	    i = 2;
+	} else {
+	    if (!(numWords%2)) {
+		return TCL_ERROR;
+	    }
+	    PushStringLiteral(envPtr, "1");
+	    otherTokenPtr = tokenPtr;
+	    i = 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, i);
+	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+	if (localIndex < 0) {
+	    return TCL_ERROR;
+	}
+	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
+    }
+
+    /*
+     * Pop the frame index, and set the result to empty
+     */
+
+    TclEmitOpcode(		INST_POP,			envPtr);
+    PushStringLiteral(envPtr, "");
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileVariableCmd --
+ *
+ *	Procedure called to compile the "variable" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "variable" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileVariableCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    int localIndex, numWords, i;
+    DefineLineInformation;	/* TIP #280 */
+
+    numWords = parsePtr->numWords;
+    if (numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Bail out if not compiling a proc body
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Loop over the (var, value) pairs.
+     */
+
+    valueTokenPtr = parsePtr->tokenPtr;
+    for (i=1; i<numWords; i+=2) {
+	varTokenPtr = TokenAfter(valueTokenPtr);
+	valueTokenPtr = TokenAfter(varTokenPtr);
+
+	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+	if (localIndex < 0) {
+	    return TCL_ERROR;
+	}
+
+	/* TODO: Consider what value can pass throug the
+	 * IndexTailVarIfKnown() screen.  Full CompileWord()
+	 * likely does not apply here.  Push known value instead. */
+	CompileWord(envPtr, varTokenPtr, interp, i);
+	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);
+
+	if (i+1 < numWords) {
+	    /*
+	     * A value has been given: set the variable, pop the value
+	     */
+
+	    CompileWord(envPtr, valueTokenPtr, interp, i+1);
+	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
+	    TclEmitOpcode(	INST_POP,			envPtr);
+	}
+    }
+
+    /*
+     * Set the result to empty
+     */
+
+    PushStringLiteral(envPtr, "");
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IndexTailVarIfKnown --
+ *
+ *	Procedure used in compiling [global] and [variable] commands. It
+ *	inspects the variable name described by varTokenPtr and, if the tail
+ *	is known at compile time, defines a corresponding local variable.
+ *
+ * Results:
+ *	Returns the variable's index in the table of compiled locals if the
+ *	tail is known at compile time, or -1 otherwise.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IndexTailVarIfKnown(
+    Tcl_Interp *interp,
+    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Obj *tailPtr;
+    const char *tailName, *p;
+    int len, n = varTokenPtr->numComponents;
+    Tcl_Token *lastTokenPtr;
+    int full, localIndex;
+
+    /*
+     * Determine if the tail is (a) known at compile time, and (b) not an
+     * array element. Should any of these fail, return an error so that the
+     * non-compiled command will be called at runtime.
+     *
+     * In order for the tail to be known at compile time, the last token in
+     * the word has to be constant and contain "::" if it is not the only one.
+     */
+
+    if (!EnvHasLVT(envPtr)) {
+	return -1;
+    }
+
+    TclNewObj(tailPtr);
+    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
+	full = 1;
+	lastTokenPtr = varTokenPtr;
+    } else {
+	full = 0;
+	lastTokenPtr = varTokenPtr + n;
+
+	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
+    }
+
+    tailName = TclGetStringFromObj(tailPtr, &len);
+
+    if (len) {
+	if (*(tailName+len-1) == ')') {
+	    /*
+	     * Possible array: bail out
+	     */
+
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+
+	/*
+	 * Get the tail: immediately after the last '::'
+	 */
+
+	for (p = tailName + len -1; p > tailName; p--) {
+	    if ((*p == ':') && (*(p-1) == ':')) {
+		p++;
+		break;
+	    }
+	}
+	if (!full && (p == tailName)) {
+	    /*
+	     * No :: in the last component.
+	     */
+
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+	len -= p - tailName;
+	tailName = p;
+    }
+
+    localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr);
+    Tcl_DecrRefCount(tailPtr);
+    return localIndex;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
+ *
+ *	Compilations of the TclOO utility commands [next] and [self].
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclCompileObjectNextCmd(
+    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 = parsePtr->tokenPtr;
+    int i;
+
+    if (parsePtr->numWords > 255) {
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt1(	INST_TCLOO_NEXT, i,		envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileObjectNextToCmd(
+    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 = parsePtr->tokenPtr;
+    int i;
+
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt1(	INST_TCLOO_NEXT_CLASS, i,	envPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileObjectSelfCmd(
+    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. */
+{
+    /*
+     * We only handle [self] and [self object] (which is the same operation).
+     * These are the only very common operations on [self] for which
+     * bytecoding is at all reasonable.
+     */
+
+    if (parsePtr->numWords == 1) {
+	goto compileSelfObject;
+    } else if (parsePtr->numWords == 2) {
+	Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd;
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) {
+	    return TCL_ERROR;
+	}
+
+	subcmd = tokenPtr + 1;
+	if (strncmp(subcmd->start, "object", subcmd->size) == 0) {
+	    goto compileSelfObject;
+	} else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) {
+	    goto compileSelfNamespace;
+	}
+    }
+
+    /*
+     * Can't compile; handle with runtime call.
+     */
+
+    return TCL_ERROR;
+
+  compileSelfObject:
+
+    /*
+     * This delegates the entire problem to a single opcode.
+     */
+
+    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
+    return TCL_OK;
+
+  compileSelfNamespace:
+
+    /*
+     * This is formally only correct with TclOO methods as they are currently
+     * implemented; it assumes that the current namespace is invariably when a
+     * TclOO context is present is the object's namespace, and that's
+     * technically only something that's a matter of current policy. But it
+     * avoids creating another opcode, so that's all good!
+     */
+
+    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
new file mode 100644
index 0000000..101edbd
--- /dev/null
+++ b/generic/tclCompCmdsSZ.c
@@ -0,0 +1,4485 @@
+/*
+ * 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"
+#include "tclStringTrim.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 void		DisassembleJumptableInfo(ClientData clientData,
+			    Tcl_Obj *dictObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
+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, int mode, int noCase,
+			    int valueIndex, int numWords,
+			    Tcl_Token **bodyToken, int *bodyLines,
+			    int **bodyNext);
+static void		IssueSwitchJumpTable(Tcl_Interp *interp,
+			    CompileEnv *envPtr, int valueIndex,
+			    int numWords, Tcl_Token **bodyToken,
+			    int *bodyLines, int **bodyContLines);
+static int		IssueTryClausesInstructions(Tcl_Interp *interp,
+			    CompileEnv *envPtr, Tcl_Token *bodyToken,
+			    int numHandlers, int *matchCodes,
+			    Tcl_Obj **matchClauses, int *resultVarIndices,
+			    int *optionVarIndices, Tcl_Token **handlerTokens);
+static int		IssueTryClausesFinallyInstructions(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		IssueTryFinallyInstructions(Tcl_Interp *interp,
+			    CompileEnv *envPtr, Tcl_Token *bodyToken,
+			    Tcl_Token *finallyToken);
+
+/*
+ * The structures below define the AuxData types defined in this file.
+ */
+
+const AuxDataType tclJumptableInfoType = {
+    "JumptableInfo",		/* name */
+    DupJumptableInfo,		/* dupProc */
+    FreeJumptableInfo,		/* freeProc */
+    PrintJumptableInfo,		/* printProc */
+    DisassembleJumptableInfo	/* disassembleProc */
+};
+
+/*
+ * 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 OP14(name,val1,val2) \
+    TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
+#define OP44(name,val1,val2) \
+    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
+#define PUSH(str) \
+    PushStringLiteral(envPtr, str)
+#define JUMP4(name,var) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
+#define FIXJUMP4(var) \
+    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define JUMP1(name,var) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
+#define FIXJUMP1(var) \
+    TclStoreInt1AtPtr(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));}
+#define INVOKE(name) \
+    TclEmitInvoke(envPtr,INST_##name)
+
+#define INDEX_END	(-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ *	Parse a token and get the encoded version of the index (as understood
+ *	by TEBC), assuming it is at all knowable at compile time. Only handles
+ *	indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ *	Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+    Tcl_Token *tokenPtr,
+    int *index)
+{
+    Tcl_Obj *tmpObj = Tcl_NewObj();
+    int result, idx;
+
+    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+	Tcl_DecrRefCount(tmpObj);
+	return TCL_ERROR;
+    }
+
+    result = TclGetIntFromObj(NULL, tmpObj, &idx);
+    if (result == TCL_OK) {
+	if (idx < 0) {
+	    result = TCL_ERROR;
+	}
+    } else {
+	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+	if (result == TCL_OK && idx > INDEX_END) {
+	    result = TCL_ERROR;
+	}
+    }
+    Tcl_DecrRefCount(tmpObj);
+
+    if (result == TCL_OK) {
+	*index = idx;
+    }
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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, 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, &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 (isScalar) {
+	    if (localIndex < 0) {
+		TclEmitOpcode((isAssignment?
+			INST_STORE_STK : INST_LOAD_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);
+	    }
+	}
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileString*Cmd --
+ *
+ *	Procedures called to compile various subcommands of the "string"
+ *	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" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringCatCmd(
+    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 i, numWords = parsePtr->numWords, numArgs;
+    Tcl_Token *wordTokenPtr;
+    Tcl_Obj *obj, *folded;
+    DefineLineInformation;	/* TIP #280 */
+
+    /* Trivial case, no arg */
+
+    if (numWords<2) {
+	PushStringLiteral(envPtr, "");
+	return TCL_OK;
+    }
+
+    /* General case: issue CONCAT1's (by chunks of 254 if needed), folding
+       contiguous constants along the way */
+
+    numArgs = 0;
+    folded = NULL;
+    wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (i = 1; i < numWords; i++) {
+	obj = Tcl_NewObj();
+	if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) {
+	    if (folded) {
+		Tcl_AppendObjToObj(folded, obj);
+		Tcl_DecrRefCount(obj);
+	    } else {
+		folded = obj;
+	    }
+	} else {
+	    Tcl_DecrRefCount(obj);
+	    if (folded) {
+		int len;
+		const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+		PushLiteral(envPtr, bytes, len);
+		Tcl_DecrRefCount(folded);
+		folded = NULL;
+		numArgs ++;
+	    }
+	    CompileWord(envPtr, wordTokenPtr, interp, i);
+	    numArgs ++;
+	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
+		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+		numArgs = 1;	/* concat pushes 1 obj, the result */
+	    }
+	}
+	wordTokenPtr = TokenAfter(wordTokenPtr);
+    }
+    if (folded) {
+	int len;
+	const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+	PushLiteral(envPtr, bytes, len);
+	Tcl_DecrRefCount(folded);
+	folded = NULL;
+	numArgs ++;
+    }
+    if (numArgs > 1) {
+	TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+    }
+
+    return TCL_OK;
+}
+
+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;
+}
+
+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;
+}
+
+int
+TclCompileStringFirstCmd(
+    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);
+    OP(STR_FIND);
+    return TCL_OK;
+}
+
+int
+TclCompileStringLastCmd(
+    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);
+    OP(STR_FIND_LAST);
+    return TCL_OK;
+}
+
+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;
+}
+
+int
+TclCompileStringIsCmd(
+    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 = TokenAfter(parsePtr->tokenPtr);
+    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
+    };
+    int t, range, allowEmpty = 0, end;
+    InstStringClassType strClassType;
+    Tcl_Obj *isClass;
+
+    if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
+	return TCL_ERROR;
+    }
+    isClass = Tcl_NewObj();
+    if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
+	Tcl_DecrRefCount(isClass);
+	return TCL_ERROR;
+    } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
+	    &t) != TCL_OK) {
+	Tcl_DecrRefCount(isClass);
+	TclCompileSyntaxError(interp, envPtr);
+	return TCL_OK;
+    }
+    Tcl_DecrRefCount(isClass);
+
+#define GotLiteral(tokenPtr, word) \
+    ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD &&			\
+     (tokenPtr)[1].size > 1 &&						\
+     (tokenPtr)[1].start[0] == word[0] &&				\
+     strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
+
+    /*
+     * Cannot handle the -failindex option at all, and that's the only legal
+     * way to have more than 4 arguments.
+     */
+
+    if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (parsePtr->numWords == 3) {
+	allowEmpty = 1;
+    } else {
+	if (!GotLiteral(tokenPtr, "-strict")) {
+	    return TCL_ERROR;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+#undef GotLiteral
+
+    /*
+     * Compile the code. There are several main classes of check here.
+     *	1. Character classes
+     *	2. Booleans
+     *	3. Integers
+     *	4. Floats
+     *	5. Lists
+     */
+
+    CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+
+    switch ((enum isClasses) t) {
+    case STR_IS_ALNUM:
+	strClassType = STR_CLASS_ALNUM;
+	goto compileStrClass;
+    case STR_IS_ALPHA:
+	strClassType = STR_CLASS_ALPHA;
+	goto compileStrClass;
+    case STR_IS_ASCII:
+	strClassType = STR_CLASS_ASCII;
+	goto compileStrClass;
+    case STR_IS_CONTROL:
+	strClassType = STR_CLASS_CONTROL;
+	goto compileStrClass;
+    case STR_IS_DIGIT:
+	strClassType = STR_CLASS_DIGIT;
+	goto compileStrClass;
+    case STR_IS_GRAPH:
+	strClassType = STR_CLASS_GRAPH;
+	goto compileStrClass;
+    case STR_IS_LOWER:
+	strClassType = STR_CLASS_LOWER;
+	goto compileStrClass;
+    case STR_IS_PRINT:
+	strClassType = STR_CLASS_PRINT;
+	goto compileStrClass;
+    case STR_IS_PUNCT:
+	strClassType = STR_CLASS_PUNCT;
+	goto compileStrClass;
+    case STR_IS_SPACE:
+	strClassType = STR_CLASS_SPACE;
+	goto compileStrClass;
+    case STR_IS_UPPER:
+	strClassType = STR_CLASS_UPPER;
+	goto compileStrClass;
+    case STR_IS_WORD:
+	strClassType = STR_CLASS_WORD;
+	goto compileStrClass;
+    case STR_IS_XDIGIT:
+	strClassType = STR_CLASS_XDIGIT;
+    compileStrClass:
+	if (allowEmpty) {
+	    OP1(	STR_CLASS, strClassType);
+	} else {
+	    int over, over2;
+
+	    OP(		DUP);
+	    OP1(	STR_CLASS, strClassType);
+	    JUMP1(	JUMP_TRUE, over);
+	    OP(		POP);
+	    PUSH(	"0");
+	    JUMP1(	JUMP, over2);
+	    FIXJUMP1(over);
+	    PUSH(	"");
+	    OP(		STR_NEQ);
+	    FIXJUMP1(over2);
+	}
+	return TCL_OK;
+
+    case STR_IS_BOOL:
+    case STR_IS_FALSE:
+    case STR_IS_TRUE:
+	OP(		TRY_CVT_TO_BOOLEAN);
+	switch (t) {
+	    int over, over2;
+
+	case STR_IS_BOOL:
+	    if (allowEmpty) {
+		JUMP1(	JUMP_TRUE, over);
+		PUSH(	"");
+		OP(	STR_EQ);
+		JUMP1(	JUMP, over2);
+		FIXJUMP1(over);
+		OP(	POP);
+		PUSH(	"1");
+		FIXJUMP1(over2);
+	    } else {
+		OP4(	REVERSE, 2);
+		OP(	POP);
+	    }
+	    return TCL_OK;
+	case STR_IS_TRUE:
+	    JUMP1(	JUMP_TRUE, over);
+	    if (allowEmpty) {
+		PUSH(	"");
+		OP(	STR_EQ);
+	    } else {
+		OP(	POP);
+		PUSH(	"0");
+	    }
+	    FIXJUMP1(	over);
+	    OP(		LNOT);
+	    OP(		LNOT);
+	    return TCL_OK;
+	case STR_IS_FALSE:
+	    JUMP1(	JUMP_TRUE, over);
+	    if (allowEmpty) {
+		PUSH(	"");
+		OP(	STR_NEQ);
+	    } else {
+		OP(	POP);
+		PUSH(	"1");
+	    }
+	    FIXJUMP1(	over);
+	    OP(		LNOT);
+	    return TCL_OK;
+	}
+
+    case STR_IS_DOUBLE: {
+	int satisfied, isEmpty;
+
+	if (allowEmpty) {
+	    OP(		DUP);
+	    PUSH(	"");
+	    OP(		STR_EQ);
+	    JUMP1(	JUMP_TRUE, isEmpty);
+	    OP(		NUM_TYPE);
+	    JUMP1(	JUMP_TRUE, satisfied);
+	    PUSH(	"0");
+	    JUMP1(	JUMP, end);
+	    FIXJUMP1(	isEmpty);
+	    OP(		POP);
+	    FIXJUMP1(	satisfied);
+	} else {
+	    OP(		NUM_TYPE);
+	    JUMP1(	JUMP_TRUE, satisfied);
+	    PUSH(	"0");
+	    JUMP1(	JUMP, end);
+	    TclAdjustStackDepth(-1, envPtr);
+	    FIXJUMP1(	satisfied);
+	}
+	PUSH(		"1");
+	FIXJUMP1(	end);
+	return TCL_OK;
+    }
+
+    case STR_IS_INT:
+    case STR_IS_WIDE:
+    case STR_IS_ENTIER:
+	if (allowEmpty) {
+	    int testNumType;
+
+	    OP(		DUP);
+	    OP(		NUM_TYPE);
+	    OP(		DUP);
+	    JUMP1(	JUMP_TRUE, testNumType);
+	    OP(		POP);
+	    PUSH(	"");
+	    OP(		STR_EQ);
+	    JUMP1(	JUMP, end);
+	    TclAdjustStackDepth(1, envPtr);
+	    FIXJUMP1(	testNumType);
+	    OP4(	REVERSE, 2);
+	    OP(		POP);
+	} else {
+	    OP(		NUM_TYPE);
+	    OP(		DUP);
+	    JUMP1(	JUMP_FALSE, end);
+	}
+
+	switch (t) {
+	case STR_IS_INT:
+	    PUSH(	"1");
+	    OP(		EQ);
+	    break;
+	case STR_IS_WIDE:
+	    PUSH(	"2");
+	    OP(		LE);
+	    break;
+	case STR_IS_ENTIER:
+	    PUSH(	"3");
+	    OP(		LE);
+	    break;
+	}
+	FIXJUMP1(	end);
+	return TCL_OK;
+
+    case STR_IS_LIST:
+	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	OP4(		BEGIN_CATCH4, range);
+	ExceptionRangeStarts(envPtr, range);
+	OP(		DUP);
+	OP(		LIST_LENGTH);
+	OP(		POP);
+	ExceptionRangeEnds(envPtr, range);
+	ExceptionRangeTarget(envPtr, range, catchOffset);
+	OP(		POP);
+	OP(		PUSH_RETURN_CODE);
+	OP(		END_CATCH);
+	OP(		LNOT);
+	return TCL_OK;
+    }
+
+    return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+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 TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+	}
+	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 TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+	}
+	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;
+}
+
+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;
+}
+
+int
+TclCompileStringMapCmd(
+    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 *mapTokenPtr, *stringTokenPtr;
+    Tcl_Obj *mapObj, **objv;
+    char *bytes;
+    int len;
+
+    /*
+     * We only handle the case:
+     *
+     *    string map {foo bar} $thing
+     *
+     * That is, a literal two-element list (doesn't need to be brace-quoted,
+     * but does need to be compile-time knowable) and any old argument (the
+     * thing to map).
+     */
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+    mapTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    stringTokenPtr = TokenAfter(mapTokenPtr);
+    mapObj = Tcl_NewObj();
+    Tcl_IncrRefCount(mapObj);
+    if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
+	Tcl_DecrRefCount(mapObj);
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
+	Tcl_DecrRefCount(mapObj);
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    } else if (len != 2) {
+	Tcl_DecrRefCount(mapObj);
+	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    /*
+     * Now issue the opcodes. Note that in the case that we know that the
+     * first word is an empty word, we don't issue the map at all. That is the
+     * correct semantics for mapping.
+     */
+
+    bytes = Tcl_GetStringFromObj(objv[0], &len);
+    if (len == 0) {
+	CompileWord(envPtr, stringTokenPtr, interp, 2);
+    } else {
+	PushLiteral(envPtr, bytes, len);
+	bytes = Tcl_GetStringFromObj(objv[1], &len);
+	PushLiteral(envPtr, bytes, len);
+	CompileWord(envPtr, stringTokenPtr, interp, 2);
+	OP(STR_MAP);
+    }
+    Tcl_DecrRefCount(mapObj);
+    return TCL_OK;
+}
+
+int
+TclCompileStringRangeCmd(
+    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 *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
+    int idx1, idx2;
+
+    if (parsePtr->numWords != 4) {
+	return TCL_ERROR;
+    }
+    stringTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    fromTokenPtr = TokenAfter(stringTokenPtr);
+    toTokenPtr = TokenAfter(fromTokenPtr);
+
+    /*
+     * Parse the two indices.
+     */
+
+    if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
+	goto nonConstantIndices;
+    }
+    if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
+	goto nonConstantIndices;
+    }
+
+    /*
+     * Push the operand onto the stack and then the substring operation.
+     */
+
+    CompileWord(envPtr, stringTokenPtr,			interp, 1);
+    OP44(		STR_RANGE_IMM, idx1, idx2);
+    return TCL_OK;
+
+    /*
+     * Push the operands onto the stack and then the substring operation.
+     */
+
+  nonConstantIndices:
+    CompileWord(envPtr, stringTokenPtr,			interp, 1);
+    CompileWord(envPtr, fromTokenPtr,			interp, 2);
+    CompileWord(envPtr, toTokenPtr,			interp, 3);
+    OP(			STR_RANGE);
+    return TCL_OK;
+}
+
+int
+TclCompileStringReplaceCmd(
+    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, *valueTokenPtr, *replacementTokenPtr = NULL;
+    DefineLineInformation;	/* TIP #280 */
+    int idx1, idx2;
+
+    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+	return TCL_ERROR;
+    }
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (parsePtr->numWords == 5) {
+	tokenPtr = TokenAfter(valueTokenPtr);
+	tokenPtr = TokenAfter(tokenPtr);
+	replacementTokenPtr = TokenAfter(tokenPtr);
+    }
+
+    /*
+     * Parse the indices. Will only compile special cases if both are
+     * constants and not an _integer_ less than zero (since we reserve
+     * negative indices here for end-relative indexing) or an end-based index
+     * greater than 'end' itself.
+     */
+
+    tokenPtr = TokenAfter(valueTokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+	goto genericReplace;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+	goto genericReplace;
+    }
+
+    /*
+     * We handle these replacements specially: first character (where
+     * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
+     * else and the semantics get rather screwy.
+     */
+
+    if (idx1 == 0 && idx2 == 0) {
+	int notEq, end;
+
+	/*
+	 * Just working with the first character.
+	 */
+
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	if (replacementTokenPtr == NULL) {
+	    /* Drop first */
+	    OP44(	STR_RANGE_IMM, 1, INDEX_END);
+	    return TCL_OK;
+	}
+	/* Replace first */
+	CompileWord(envPtr, replacementTokenPtr, interp, 4);
+	OP4(		OVER, 1);
+	PUSH(		"");
+	OP(		STR_EQ);
+	JUMP1(		JUMP_FALSE, notEq);
+	OP(		POP);
+	JUMP1(		JUMP, end);
+	FIXJUMP1(notEq);
+	TclAdjustStackDepth(1, envPtr);
+	OP4(		REVERSE, 2);
+	OP44(		STR_RANGE_IMM, 1, INDEX_END);
+	OP1(		STR_CONCAT1, 2);
+	FIXJUMP1(end);
+	return TCL_OK;
+
+    } else if (idx1 == INDEX_END && idx2 == INDEX_END) {
+	int notEq, end;
+
+	/*
+	 * Just working with the last character.
+	 */
+
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	if (replacementTokenPtr == NULL) {
+	    /* Drop last */
+	    OP44(	STR_RANGE_IMM, 0, INDEX_END-1);
+	    return TCL_OK;
+	}
+	/* Replace last */
+	CompileWord(envPtr, replacementTokenPtr, interp, 4);
+	OP4(		OVER, 1);
+	PUSH(		"");
+	OP(		STR_EQ);
+	JUMP1(		JUMP_FALSE, notEq);
+	OP(		POP);
+	JUMP1(		JUMP, end);
+	FIXJUMP1(notEq);
+	TclAdjustStackDepth(1, envPtr);
+	OP4(		REVERSE, 2);
+	OP44(		STR_RANGE_IMM, 0, INDEX_END-1);
+	OP4(		REVERSE, 2);
+	OP1(		STR_CONCAT1, 2);
+	FIXJUMP1(end);
+	return TCL_OK;
+
+    } else {
+	/*
+	 * Need to process indices at runtime. This could be because the
+	 * indices are not constants, or because we need to resolve them to
+	 * absolute indices to work out if a replacement is going to happen.
+	 * In any case, to runtime it is.
+	 */
+
+    genericReplace:
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	tokenPtr = TokenAfter(valueTokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 3);
+	if (replacementTokenPtr != NULL) {
+	    CompileWord(envPtr, replacementTokenPtr, interp, 4);
+	} else {
+	    PUSH(	"");
+	}
+	OP(		STR_REPLACE);
+	return TCL_OK;
+    }
+}
+
+int
+TclCompileStringTrimLCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr,			interp, 2);
+    } else {
+	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+    }
+    OP(			STR_TRIM_LEFT);
+    return TCL_OK;
+}
+
+int
+TclCompileStringTrimRCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr,			interp, 2);
+    } else {
+	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+    }
+    OP(			STR_TRIM_RIGHT);
+    return TCL_OK;
+}
+
+int
+TclCompileStringTrimCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr,			interp, 2);
+    } else {
+	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+    }
+    OP(			STR_TRIM);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToUpperCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_UPPER);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToLowerCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_LOWER);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToTitleCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_TITLE);
+    return TCL_OK;
+}
+
+/*
+ * Support definitions for the [string is] compilation.
+ */
+
+static int
+UniCharIsAscii(
+    int character)
+{
+    return (character >= 0) && (character < 0x80);
+}
+
+static int
+UniCharIsHexDigit(
+    int character)
+{
+    return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+StringClassDesc const tclStringClassTable[] = {
+    {"alnum",	Tcl_UniCharIsAlnum},
+    {"alpha",	Tcl_UniCharIsAlpha},
+    {"ascii",	UniCharIsAscii},
+    {"control", Tcl_UniCharIsControl},
+    {"digit",	Tcl_UniCharIsDigit},
+    {"graph",	Tcl_UniCharIsGraph},
+    {"lower",	Tcl_UniCharIsLower},
+    {"print",	Tcl_UniCharIsPrint},
+    {"punct",	Tcl_UniCharIsPunct},
+    {"space",	Tcl_UniCharIsSpace},
+    {"upper",	Tcl_UniCharIsUpper},
+    {"word",	Tcl_UniCharIsWordChar},
+    {"xdigit",	UniCharIsHexDigit},
+    {NULL,	NULL}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+    if (state != NULL) {
+	Tcl_ResetResult(interp);
+    }
+
+    /*
+     * 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_STR_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) {
+	PUSH("");
+	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;
+	case TCL_TOKEN_VARIABLE:
+	    /*
+	     * Check for simple variable access; see if we can only generate
+	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
+	     * there is no need to generate elaborate exception-management
+	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
+	     * always TCL_TOKEN_TEXT...
+	     */
+
+	    if (tokenPtr->numComponents > 1) {
+		int i, foundCommand = 0;
+
+		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
+		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
+			foundCommand = 1;
+			break;
+		    }
+		}
+		if (foundCommand) {
+		    break;
+		}
+	    }
+
+	    envPtr->line = bline;
+	    TclCompileVarSubst(interp, tokenPtr, envPtr);
+	    bline = envPtr->line;
+	    count++;
+	    continue;
+	}
+
+	while (count > 255) {
+	    OP1(		STR_CONCAT1, 255);
+	    count -= 254;
+	}
+	if (count > 1) {
+	    OP1(		STR_CONCAT1, count);
+	    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 = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	OP4(	BEGIN_CATCH4, catchRange);
+	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 */
+	OP(	END_CATCH);
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
+	TclAdjustStackDepth(-1, envPtr);
+
+	/* Exceptional return codes processed here */
+	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
+	OP(	PUSH_RETURN_OPTIONS);
+	OP(	PUSH_RESULT);
+	OP(	PUSH_RETURN_CODE);
+	OP(	END_CATCH);
+	OP(	RETURN_CODE_BRANCH);
+
+	/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
+	OP(	RETURN_STK);
+	OP(	NOP);
+
+	/* 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);
+
+	TclAdjustStackDepth(1, envPtr);
+	/* BREAK destination */
+	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
+	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
+		    (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
+	}
+	OP(	POP);
+	OP(	POP);
+
+	breakJump = CurrentOffset(envPtr) - breakOffset;
+	if (breakJump > 127) {
+	    OP4(JUMP4, -breakJump);
+	} else {
+	    OP1(JUMP1, -breakJump);
+	}
+
+	TclAdjustStackDepth(2, envPtr);
+	/* CONTINUE destination */
+	if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
+	    Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
+		    (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
+	}
+	OP(	POP);
+	OP(	POP);
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);
+
+	TclAdjustStackDepth(2, envPtr);
+	/* 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.
+	 */
+
+	OP4(	REVERSE, 2);
+	OP(	POP);
+
+	/* OK destination */
+	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
+	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
+		    (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
+	}
+	if (count > 1) {
+	    OP1(STR_CONCAT1, count);
+	    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) {
+	OP1(	STR_CONCAT1, 255);
+	count -= 254;
+    }
+    if (count > 1) {
+	OP1(	STR_CONCAT1, count);
+    }
+
+    Tcl_FreeParse(&parse);
+
+    if (state != NULL) {
+	Tcl_RestoreInterpState(interp, state);
+	TclCompileSyntaxError(interp, envPtr);
+	TclAdjustStackDepth(-1, 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) {
+		goto abort;
+	    }
+
+	    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) {
+	abort:
+	    ckfree((char *) bodyToken);
+	    ckfree((char *) bodyTokenArray);
+	    ckfree((char *) bodyLines);
+	    ckfree((char *) bodyContLines);
+	    return TCL_ERROR;
+	}
+    } else if (numWords % 2 || numWords == 0) {
+	/*
+	 * Odd number of words (>1) available, or no words at all available.
+	 * Both are error cases, so punt and let the interpreted-version
+	 * generate the error message. Note that the second case probably
+	 * should get caught earlier, but it's easy to check here again anyway
+	 * because it'd cause a nasty crash otherwise.
+	 */
+
+	return TCL_ERROR;
+    } else {
+	/*
+	 * Multi-word definition of patterns & actions.
+	 */
+
+	bodyToken = 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.
+     */
+
+    /* Both methods push the value to match against onto the stack. */
+    CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
+
+    if (mode == Switch_Exact) {
+	IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
+		bodyLines, bodyContLines);
+    } else {
+	IssueSwitchChainedTests(interp, envPtr, mode, noCase, valueIndex,
+		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. */
+    int mode,			/* Exact, Glob or Regexp */
+    int noCase,			/* Case-insensitivity flag. */
+    int valueIndex,		/* The value to match against. */
+    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 foundDefault;		/* Flag to indicate whether a "default" clause
+				 * is present. */
+    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
+    unsigned 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;
+
+    /*
+     * 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;
+	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:
+		OP(	DUP);
+		TclCompileTokens(interp, bodyToken[i], 1,	envPtr);
+		OP(	STR_EQ);
+		break;
+	    case Switch_Glob:
+		TclCompileTokens(interp, bodyToken[i], 1,	envPtr);
+		OP4(	OVER, 1);
+		OP1(	STR_MATCH, noCase);
+		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 == "".
+			 */
+
+			PUSH("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, NULL) == TCL_OK){
+			simple = 1;
+			PushLiteral(envPtr, Tcl_DStringValue(&ds),
+				Tcl_DStringLength(&ds));
+			Tcl_DStringFree(&ds);
+		    }
+		}
+		if (!simple) {
+		    TclCompileTokens(interp, bodyToken[i], 1, envPtr);
+		}
+
+		OP4(	OVER, 1);
+		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);
+
+		    OP1(REGEXP, cflags);
+		} else if (exact && !noCase) {
+		    OP(	STR_EQ);
+		} else {
+		    OP1(STR_MATCH, noCase);
+		}
+		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 BODY()
+	 * because we may have synthesized the tokens in a non-standard
+	 * pattern.
+	 */
+
+	OP(	POP);
+	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) {
+	OP(	POP);
+	PUSH("");
+    }
+
+    /*
+     * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+    int valueIndex,		/* The value to match against. */
+    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;
+
+    /*
+     * 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);
+    OP4(	JUMP_TABLE, infoIndex);
+    jumpToDefault = CurrentOffset(envPtr);
+    OP4(	JUMP4, 0);
+
+    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);
+	    TclDStringAppendToken(&buffer, bodyToken[i]);
+	    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.
+	     */
+
+	    OP4(	JUMP4, 0);
+	    TclAdjustStackDepth(-1, 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);
+	PUSH("");
+    }
+
+    /*
+     * 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
+ *	DisassembleJumptableInfo: none
+ *
+ * Side effects:
+ *	DupJumptableInfo: allocates memory
+ *	FreeJumptableInfo: releases memory
+ *	PrintJumptableInfo: none
+ *	DisassembleJumptableInfo: 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);
+    }
+}
+
+static void
+DisassembleJumptableInfo(
+    ClientData clientData,
+    Tcl_Obj *dictObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    register JumptableInfo *jtPtr = clientData;
+    Tcl_Obj *mapping = Tcl_NewObj();
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    const char *keyPtr;
+    int offset;
+
+    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
+	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
+	offset = PTR2INT(Tcl_GetHashValue(hPtr));
+	Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
+		Tcl_NewIntObj(offset));
+    }
+    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileTailcallCmd --
+ *
+ *	Procedure called to compile the "tailcall" 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 "tailcall" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileTailcallCmd(
+    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 = parsePtr->tokenPtr;
+    int i;
+
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
+	    || envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /* make room for the nsObjPtr */
+    /* TODO: Doesn't this have to be a known value? */
+    CompileWord(envPtr, tokenPtr, interp, 0);
+    for (i=1 ; i<parsePtr->numWords ; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords,	envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    int codeKnown, codeIsList, codeIsValid, len;
+
+    if (numWords != 3) {
+	return TCL_ERROR;
+    }
+    codeToken = TokenAfter(parsePtr->tokenPtr);
+    msgToken = TokenAfter(codeToken);
+
+    TclNewObj(objPtr);
+    Tcl_IncrRefCount(objPtr);
+
+    codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr);
+
+    /*
+     * First we must emit the code to substitute the arguments.  This
+     * must come first in case substitution raises errors.
+     */
+    if (!codeKnown) {
+	CompileWord(envPtr, codeToken, interp, 1);
+	PUSH(			"-errorcode");
+    }
+    CompileWord(envPtr, msgToken, interp, 2);
+
+    codeIsList = codeKnown && (TCL_OK ==
+	    Tcl_ListObjLength(interp, objPtr, &len));
+    codeIsValid = codeIsList && (len != 0);
+
+    if (codeIsValid) {
+	Tcl_Obj *errPtr, *dictPtr;
+
+	TclNewLiteralStringObj(errPtr, "-errorcode");
+	TclNewObj(dictPtr);
+	Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr);
+	TclEmitPush(TclAddLiteralObj(envPtr, dictPtr, NULL), envPtr);
+    }
+    TclDecrRefCount(objPtr);
+
+    /*
+     * Simpler bytecodes when we detect invalid arguments at compile time.
+     */
+    if (codeKnown && !codeIsValid) {
+	OP(			POP);
+	if (codeIsList) {
+	    /* Must be an empty list */
+	    goto issueErrorForEmptyCode;
+	}
+	TclCompileSyntaxError(interp, envPtr);
+	return TCL_OK;
+    }
+
+    if (!codeKnown) {
+	/*
+	 * Argument validity checking has to be done by bytecode at
+	 * run time.
+	 */
+	OP4(			REVERSE, 3);
+	OP(			DUP);
+	OP(			LIST_LENGTH);
+	OP1(			JUMP_FALSE1, 16);
+	OP4(			LIST, 2);
+	OP44(			RETURN_IMM, TCL_ERROR, 0);
+	TclAdjustStackDepth(2, envPtr);
+	OP(			POP);
+	OP(			POP);
+	OP(			POP);
+    issueErrorForEmptyCode:
+	PUSH(			"type must be non-empty list");
+	PUSH(			"-errorcode {TCL OPERATION THROW BADEXCEPTION}");
+    }
+    OP44(			RETURN_IMM, TCL_ERROR, 0);
+    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 */
+	BODY(bodyToken, 1);
+	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);
+
+		resultVarIndices[i] = LocalScalar(varname, len, envPtr);
+		if (resultVarIndices[i] < 0) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+	    } else {
+		resultVarIndices[i] = -1;
+	    }
+	    if (objc == 2) {
+		int len;
+		const char *varname = Tcl_GetStringFromObj(objv[1], &len);
+
+		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
+		if (optionVarIndices[i] < 0) {
+		    TclDecrRefCount(tmpObj);
+		    goto failedToCompile;
+		}
+	    } 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 = IssueTryClausesInstructions(interp, envPtr, bodyToken,
+		numHandlers, matchCodes, matchClauses, resultVarIndices,
+		optionVarIndices, handlerTokens);
+    } else if (numHandlers == 0) {
+	result = IssueTryFinallyInstructions(interp, envPtr, bodyToken,
+		finallyToken);
+    } else {
+	result = IssueTryClausesFinallyInstructions(interp, envPtr, bodyToken,
+		numHandlers, matchCodes, matchClauses, resultVarIndices,
+		optionVarIndices, handlerTokens, finallyToken);
+    }
+
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IssueTryClausesInstructions, IssueTryClausesFinallyInstructions,
+ * IssueTryFinallyInstructions --
+ *
+ *	The code generators for [try]. Split from the parsing engine for
+ *	reasons of developer sanity, and also split between no-finally,
+ *	just-finally and with-finally cases because so many of the details of
+ *	generation vary between the three.
+ *
+ *	The macros below make the instruction issuing easier to follow.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IssueTryClausesInstructions(
+    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, trapZero = 0, afterBody = 0;
+    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+    int *noError;
+    char buf[TCL_INTEGER_SPACE];
+
+    resultVar = AnonymousLocal(envPtr);
+    optionsVar = AnonymousLocal(envPtr);
+    if (resultVar < 0 || optionsVar < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check if we're supposed to trap a normal TCL_OK completion of the body.
+     * If not, we can handle that case much more efficiently.
+     */
+
+    for (i=0 ; i<numHandlers ; i++) {
+	if (matchCodes[i] == 0) {
+	    trapZero = 1;
+	    break;
+	}
+    }
+
+    /*
+     * 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 = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				bodyToken, 1);
+    ExceptionRangeEnds(envPtr, range);
+    if (!trapZero) {
+	OP(				END_CATCH);
+	JUMP4(				JUMP, afterBody);
+	TclAdjustStackDepth(-1, envPtr);
+    } else {
+	PUSH(				"0");
+	OP4(				REVERSE, 2);
+	OP1(				JUMP1, 4);
+	TclAdjustStackDepth(-2, envPtr);
+    }
+    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);
+    noError = TclStackAlloc(interp, sizeof(int)*numHandlers);
+
+    for (i=0 ; i<numHandlers ; i++) {
+	noError[i] = -1;
+	sprintf(buf, "%d", matchCodes[i]);
+	OP(				DUP);
+	PushLiteral(envPtr, buf, strlen(buf));
+	OP(				EQ);
+	JUMP4(				JUMP_FALSE, notCodeJumpSource);
+	if (matchClauses[i]) {
+	    const char *p;
+	    Tcl_ListObjLength(NULL, matchClauses[i], &len);
+
+	    /*
+	     * Match the errorcode according to try/trap rules.
+	     */
+
+	    LOAD(			optionsVar);
+	    PUSH(			"-errorcode");
+	    OP4(			DICT_GET, 1);
+	    TclAdjustStackDepth(-1, envPtr);
+	    OP44(			LIST_RANGE_IMM, 0, len-1);
+	    p = Tcl_GetStringFromObj(matchClauses[i], &len);
+	    PushLiteral(envPtr, p, len);
+	    OP(				STR_EQ);
+	    JUMP4(			JUMP_FALSE, notECJumpSource);
+	} 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;
+	    JUMP4(			JUMP, forwardsToFix[i]);
+	    TclAdjustStackDepth(1, envPtr);
+	} else {
+	    int dontChangeOptions;
+
+	    forwardsToFix[i] = -1;
+	    if (forwardsNeedFixing) {
+		forwardsNeedFixing = 0;
+		for (j=0 ; j<i ; j++) {
+		    if (forwardsToFix[j] == -1) {
+			continue;
+		    }
+		    FIXJUMP4(forwardsToFix[j]);
+		    forwardsToFix[j] = -1;
+		}
+	    }
+	    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	    OP4(			BEGIN_CATCH4, range);
+	    ExceptionRangeStarts(envPtr, range);
+	    BODY(			handlerTokens[i], 5+i*4);
+	    ExceptionRangeEnds(envPtr, range);
+	    OP(				END_CATCH);
+	    JUMP4(			JUMP, noError[i]);
+	    ExceptionRangeTarget(envPtr, range, catchOffset);
+	    TclAdjustStackDepth(-1, envPtr);
+	    OP(				PUSH_RESULT);
+	    OP(				PUSH_RETURN_OPTIONS);
+	    OP(				PUSH_RETURN_CODE);
+	    OP(				END_CATCH);
+	    PUSH(			"1");
+	    OP(				EQ);
+	    JUMP1(			JUMP_FALSE, dontChangeOptions);
+	    LOAD(			optionsVar);
+	    OP4(			REVERSE, 2);
+	    STORE(			optionsVar);
+	    OP(				POP);
+	    PUSH(			"-during");
+	    OP4(			REVERSE, 2);
+	    OP44(			DICT_SET, 1, optionsVar);
+	    TclAdjustStackDepth(-1, envPtr);
+	    FIXJUMP1(		dontChangeOptions);
+	    OP4(			REVERSE, 2);
+	    INVOKE(			RETURN_STK);
+	}
+
+	JUMP4(				JUMP, addrsToFix[i]);
+	if (matchClauses[i]) {
+	    FIXJUMP4(	notECJumpSource);
+	}
+	FIXJUMP4(	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);
+    INVOKE(				RETURN_STK);
+
+    /*
+     * Fix all the jumps from taken clauses to here (which is the end of the
+     * [try]).
+     */
+
+    if (!trapZero) {
+	FIXJUMP4(afterBody);
+    }
+    for (i=0 ; i<numHandlers ; i++) {
+	FIXJUMP4(addrsToFix[i]);
+	if (noError[i] != -1) {
+	    FIXJUMP4(noError[i]);
+	}
+    }
+    TclStackFree(interp, noError);
+    TclStackFree(interp, forwardsToFix);
+    TclStackFree(interp, addrsToFix);
+    return TCL_OK;
+}
+
+static int
+IssueTryClausesFinallyInstructions(
+    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 range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
+    int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
+    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
+    char buf[TCL_INTEGER_SPACE];
+
+    resultVar = AnonymousLocal(envPtr);
+    optionsVar = AnonymousLocal(envPtr);
+    if (resultVar < 0 || optionsVar < 0) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check if we're supposed to trap a normal TCL_OK completion of the body.
+     * If not, we can handle that case much more efficiently.
+     */
+
+    for (i=0 ; i<numHandlers ; i++) {
+	if (matchCodes[i] == 0) {
+	    trapZero = 1;
+	    break;
+	}
+    }
+
+    /*
+     * 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 = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				bodyToken, 1);
+    ExceptionRangeEnds(envPtr, range);
+    if (!trapZero) {
+	OP(				END_CATCH);
+	STORE(				resultVar);
+	OP(				POP);
+	PUSH(				"-level 0 -code 0");
+	STORE(				optionsVar);
+	OP(				POP);
+	JUMP4(				JUMP, afterBody);
+    } else {
+	PUSH(				"0");
+	OP4(				REVERSE, 2);
+	OP1(				JUMP1, 4);
+	TclAdjustStackDepth(-2, envPtr);
+    }
+    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.
+     *
+     * 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++) {
+	int noTrapError, trapError;
+	const char *p;
+
+	sprintf(buf, "%d", matchCodes[i]);
+	OP(				DUP);
+	PushLiteral(envPtr, buf, strlen(buf));
+	OP(				EQ);
+	JUMP4(				JUMP_FALSE, notCodeJumpSource);
+	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);
+	    TclAdjustStackDepth(-1, envPtr);
+	    OP44(			LIST_RANGE_IMM, 0, len-1);
+	    p = Tcl_GetStringFromObj(matchClauses[i], &len);
+	    PushLiteral(envPtr, p, len);
+	    OP(				STR_EQ);
+	    JUMP4(			JUMP_FALSE, notECJumpSource);
+	} else {
+	    notECJumpSource = -1; /* LINT */
+	}
+	OP(				POP);
+
+	/*
+	 * 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 = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	    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;
+		JUMP4(			JUMP, forwardsToFix[i]);
+		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;
+	    JUMP4(			JUMP, forwardsToFix[i]);
+	    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;
+		}
+		FIXJUMP4(	forwardsToFix[j]);
+		forwardsToFix[j] = -1;
+	    }
+	    OP4(			BEGIN_CATCH4, range);
+	}
+	BODY(				handlerTokens[i], 5+i*4);
+	ExceptionRangeEnds(envPtr, range);
+	PUSH(				"0");
+	OP(				PUSH_RETURN_OPTIONS);
+	OP4(				REVERSE, 3);
+	OP1(				JUMP1, 5);
+	TclAdjustStackDepth(-3, envPtr);
+	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_RETURN_CODE);
+	OP(				PUSH_RESULT);
+	OP(				END_CATCH);
+	STORE(				resultVar);
+	OP(				POP);
+	PUSH(				"1");
+	OP(				EQ);
+	JUMP1(				JUMP_FALSE, noTrapError);
+	LOAD(				optionsVar);
+	PUSH(				"-during");
+	OP4(				REVERSE, 3);
+	STORE(				optionsVar);
+	OP(				POP);
+	OP44(				DICT_SET, 1, optionsVar);
+	TclAdjustStackDepth(-1, envPtr);
+	JUMP1(				JUMP, trapError);
+	FIXJUMP1(		noTrapError);
+	STORE(				optionsVar);
+	FIXJUMP1(		trapError);
+	/* Skip POP at end; can clean up with subsequent POP */
+	if (i+1 < numHandlers) {
+	    OP(				POP);
+	}
+
+    endOfThisArm:
+	if (i+1 < numHandlers) {
+	    JUMP4(			JUMP, addrsToFix[i]);
+	    TclAdjustStackDepth(1, envPtr);
+	}
+	if (matchClauses[i]) {
+	    FIXJUMP4(		notECJumpSource);
+	}
+	FIXJUMP4(		notCodeJumpSource);
+    }
+
+    /*
+     * Drop the result code, and fix all the jumps from taken clauses - which
+     * drop the result code as their first action - to point straight after
+     * (i.e., to the start of the finally clause).
+     */
+
+    OP(					POP);
+    for (i=0 ; i<numHandlers-1 ; i++) {
+	FIXJUMP4(		addrsToFix[i]);
+    }
+    TclStackFree(interp, forwardsToFix);
+    TclStackFree(interp, addrsToFix);
+
+    /*
+     * 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).
+     */
+
+    if (!trapZero) {
+	FIXJUMP4(		afterBody);
+    }
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				finallyToken, 3 + 4*numHandlers);
+    ExceptionRangeEnds(envPtr, range);
+    OP(					END_CATCH);
+    OP(					POP);
+    JUMP1(				JUMP, finalOK);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    OP(					PUSH_RESULT);
+    OP(					PUSH_RETURN_OPTIONS);
+    OP(					PUSH_RETURN_CODE);
+    OP(					END_CATCH);
+    PUSH(				"1");
+    OP(					EQ);
+    JUMP1(				JUMP_FALSE, noFinalError);
+    LOAD(				optionsVar);
+    PUSH(				"-during");
+    OP4(				REVERSE, 3);
+    STORE(				optionsVar);
+    OP(					POP);
+    OP44(				DICT_SET, 1, optionsVar);
+    TclAdjustStackDepth(-1, envPtr);
+    OP(					POP);
+    JUMP1(				JUMP, finalError);
+    TclAdjustStackDepth(1, envPtr);
+    FIXJUMP1(			noFinalError);
+    STORE(				optionsVar);
+    OP(					POP);
+    FIXJUMP1(			finalError);
+    STORE(				resultVar);
+    OP(					POP);
+    FIXJUMP1(			finalOK);
+    LOAD(				optionsVar);
+    LOAD(				resultVar);
+    INVOKE(				RETURN_STK);
+
+    return TCL_OK;
+}
+
+static int
+IssueTryFinallyInstructions(
+    Tcl_Interp *interp,
+    CompileEnv *envPtr,
+    Tcl_Token *bodyToken,
+    Tcl_Token *finallyToken)
+{
+    DefineLineInformation;	/* TIP #280 */
+    int range, jumpOK, jumpSplice;
+
+    /*
+     * Note that this one is simple enough that we can issue it without
+     * needing a local variable table, making it a universal compilation.
+     */
+
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				bodyToken, 1);
+    ExceptionRangeEnds(envPtr, range);
+    OP1(				JUMP1, 3);
+    TclAdjustStackDepth(-1, envPtr);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    OP(					PUSH_RESULT);
+    OP(					PUSH_RETURN_OPTIONS);
+    OP(					END_CATCH);
+
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    OP4(				BEGIN_CATCH4, range);
+    ExceptionRangeStarts(envPtr, range);
+    BODY(				finallyToken, 3);
+    ExceptionRangeEnds(envPtr, range);
+    OP(					END_CATCH);
+    OP(					POP);
+    JUMP1(				JUMP, jumpOK);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    OP(					PUSH_RESULT);
+    OP(					PUSH_RETURN_OPTIONS);
+    OP(					PUSH_RETURN_CODE);
+    OP(					END_CATCH);
+    PUSH(				"1");
+    OP(					EQ);
+    JUMP1(				JUMP_FALSE, jumpSplice);
+    PUSH(				"-during");
+    OP4(				OVER, 3);
+    OP4(				LIST, 2);
+    OP(					LIST_CONCAT);
+    FIXJUMP1(		jumpSplice);
+    OP4(				REVERSE, 4);
+    OP(					POP);
+    OP(					POP);
+    OP1(				JUMP1, 7);
+    FIXJUMP1(		jumpOK);
+    OP4(				REVERSE, 2);
+    INVOKE(				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, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
+    DefineLineInformation;	/* TIP #280 */
+
+    /* TODO: Consider support for compiling expanded args. */
+
+    /*
+     * Verify that all words - except the first non-option one - are known at
+     * compile time so that we can handle them without needing to do a nasty
+     * push/rotate. [Bug 3970f54c4e]
+     */
+
+    for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+	Tcl_Obj *leadingWord = Tcl_NewObj();
+
+	varTokenPtr = TokenAfter(varTokenPtr);
+	if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+	    TclDecrRefCount(leadingWord);
+
+	    /*
+	     * We can tolerate non-trivial substitutions in the first variable
+	     * to be unset. If a '--' or '-nocomplain' was present, anything
+	     * goes in that one place! (All subsequent variable names must be
+	     * constants since we don't want to have to push them all first.)
+	     */
+
+	    if (varCount == 0) {
+		if (haveFlags) {
+		    continue;
+		}
+
+		/*
+		 * In fact, we're OK as long as we're the first argument *and*
+		 * we provably don't start with a '-'. If that is true, then
+		 * even if everything else is varying, we still can't be a
+		 * flag. Otherwise we'll spill to runtime to place a limit on
+		 * the trickiness.
+		 */
+
+		if (varTokenPtr->type == TCL_TOKEN_WORD
+			&& varTokenPtr[1].type == TCL_TOKEN_TEXT
+			&& varTokenPtr[1].size > 0
+			&& varTokenPtr[1].start[0] != '-') {
+		    continue;
+		}
+	    }
+	    return TCL_ERROR;
+	}
+	if (varCount == 0) {
+	    const char *bytes;
+	    int len;
+
+	    bytes = Tcl_GetStringFromObj(leadingWord, &len);
+	    if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+		flags = 0;
+		haveFlags++;
+	    } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
+		haveFlags++;
+	    } else {
+		varCount++;
+	    }
+	} else {
+	    varCount++;
+	}
+	TclDecrRefCount(leadingWord);
+    }
+
+    /*
+     * Issue instructions to unset each of the named variables.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for (i=0; i<haveFlags;i++) {
+	varTokenPtr = TokenAfter(varTokenPtr);
+    }
+    for (i=1+haveFlags ; i<parsePtr->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, &isScalar, i);
+
+	/*
+	 * Emit instructions to unset the variable.
+	 */
+
+	if (isScalar) {
+	    if (localIndex < 0) {
+		OP1(	UNSET_STK, flags);
+	    } else {
+		OP14(	UNSET_SCALAR, flags, localIndex);
+	    }
+	} else {
+	    if (localIndex < 0) {
+		OP1(	UNSET_ARRAY_STK, flags);
+	    } else {
+		OP14(	UNSET_ARRAY, flags, localIndex);
+	    }
+	}
+
+	varTokenPtr = TokenAfter(varTokenPtr);
+    }
+    PUSH("");
+    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 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 = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
+    /*
+     * 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 &= ~1;
+	testCodeOffset = CurrentOffset(envPtr);
+    }
+
+    /*
+     * Compile the loop body.
+     */
+
+    bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
+    if (!loopMayEnd) {
+	envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+	envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
+    }
+    BODY(bodyTokenPtr, 2);
+    ExceptionRangeEnds(envPtr, range);
+    OP(		POP);
+
+    /*
+     * 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;
+	}
+	SetLineInformation(1);
+	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+
+	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);
+    TclFinalizeLoopExceptionRange(envPtr, range);
+
+    /*
+     * The while command's result is an empty string.
+     */
+
+  pushResult:
+    PUSH("");
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileYieldCmd --
+ *
+ *	Procedure called to compile the "yield" 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 "yield" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    if (parsePtr->numWords < 1 || parsePtr->numWords > 2) {
+	return TCL_ERROR;
+    }
+
+    if (parsePtr->numWords == 1) {
+	PUSH("");
+    } else {
+	DefineLineInformation;	/* TIP #280 */
+	Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+    }
+    OP(		YIELD);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileYieldToCmd --
+ *
+ *	Procedure called to compile the "yieldto" 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 "yieldto" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldToCmd(
+    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 = TokenAfter(parsePtr->tokenPtr);
+    int i;
+
+    if (parsePtr->numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    OP(		NS_CURRENT);
+    for (i = 1 ; i < parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    OP4(	LIST, i);
+    OP(		YIELD_TO_INVOKE);
+    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;
+
+    /* TODO: Consider support for compiling expanded args. */
+    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.
+	 */
+
+	OP4(	REVERSE, words-1);
+    }
+    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 */
+
+    /* TODO: Consider support for compiling expanded args. */
+    if (parsePtr->numWords < 3) {
+	PUSH("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 = AnonymousLocal(envPtr);
+	int words;
+
+	tokenPtr = TokenAfter(parsePtr->tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 1);
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	STORE(tmpIndex);
+	TclEmitOpcode(instruction, envPtr);
+	for (words=3 ; words<parsePtr->numWords ;) {
+	    LOAD(tmpIndex);
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp, words);
+	    if (++words < parsePtr->numWords) {
+		STORE(tmpIndex);
+	    }
+	    TclEmitOpcode(instruction, envPtr);
+	}
+	for (; words>3 ; words--) {
+	    OP(	BITAND);
+	}
+
+	/*
+	 * Drop the value from the temp variable; retaining that reference
+	 * might be expensive elsewhere.
+	 */
+
+	OP14(	UNSET_SCALAR, 0, tmpIndex);
+    }
+    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) {
+	PUSH("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;
+
+    /* TODO: Consider support for compiling expanded args. */
+    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;
+
+    /* TODO: Consider support for compiling expanded args. */
+    if (parsePtr->numWords == 1) {
+	/*
+	 * Fallback to direct eval to report syntax error.
+	 */
+
+	return TCL_ERROR;
+    }
+    if (parsePtr->numWords == 2) {
+	PUSH("1.0");
+    }
+    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 abb917f..4390282 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1,8 +1,8 @@
 /*
  * tclCompExpr.c --
  *
- *	This file contains the code to parse and compile Tcl expressions
- *	and implementations of the Tcl commands corresponding to expression
+ *	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::+ .
  *
  * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
@@ -15,11 +15,11 @@
 #include "tclCompile.h"		/* CompileEnv */
 
 /*
- * 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.
+ * 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.
  */
 
 typedef struct OpNode {
@@ -36,36 +36,36 @@ typedef struct OpNode {
 } OpNode;
 
 /*
- * The storage for the tree is dynamically allocated array of OpNodes.  The
+ * 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
+ * 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
+ * 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.
+ * 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. */
+    OT_EMPTY = -1	/* "Operand" is an empty string. This is a special
+			 * case used only to represent the EMPTY lexeme. See
+			 * below. */
 };
 
 /*
@@ -79,31 +79,30 @@ enum OperandTypes {
 
 /*
  * 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.
+ * 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
+ * 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.
+ * 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.
+ * 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:
+ * 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 {
@@ -119,185 +118,184 @@ enum Marks {
  */
 
 /*
- * 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.
+ * Each lexeme belongs to one of four categories, which determine its place in
+ * the parse tree. We use the two high bits of the (unsigned char) value to
+ * store a NODE_TYPE code.
  */
 
 #define NODE_TYPE	0xC0
 
 /*
- * The four category values are LEAF, UNARY, and BINARY, explained below,
- * and "uncategorized", which is used either temporarily, until context
- * determines which of the other three categories is correct, or for
- * lexemes like INVALID, which aren't really lexemes at all, but indicators
- * of a parsing error.  Note that the codes must be distinct to distinguish
- * categories, but need not take the form of a bit array.
+ * The four category values are LEAF, UNARY, and BINARY, explained below, and
+ * "uncategorized", which is used either temporarily, until context determines
+ * which of the other three categories is correct, or for lexemes like
+ * INVALID, which aren't really lexemes at all, but indicators of a parsing
+ * error. Note that the codes must be distinct to distinguish categories, but
+ * need not take the form of a bit array.
  */
 
-#define BINARY		0x40	/* This lexeme is a binary operator.  An
-				 * OpNode representing it should go into the
-				 * parse tree, and two operands should be
-				 * parsed for it in the expression.  */
-#define UNARY		0x80	/* This lexeme is a unary operator.  An OpNode
+#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
+				 * 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.
-				 */
+				 * form of substitution. */
 
 /* Uncategorized lexemes */
 
-#define PLUS		1	/* Ambiguous.  Resolves to UNARY_PLUS or
+#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
 				 * BINARY_PLUS according to context. */
-#define MINUS		2	/* Ambiguous.  Resolves to UNARY_MINUS or
+#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
 				 * BINARY_MINUS according to context. */
-#define BAREWORD	3	/* Ambigous.  Resolves to BOOLEAN or to
+#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
+#define INCOMPLETE	4	/* A parse error. Used only when the single
 				 * "=" is encountered.  */
-#define INVALID		5	/* A parse error.  Used when any punctuation
+#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() */
+#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)
+#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 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. */
+
 /*
  * 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.
+ * 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.
  */
 
 enum Precedence {
@@ -322,9 +320,9 @@ enum Precedence {
 };
 
 /*
- * 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.
+ * Here the same information contained in the comments above is stored in
+ * inverted form, so that given a lexeme, one can quickly look up its
+ * precedence value.
  */
 
 static const unsigned char prec[] = {
@@ -455,7 +453,7 @@ static const unsigned char Lexeme[] = {
 	INVALID		/* SUB */,	INVALID		/* ESC */,
 	INVALID		/* FS */,	INVALID		/* GS */,
 	INVALID		/* RS */,	INVALID		/* US */,
-	INVALID		/* SPACE */,	0 		/* ! or != */,
+	INVALID		/* SPACE */,	0		/* ! or != */,
 	QUOTED		/* " */,	INVALID		/* # */,
 	VARIABLE	/* $ */,	MOD		/* % */,
 	0		/* & or && */,	INVALID		/* ' */,
@@ -492,13 +490,6 @@ 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;
 
@@ -521,7 +512,6 @@ static int		ParseExpr(Tcl_Interp *interp, const char *start,
 			    Tcl_Parse *parsePtr, int parseOnly);
 static int		ParseLexeme(const char *start, int numBytes,
 			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);
-
 
 /*
  *----------------------------------------------------------------------
@@ -529,27 +519,27 @@ static int		ParseLexeme(const char *start, int numBytes,
  * ParseExpr --
  *
  *	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.
+ *	parses it as a Tcl expression and constructs a tree representing the
+ *	structure of the expression. The caller must pass in empty lists as
+ *	the funcList and litList arguments. The elements of the parsed
+ *	expression are returned to the caller as that tree, a list of literal
+ *	values, a list of function names, and in Tcl_Tokens added to a
+ *	Tcl_Parse struct passed in by the caller.
  *
  * Results:
  *	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.
+ *	is returned, and data about the expression structure is written to the
+ *	last four arguments. If the string cannot be parsed as a valid Tcl
+ *	expression, TCL_ERROR is returned, and if interp is non-NULL, an error
+ *	message is written to interp.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
@@ -568,68 +558,82 @@ ParseExpr(
 				 * 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. */
+				 * on to compile the expression. Different
+				 * optimizations are appropriate for the two
+				 * scenarios. */
 {
     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. */
+    unsigned 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. */
+    unsigned 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
+				 * 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
+				 * an OperandTypes value encoding what we need
+				 * to know about it. */
+    int incomplete;		/* Index of the most recent incomplete tree in
+				 * the OpNode array. Heads a stack of
 				 * incomplete trees linked by p.prev. */
     int complete = OT_EMPTY;	/* "Index" of the complete tree (that is, a
 				 * complete subexpression) determined at the
-				 * moment.   OT_EMPTY is a nonsense value
-				 * used only to silence compiler warnings.
-				 * During a parse, complete will always hold
-				 * an index or an OperandTypes value pointing
-				 * to an actual leaf at the time the complete
-				 * tree is needed. */
-
-    /* These variables control generation of the error message. */
+				 * moment. OT_EMPTY is a nonsense value used
+				 * only to silence compiler warnings. During a
+				 * parse, complete will always hold an index
+				 * or an OperandTypes value pointing to an
+				 * actual leaf at the time the complete tree
+				 * is needed. */
+
+    /*
+     * These variables control generation of the error message.
+     */
+
     Tcl_Obj *msg = NULL;	/* The error message. */
     Tcl_Obj *post = NULL;	/* In a few cases, an additional postscript
 				 * for the error message, supplying more
 				 * information after the error msg and
 				 * location have been reported. */
-    const char *mark = "_@_";	/* In the portion of the complete error message
-				 * where the error location is reported, this
-				 * "mark" substring is inserted into the
-				 * string being parsed to aid in pinpointing
-				 * the location of the syntax error in the
-				 * expression. */
+    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. */
+				 * original expression. In order to keep the
+				 * error message readable, we impose this
+				 * limit on the substring size we extract. */
 
     TclParseInit(interp, start, numBytes, parsePtr);
 
-    nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
+    nodes = attemptckalloc(nodesAvailable * sizeof(OpNode));
     if (nodes == NULL) {
 	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
+	errCode = "NOMEM";
 	goto error;
     }
 
-    /* Initialize the parse tree with the special "START" node. */
+    /*
+     * Initialize the parse tree with the special "START" node.
+     */
+
     nodes->lexeme = START;
     nodes->precedence = prec[START];
     nodes->mark = MARK_RIGHT;
@@ -638,19 +642,19 @@ ParseExpr(
     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.
+     * 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. */
+	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. */
+	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
@@ -658,19 +662,19 @@ ParseExpr(
 	 */
 
 	if (nodesUsed >= nodesAvailable) {
-	    int size = nodesUsed * 2;
+	    unsigned int size = nodesUsed * 2;
 	    OpNode *newPtr = NULL;
 
 	    do {
 	      if (size <= UINT_MAX/sizeof(OpNode)) {
-		newPtr = (OpNode *) attemptckrealloc((char *) nodes,
-			(unsigned int) size * sizeof(OpNode));
+		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;
@@ -678,32 +682,41 @@ ParseExpr(
 	}
 	nodePtr = nodes + nodesUsed;
 
-	/* Skip white space between lexemes. */
+	/*
+	 * 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. */
+	/*
+	 * 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);
+		msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
+			scanned, start);
+		errCode = "BADCHAR";
 		goto error;
 	    case INCOMPLETE:
-		msg = Tcl_ObjPrintf(
-			"incomplete operator \"%.*s\"", scanned, start);
+		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.
+		 * 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(
@@ -718,63 +731,65 @@ ParseExpr(
 		     */
 
 		    Tcl_ListObjAppendElement(NULL, funcList, literal);
+		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
+		    lexeme = BOOLEAN;
 		} else {
-		    int b;
-		    if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
-			lexeme = BOOLEAN;
-		    } else {
-			Tcl_DecrRefCount(literal);
-			msg = Tcl_ObjPrintf(
-				"invalid bareword \"%.*s%s\"",
-				(scanned < limit) ? scanned : limit - 3, start,
-				(scanned < limit) ? "" : "...");
-			post = Tcl_ObjPrintf(
-				"should be \"$%.*s%s\" or \"{%.*s%s}\"",
-				(scanned < limit) ? scanned : limit - 3,
-				start, (scanned < limit) ? "" : "...",
-				(scanned < limit) ? scanned : limit - 3,
-				start, (scanned < limit) ? "" : "...");
-			Tcl_AppendPrintfToObj(post,
-				" or \"%.*s%s(...)\" or ...",
-				(scanned < limit) ? scanned : limit - 3,
-				start, (scanned < limit) ? "" : "...");
-			if (start[0] == '0') {
-			    const char *stop;
-			    TclParseNumber(NULL, NULL, NULL, start, scanned,
-				    &stop, TCL_PARSE_NO_WHITESPACE);
-
-			    if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
+		    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;
-
-				switch (start[1]) {
-				case 'b':
-				    Tcl_AppendToObj(post,
-					    " (invalid binary number?)", -1);
-				    break;
-				case 'o':
+				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);
-				    break;
-				default:
-				    if (isdigit(UCHAR(start[1]))) {
-				        Tcl_AppendToObj(post,
-						" (invalid octal number?)", -1);
-				    }
-				    break;
+				    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+				    errCode = "BADNUMBER";
+				    subErrCode = "OCTAL";
 				}
+				break;
 			    }
 			}
-			goto error;
 		    }
+		    goto error;
 		}
 		break;
 	    case PLUS:
 	    case MINUS:
 		if (IsOperator(lastParsed)) {
-
 		    /*
-		     * A "+" or "-" coming just after another operator
-		     * must be interpreted as a unary operator.
+		     * A "+" or "-" coming just after another operator must be
+		     * interpreted as a unary operator.
 		     */
 
 		    lexeme |= UNARY;
@@ -784,17 +799,19 @@ ParseExpr(
 	    }
 	}	/* Uncategorized lexemes */
 
-	/* Handle lexeme based on its category. */
-	switch (NODE_TYPE & lexeme) {
-
 	/*
-	 * Each LEAF results in either a literal getting appended to the
-	 * litList, or a sequence of Tcl_Tokens representing a Tcl word
-	 * getting appended to the parsePtr->tokens.  No OpNode is filled
-	 * for this lexeme.
+	 * 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;
@@ -807,10 +824,14 @@ ParseExpr(
 
 	    if (NotOperator(lastParsed)) {
 		msg = Tcl_ObjPrintf("missing operator at %s", mark);
+		errCode = "MISSING";
 		scanned = 0;
 		insertMark = 1;
 
-		/* Free any literal to avoid a memleak. */
+		/*
+		 * Free any literal to avoid a memleak.
+		 */
+
 		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
 		    Tcl_DecrRefCount(literal);
 		}
@@ -827,15 +848,16 @@ ParseExpr(
 		 * 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.
+		 * 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.
+		 *	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;
@@ -847,8 +869,8 @@ ParseExpr(
 	    }
 
 	    /*
-	     * Remaining LEAF cases may involve filling Tcl_Tokens, so
-	     * make room for at least 2 more tokens.
+	     * Remaining LEAF cases may involve filling Tcl_Tokens, so make
+	     * room for at least 2 more tokens.
 	     */
 
 	    TclGrowParseTokenArray(parsePtr, 2);
@@ -867,7 +889,7 @@ ParseExpr(
 
 	    case BRACED:
 		code = Tcl_ParseBraces(NULL, start, numBytes,
-			    parsePtr, 1, &end);
+			parsePtr, 1, &end);
 		scanned = end - start;
 		break;
 
@@ -882,6 +904,7 @@ ParseExpr(
 		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;
@@ -889,7 +912,7 @@ ParseExpr(
 
 	    case SCRIPT: {
 		Tcl_Parse *nestedPtr =
-			(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+			TclStackAlloc(interp, sizeof(Tcl_Parse));
 
 		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
 		tokenPtr->type = TCL_TOKEN_COMMAND;
@@ -899,7 +922,7 @@ ParseExpr(
 		end = start + numBytes;
 		start++;
 		while (1) {
-		    code = Tcl_ParseCommand(interp, start, (end - start), 1,
+		    code = Tcl_ParseCommand(interp, start, end - start, 1,
 			    nestedPtr);
 		    if (code != TCL_OK) {
 			parsePtr->term = nestedPtr->term;
@@ -907,10 +930,10 @@ ParseExpr(
 			parsePtr->incomplete = nestedPtr->incomplete;
 			break;
 		    }
-		    start = (nestedPtr->commandStart + nestedPtr->commandSize);
+		    start = nestedPtr->commandStart + nestedPtr->commandSize;
 		    Tcl_FreeParse(nestedPtr);
-		    if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
-			    && !(nestedPtr->incomplete)) {
+		    if ((nestedPtr->term < end) && (nestedPtr->term[0] == ']')
+			    && !nestedPtr->incomplete) {
 			break;
 		    }
 
@@ -920,6 +943,7 @@ ParseExpr(
 			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
 			parsePtr->incomplete = 1;
 			code = TCL_ERROR;
+			errCode = "UNBALANCED";
 			break;
 		    }
 		}
@@ -930,28 +954,29 @@ ParseExpr(
 		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.
+		 * 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;
 	    }
 
@@ -959,20 +984,19 @@ ParseExpr(
 	    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.
+		 * 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
+		 * 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.
 		 */
@@ -1002,10 +1026,14 @@ ParseExpr(
 		msg = Tcl_ObjPrintf("missing operator at %s", mark);
 		scanned = 0;
 		insertMark = 1;
+		errCode = "MISSING";
 		goto error;
 	    }
 
-	    /* Create an OpNode for the unary operator */
+	    /*
+	     * Create an OpNode for the unary operator.
+	     */
+
 	    nodePtr->lexeme = lexeme;
 	    nodePtr->precedence = prec[lexeme];
 	    nodePtr->mark = MARK_RIGHT;
@@ -1013,16 +1041,16 @@ ParseExpr(
 	    /*
 	     * 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
+	     * 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.
+	     * 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;
@@ -1043,15 +1071,14 @@ ParseExpr(
 		if ((lexeme == CLOSE_PAREN)
 			&& (nodePtr[-1].lexeme == OPEN_PAREN)) {
 		    if (nodePtr[-2].lexeme == FUNCTION) {
-
 			/*
 			 * Normally, "()" is a syntax error, but as a special
 			 * case accept it as an argument list for a function.
 			 * Treat this as a special LEAF lexeme, and restart
-			 * the parsing loop with zero characters scanned.
-			 * We'll parse the ")" again the next time through,
-			 * but with the OT_EMPTY leaf as the subexpression
-			 * between the parens.
+			 * 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;
@@ -1061,6 +1088,7 @@ ParseExpr(
 		    msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
 		    scanned = 0;
 		    insertMark = 1;
+		    errCode = "EMPTY";
 		    goto error;
 		}
 
@@ -1068,63 +1096,66 @@ ParseExpr(
 		    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");
-		    } 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;
-		    }
+		} 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.
+	     * 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.
+	     * "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.
+	     * 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-".
+	     * 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) {
@@ -1135,16 +1166,18 @@ ParseExpr(
 		}
 
 		if (incompletePtr->precedence == precedence) {
+		    /*
+		     * Right association rules for exponentiation.
+		     */
 
-		    /* 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.
+		     * 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)
@@ -1158,13 +1191,16 @@ ParseExpr(
 		    }
 		}
 
-		/* Some special syntax checks... */
+		/*
+		 * 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;
 		}
 
@@ -1172,10 +1208,10 @@ ParseExpr(
 		if ((incompletePtr->lexeme == QUESTION)
 			&& (NotOperator(complete)
 			|| (nodes[complete].lexeme != COLON))) {
-		    msg = Tcl_ObjPrintf(
-			    "missing operator \":\" at %s", mark);
+		    msg = Tcl_ObjPrintf("missing operator \":\" at %s", mark);
 		    scanned = 0;
 		    insertMark = 1;
+		    errCode = "MISSING";
 		    goto error;
 		}
 
@@ -1186,6 +1222,7 @@ ParseExpr(
 		    TclNewLiteralStringObj(msg,
 			    "unexpected operator \":\" "
 			    "without preceding \"?\"");
+		    errCode = "SURPRISE";
 		    goto error;
 		}
 
@@ -1205,9 +1242,9 @@ ParseExpr(
 		}
 
 		/*
-		 * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each
-		 * make up a single operator.  Force them to agree whether they
-		 * have a constant expression.
+		 * 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)
@@ -1216,7 +1253,6 @@ ParseExpr(
 		}
 
 		if (incompletePtr->lexeme == START) {
-
 		    /*
 		     * Completing the START tree indicates we're done.
 		     * Transfer the parse tree to the caller and return.
@@ -1228,8 +1264,8 @@ ParseExpr(
 
 		/*
 		 * With a right operand attached, last incomplete tree has
-		 * become the complete tree.  Pop it from the incomplete
-		 * tree stack.
+		 * become the complete tree. Pop it from the incomplete tree
+		 * stack.
 		 */
 
 		complete = incomplete;
@@ -1241,12 +1277,15 @@ ParseExpr(
 		}
 	    }
 
-	    /* More syntax checks... */
+	    /*
+	     * More syntax checks...
+	     */
 
 	    /* Parens must balance. */
 	    if (lexeme == CLOSE_PAREN) {
 		if (incompletePtr->lexeme != OPEN_PAREN) {
 		    TclNewLiteralStringObj(msg, "unbalanced close paren");
+		    errCode = "UNBALANCED";
 		    goto error;
 		}
 	    }
@@ -1257,6 +1296,7 @@ ParseExpr(
 			|| (incompletePtr[-1].lexeme != FUNCTION)) {
 		    TclNewLiteralStringObj(msg,
 			    "unexpected \",\" outside function argument list");
+		    errCode = "SURPRISE";
 		    goto error;
 		}
 	    }
@@ -1265,15 +1305,22 @@ ParseExpr(
 	    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. */
+	    /*
+	     * Create no node for a CLOSE_PAREN lexeme.
+	     */
+
 	    if (lexeme == CLOSE_PAREN) {
 		break;
 	    }
 
-	    /* Link complete tree as left operand of new node. */
+	    /*
+	     * Link complete tree as left operand of new node.
+	     */
+
 	    nodePtr->lexeme = lexeme;
 	    nodePtr->precedence = precedence;
 	    nodePtr->mark = MARK_LEFT;
@@ -1281,9 +1328,9 @@ ParseExpr(
 
 	    /*
 	     * 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.
+	     * 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);
@@ -1298,9 +1345,9 @@ ParseExpr(
 	    }
 
 	    /*
-	     * 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.
+	     * 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;
@@ -1315,34 +1362,36 @@ ParseExpr(
 	numBytes -= scanned;
     }	/* main parsing loop */
 
-  error:
-
     /*
-     * 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.
+     * 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.
      */
 
+  error:
     if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
 	parsePtr->errorType = TCL_PARSE_SYNTAX;
     }
 
-    /* Free any partial parse tree we've built. */
+    /*
+     * Free any partial parse tree we've built.
+     */
+
     if (nodes != NULL) {
-	ckfree((char*) nodes);
+	ckfree(nodes);
     }
 
     if (interp == NULL) {
+	/*
+	 * Nowhere to report an error message, so just free it.
+	 */
 
-	/* 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...
+	 * Construct the complete error message. Start with the simple error
+	 * message, pulled from the interp result if necessary...
 	 */
 
 	if (msg == NULL) {
@@ -1367,7 +1416,10 @@ ParseExpr(
 		start + scanned,
 		(start + scanned + limit > parsePtr->end) ? "" : "...");
 
-	/* Next, append any postscript message. */
+	/*
+	 * Next, append any postscript message.
+	 */
+
 	if (post != NULL) {
 	    Tcl_AppendToObj(msg, ";\n", -1);
 	    Tcl_AppendObjToObj(msg, post);
@@ -1375,12 +1427,19 @@ ParseExpr(
 	}
 	Tcl_SetObjResult(interp, msg);
 
-	/* Finally, place context information in the errorInfo. */
+	/*
+	 * 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);
+	}
     }
 
     return TCL_ERROR;
@@ -1394,10 +1453,10 @@ ParseExpr(
  *	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.
+ *	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.
@@ -1433,7 +1492,10 @@ ConvertTreeToTokens(
 
 	nodePtr->mark++;
 
-	/* Handle next child node or leaf */
+	/*
+	 * Handle next child node or leaf.
+	 */
+
 	switch (next) {
 	case OT_EMPTY:
 
@@ -1442,12 +1504,18 @@ ConvertTreeToTokens(
 
 	case OT_LITERAL:
 
-	    /* Skip any white space that comes before the literal */
+	    /*
+	     * Skip any white space that comes before the literal.
+	     */
+
 	    scanned = TclParseAllWhiteSpace(start, numBytes);
-	    start +=scanned;
+	    start += scanned;
 	    numBytes -= scanned;
 
-	    /* Reparse the literal to get pointers into source string */
+	    /*
+	     * Reparse the literal to get pointers into source string.
+	     */
+
 	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
 
 	    TclGrowParseTokenArray(parsePtr, 2);
@@ -1462,32 +1530,30 @@ ConvertTreeToTokens(
 	    subExprTokenPtr[1].numComponents = 0;
 
 	    parsePtr->numTokens += 2;
-	    start +=scanned;
+	    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.
+	     * 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
+		 * Single element word. Copy tokens and convert the leading
 		 * token to TCL_TOKEN_SUB_EXPR.
 		 */
 
@@ -1498,11 +1564,10 @@ ConvertTreeToTokens(
 		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.
+		 * 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);
@@ -1517,7 +1582,7 @@ ConvertTreeToTokens(
 	    }
 
 	    scanned = tokenPtr->start + tokenPtr->size - start;
-	    start +=scanned;
+	    start += scanned;
 	    numBytes -= scanned;
 	    tokenPtr += toCopy;
 	    break;
@@ -1525,15 +1590,24 @@ ConvertTreeToTokens(
 
 	default:
 
-	    /* Advance to the child node, which is an operator. */
+	    /*
+	     * Advance to the child node, which is an operator.
+	     */
+
 	    nodePtr = nodes + next;
 
-	    /* Skip any white space that comes before the subexpression */
+	    /*
+	     * Skip any white space that comes before the subexpression.
+	     */
+
 	    scanned = TclParseAllWhiteSpace(start, numBytes);
-	    start +=scanned;
+	    start += scanned;
 	    numBytes -= scanned;
 
-	    /* Generate tokens for the operator / subexpression... */
+	    /*
+	     * Generate tokens for the operator / subexpression...
+	     */
+
 	    switch (nodePtr->lexeme) {
 	    case OPEN_PAREN:
 	    case COMMA:
@@ -1550,16 +1624,16 @@ ConvertTreeToTokens(
 
 		/*
 		 * Remember the index of the last subexpression we were
-		 * working on -- that of our parent.  We'll stack it later.
+		 * 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.
+		 * 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);
@@ -1578,7 +1652,7 @@ ConvertTreeToTokens(
 
 		/*
 		 * Eventually, we know that the numComponents field of the
-		 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0.  This means
+		 * 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.
 		 */
@@ -1600,9 +1674,12 @@ ConvertTreeToTokens(
 	case MARK_RIGHT:
 	    next = nodePtr->right;
 
-	    /* Skip any white space that comes before the operator */
+	    /*
+	     * Skip any white space that comes before the operator.
+	     */
+
 	    scanned = TclParseAllWhiteSpace(start, numBytes);
-	    start +=scanned;
+	    start += scanned;
 	    numBytes -= scanned;
 
 	    /*
@@ -1617,7 +1694,10 @@ ConvertTreeToTokens(
 	    case COMMA:
 	    case COLON:
 
-		/* No tokens for these lexemes -> nothing to do. */
+		/*
+		 * No tokens for these lexemes -> nothing to do.
+		 */
+
 		break;
 
 	    default:
@@ -1633,7 +1713,7 @@ ConvertTreeToTokens(
 		break;
 	    }
 
-	    start +=scanned;
+	    start += scanned;
 	    numBytes -= scanned;
 	    break;
 
@@ -1652,16 +1732,19 @@ ConvertTreeToTokens(
 
 	    case OPEN_PAREN:
 
-		/* Skip past matching close paren. */
+		/*
+		 * Skip past matching close paren.
+		 */
+
 		scanned = TclParseAllWhiteSpace(start, numBytes);
-		start +=scanned;
+		start += scanned;
 		numBytes -= scanned;
 		scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
-		start +=scanned;
+		start += scanned;
 		numBytes -= scanned;
 		break;
 
-	    default: {
+	    default:
 
 		/*
 		 * Before we leave this node/operator/subexpression for the
@@ -1676,7 +1759,7 @@ ConvertTreeToTokens(
 
 		/*
 		 * All the Tcl_Tokens allocated and filled belong to
-		 * this subexpresion.  The first token is the leading
+		 * this subexpresion. The first token is the leading
 		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
 		 * are its components.
 		 */
@@ -1695,9 +1778,11 @@ ConvertTreeToTokens(
 		subExprTokenIdx = parentIdx;
 		break;
 	    }
-	    }
 
-	    /* Since we're returning to parent, skip child handling code. */
+	    /*
+	     * Since we're returning to parent, skip child handling code.
+	     */
+
 	    nodePtr = nodes + nodePtr->p.parent;
 	    goto router;
 	}
@@ -1742,19 +1827,18 @@ Tcl_ParseExpr(
 				 * information in the structure is ignored. */
 {
     int code;
-    OpNode *opTree = NULL;	/* Will point to the tree of operators */
-    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
-    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
-    Tcl_Parse *exprParsePtr =
-	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
-				/* Holds the Tcl_Tokens of substitutions */
+    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 */);
+    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
+	    exprParsePtr, 1 /* parseOnly */);
     Tcl_DecrRefCount(funcList);
     Tcl_DecrRefCount(litList);
 
@@ -1769,7 +1853,7 @@ Tcl_ParseExpr(
 
     Tcl_FreeParse(exprParsePtr);
     TclStackFree(interp, exprParsePtr);
-    ckfree((char *) opTree);
+    ckfree(opTree);
     return code;
 }
 
@@ -1809,7 +1893,7 @@ ParseLexeme(
 	*lexemePtr = END;
 	return 0;
     }
-    byte = (unsigned char)(*start);
+    byte = UCHAR(*start);
     if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
 	*lexemePtr = Lexeme[byte];
 	return 1;
@@ -1886,11 +1970,10 @@ ParseLexeme(
     case 'i':
 	if ((numBytes > 1) && (start[1] == 'n')
 		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
-
 	    /*
-	     * Must make this check so we can tell the difference between
-	     * the "in" operator and the "int" function name and the
-	     * "infinity" numeric value.
+	     * Must make this check so we can tell the difference between the
+	     * "in" operator and the "int" function name and the "infinity"
+	     * numeric value.
 	     */
 
 	    *lexemePtr = IN_LIST;
@@ -1924,7 +2007,7 @@ ParseLexeme(
     if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
 	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
 	if (end < start + numBytes && !TclIsBareword(*end)) {
-	
+
 	number:
 	    TclInitStringRep(literal, start, end-start);
 	    *lexemePtr = NUMBER;
@@ -1946,10 +2029,11 @@ ParseLexeme(
 	     */
 	    if (literal->typePtr == &tclDoubleType) {
 		const char *p = start;
+
 		while (p < end) {
 		    if (!TclIsBareword(*p++)) {
 			/*
-			 * The number has non-bareword characters, so we 
+			 * The number has non-bareword characters, so we
 			 * must treat it as a number.
 			 */
 			goto number;
@@ -1965,6 +2049,7 @@ ParseLexeme(
 		 */
 		goto number;
 	    }
+
 	    /*
 	     * Otherwise, fall through and parse the whole as a bareword.
 	     */
@@ -1975,13 +2060,14 @@ ParseLexeme(
      * We reject leading underscores in bareword.  No sensible reason why.
      * Might be inspired by reserved identifier rules in C, which of course
      * have no direct relevance here.
-     */  
+     */
 
     if (!TclIsBareword(*start) || *start == '_') {
 	if (Tcl_UtfCharComplete(start, numBytes)) {
 	    scanned = Tcl_UtfToUniChar(start, &ch);
 	} else {
 	    char utfBytes[TCL_UTF_MAX];
+
 	    memcpy(utfBytes, start, (size_t) numBytes);
 	    utfBytes[numBytes] = '\0';
 	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
@@ -2028,21 +2114,22 @@ TclCompileExpr(
     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 */
+    int optimize)		/* 0 for one-off expressions. */
 {
     OpNode *opTree = NULL;	/* Will point to the tree of operators */
     Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
     Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
-    Tcl_Parse *parsePtr =
-	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
 				/* Holds the Tcl_Tokens of substitutions */
 
     int code = ParseExpr(interp, script, numBytes, &opTree, litList,
 	    funcList, parsePtr, 0 /* parseOnly */);
 
     if (code == TCL_OK) {
+	/*
+	 * Valid parse; compile the tree.
+	 */
 
-	/* Valid parse; compile the tree. */
 	int objc;
 	Tcl_Obj *const *litObjv;
 	Tcl_Obj **funcObjv;
@@ -2063,7 +2150,7 @@ TclCompileExpr(
     TclStackFree(interp, parsePtr);
     Tcl_DecrRefCount(funcList);
     Tcl_DecrRefCount(litList);
-    ckfree((char *) opTree);
+    ckfree(opTree);
 }
 
 /*
@@ -2095,6 +2182,7 @@ ExecConstantExprTree(
     ByteCode *byteCodePtr;
     int code;
     Tcl_Obj *byteCodeObj = Tcl_NewObj();
+    NRE_callback *rootPtr = TOP_CB(interp);
 
     /*
      * Note we are compiling an expression with literal arguments. This means
@@ -2102,7 +2190,7 @@ ExecConstantExprTree(
      * bytecode, so there's no need to tend to TIP 280 issues.
      */
 
-    envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv));
+    envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
     TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
     CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
 	    0 /* optimize */);
@@ -2111,8 +2199,9 @@ ExecConstantExprTree(
     TclInitByteCodeObj(byteCodeObj, envPtr);
     TclFreeCompileEnv(envPtr);
     TclStackFree(interp, envPtr);
-    byteCodePtr = (ByteCode *) byteCodeObj->internalRep.twoPtrValue.ptr1;
-    code = TclExecuteByteCode(interp, byteCodePtr);
+    byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
+    TclNRExecuteByteCode(interp, byteCodePtr);
+    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
     Tcl_DecrRefCount(byteCodeObj);
     return code;
 }
@@ -2121,20 +2210,20 @@ ExecConstantExprTree(
  *----------------------------------------------------------------------
  *
  * CompileExprTree --
- *	Compiles and writes to envPtr instructions for the subexpression
- *	tree at index in the nodes array.  (*litObjvPtr) must point to the
- *	proper location in a corresponding literals list.  Likewise, when
- *	non-NULL, funcObjv and tokenPtr must point into matching arrays of
- * 	function names and Tcl_Token's derived from earlier call to
- *	ParseExpr().  When optimize is true, any constant subexpressions
- *	will be precomputed.
+ *
+ *	Compiles and writes to envPtr instructions for the subexpression tree
+ *	at index in the nodes array. (*litObjvPtr) must point to the proper
+ *	location in a corresponding literals list. Likewise, when non-NULL,
+ *	funcObjv and tokenPtr must point into matching arrays of function
+ *	names and Tcl_Token's derived from earlier call to ParseExpr(). When
+ *	optimize is true, any constant subexpressions will be precomputed.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	Adds instructions to envPtr to evaluate the expression at runtime.
- *	Consumes subtree of nodes rooted at index.  Advances the pointer
+ *	Consumes subtree of nodes rooted at index. Advances the pointer
  *	*litObjvPtr.
  *
  *----------------------------------------------------------------------
@@ -2164,30 +2253,8 @@ CompileExprTree(
 	if (nodePtr->mark == MARK_LEFT) {
 	    next = nodePtr->left;
 
-	    switch (nodePtr->lexeme) {
-	    case QUESTION:
-		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		jumpPtr->depth = envPtr->currStackDepth;
+	    if (nodePtr->lexeme == QUESTION) {
 		convert = 1;
-		break;
-	    case AND:
-	    case OR:
-		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		jumpPtr->depth = envPtr->currStackDepth;
-		break;
 	    }
 	} else if (nodePtr->mark == MARK_RIGHT) {
 	    next = nodePtr->right;
@@ -2199,20 +2266,20 @@ CompileExprTree(
 		int length;
 
 		Tcl_DStringInit(&cmdName);
-		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
+		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
 		p = TclGetStringFromObj(*funcObjv, &length);
 		funcObjv++;
 		Tcl_DStringAppend(&cmdName, p, length);
-		TclEmitPush(TclRegisterNewNSLiteral(envPtr,
+		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.
+		 * 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;
@@ -2220,24 +2287,35 @@ CompileExprTree(
 		break;
 	    }
 	    case QUESTION:
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
+		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
 		break;
 	    case COLON:
+		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-			&(jumpPtr->next->jump));
-		envPtr->currStackDepth = jumpPtr->depth;
-		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
-		jumpPtr->convert = convert;
+			&jumpPtr->jump);
+		TclAdjustStackDepth(-1, envPtr);
+		if (convert) {
+		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
+		}
 		convert = 1;
 		break;
 	    case AND:
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
-		break;
 	    case OR:
-		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
+		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
+			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
 		break;
 	    }
 	} else {
+	    int pc1, pc2, target;
+
 	    switch (nodePtr->lexeme) {
 	    case START:
 	    case QUESTION:
@@ -2250,69 +2328,72 @@ CompileExprTree(
 		/* do nothing */
 		break;
 	    case FUNCTION:
-
 		/*
-		 * Use the numWords count we've kept to invoke the
-		 * function command with the correct number of arguments.
+		 * 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);
+		    TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
 		} else {
-		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
+		    TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
 		}
 
-		/* Restore any saved numWords value. */
+		/*
+		 * Restore any saved numWords value.
+		 */
+
 		numWords = nodePtr->left;
 		convert = 1;
 		break;
 	    case COMMA:
+		/*
+		 * Each comma implies another function argument.
+		 */
 
-		/* Each comma implies another function argument. */
 		numWords++;
 		break;
 	    case COLON:
-		if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
-			(envPtr->codeNext - envPtr->codeStart)
-			- jumpPtr->next->jump.codeOffset, 127)) {
-		    jumpPtr->offset += 3;
+		CLANG_ASSERT(jumpPtr);
+		if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
+		    jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
+		    convert = 1;
+		}
+		target = jumpPtr->jump.codeOffset + 2;
+		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
+		    target += 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);
+		TclFixupForwardJump(envPtr, &jumpPtr->jump,
+			target - jumpPtr->jump.codeOffset, 127);
+
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
 		break;
 	    case AND:
 	    case OR:
-		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
-			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
-			&(jumpPtr->next->jump));
+		CLANG_ASSERT(jumpPtr);
+		pc1 = CurrentOffset(envPtr);
+		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
+			: INST_JUMP_TRUE1, 0, envPtr);
 		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;
+		pc2 = CurrentOffset(envPtr);
+		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
+		TclAdjustStackDepth(-1, envPtr);
+		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
+			envPtr->codeStart + pc1 + 1);
+		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
+		    pc2 += 3;
 		}
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
-		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
-			127);
+		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
+			envPtr->codeStart + pc2 + 1);
 		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);
@@ -2323,8 +2404,8 @@ CompileExprTree(
 		break;
 	    }
 	    if (nodePtr == rootPtr) {
-
 		/* We're done */
+
 		return;
 	    }
 	    nodePtr = nodes + nodePtr->p.parent;
@@ -2341,14 +2422,11 @@ CompileExprTree(
 	    Tcl_Obj *literal = *litObjv;
 
 	    if (optimize) {
-		int length, index;
+		int length;
 		const char *bytes = TclGetStringFromObj(literal, &length);
-		LiteralEntry *lePtr;
-		Tcl_Obj *objPtr;
+		int index = TclRegisterNewLiteral(envPtr, bytes, length);
+		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
 
-		index = TclRegisterNewLiteral(envPtr, bytes, length);
-		lePtr = envPtr->literalArrayPtr + index;
-		objPtr = lePtr->objPtr;
 		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
 		    /*
 		     * Would like to do this:
@@ -2359,10 +2437,10 @@ CompileExprTree(
 		     *
 		     * 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.
-		     *
+		     * to change. So rather than replace lePtr->objPtr, we do
+		     * surgery to transfer our desired intrep into it.
 		     */
+
 		    objPtr->typePtr = literal->typePtr;
 		    objPtr->internalRep = literal->internalRep;
 		    literal->typePtr = NULL;
@@ -2370,30 +2448,57 @@ CompileExprTree(
 		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
+		 * 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);
+	    CompileTokens(envPtr, tokenPtr, interp);
 	    tokenPtr += tokenPtr->numComponents + 1;
 	    break;
 	default:
 	    if (optimize && nodes[next].constant) {
 		Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);
+
 		if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
 			== TCL_OK) {
-		    TclEmitPush(TclAddLiteralObj(envPtr,
-			    Tcl_GetObjResult(interp), NULL), envPtr);
+		    int index;
+		    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+
+		    /*
+		     * Don't generate a string rep, but if we have one
+		     * already, then use it to share via the literal table.
+		     */
+
+		    if (objPtr->bytes) {
+			Tcl_Obj *tableValue;
+
+			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
+				objPtr->length);
+			tableValue = TclFetchLiteral(envPtr, index);
+			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);
 		}
@@ -2410,6 +2515,7 @@ CompileExprTree(
  *----------------------------------------------------------------------
  *
  * 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
@@ -2419,7 +2525,7 @@ CompileExprTree(
  *	A standard Tcl return code and result left in interp.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -2431,12 +2537,12 @@ TclSingleOpCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
-    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    TclOpCmdClientData *occdPtr = clientData;
     unsigned char lexeme;
     OpNode nodes[2];
     Tcl_Obj *const *litObjv = objv + 1;
 
-    if (objc != 1+occdPtr->i.numArgs) {
+    if (objc != 1 + occdPtr->i.numArgs) {
 	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
 	return TCL_ERROR;
     }
@@ -2462,16 +2568,17 @@ TclSingleOpCmd(
  *----------------------------------------------------------------------
  *
  * TclSortingOpCmd --
- *	Implements the commands: <, <=, >, >=, ==, eq
- *	in the ::tcl::mathop namespace.  These commands are defined for
+ *	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.
+ *	operator applied to all neighbor argument pairs.
  *
  * Results:
  *	A standard Tcl return code and result left in interp.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -2488,11 +2595,10 @@ TclSortingOpCmd(
     if (objc < 3) {
 	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
     } else {
-	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
-	Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp,
-		2*(objc-2)*sizeof(Tcl_Obj *));
-	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
-		2*(objc-2)*sizeof(OpNode));
+	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;
@@ -2543,16 +2649,16 @@ TclSortingOpCmd(
  *
  * TclVariadicOpCmd --
  *	Implements the commands: +, *, &, |, ^, **
- *	in the ::tcl::mathop namespace.  These commands are defined for
+ *	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
+ *	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.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -2564,7 +2670,7 @@ TclVariadicOpCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
-    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    TclOpCmdClientData *occdPtr = clientData;
     unsigned char lexeme;
     int code;
 
@@ -2619,14 +2725,13 @@ TclVariadicOpCmd(
 	return code;
     } else {
 	Tcl_Obj *const *litObjv = objv + 1;
-	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
-		(objc-1)*sizeof(OpNode));
+	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-- ) {
+	    for (i=objc-2; i>0; i--) {
 		nodes[i].lexeme = lexeme;
 		nodes[i].mark = MARK_LEFT;
 		nodes[i].left = OT_LITERAL;
@@ -2637,7 +2742,7 @@ TclVariadicOpCmd(
 		lastOp = i;
 	    }
 	} else {
-	    for (i=1; i<objc-1; i++ ) {
+	    for (i=1; i<objc-1; i++) {
 		nodes[i].lexeme = lexeme;
 		nodes[i].mark = MARK_LEFT;
 		nodes[i].left = lastOp;
@@ -2654,7 +2759,6 @@ TclVariadicOpCmd(
 	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
 
 	TclStackFree(interp, nodes);
-
 	return code;
     }
 }
@@ -2664,16 +2768,16 @@ TclVariadicOpCmd(
  *
  * 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.
+ *	in the ::tcl::mathop namespace. These commands are defined for
+ *	arbitrary non-zero number of arguments by repeatedly applying the base
+ *	operator with suitable associative rules. When no arguments are
+ *	provided, an error is raised.
  *
  * Results:
  *	A standard Tcl return code and result left in interp.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -2685,7 +2789,8 @@ TclNoIdentOpCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
-    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
+    TclOpCmdClientData *occdPtr = clientData;
+
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
 	return TCL_ERROR;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index eeee1b0..f716195 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -14,15 +14,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
-
-/*
- * Table of all AuxData types.
- */
-
-static Tcl_HashTable auxDataTypeTable;
-static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */
-
-TCL_DECLARE_MUTEX(tableMutex)
+#include <assert.h>
 
 /*
  * Variable that controls whether compilation tracing is enabled and, if so,
@@ -37,7 +29,7 @@ TCL_DECLARE_MUTEX(tableMutex)
 int tclTraceCompile = 0;
 static int traceInitialized = 0;
 #endif
-
+
 /*
  * A table describing the Tcl bytecode instructions. Entries in this table
  * must correspond to the instruction opcode definitions in tclCompile.h. The
@@ -50,19 +42,19 @@ static int traceInitialized = 0;
  * existence of a procedure call frame to distinguish these.
  */
 
-InstructionDesc tclInstructionTable[] = {
+InstructionDesc const tclInstructionTable[] = {
     /* Name	      Bytes stackEffect #Opnds  Operand types */
     {"done",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Finish ByteCode execution and return stktop (top stack item) */
-    {"push1",		  2,   +1,         1,	{OPERAND_UINT1}},
+    {"push1",		  2,   +1,         1,	{OPERAND_LIT1}},
 	/* Push object at ByteCode objArray[op1] */
-    {"push4",		  5,   +1,         1,	{OPERAND_UINT4}},
+    {"push4",		  5,   +1,         1,	{OPERAND_LIT4}},
 	/* Push object at ByteCode objArray[op4] */
     {"pop",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Pop the topmost stack object */
     {"dup",		  1,   +1,         0,	{OPERAND_NONE}},
 	/* Duplicate the topmost stack object and push the result */
-    {"concat1",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
+    {"strcat",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
 	/* Concatenate the top op1 items and push result */
     {"invokeStk1",	  2,   INT_MIN,    1,	{OPERAND_UINT1}},
 	/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
@@ -124,17 +116,17 @@ InstructionDesc tclInstructionTable[] = {
     {"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_OFFSET1}},
 	/* Jump relative to (pc + op1) */
-    {"jump4",		  5,   0,          1,	{OPERAND_INT4}},
+    {"jump4",		  5,   0,          1,	{OPERAND_OFFSET4}},
 	/* Jump relative to (pc + op4) */
-    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_INT1}},
+    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
 	/* Jump relative to (pc + op1) if stktop expr object is true */
-    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_INT4}},
+    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
 	/* Jump relative to (pc + op4) if stktop expr object is true */
-    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_INT1}},
+    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
 	/* Jump relative to (pc + op1) if stktop expr object is false */
-    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_INT4}},
+    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
 	/* Jump relative to (pc + op4) if stktop expr object is false */
 
     {"lor",		  1,   -1,         0,	{OPERAND_NONE}},
@@ -154,11 +146,11 @@ InstructionDesc tclInstructionTable[] = {
     {"lt",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Less:	push (stknext < stktop) */
     {"gt",		  1,   -1,         0,	{OPERAND_NONE}},
-	/* Greater:	push (stknext || stktop) */
+	/* Greater:	push (stknext > stktop) */
     {"le",		  1,   -1,         0,	{OPERAND_NONE}},
-	/* Less or equal: push (stknext || stktop) */
+	/* Less or equal: push (stknext <= stktop) */
     {"ge",		  1,   -1,         0,	{OPERAND_NONE}},
-	/* Greater or equal: push (stknext || stktop) */
+	/* Greater or equal: push (stknext >= stktop) */
     {"lshift",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Left shift:	push (stknext << stktop) */
     {"rshift",		  1,   -1,         0,	{OPERAND_NONE}},
@@ -297,7 +289,7 @@ InstructionDesc tclInstructionTable[] = {
 	/* 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}},
+    {"startCommand",	  9,	0,	   2,	{OPERAND_OFFSET4, OPERAND_UINT4}},
 	/* Start of bytecoded command: op is the length of the cmd's code, op2
 	 * is number of commands here */
 
@@ -309,7 +301,7 @@ InstructionDesc tclInstructionTable[] = {
     {"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}},
+    {"returnStk",	  1,	-1,	   0,	{OPERAND_NONE}},
 	/* Compiled [return]; options and result are on the stack, code and
 	 * level are in the options. */
 
@@ -341,21 +333,23 @@ InstructionDesc tclInstructionTable[] = {
 	 * Stack:  ... key valueToAppend => ... newDict */
     {"dictFirst",	  5,	+2,	   1,	{OPERAND_LVT4}},
 	/* Begin iterating over the dictionary, using the local scalar
-	 * indicated by op4 to hold the iterator state. If doneBool is true,
-	 * dictDone *must* be called later on.
+	 * 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. */
+	/* 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 (popped from the stack) must be the same length as the list
-	 * of variables.
-	 * Stack:  ... keyList => ... */
+	 * of keys (top of the stack, not popped) 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
@@ -363,24 +357,25 @@ InstructionDesc tclInstructionTable[] = {
 	 * 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}},
+    {"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. */
+    {"upvar",            5,    -1,        1,   {OPERAND_LVT4}},
+	/* finds level and otherName in stack, links to local variable at
+	 * index op1. Leaves the level on stack. */
+    {"nsupvar",          5,    -1,        1,   {OPERAND_LVT4}},
+	/* finds namespace and otherName in stack, links to local variable at
+	 * index op1. Leaves the namespace on stack. */
+    {"variable",         5,    -1,        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. Equivalent to returnImm
+	 * except for the ERR_ALREADY_LOGGED flag in the interpreter. */
     {"reverse",		 5,    0,         1,	{OPERAND_UINT4}},
 	/* Reverse the order of the arg elements at the top of stack */
 
@@ -397,13 +392,282 @@ InstructionDesc tclInstructionTable[] = {
 	 * stknext */
     {"existStk",	 1,    0,         0,	{OPERAND_NONE}},
 	/* Test if general variable exists; unparsed variable name is stktop*/
-    {0, 0, 0, 0, {0}}
-};
 
+    {"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", 5,    -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 => ... */
+    {"dictExists",	 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 a
+	 * boolean indicating whether it is possible to read out a value from
+	 * that key-path (like [dict exists]).
+	 * Stack:  ... dict key1 ... keyN => ... boolean */
+    {"verifyDict",	 1,    -1,	  0,	{OPERAND_NONE}},
+	/* Verifies that the word on the top of the stack is a dictionary,
+	 * popping it if it is and throwing an error if it is not.
+	 * Stack:  ... value => ... */
+
+    {"strmap",		 1,    -2,	  0,	{OPERAND_NONE}},
+	/* Simplified version of [string map] that only applies one change
+	 * string, and only case-sensitively.
+	 * Stack:  ... from to string => ... changedString */
+    {"strfind",		 1,    -1,	  0,	{OPERAND_NONE}},
+	/* Find the first index of a needle string in a haystack string,
+	 * producing the index (integer) or -1 if nothing found.
+	 * Stack:  ... needle haystack => ... index */
+    {"strrfind",	 1,    -1,	  0,	{OPERAND_NONE}},
+	/* Find the last index of a needle string in a haystack string,
+	 * producing the index (integer) or -1 if nothing found.
+	 * Stack:  ... needle haystack => ... index */
+    {"strrangeImm",	 9,	0,	  2,	{OPERAND_IDX4, OPERAND_IDX4}},
+	/* String Range: push (string range stktop op4 op4) */
+    {"strrange",	 1,    -2,	  0,	{OPERAND_NONE}},
+	/* String Range with non-constant arguments.
+	 * Stack:  ... string idxA idxB => ... substring */
+
+    {"yield",		 1,	0,	  0,	{OPERAND_NONE}},
+	/* Makes the current coroutine yield the value at the top of the
+	 * stack, and places the response back on top of the stack when it
+	 * resumes.
+	 * Stack:  ... valueToYield => ... resumeValue */
+    {"coroName",         1,    +1,	  0,	{OPERAND_NONE}},
+	/* Push the name of the interpreter's current coroutine as an object
+	 * on the stack. */
+    {"tailcall",	 2,    INT_MIN,	  1,	{OPERAND_UINT1}},
+	/* Do a tailcall with the opnd items on the stack as the thing to
+	 * tailcall to; opnd must be greater than 0 for the semantics to work
+	 * right. */
+
+    {"currentNamespace", 1,    +1,	  0,	{OPERAND_NONE}},
+	/* Push the name of the interpreter's current namespace as an object
+	 * on the stack. */
+    {"infoLevelNumber",  1,    +1,	  0,	{OPERAND_NONE}},
+	/* Push the stack depth (i.e., [info level]) of the interpreter as an
+	 * object on the stack. */
+    {"infoLevelArgs",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Push the argument words to a stack depth (i.e., [info level <n>])
+	 * of the interpreter as an object on the stack.
+	 * Stack:  ... depth => ... argList */
+    {"resolveCmd",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Resolves the command named on the top of the stack to its fully
+	 * qualified version, or produces the empty string if no such command
+	 * exists. Never generates errors.
+	 * Stack:  ... cmdName => ... fullCmdName */
+
+    {"tclooSelf",	 1,	+1,	  0,	{OPERAND_NONE}},
+	/* Push the identity of the current TclOO object (i.e., the name of
+	 * its current public access command) on the stack. */
+    {"tclooClass",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Push the class of the TclOO object named at the top of the stack
+	 * onto the stack.
+	 * Stack:  ... object => ... class */
+    {"tclooNamespace",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Push the namespace of the TclOO object named at the top of the
+	 * stack onto the stack.
+	 * Stack:  ... object => ... namespace */
+    {"tclooIsObject",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Push whether the value named at the top of the stack is a TclOO
+	 * object (i.e., a boolean). Can corrupt the interpreter result
+	 * despite not throwing, so not safe for use in a post-exception
+	 * context.
+	 * Stack:  ... value => ... boolean */
+
+    {"arrayExistsStk",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Looks up the element on the top of the stack and tests whether it
+	 * is an array. Pushes a boolean describing whether this is the
+	 * case. Also runs the whole-array trace on the named variable, so can
+	 * throw anything.
+	 * Stack:  ... varName => ... boolean */
+    {"arrayExistsImm",	 5,	+1,	  1,	{OPERAND_LVT4}},
+	/* Looks up the variable indexed by opnd and tests whether it is an
+	 * array. Pushes a boolean describing whether this is the case. Also
+	 * runs the whole-array trace on the named variable, so can throw
+	 * anything.
+	 * Stack:  ... => ... boolean */
+    {"arrayMakeStk",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* Forces the element on the top of the stack to be the name of an
+	 * array.
+	 * Stack:  ... varName => ... */
+    {"arrayMakeImm",	 5,	0,	  1,	{OPERAND_LVT4}},
+	/* Forces the variable indexed by opnd to be an array. Does not touch
+	 * the stack. */
+
+    {"invokeReplace",	 6,	INT_MIN,  2,	{OPERAND_UINT4,OPERAND_UINT1}},
+	/* Invoke command named objv[0], replacing the first two words with
+	 * the word at the top of the stack;
+	 * <objc,objv> = <op4,top op4 after popping 1> */
+
+    {"listConcat",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* Concatenates the two lists at the top of the stack into a single
+	 * list and pushes that resulting list onto the stack.
+	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */
+
+    {"expandDrop",       1,    0,          0,	{OPERAND_NONE}},
+	/* Drops an element from the auxiliary stack, popping stack elements
+	 * until the matching stack depth is reached. */
+
+    /* New foreach implementation */
+    {"foreach_start",	 5,	+2,	  1,	{OPERAND_AUX4}},
+	/* Initialize execution of a foreach loop. Operand is aux data index
+	 * of the ForeachInfo structure for the foreach command. It pushes 2
+	 * elements which hold runtime params for foreach_step, they are later
+	 * dropped by foreach_end together with the value lists. NOTE that the
+	 * iterator-tracker and info reference must not be passed to bytecodes
+	 * that handle normal Tcl values. NOTE that this instruction jumps to
+	 * the foreach_step instruction paired with it; the stack info below
+	 * is only nominal.
+	 * Stack: ... listObjs... => ... listObjs... iterTracker info */
+    {"foreach_step",	 1,	 0,	  0,	{OPERAND_NONE}},
+	/* "Step" or begin next iteration of foreach loop. Assigns to foreach
+	 * iteration variables. May jump to straight after the foreach_start
+	 * that pushed the iterTracker and info values. MUST be followed
+	 * immediately by a foreach_end.
+	 * Stack: ... listObjs... iterTracker info =>
+	 *				... listObjs... iterTracker info */
+    {"foreach_end",	 1,	 0,	  0,	{OPERAND_NONE}},
+	/* Clean up a foreach loop by dropping the info value, the tracker
+	 * value and the lists that were being iterated over.
+	 * Stack: ... listObjs... iterTracker info => ... */
+    {"lmap_collect",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* Appends the value at the top of the stack to the list located on
+	 * the stack the "other side" of the foreach-related values.
+	 * Stack: ... collector listObjs... iterTracker info value =>
+	 *			... collector listObjs... iterTracker info */
+
+    {"strtrim",		 1,	-1,	  0,	{OPERAND_NONE}},
+	/* [string trim] core: removes the characters (designated by the value
+	 * at the top of the stack) from both ends of the string and pushes
+	 * the resulting string.
+	 * Stack: ... string charset => ... trimmedString */
+    {"strtrimLeft",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* [string trimleft] core: removes the characters (designated by the
+	 * value at the top of the stack) from the left of the string and
+	 * pushes the resulting string.
+	 * Stack: ... string charset => ... trimmedString */
+    {"strtrimRight",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* [string trimright] core: removes the characters (designated by the
+	 * value at the top of the stack) from the right of the string and
+	 * pushes the resulting string.
+	 * Stack: ... string charset => ... trimmedString */
+
+    {"concatStk",	 5,	INT_MIN,  1,	{OPERAND_UINT4}},
+	/* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
+	 * is number of values to concatenate.
+	 * Operation:	push concat(stk1 stk2 ... stktop) */
+
+    {"strcaseUpper",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string toupper] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strcaseLower",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string tolower] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strcaseTitle",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string totitle] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strreplace",	 1,	-3,	  0,	{OPERAND_NONE}},
+	/* [string replace] core: replaces a non-empty range of one string
+	 * with the contents of another.
+	 * Stack: ... string fromIdx toIdx replacement => ... newString */
+
+    {"originCmd",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Reports which command was the origin (via namespace import chain)
+	 * of the command named on the top of the stack.
+	 * Stack:  ... cmdName => ... fullOriginalCmdName */
+
+    {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
+	/* Call the next item on the TclOO call chain, passing opnd arguments
+	 * (min 1, max 255, *includes* "next").  The result of the invoked
+	 * method implementation will be pushed on the stack in place of the
+	 * arguments (similar to invokeStk).
+	 * Stack:  ... "next" arg2 arg3 -- argN => ... result */
+    {"tclooNextClass",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
+	/* Call the following item on the TclOO call chain defined by class
+	 * className, passing opnd arguments (min 2, max 255, *includes*
+	 * "nextto" and the class name). The result of the invoked method
+	 * implementation will be pushed on the stack in place of the
+	 * arguments (similar to invokeStk).
+	 * Stack:  ... "nextto" className arg3 arg4 -- argN => ... result */
+
+    {"yieldToInvoke",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Makes the current coroutine yield the value at the top of the
+	 * stack, invoking the given command/args with resolution in the given
+	 * namespace (all packed into a list), and places the list of values
+	 * that are the response back on top of the stack when it resumes.
+	 * Stack:  ... [list ns cmd arg1 ... argN] => ... resumeList */
+
+    {"numericType",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Pushes the numeric type code of the word at the top of the stack.
+	 * Stack:  ... value => ... typeCode */
+    {"tryCvtToBoolean",	 1,	+1,	  0,	{OPERAND_NONE}},
+	/* Try converting stktop to boolean if possible. No errors.
+	 * Stack:  ... value => ... value isStrictBool */
+    {"strclass",	 2,	0,	  1,	{OPERAND_SCLS1}},
+	/* See if all the characters of the given string are a member of the
+	 * specified (by opnd) character class. Note that an empty string will
+	 * satisfy the class check (standard definition of "all").
+	 * Stack:  ... stringValue => ... boolean */
+
+    {"lappendList",	 5,	0,	1,	{OPERAND_LVT4}},
+	/* Lappend list to scalar variable at op4 in frame.
+	 * Stack:  ... list => ... listVarContents */
+    {"lappendListArray", 5,	-1,	1,	{OPERAND_LVT4}},
+	/* Lappend list to array element; array at op4.
+	 * Stack:  ... elem list => ... listVarContents */
+    {"lappendListArrayStk", 1,	-2,	0,	{OPERAND_NONE}},
+	/* Lappend list to array element.
+	 * Stack:  ... arrayName elem list => ... listVarContents */
+    {"lappendListStk",	 1,	-1,	0,	{OPERAND_NONE}},
+	/* Lappend list to general variable.
+	 * Stack:  ... varName list => ... listVarContents */
+
+    {"clockRead",	 2,	+1,	1,	{OPERAND_UINT1}},
+        /* Read clock out to the stack. Operand is which clock to read
+	 * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
+	 * Stack: ... => ... time */
+
+    {NULL, 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,
@@ -413,25 +677,25 @@ static void		EnterCmdExtentData(CompileEnv *envPtr,
 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 int		IsCompactibleCompileEnv(Tcl_Interp *interp,
+			    CompileEnv *envPtr);
 #ifdef TCL_COMPILE_STATS
 static void		RecordByteCodeStats(ByteCode *codePtr);
 #endif /* TCL_COMPILE_STATS */
-static void		RegisterAuxDataType(AuxDataType *typePtr);
 static int		SetByteCodeFromAny(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
-static int		FormatInstruction(ByteCode *codePtr,
-			    unsigned char *pc, Tcl_Obj *bufferObj);
-static void		PrintSourceToObj(Tcl_Obj *appendObj,
-			    const char *stringPtr, int maxChars);
+static void		StartExpanding(CompileEnv *envPtr);
+
 /*
  * 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);
+			    int numWords, int line, int *clNext, int **lines,
+			    CompileEnv *envPtr);
 static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);
 
 /*
@@ -439,13 +703,33 @@ static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);
  * procedures that can be invoked by generic object code.
  */
 
-Tcl_ObjType tclByteCodeType = {
+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 const Tcl_ObjType substCodeType = {
+    "substcode",		/* name */
+    FreeSubstCodeInternalRep,	/* freeIntRepProc */
+    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
+    NULL,			/* updateStringProc */
+    NULL,			/* setFromAnyProc */
+};
+
+/*
+ * Helper macros.
+ */
+
+#define TclIncrUInt4AtPtr(ptr, delta) \
+    TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr));
 
 /*
  *----------------------------------------------------------------------
@@ -486,7 +770,8 @@ TclSetByteCodeFromAny(
 				 * in frame. */
     int length, result = TCL_OK;
     const char *stringPtr;
-    ContLineLoc* clLocPtr;
+    Proc *procPtr = iPtr->compiledProcPtr;
+    ContLineLoc *clLocPtr;
 
 #ifdef TCL_COMPILE_DEBUG
     if (!traceInitialized) {
@@ -508,6 +793,7 @@ TclSetByteCodeFromAny(
 
     TclInitCompileEnv(interp, &compEnv, stringPtr, length,
 	    iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+
     /*
      * Now we check if we have data about invisible continuation lines for the
      * script, and make it available to the compile environment, if so.
@@ -515,16 +801,14 @@ 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.clNext = &compEnv.clLoc->loc[0];
-	Tcl_Preserve (compEnv.clLoc);
+	compEnv.clNext = &clLocPtr->loc[0];
     }
 
     TclCompileScript(interp, stringPtr, length, &compEnv);
@@ -536,11 +820,45 @@ TclSetByteCodeFromAny(
     TclEmitOpcode(INST_DONE, &compEnv);
 
     /*
+     * Check for optimizations!
+     *
+     * Test if the generated code is free of most hazards; if so, recompile
+     * but with generation of INST_START_CMD disabled. This produces somewhat
+     * faster code in some cases, and more compact code in more.
+     */
+
+    if (Tcl_GetMaster(interp) == NULL &&
+	    !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
+	    && IsCompactibleCompileEnv(interp, &compEnv)) {
+	TclFreeCompileEnv(&compEnv);
+	iPtr->compiledProcPtr = procPtr;
+	TclInitCompileEnv(interp, &compEnv, stringPtr, length,
+		iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+	if (clLocPtr) {
+	    compEnv.clNext = &clLocPtr->loc[0];
+	}
+	compEnv.atCmdStart = 2;		/* The disabling magic. */
+	TclCompileScript(interp, stringPtr, length, &compEnv);
+	assert (compEnv.atCmdStart > 1);
+	TclEmitOpcode(INST_DONE, &compEnv);
+	assert (compEnv.atCmdStart > 1);
+    }
+
+    /*
+     * Apply some peephole optimizations that can cross specific/generic
+     * instruction generator boundaries.
+     */
+
+    if (iPtr->extra.optimizer) {
+	(iPtr->extra.optimizer)(&compEnv);
+    }
+
+    /*
      * Invoke the compilation hook procedure if one exists.
      */
 
     if (hookProc) {
-	result = (*hookProc)(interp, &compEnv, clientData);
+	result = hookProc(interp, &compEnv, clientData);
     }
 
     /*
@@ -598,8 +916,7 @@ SetByteCodeFromAny(
     if (interp == NULL) {
 	return TCL_ERROR;
     }
-    (void) TclSetByteCodeFromAny(interp, objPtr, NULL, (ClientData) NULL);
-    return TCL_OK;
+    return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
 }
 
 /*
@@ -653,14 +970,12 @@ static void
 FreeByteCodeInternalRep(
     register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
 {
-    register ByteCode *codePtr = (ByteCode *)
-	    objPtr->internalRep.twoPtrValue.ptr1;
+    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    codePtr->refCount--;
-    if (codePtr->refCount <= 0) {
+    objPtr->typePtr = NULL;
+    if (codePtr->refCount-- <= 1) {
 	TclCleanupByteCode(codePtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -691,7 +1006,7 @@ TclCleanupByteCode(
     int numLitObjects = codePtr->numLitObjects;
     int numAuxDataItems = codePtr->numAuxDataItems;
     register Tcl_Obj **objArrayPtr, *objPtr;
-    register AuxData *auxDataPtr;
+    register const AuxData *auxDataPtr;
     int i;
 #ifdef TCL_COMPILE_STATS
 
@@ -700,7 +1015,7 @@ TclCleanupByteCode(
 	Tcl_Time destroyTime;
 	int lifetimeSec, lifetimeMicroSec, log2;
 
-	statsPtr = &((Interp *) interp)->stats;
+	statsPtr = &iPtr->stats;
 
 	statsPtr->numByteCodesFreed++;
 	statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
@@ -752,7 +1067,7 @@ TclCleanupByteCode(
      * released.
      */
 
-    if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) {
+    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
 
 	objArrayPtr = codePtr->objArrayPtr;
 	for (i = 0;  i < numLitObjects;  i++) {
@@ -765,24 +1080,16 @@ TclCleanupByteCode(
 	codePtr->numLitObjects = 0;
     } else {
 	objArrayPtr = codePtr->objArrayPtr;
-	for (i = 0;  i < numLitObjects;  i++) {
-	    /*
-	     * TclReleaseLiteral sets a ByteCode's object array entry NULL to
-	     * indicate that it has already freed the literal.
-	     */
-
-	    objPtr = *objArrayPtr;
-	    if (objPtr != NULL) {
-		TclReleaseLiteral(interp, objPtr);
-	    }
-	    objArrayPtr++;
+	while (numLitObjects--) {
+	    /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */
+	    TclReleaseLiteral(interp, *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++;
     }
@@ -798,6 +1105,7 @@ TclCleanupByteCode(
     if (iPtr) {
 	Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
 		(char *) codePtr);
+
 	if (hePtr) {
 	    ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
 	    Tcl_DeleteHashEntry(hePtr);
@@ -809,7 +1117,251 @@ TclCleanupByteCode(
     }
 
     TclHandleRelease(codePtr->interpHandle);
-    ckfree((char *) codePtr);
+    ckfree(codePtr);
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * IsCompactibleCompileEnv --
+ *
+ *	Checks to see if we may apply some basic compaction optimizations to a
+ *	piece of bytecode. Idempotent.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static int
+IsCompactibleCompileEnv(
+    Tcl_Interp *interp,
+    CompileEnv *envPtr)
+{
+    unsigned char *pc;
+    int size;
+
+    /*
+     * Special: procedures in the '::tcl' namespace (or its children) are
+     * considered to be well-behaved and so can have compaction applied even
+     * if it would otherwise be invalid.
+     */
+
+    if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL
+	    && envPtr->procPtr->cmdPtr->nsPtr != NULL) {
+	Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+
+	if (strcmp(nsPtr->fullName, "::tcl") == 0
+		|| strncmp(nsPtr->fullName, "::tcl::", 7) == 0) {
+	    return 1;
+	}
+    }
+
+    /*
+     * Go through and ensure that no operation involved can cause a desired
+     * change of bytecode sequence during running. This comes down to ensuring
+     * that there are no mapped variables (due to traces) or calls to external
+     * commands (traces, [uplevel] trickery). This is actually a very
+     * conservative check; it turns down a lot of code that is OK in practice.
+     */
+
+    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
+	switch (*pc) {
+	    /* Invokes */
+	case INST_INVOKE_STK1:
+	case INST_INVOKE_STK4:
+	case INST_INVOKE_EXPANDED:
+	case INST_INVOKE_REPLACE:
+	    return 0;
+	    /* Runtime evals */
+	case INST_EVAL_STK:
+	case INST_EXPR_STK:
+	case INST_YIELD:
+	    return 0;
+	    /* Upvars */
+	case INST_UPVAR:
+	case INST_NSUPVAR:
+	case INST_VARIABLE:
+	    return 0;
+	default:
+	    size = tclInstructionTable[*pc].numBytes;
+	    assert (size > 0);
+	    break;
+	}
+    }
+
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    NRE_callback *rootPtr = TOP_CB(interp);
+
+    if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
+	    rootPtr) != TCL_OK) {
+	return NULL;
+    }
+    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.twoPtrValue.ptr1;
+	if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
+		|| ((Interp *) *codePtr->interpHandle != iPtr)
+		|| (codePtr->compileEpoch != iPtr->compileEpoch)
+		|| (codePtr->nsPtr != nsPtr)
+		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
+		|| (codePtr->localCachePtr !=
+		iPtr->varFramePtr->localCachePtr)) {
+	    FreeSubstCodeInternalRep(objPtr);
+	}
+    }
+    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.twoPtrValue.ptr1;
+	objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
+	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
+	if (iPtr->varFramePtr->localCachePtr) {
+	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+	    codePtr->localCachePtr->refCount++;
+	}
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceCompile >= 2) {
+	    TclPrintByteCodeObj(interp, objPtr);
+	    fflush(stdout);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+    }
+    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.twoPtrValue.ptr1;
+
+    objPtr->typePtr = NULL;
+    if (codePtr->refCount-- <= 1) {
+	TclCleanupByteCode(codePtr);
+    }
 }
 
 static void
@@ -829,8 +1381,6 @@ ReleaseCmdWordData(
 	ckfree((char *) eclPtr->loc);
     }
 
-    Tcl_DeleteHashTable (&eclPtr->litInfo);
-
     ckfree((char *) eclPtr);
 }
 
@@ -865,6 +1415,8 @@ TclInitCompileEnv(
 {
     Interp *iPtr = (Interp *) interp;
 
+    assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
+
     envPtr->iPtr = iPtr;
     envPtr->source = stringPtr;
     envPtr->numSrcBytes = numBytes;
@@ -875,11 +1427,11 @@ 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;
@@ -888,6 +1440,7 @@ TclInitCompileEnv(
     envPtr->mallocedLiteralArray = 0;
 
     envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
+    envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace;
     envPtr->exceptArrayNext = 0;
     envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
     envPtr->mallocedExceptArray = 0;
@@ -896,6 +1449,7 @@ TclInitCompileEnv(
     envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
     envPtr->mallocedCmdMap = 0;
     envPtr->atCmdStart = 1;
+    envPtr->expandCount = 0;
 
     /*
      * TIP #280: Set up the extended command location information, based on
@@ -906,40 +1460,70 @@ TclInitCompileEnv(
      * non-compiling evaluator
      */
 
-    envPtr->extCmdMapPtr = (ExtCmdLoc *) ckalloc(sizeof(ExtCmdLoc));
+    envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc));
     envPtr->extCmdMapPtr->loc = NULL;
     envPtr->extCmdMapPtr->nloc = 0;
     envPtr->extCmdMapPtr->nuloc = 0;
     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) {
+	/*
 	 * Initialize the compiler for relative counting in case of a
 	 * dynamic context.
 	 */
 
 	envPtr->line = 1;
-	envPtr->extCmdMapPtr->type =
+	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);
+	}
     } 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.
 	 */
 
-	CmdFrame* ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
+	CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
 	int pc = 0;
 
 	*ctxPtr = *invoker;
-
 	if (invoker->type == TCL_LOCATION_BC) {
 	    /*
 	     * Note: Type BC => ctx.data.eval.path    is not used.
-	     *                  ctx.data.tebc.codePtr is used instead.
+	     *			ctx.data.tebc.codePtr is used instead.
 	     */
 
 	    TclGetSrcInfoForPc(ctxPtr);
@@ -959,6 +1543,7 @@ TclInitCompileEnv(
 		/*
 		 * The reference made by 'TclGetSrcInfoForPc' is dead.
 		 */
+
 		Tcl_DecrRefCount(ctxPtr->data.eval.path);
 	    }
 	} else {
@@ -979,7 +1564,7 @@ TclInitCompileEnv(
 		     * We have a new reference here.
 		     */
 
-		    Tcl_IncrRefCount(ctxPtr->data.eval.path);
+		    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
 		}
 	    }
 	}
@@ -990,12 +1575,11 @@ TclInitCompileEnv(
     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->clNext = NULL;
 
     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
@@ -1030,12 +1614,12 @@ void
 TclFreeCompileEnv(
     register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
 {
-    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets) {
-	ckfree((char *) envPtr->localLitTable.buckets);
+    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
+	ckfree(envPtr->localLitTable.buckets);
 	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
     }
     if (envPtr->iPtr) {
-	/* 
+	/*
 	 * We never converted to Bytecode, so free the things we would
 	 * have transferred to it.
 	 */
@@ -1061,34 +1645,25 @@ TclFreeCompileEnv(
 	}
     }
     if (envPtr->mallocedCodeArray) {
-	ckfree((char *) envPtr->codeStart);
+	ckfree(envPtr->codeStart);
     }
     if (envPtr->mallocedLiteralArray) {
-	ckfree((char *) envPtr->literalArrayPtr);
+	ckfree(envPtr->literalArrayPtr);
     }
     if (envPtr->mallocedExceptArray) {
-	ckfree((char *) envPtr->exceptArrayPtr);
+	ckfree(envPtr->exceptArrayPtr);
+	ckfree(envPtr->exceptAuxArrayPtr);
     }
     if (envPtr->mallocedCmdMap) {
-	ckfree((char *) envPtr->cmdMapPtr);
+	ckfree(envPtr->cmdMapPtr);
     }
     if (envPtr->mallocedAuxDataArray) {
-	ckfree((char *) envPtr->auxDataArrayPtr);
+	ckfree(envPtr->auxDataArrayPtr);
     }
     if (envPtr->extCmdMapPtr) {
 	ReleaseCmdWordData(envPtr->extCmdMapPtr);
 	envPtr->extCmdMapPtr = NULL;
     }
-
-    /*
-     * 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
-     * TclSetByteCodeFromAny(), found in this file.
-     */
-
-    if (envPtr->clLoc) {
-	Tcl_Release (envPtr->clLoc);
-    }
 }
 
 /*
@@ -1151,6 +1726,7 @@ TclWordKnownAtCompileTime(
 		char utfBuf[TCL_UTF_MAX];
 		int length = TclParseBackslash(tokenPtr->start,
 			tokenPtr->size, NULL, utfBuf);
+
 		Tcl_AppendToObj(tempPtr, utfBuf, length);
 	    }
 	    break;
@@ -1188,451 +1764,475 @@ TclWordKnownAtCompileTime(
  *----------------------------------------------------------------------
  */
 
-void
-TclCompileScript(
-    Tcl_Interp *interp,		/* Used for error and status reporting. Also
-				 * serves as context for finding and compiling
-				 * commands. May not be NULL. */
-    const char *script,		/* The source script to compile. */
-    int numBytes,		/* Number of bytes in script. If < 0, the
-				 * script consists of all bytes up to the
-				 * first null character. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
+static int
+ExpandRequested(
+    Tcl_Token *tokenPtr,
+    int numWords)
 {
-    Interp *iPtr = (Interp *) interp;
-    int lastTopLevelCmdIndex = -1;
-    				/* 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. */
-    unsigned char *entryCodeNext = envPtr->codeNext;
-    const char *p, *next;
-    Namespace *cmdNsPtr;
+    /* Determine whether any words of the command require expansion */
+    while (numWords--) {
+	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+	    return 1;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    return 0;
+}
+
+static void
+CompileCmdLiteral(
+    Tcl_Interp *interp,
+    Tcl_Obj *cmdObj,
+    CompileEnv *envPtr)
+{
+    int numBytes;
+    const char *bytes;
     Command *cmdPtr;
-    Tcl_Token *tokenPtr;
-    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex;
-    int commandLength, objIndex;
-    Tcl_DString ds;
-    /* TIP #280 */
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
-    int *wlines, wlineat, cmdLine;
-    int* clNext;
-    Tcl_Parse *parsePtr = (Tcl_Parse *)
-	    TclStackAlloc(interp, sizeof(Tcl_Parse));
+    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
 
-    if (envPtr->iPtr == NULL) {
-	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
+	extraLiteralFlags |= LITERAL_UNSHARED;
+    }
+
+    bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+    cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags);
+
+    if (cmdPtr) {
+	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
+    }
+    TclEmitPush(cmdLitIdx, envPtr);
+}
+
+void
+TclCompileInvocation(
+    Tcl_Interp *interp,
+    Tcl_Token *tokenPtr,
+    Tcl_Obj *cmdObj,
+    int numWords,
+    CompileEnv *envPtr)
+{
+    int wordIdx = 0, depth = TclGetStackDepth(envPtr);
+    DefineLineInformation;
+
+    if (cmdObj) {
+	CompileCmdLiteral(interp, cmdObj, envPtr);
+	wordIdx = 1;
+	tokenPtr = TokenAfter(tokenPtr);
     }
 
-    Tcl_DStringInit(&ds);
+    for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
+	int objIdx;
+
+	SetLineInformation(wordIdx);
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    CompileTokens(envPtr, tokenPtr, interp);
+	    continue;
+	}
 
-    if (numBytes < 0) {
-	numBytes = strlen(script);
+	objIdx = TclRegisterNewLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size);
+	if (envPtr->clNext) {
+	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
+	}
+	TclEmitPush(objIdx, envPtr);
     }
-    Tcl_ResetResult(interp);
-    isFirstCmd = 1;
 
-    if (envPtr->procPtr != NULL) {
-	cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+    if (wordIdx <= 255) {
+	TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
     } else {
-	cmdNsPtr = NULL;	/* use current NS */
+	TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
+    }
+    TclCheckStackDepth(depth+1, envPtr);
+}
+
+static void
+CompileExpanded(
+    Tcl_Interp *interp,
+    Tcl_Token *tokenPtr,
+    Tcl_Obj *cmdObj,
+    int numWords,
+    CompileEnv *envPtr)
+{
+    int wordIdx = 0;
+    DefineLineInformation;
+    int depth = TclGetStackDepth(envPtr);
+
+    StartExpanding(envPtr);
+    if (cmdObj) {
+	CompileCmdLiteral(interp, cmdObj, envPtr);
+	wordIdx = 1;
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+
+    for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
+	int objIdx;
+
+	SetLineInformation(wordIdx);
+
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    CompileTokens(envPtr, tokenPtr, interp);
+	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+		TclEmitInstInt4(INST_EXPAND_STKTOP,
+			envPtr->currStackDepth, envPtr);
+	    }
+	    continue;
+	}
+
+	objIdx = TclRegisterNewLiteral(envPtr,
+		tokenPtr[1].start, tokenPtr[1].size);
+	if (envPtr->clNext) {
+	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
+	}
+	TclEmitPush(objIdx, envPtr);
     }
 
     /*
-     * Each iteration through the following loop compiles the next command
-     * from the script.
+     * 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.
      */
 
-    p = script;
-    bytesLeft = numBytes;
-    cmdLine = envPtr->line;
-    clNext = envPtr->clNext;
-    do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
-	    /*
-	     * Compile bytecodes to report the parse error at runtime.
-	     */
+    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
+    TclCheckStackDepth(depth+1, envPtr);
+}
 
-	    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;
+static int
+CompileCmdCompileProc(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Command *cmdPtr,
+    CompileEnv *envPtr)
+{
+    int unwind = 0, incrOffset = -1;
+    DefineLineInformation;
+    int depth = TclGetStackDepth(envPtr);
+
+    /*
+     * Emit of the INST_START_CMD instruction is controlled by the value of
+     * envPtr->atCmdStart:
+     *
+     * atCmdStart == 2	: We are not using the INST_START_CMD instruction.
+     * atCmdStart == 1	: INST_START_CMD was the last instruction emitted.
+     *			: We do not need to emit another.  Instead we
+     *			: increment the number of cmds started at it (except
+     *			: for the special case at the start of a script.)
+     * atCmdStart == 0	: The last instruction was something else.  We need
+     *			: to emit INST_START_CMD here.
+     */
+
+    switch (envPtr->atCmdStart) {
+    case 0:
+	unwind = tclInstructionTable[INST_START_CMD].numBytes;
+	TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+	incrOffset = envPtr->codeNext - envPtr->codeStart;
+	TclEmitInt4(0, envPtr);
+	break;
+    case 1:
+	if (envPtr->codeNext > envPtr->codeStart) {
+	    incrOffset = envPtr->codeNext - 4 - envPtr->codeStart;
 	}
-	if (parsePtr->numWords > 0) {
-	    int expand = 0;	/* Set if there are dynamic expansions to
-				 * handle */
+	break;
+    case 2:
+	/* Nothing to do */
+	;
+    }
 
+    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
+	if (incrOffset >= 0) {
 	    /*
-	     * If not the first command, pop the previous command's result
-	     * and, if we're compiling a top level command, update the last
-	     * command's code size to account for the pop instruction.
+	     * We successfully compiled a command.  Increment the number of
+	     * commands that start at the currently active INST_START_CMD.
 	     */
 
-	    if (!isFirstCmd) {
-		TclEmitOpcode(INST_POP, envPtr);
-		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
-			(envPtr->codeNext - envPtr->codeStart)
-			- startCodeOffset;
+	    unsigned char *incrPtr = envPtr->codeStart + incrOffset;
+	    unsigned char *startPtr = incrPtr - 5;
+
+	    TclIncrUInt4AtPtr(incrPtr, 1);
+	    if (unwind) {
+		/* We started the INST_START_CMD.  Record the code length. */
+		TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
 	    }
+	}
+	TclCheckStackDepth(depth+1, envPtr);
+	return TCL_OK;
+    }
 
-	    /*
-	     * Determine the actual length of the command.
-	     */
+    envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
 
-	    commandLength = parsePtr->commandSize;
-	    if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
-		/*
-		 * The command terminator character (such as ; or ]) is the
-		 * last character in the parsed command. Reduce the length by
-		 * one so that the trace message doesn't include the
-		 * terminator character.
-		 */
+    /*
+     * Throw out any line information generated by the failed compile attempt.
+     */
 
-		commandLength -= 1;
-	    }
+    while (mapPtr->nuloc - 1 > eclIndex) {
+	mapPtr->nuloc--;
+	ckfree(mapPtr->loc[mapPtr->nuloc].line);
+	mapPtr->loc[mapPtr->nuloc].line = NULL;
+    }
 
-#ifdef TCL_COMPILE_DEBUG
-	    /*
-	     * If tracing, print a line for each top level command compiled.
-	     */
+    /*
+     * Reset the index of next command.  Toss out any from failed nested
+     * partial compiles.
+     */
 
-	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
-		fprintf(stdout, "  Compiling: ");
-		TclPrintSource(stdout, parsePtr->commandStart,
-			TclMin(commandLength, 55));
-		fprintf(stdout, "\n");
-	    }
-#endif
+    envPtr->numCommands = mapPtr->nuloc;
+    return TCL_ERROR;
+}
 
-	    /*
-	     * Check whether expansion has been requested for any of the
-	     * words.
-	     */
+static int
+CompileCommandTokens(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    CompileEnv *envPtr)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+    Tcl_Obj *cmdObj = Tcl_NewObj();
+    Command *cmdPtr = NULL;
+    int code = TCL_ERROR;
+    int cmdKnown, expand = -1;
+    int *wlines, wlineat;
+    int cmdLine = envPtr->line;
+    int *clNext = envPtr->clNext;
+    int cmdIdx = envPtr->numCommands;
+    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+    int depth = TclGetStackDepth(envPtr);
 
-	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
-		    wordIdx < parsePtr->numWords;
-		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
-		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-		    expand = 1;
-		    break;
-		}
-	    }
+    assert (parsePtr->numWords > 0);
 
-	    envPtr->numCommands++;
-	    currCmdIndex = (envPtr->numCommands - 1);
-	    lastTopLevelCmdIndex = currCmdIndex;
-	    startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-	    EnterCmdStartData(envPtr, currCmdIndex,
-		    parsePtr->commandStart - envPtr->source, startCodeOffset);
+    /* Pre-Compile */
 
-	    /*
-	     * Should only start issuing instructions after the "command has
-	     * started" so that the command range is correct in the bytecode.
-	     */
+    envPtr->numCommands++;
+    EnterCmdStartData(envPtr, cmdIdx,
+	    parsePtr->commandStart - envPtr->source, startCodeOffset);
 
-	    if (expand) {
-		TclEmitOpcode(INST_EXPAND_START, envPtr);
-	    }
+    /*
+     * TIP #280. Scan the words and compute the extended location information.
+     * The map first contain full per-word line information for use by the
+     * compiler. This is later replaced by a reduced form which signals
+     * non-literal words, stored in 'wlines'.
+     */
 
-	    /*
-	     * 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);
+    wlineat = eclPtr->nuloc - 1;
 
-	    TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
-	    TclAdvanceContinuations (&cmdLine, &clNext,
-				     parsePtr->commandStart - envPtr->source);
-	    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
-			     parsePtr->tokenPtr, parsePtr->commandStart,
-			     parsePtr->commandSize, parsePtr->numWords, cmdLine,
-			     clNext, &wlines, envPtr);
-	    wlineat = eclPtr->nuloc - 1;
+    envPtr->line = eclPtr->loc[wlineat].line[0];
+    envPtr->clNext = eclPtr->loc[wlineat].next[0];
 
+    /* Do we know the command word? */
+    Tcl_IncrRefCount(cmdObj);
+    tokenPtr = parsePtr->tokenPtr;
+    cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
+
+    /* Is this a command we should (try to) compile with a compileProc ? */
+    if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+	if (cmdPtr) {
 	    /*
-	     * Each iteration of the following loop compiles one word from the
-	     * command.
+	     * Found a command.  Test the ways we can be told not to attempt
+	     * to compile it.
 	     */
+	    if ((cmdPtr->compileProc == NULL)
+		    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
+		    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+		cmdPtr = NULL;
+	    }
+	}
+	if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+	    expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+	    if (expand) {
+		/* We need to expand, but compileProc cannot. */
+		cmdPtr = NULL;
+	    }
+	}
+    }
 
-	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
-		    wordIdx < parsePtr->numWords; wordIdx++,
-		    tokenPtr += (tokenPtr->numComponents + 1)) {
+    /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
+    if (cmdPtr) {
+	code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr);
+    }
 
-		envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
-		envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];
+    if (code == TCL_ERROR) {
+	if (expand < 0) {
+	    expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+	}
 
-		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		    /*
-		     * The word is not a simple string of characters.
-		     */
+	if (expand) {
+	    CompileExpanded(interp, parsePtr->tokenPtr,
+		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
+	} else {
+	    TclCompileInvocation(interp, parsePtr->tokenPtr,
+		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
+	}
+    }
 
-		    TclCompileTokens(interp, tokenPtr+1,
-			    tokenPtr->numComponents, envPtr);
-		    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-			TclEmitInstInt4(INST_EXPAND_STKTOP,
-				envPtr->currStackDepth, envPtr);
-		    }
-		    continue;
-		}
+    Tcl_DecrRefCount(cmdObj);
 
-		/*
-		 * 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.
-		 */
+    TclEmitOpcode(INST_POP, envPtr);
+    EnterCmdExtentData(envPtr, cmdIdx,
+	    parsePtr->term - parsePtr->commandStart,
+	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 
-		if ((wordIdx == 0) && !expand) {
-		    /*
-		     * We copy the string before trying to find the command by
-		     * name. We used to modify the string in place, but this
-		     * is not safe because the name resolution handlers could
-		     * have side effects that rely on the unmodified string.
-		     */
+    /*
+     * TIP #280: Free full form of per-word line data and insert the reduced
+     * form now
+     */
 
-		    Tcl_DStringSetLength(&ds, 0);
-		    Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);
-
-		    cmdPtr = (Command *) Tcl_FindCommand(interp,
-			    Tcl_DStringValue(&ds),
-			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
-
-		    if ((cmdPtr != NULL)
-			    && (cmdPtr->compileProc != NULL)
-			    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
-			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
-			int savedNumCmds = envPtr->numCommands;
-			unsigned savedCodeNext =
-				envPtr->codeNext - envPtr->codeStart;
-			int update = 0, code;
-
-			/*
-			 * Mark the start of the command; the proper bytecode
-			 * length will be updated later. There is no need to
-			 * do this for the first bytecode in the compile env,
-			 * as the check is done before calling
-			 * TclExecuteByteCode(). Do emit an INST_START_CMD in
-			 * special cases where the first bytecode is in a
-			 * loop, to insure that the corresponding command is
-			 * counted properly. Compilers for commands able to
-			 * produce such a beast (currently 'while 1' only) set
-			 * envPtr->atCmdStart to 0 in order to signal this
-			 * case. [Bug 1752146]
-			 *
-			 * Note that the environment is initialised with
-			 * atCmdStart=1 to avoid emitting ISC for the first
-			 * command.
-			 */
-
-			if (envPtr->atCmdStart) {
-			    if (savedCodeNext != 0) {
-				/*
-				 * 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!
-				 */
-
-				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) {
-				/*
-				 * Fix the bytecode length.
-				 */
-
-				unsigned char *fixPtr = envPtr->codeStart
-					+ savedCodeNext + 1;
-				unsigned fixLen = envPtr->codeNext
-					- envPtr->codeStart - savedCodeNext;
-
-				TclStoreInt4AtPtr(fixLen, fixPtr);
-			    }
-			    goto finishCommand;
-			} else {
-			    if (envPtr->atCmdStart && savedCodeNext != 0) {
-				/*
-				 * Decrease the number of commands being
-				 * started at the current point. Note that
-				 * this depends on the exact layout of the
-				 * INST_START_CMD's operands, so be careful!
-				 */
-
-				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]
-			     */
-
-			    envPtr->numCommands = savedNumCmds;
-			    envPtr->codeNext = envPtr->codeStart+savedCodeNext;
-			}
-		    }
+    envPtr->line = cmdLine;
+    envPtr->clNext = clNext;
+    ckfree(eclPtr->loc[wlineat].line);
+    ckfree(eclPtr->loc[wlineat].next);
+    eclPtr->loc[wlineat].line = wlines;
+    eclPtr->loc[wlineat].next = NULL;
 
-		    /*
-		     * No compile procedure so push the word. If the command
-		     * was found, push a CmdName object to reduce runtime
-		     * lookups. Avoid sharing this literal among different
-		     * namespaces to reduce shimmering.
-		     */
+    TclCheckStackDepth(depth, envPtr);
+    return cmdIdx;
+}
 
-		    objIndex = TclRegisterNewNSLiteral(envPtr,
-			    tokenPtr[1].start, tokenPtr[1].size);
-		    if (cmdPtr != NULL) {
-			TclSetCmdNameObj(interp,
-			      envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr);
-		    }
-		    if ((wordIdx == 0) && (parsePtr->numWords == 1)) {
-			/*
-			 * Single word script: unshare the command name to
-			 * avoid shimmering between bytecode and cmdName
-			 * representations [Bug 458361]
-			 */
-
-			TclHideLiteral(interp, envPtr, objIndex);
-		    }
-		} 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 = TclRegisterNewLiteral(envPtr,
-			    tokenPtr[1].start, tokenPtr[1].size);
+void
+TclCompileScript(
+    Tcl_Interp *interp,		/* Used for error and status reporting. Also
+				 * serves as context for finding and compiling
+				 * commands. May not be NULL. */
+    const char *script,		/* The source script to compile. */
+    int numBytes,		/* Number of bytes in script. If < 0, the
+				 * script consists of all bytes up to the
+				 * first null character. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
+				 * command this routine compiles into bytecode.
+				 * Initial value of -1 indicates this routine
+				 * has not yet generated any bytecode. */
+    const char *p = script;	/* Where we are in our compile. */
+    int depth = TclGetStackDepth(envPtr);
 
-		    if (envPtr->clNext) {
-			TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
-						      tokenPtr[1].start - envPtr->source,
-						      eclPtr->loc [wlineat].next [wordIdx]);
-		    }
-		}
-		TclEmitPush(objIndex, envPtr);
-	    } /* for loop */
+    if (envPtr->iPtr == NULL) {
+	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+    }
+
+    /* Each iteration compiles one command from the script. */
+
+    while (numBytes > 0) {
+	Tcl_Parse parse;
+	const char *next;
 
+	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
 	    /*
-	     * Emit an invoke instruction for the command. We skip this if a
-	     * compile procedure was found for the command.
+	     * Compile bytecodes to report the parse error at runtime.
 	     */
 
-	    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.
-		 */
+	    Tcl_LogCommandInfo(interp, script, parse.commandStart,
+		    parse.term + 1 - parse.commandStart);
+	    TclCompileSyntaxError(interp, envPtr);
+	    return;
+	}
 
-		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
-		TclAdjustStackDepth((1-wordIdx), envPtr);
-	    } else if (wordIdx > 0) {
-		/*
-		 * Save PC -> command map for the TclArgumentBC* functions.
-		 */
+#ifdef TCL_COMPILE_DEBUG
+	/*
+	 * If tracing, print a line for each top level command compiled.
+	 * TODO: Suppress when numWords == 0 ?
+	 */
 
-		int isnew;
-		Tcl_HashEntry* hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
-			   (char*) (envPtr->codeNext - envPtr->codeStart), &isnew);
-		Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
+	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+	    int commandLength = parse.term - parse.commandStart;
+	    fprintf(stdout, "  Compiling: ");
+	    TclPrintSource(stdout, parse.commandStart,
+		    TclMin(commandLength, 55));
+	    fprintf(stdout, "\n");
+	}
+#endif
 
-		if (wordIdx <= 255) {
-		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
-		}
-	    }
+	/*
+	 * TIP #280: Count newlines before the command start.
+	 * (See test info-30.33).
+	 */
 
-	    /*
-	     * Update the compilation environment structure and record the
-	     * offsets of the source and code for the command.
-	     */
+	TclAdvanceLines(&envPtr->line, p, parse.commandStart);
+	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+		parse.commandStart - envPtr->source);
+
+	/*
+	 * Advance parser to the next command in the script.
+	 */
 
-	finishCommand:
-	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
-		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
-	    isFirstCmd = 0;
+	next = parse.commandStart + parse.commandSize;
+	numBytes -= next - p;
+	p = next;
 
+	if (parse.numWords == 0) {
 	    /*
-	     * TIP #280: Free full form of per-word line data and insert the
-	     * reduced form now
+	     * The "command" parsed has no words.  In this case we can skip
+	     * the rest of the loop body.  With no words, clearly
+	     * CompileCommandTokens() has nothing to do.  Since the parser
+	     * aggressively sucks up leading comment and white space,
+	     * including newlines, parse.commandStart must be pointing at
+	     * either the end of script, or a command-terminating semi-colon.
+	     * In either case, the TclAdvance*() calls have nothing to do.
+	     * Finally, when no words are parsed, no tokens have been
+	     * allocated at parse.tokenPtr so there's also nothing for
+	     * Tcl_FreeParse() to do.
+	     *
+	     * The advantage of this shortcut is that CompileCommandTokens()
+	     * can be written with an assumption that parse.numWords > 0, with
+	     * the implication the CCT() always generates bytecode.
 	     */
+	    continue;
+	}
 
-	    ckfree((char *) eclPtr->loc[wlineat].line);
-	    ckfree((char *) eclPtr->loc[wlineat].next);
-	    eclPtr->loc[wlineat].line = wlines;
-	    eclPtr->loc[wlineat].next = NULL;
-	} /* end if parsePtr->numWords > 0 */
+	lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr);
 
 	/*
-	 * Advance to the next command in the script.
+	 * TIP #280: Track lines in the just compiled command.
 	 */
 
-	next = parsePtr->commandStart + parsePtr->commandSize;
-	bytesLeft -= next - p;
-	p = next;
+	TclAdvanceLines(&envPtr->line, parse.commandStart, p);
+	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+		p - envPtr->source);
+	Tcl_FreeParse(&parse);
+    }
 
+    if (lastCmdIdx == -1) {
 	/*
-	 * TIP #280: Track lines in the just compiled command.
+	 * Compiling the script yielded no bytecode.  The script must be all
+	 * whitespace, comments, and empty commands.  Such scripts are defined
+	 * to successfully produce the empty string result, so we emit the
+	 * simple bytecode that makes that happen.
 	 */
 
-	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
-	TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
-	Tcl_FreeParse(parsePtr);
-    } while (bytesLeft > 0);
-
-    /*
-     * If the source script yielded no instructions (e.g., if it was empty),
-     * push an empty string as the command's result.
-     *
-     * WARNING: push an unshared object! If the script being compiled is a
-     * shared empty string, it will otherwise be self-referential and cause
-     * difficulties with literal management [Bugs 467523, 983660]. We used to
-     * have special code in TclReleaseLiteral to handle this particular
-     * self-reference, but now opt for avoiding its creation altogether.
-     */
+	PushStringLiteral(envPtr, "");
+    } else {
+	/*
+	 * We compiled at least one command to bytecode.  The routine
+	 * CompileCommandTokens() follows the bytecode of each compiled
+	 * command with an INST_POP, so that stack balance is maintained when
+	 * several commands are in sequence.  (The result of each command is
+	 * thrown away before moving on to the next command).  For the last
+	 * command compiled, we need to undo that INST_POP so that the result
+	 * of the last command becomes the result of the script.  The code
+	 * here removes that trailing INST_POP.
+	 */
 
-    if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewObj(), NULL), envPtr);
+	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
+	envPtr->codeNext--;
+	envPtr->currStackDepth++;
     }
-
-    TclStackFree(interp, parsePtr);
-    Tcl_DStringFree(&ds);
+    TclCheckStackDepth(depth+1, envPtr);
 }
 
 /*
@@ -1657,6 +2257,76 @@ TclCompileScript(
  */
 
 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) {
+	PushLiteral(envPtr, name, nameBytes);
+    }
+
+    /*
+     * 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_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
@@ -1668,52 +2338,53 @@ TclCompileTokens(
     Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
 				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
     char buffer[TCL_UTF_MAX];
-    const char *name, *p;
-    int numObjsToConcat, nameBytes, localVarName, localVar;
-    int length, i;
+    int i, numObjsToConcat, length, adjust;
     unsigned char *entryCodeNext = envPtr->codeNext;
 #define NUM_STATIC_POS 20
     int isLiteral, maxNumCL, numCL;
-    int* clPosition = NULL;
+    int *clPosition = NULL;
+    int depth = TclGetStackDepth(envPtr);
 
     /*
      * 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 runtime processing.
+     * 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.
      */
 
-    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 = (int*) ckalloc (maxNumCL*sizeof(int));
+	maxNumCL = NUM_STATIC_POS;
+	clPosition = ckalloc(maxNumCL * sizeof(int));
     }
 
+    adjust = 0;
     Tcl_DStringInit(&textBuffer);
     numObjsToConcat = 0;
     for ( ;  count > 0;  count--, tokenPtr++) {
 	switch (tokenPtr->type) {
 	case TCL_TOKEN_TEXT:
-	    Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
+	    TclDStringAppendToken(&textBuffer, tokenPtr);
+	    TclAdvanceLines(&envPtr->line, tokenPtr->start,
+		    tokenPtr->start + tokenPtr->size);
 	    break;
 
 	case TCL_TOKEN_BS:
@@ -1739,16 +2410,17 @@ TclCompileTokens(
 	    if ((length == 1) && (buffer[0] == ' ') &&
 		(tokenPtr->start[1] == '\n')) {
 		if (isLiteral) {
-		    int clPos = Tcl_DStringLength (&textBuffer);
+		    int clPos = Tcl_DStringLength(&textBuffer);
 
 		    if (numCL >= maxNumCL) {
 			maxNumCL *= 2;
-			clPosition = (int*) ckrealloc ((char*)clPosition,
-						       maxNumCL*sizeof(int));
+			clPosition = ckrealloc(clPosition,
+                                maxNumCL * sizeof(int));
 		    }
 		    clPosition[numCL] = clPos;
 		    numCL ++;
 		}
+		adjust++;
 	    }
 	    break;
 
@@ -1758,23 +2430,23 @@ TclCompileTokens(
 	     */
 
 	    if (Tcl_DStringLength(&textBuffer) > 0) {
-		int literal = TclRegisterNewLiteral(envPtr,
-			Tcl_DStringValue(&textBuffer),
-			Tcl_DStringLength(&textBuffer));
+		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
 
 		TclEmitPush(literal, envPtr);
 		numObjsToConcat++;
 		Tcl_DStringFree(&textBuffer);
 
 		if (numCL) {
-		    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
-					  numCL, clPosition);
+		    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
+			    numCL, clPosition);
 		}
 		numCL = 0;
 	    }
 
+	    envPtr->line += adjust;
 	    TclCompileScript(interp, tokenPtr->start+1,
 		    tokenPtr->size-2, envPtr);
+	    envPtr->line -= adjust;
 	    numObjsToConcat++;
 	    break;
 
@@ -1786,79 +2458,13 @@ TclCompileTokens(
 	    if (Tcl_DStringLength(&textBuffer) > 0) {
 		int literal;
 
-		literal = TclRegisterNewLiteral(envPtr,
-			Tcl_DStringValue(&textBuffer),
-			Tcl_DStringLength(&textBuffer));
+		literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
 		TclEmitPush(literal, envPtr);
 		numObjsToConcat++;
 		Tcl_DStringFree(&textBuffer);
 	    }
 
-	    /*
-	     * Determine how the variable name should be handled: if it
-	     * contains any namespace qualifiers it is not a local variable
-	     * (localVarName=-1); if it looks like an array element and the
-	     * token has a single component, it should not be created here
-	     * [Bug 569438] (localVarName=0); otherwise, the local variable
-	     * can safely be created (localVarName=1).
-	     */
-
-	    name = tokenPtr[1].start;
-	    nameBytes = tokenPtr[1].size;
-	    localVarName = -1;
-	    if (envPtr->procPtr != NULL) {
-		localVarName = 1;
-		for (i = 0, p = name;  i < nameBytes;  i++, p++) {
-		    if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
-			localVarName = -1;
-			break;
-		    } else if ((*p == '(')
-			    && (tokenPtr->numComponents == 1)
-			    && (*(name + nameBytes - 1) == ')')) {
-			localVarName = 0;
-			break;
-		    }
-		}
-	    }
-
-	    /*
-	     * Either push the variable's name, or find its index in the array
-	     * of local variables in a procedure frame.
-	     */
-
-	    localVar = -1;
-	    if (localVarName != -1) {
-		localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
-			envPtr->procPtr);
-	    }
-	    if (localVar < 0) {
-		TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
-			envPtr);
-	    }
-
-	    /*
-	     * Emit instructions to load the variable.
-	     */
-
-	    if (tokenPtr->numComponents == 1) {
-		if (localVar < 0) {
-		    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);
-		}
-	    }
+	    TclCompileVarSubst(interp, tokenPtr, envPtr);
 	    numObjsToConcat++;
 	    count -= tokenPtr->numComponents;
 	    tokenPtr += tokenPtr->numComponents;
@@ -1875,16 +2481,13 @@ TclCompileTokens(
      */
 
     if (Tcl_DStringLength(&textBuffer) > 0) {
-	int literal;
+	int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
 
-	literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
-		Tcl_DStringLength(&textBuffer));
 	TclEmitPush(literal, envPtr);
 	numObjsToConcat++;
-
 	if (numCL) {
-	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
-				  numCL, clPosition);
+	    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
+		    numCL, clPosition);
 	}
 	numCL = 0;
     }
@@ -1894,11 +2497,11 @@ TclCompileTokens(
      */
 
     while (numObjsToConcat > 255) {
-	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
 	numObjsToConcat -= 254;	/* concat pushes 1 obj, the result */
     }
     if (numObjsToConcat > 1) {
-	TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr);
     }
 
     /*
@@ -1906,18 +2509,19 @@ TclCompileTokens(
      */
 
     if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+	PushStringLiteral(envPtr, "");
     }
     Tcl_DStringFree(&textBuffer);
 
     /*
-     * 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 ((char*) clPosition);
+	ckfree(clPosition);
     }
+    TclCheckStackDepth(depth+1, envPtr);
 }
 
 /*
@@ -1965,7 +2569,7 @@ TclCompileCmdWord(
 	 */
 
 	TclCompileTokens(interp, tokenPtr, count, envPtr);
-	TclEmitOpcode(INST_EVAL_STK, envPtr);
+	TclEmitInvoke(envPtr, INST_EVAL_STK);
     }
 }
 
@@ -2010,7 +2614,7 @@ TclCompileExprWords(
      */
 
     if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
-	TclCompileExpr(interp, tokenPtr[1].start, tokenPtr[1].size, envPtr, 1);
+	TclCompileExpr(interp, tokenPtr[1].start,tokenPtr[1].size, envPtr, 1);
 	return;
     }
 
@@ -2021,19 +2625,19 @@ TclCompileExprWords(
 
     wordPtr = tokenPtr;
     for (i = 0;  i < numWords;  i++) {
-	TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
+	CompileTokens(envPtr, wordPtr, interp);
 	if (i < (numWords - 1)) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1), envPtr);
+	    PushStringLiteral(envPtr, " ");
 	}
-	wordPtr += (wordPtr->numComponents + 1);
+	wordPtr += wordPtr->numComponents + 1;
     }
     concatItems = 2*numWords - 1;
     while (concatItems > 255) {
-	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
 	concatItems -= 254;
     }
     if (concatItems > 1) {
-	TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr);
     }
     TclEmitOpcode(INST_EXPR_STK, envPtr);
 }
@@ -2050,8 +2654,8 @@ TclCompileExprWords(
  *
  * 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.
+ *	result is pushed onto the stack: the compiler has to take care of this
+ *	itself if the last compiled command is a NoOp.
  *
  *----------------------------------------------------------------------
  */
@@ -2067,21 +2671,17 @@ TclCompileNoOp(
 {
     Tcl_Token *tokenPtr;
     int i;
-    int savedStackDepth = envPtr->currStackDepth;
 
     tokenPtr = parsePtr->tokenPtr;
-    for(i = 1; i < parsePtr->numWords; i++) {
+    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);
+	    CompileTokens(envPtr, tokenPtr, interp);
 	    TclEmitOpcode(INST_POP, envPtr);
 	}
     }
-    envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+    PushStringLiteral(envPtr, "");
     return TCL_OK;
 }
 
@@ -2136,10 +2736,10 @@ TclInitByteCodeObj(
 
     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);
 
     /*
@@ -2159,7 +2759,7 @@ TclInitByteCodeObj(
 	namespacePtr = envPtr->iPtr->globalNsPtr;
     }
 
-    p = (unsigned char *) ckalloc((size_t) structureSize);
+    p = ckalloc(structureSize);
     codePtr = (ByteCode *) p;
     codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
     codePtr->compileEpoch = iPtr->compileEpoch;
@@ -2191,7 +2791,29 @@ TclInitByteCodeObj(
     p += TCL_ALIGN(codeBytes);		/* align object array */
     codePtr->objArrayPtr = (Tcl_Obj **) p;
     for (i = 0;  i < numLitObjects;  i++) {
-	codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
+	Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);
+
+	if (objPtr == fetched) {
+	    /*
+	     * 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]);
+	    TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
+	} else {
+	    codePtr->objArrayPtr[i] = fetched;
+	}
     }
 
     p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
@@ -2216,7 +2838,7 @@ TclInitByteCodeObj(
 #else
     nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
     if (((size_t)(nextPtr - p)) != cmdLocBytes) {
-	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d", (nextPtr - p), cmdLocBytes);
+	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes);
     }
 #endif
 
@@ -2228,7 +2850,7 @@ 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 */
@@ -2239,7 +2861,7 @@ TclInitByteCodeObj(
      */
 
     TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = (void *) codePtr;
+    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
     objPtr->typePtr = &tclByteCodeType;
 
     /*
@@ -2247,7 +2869,7 @@ TclInitByteCodeObj(
      * byte code object (internal rep), for use with the bc compiler.
      */
 
-    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, (char *) codePtr,
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
 	    &isNew), envPtr->extCmdMapPtr);
     envPtr->extCmdMapPtr = NULL;
 
@@ -2288,20 +2910,49 @@ TclFindCompiledLocal(
 				 * scalar or array variable. If NULL, a
 				 * temporary var should be created. */
     int nameBytes,		/* Number of bytes in the name. */
-    int create,			/* If non-zero, allocate a local frame entry
-				 * for the variable if it is new. */
-    register Proc *procPtr)	/* Points to structure describing procedure
-				 * containing the variable reference. */
+    int create,			/* If 1, allocate a local frame entry for the
+				 * variable if it is new. */
+    CompileEnv *envPtr)		/* Points to the current compile environment*/
 {
     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) {
 	int localCt = procPtr->numCompiledLocals;
 
@@ -2325,9 +2976,7 @@ TclFindCompiledLocal(
 
     if (create || (name == NULL)) {
 	localVar = procPtr->numCompiledLocals;
-	localPtr = (CompiledLocal *) ckalloc((unsigned)
-		(sizeof(CompiledLocal) - sizeof(localPtr->name)
-		+ nameBytes + 1));
+	localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
 	if (procPtr->firstLocalPtr == NULL) {
 	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
 	} else {
@@ -2377,7 +3026,7 @@ TclExpandCodeArray(
     void *envArgPtr)		/* Points to the CompileEnv whose code array
 				 * must be enlarged. */
 {
-    CompileEnv *envPtr = (CompileEnv *) envArgPtr;
+    CompileEnv *envPtr = envArgPtr;
 				/* The CompileEnv containing the code array to
 				 * be doubled in size. */
 
@@ -2387,25 +3036,26 @@ TclExpandCodeArray(
      * [inclusive].
      */
 
-    size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
-    size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
+    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
+    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
 
     if (envPtr->mallocedCodeArray) {
-	envPtr->codeStart = (unsigned char *)
-		ckrealloc((char *)envPtr->codeStart, newBytes);
+	envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes);
     } else {
 	/*
-	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must
-	 * code a ckrealloc equivalent for ourselves.
+	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
+	 * ckrealloc equivalent for ourselves.
 	 */
-	unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
+
+	unsigned char *newPtr = ckalloc(newBytes);
+
 	memcpy(newPtr, envPtr->codeStart, currBytes);
 	envPtr->codeStart = newPtr;
 	envPtr->mallocedCodeArray = 1;
     }
 
-    envPtr->codeNext = (envPtr->codeStart + currBytes);
-    envPtr->codeEnd = (envPtr->codeStart + newBytes);
+    envPtr->codeNext = envPtr->codeStart + currBytes;
+    envPtr->codeEnd = envPtr->codeStart + newBytes;
 }
 
 /*
@@ -2452,19 +3102,20 @@ 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);
 
 	if (envPtr->mallocedCmdMap) {
-	    envPtr->cmdMapPtr = (CmdLocation *)
-		    ckrealloc((char *) envPtr->cmdMapPtr, newBytes);
+	    envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes);
 	} else {
 	    /*
-	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must
-	     * code a ckrealloc equivalent for ourselves.
+	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
+	     * ckrealloc equivalent for ourselves.
 	     */
-	    CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);
+
+	    CmdLocation *newPtr = ckalloc(newBytes);
+
 	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
 	    envPtr->cmdMapPtr = newPtr;
 	    envPtr->mallocedCmdMap = 1;
@@ -2478,7 +3129,7 @@ EnterCmdStartData(
 	}
     }
 
-    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
     cmdLocPtr->codeOffset = codeOffset;
     cmdLocPtr->srcOffset = srcOffset;
     cmdLocPtr->numSrcBytes = -1;
@@ -2527,7 +3178,7 @@ EnterCmdExtentData(
 		cmdIndex);
     }
 
-    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
+    cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
     cmdLocPtr->numSrcBytes = numSrcBytes;
     cmdLocPtr->numCodeBytes = numCodeBytes;
 }
@@ -2563,14 +3214,13 @@ EnterCmdWordData(
     int len,
     int numWords,
     int line,
-    int* clNext,
+    int *clNext,
     int **wlines,
-    CompileEnv* envPtr)
+    CompileEnv *envPtr)
 {
     ECL *ePtr;
     const char *last;
-    int wordIdx, wordLine, *wwlines;
-    int* wordNext;
+    int wordIdx, wordLine, *wwlines, *wordNext;
 
     if (eclPtr->nuloc >= eclPtr->nloc) {
 	/*
@@ -2583,25 +3233,25 @@ EnterCmdWordData(
 	size_t newElems = (currElems ? 2*currElems : 1);
 	size_t newBytes = newElems * sizeof(ECL);
 
-	eclPtr->loc = (ECL *) ckrealloc((char *)(eclPtr->loc), newBytes);
+	eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
 	eclPtr->nloc = newElems;
     }
 
     ePtr = &eclPtr->loc[eclPtr->nuloc];
     ePtr->srcOffset = srcOffset;
-    ePtr->line = (int *) ckalloc(numWords * sizeof(int));
-    ePtr->next = (int**) ckalloc (numWords * sizeof (int*));
+    ePtr->line = ckalloc(numWords * sizeof(int));
+    ePtr->next = ckalloc(numWords * sizeof(int *));
     ePtr->nline = numWords;
-    wwlines = (int *) ckalloc(numWords * sizeof(int));
+    wwlines = ckalloc(numWords * sizeof(int));
 
     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);
+	TclAdvanceLines(&wordLine, last, tokenPtr->start);
+	TclAdvanceContinuations(&wordLine, &wordNext,
+		tokenPtr->start - envPtr->source);
 	/* See Ticket 4b61afd660 */
 	wwlines[wordIdx] =
 		((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
@@ -2642,6 +3292,7 @@ TclCreateExceptRange(
 				 * new ExceptionRange structure. */
 {
     register ExceptionRange *rangePtr;
+    register ExceptionAux *auxPtr;
     int index = envPtr->exceptArrayNext;
 
     if (index >= envPtr->exceptArrayEnd) {
@@ -2653,28 +3304,36 @@ TclCreateExceptRange(
 
 	size_t currBytes =
 		envPtr->exceptArrayNext * sizeof(ExceptionRange);
+	size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
 	int newElems = 2*envPtr->exceptArrayEnd;
 	size_t newBytes = newElems * sizeof(ExceptionRange);
+	size_t newBytes2 = newElems * sizeof(ExceptionAux);
 
 	if (envPtr->mallocedExceptArray) {
-	    envPtr->exceptArrayPtr = (ExceptionRange *)
-		    ckrealloc((char *)(envPtr->exceptArrayPtr), newBytes);
+	    envPtr->exceptArrayPtr =
+		    ckrealloc(envPtr->exceptArrayPtr, newBytes);
+	    envPtr->exceptAuxArrayPtr =
+		    ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
 	} else {
 	    /*
 	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
 	     * code a ckrealloc equivalent for ourselves.
 	     */
-	    ExceptionRange *newPtr = (ExceptionRange *)
-		    ckalloc((unsigned) newBytes);
+
+	    ExceptionRange *newPtr = ckalloc(newBytes);
+	    ExceptionAux *newPtr2 = ckalloc(newBytes2);
+
 	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
+	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
 	    envPtr->exceptArrayPtr = newPtr;
+	    envPtr->exceptAuxArrayPtr = newPtr2;
 	    envPtr->mallocedExceptArray = 1;
 	}
 	envPtr->exceptArrayEnd = newElems;
     }
     envPtr->exceptArrayNext++;
 
-    rangePtr = &(envPtr->exceptArrayPtr[index]);
+    rangePtr = &envPtr->exceptArrayPtr[index];
     rangePtr->type = type;
     rangePtr->nestingLevel = envPtr->exceptDepth;
     rangePtr->codeOffset = -1;
@@ -2682,10 +3341,293 @@ TclCreateExceptRange(
     rangePtr->breakOffset = -1;
     rangePtr->continueOffset = -1;
     rangePtr->catchOffset = -1;
+    auxPtr = &envPtr->exceptAuxArrayPtr[index];
+    auxPtr->supportsContinue = 1;
+    auxPtr->stackDepth = envPtr->currStackDepth;
+    auxPtr->expandTarget = envPtr->expandCount;
+    auxPtr->expandTargetDepth = -1;
+    auxPtr->numBreakTargets = 0;
+    auxPtr->breakTargets = NULL;
+    auxPtr->allocBreakTargets = 0;
+    auxPtr->numContinueTargets = 0;
+    auxPtr->continueTargets = NULL;
+    auxPtr->allocContinueTargets = 0;
     return index;
 }
 
 /*
+ * ---------------------------------------------------------------------
+ *
+ * TclGetInnermostExceptionRange --
+ *
+ *	Returns the innermost exception range that covers the current code
+ *	creation point, and (optionally) the stack depth that is expected at
+ *	that point. Relies on the fact that the range has a numCodeBytes = -1
+ *	when it is being populated and that inner ranges come after outer
+ *	ranges.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+ExceptionRange *
+TclGetInnermostExceptionRange(
+    CompileEnv *envPtr,
+    int returnCode,
+    ExceptionAux **auxPtrPtr)
+{
+    int i = envPtr->exceptArrayNext;
+    ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;
+
+    while (i > 0) {
+	rangePtr--; i--;
+
+	if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
+		(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
+			rangePtr->codeOffset+rangePtr->numCodeBytes) &&
+		(returnCode != TCL_CONTINUE ||
+			envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
+
+	    if (auxPtrPtr) {
+		*auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
+	    }
+	    return rangePtr;
+	}
+    }
+    return NULL;
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
+ *
+ *	Adds a place that wants to break/continue to the loop exception range
+ *	tracking that will be fixed up once the loop can be finalized. These
+ *	functions will generate an INST_JUMP4 that will be fixed up during the
+ *	loop finalization.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclAddLoopBreakFixup(
+    CompileEnv *envPtr,
+    ExceptionAux *auxPtr)
+{
+    int range = auxPtr - envPtr->exceptAuxArrayPtr;
+
+    if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+	Tcl_Panic("trying to add 'break' fixup to full exception range");
+    }
+
+    if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
+	auxPtr->allocBreakTargets *= 2;
+	auxPtr->allocBreakTargets += 2;
+	if (auxPtr->breakTargets) {
+	    auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets,
+		    sizeof(int) * auxPtr->allocBreakTargets);
+	} else {
+	    auxPtr->breakTargets =
+		    ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
+	}
+    }
+    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
+    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+}
+
+void
+TclAddLoopContinueFixup(
+    CompileEnv *envPtr,
+    ExceptionAux *auxPtr)
+{
+    int range = auxPtr - envPtr->exceptAuxArrayPtr;
+
+    if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
+	Tcl_Panic("trying to add 'continue' fixup to full exception range");
+    }
+
+    if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
+	auxPtr->allocContinueTargets *= 2;
+	auxPtr->allocContinueTargets += 2;
+	if (auxPtr->continueTargets) {
+	    auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets,
+		    sizeof(int) * auxPtr->allocContinueTargets);
+	} else {
+	    auxPtr->continueTargets =
+		    ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
+	}
+    }
+    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
+	    CurrentOffset(envPtr);
+    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclCleanupStackForBreakContinue --
+ *
+ *	Ditch the extra elements from the auxiliary stack and the main stack.
+ *	How to do this exactly depends on whether there are any elements on
+ *	the auxiliary stack to pop.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclCleanupStackForBreakContinue(
+    CompileEnv *envPtr,
+    ExceptionAux *auxPtr)
+{
+    int savedStackDepth = envPtr->currStackDepth;
+    int toPop = envPtr->expandCount - auxPtr->expandTarget;
+
+    if (toPop > 0) {
+	while (toPop --> 0) {
+	    TclEmitOpcode(INST_EXPAND_DROP, envPtr);
+	}
+	TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
+		envPtr);
+	envPtr->currStackDepth = auxPtr->expandTargetDepth;
+    }
+    toPop = envPtr->currStackDepth - auxPtr->stackDepth;
+    while (toPop --> 0) {
+	TclEmitOpcode(INST_POP, envPtr);
+    }
+    envPtr->currStackDepth = savedStackDepth;
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * StartExpanding --
+ *
+ *	Pushes an INST_EXPAND_START and does some additional housekeeping so
+ *	that the [break] and [continue] compilers can use an exception-free
+ *	issue to discard it.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static void
+StartExpanding(
+    CompileEnv *envPtr)
+{
+    int i;
+
+    TclEmitOpcode(INST_EXPAND_START, envPtr);
+
+    /*
+     * Update inner exception ranges with information about the environment
+     * where this expansion started.
+     */
+
+    for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
+	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+	ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i];
+
+	/*
+	 * Ignore loops unless they're still being built.
+	 */
+
+	if (rangePtr->codeOffset > CurrentOffset(envPtr)) {
+	    continue;
+	}
+	if (rangePtr->numCodeBytes != -1) {
+	    continue;
+	}
+
+	/*
+	 * Adequate condition: further out loops and further in exceptions
+	 * don't actually need this information.
+	 */
+
+	if (auxPtr->expandTarget == envPtr->expandCount) {
+	    auxPtr->expandTargetDepth = envPtr->currStackDepth;
+	}
+    }
+
+    /*
+     * There's now one more expansion being processed on the auxiliary stack.
+     */
+
+    envPtr->expandCount++;
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * TclFinalizeLoopExceptionRange --
+ *
+ *	Finalizes a loop exception range, binding the registered [break] and
+ *	[continue] implementations so that they jump to the correct place.
+ *	Note that this must only be called after *all* the exception range
+ *	target offsets have been set.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclFinalizeLoopExceptionRange(
+    CompileEnv *envPtr,
+    int range)
+{
+    ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[range];
+    ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[range];
+    int i, offset;
+    unsigned char *site;
+
+    if (rangePtr->type != LOOP_EXCEPTION_RANGE) {
+	Tcl_Panic("trying to finalize a loop exception range");
+    }
+
+    /*
+     * Do the jump fixups. Note that these are always issued as INST_JUMP4 so
+     * there is no need to fuss around with updating code offsets.
+     */
+
+    for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
+	site = envPtr->codeStart + auxPtr->breakTargets[i];
+	offset = rangePtr->breakOffset - auxPtr->breakTargets[i];
+	TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
+    }
+    for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
+	site = envPtr->codeStart + auxPtr->continueTargets[i];
+	if (rangePtr->continueOffset == -1) {
+	    int j;
+
+	    /*
+	     * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough
+	     * space to do anything else.
+	     */
+
+	    *site = INST_CONTINUE;
+	    for (j=0 ; j<4 ; j++) {
+		*++site = INST_NOP;
+	    }
+	} else {
+	    offset = rangePtr->continueOffset - auxPtr->continueTargets[i];
+	    TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
+	}
+    }
+
+    /*
+     * Drop the arrays we were holding the only reference to.
+     */
+
+    if (auxPtr->breakTargets) {
+	ckfree(auxPtr->breakTargets);
+	auxPtr->breakTargets = NULL;
+	auxPtr->numBreakTargets = 0;
+    }
+    if (auxPtr->continueTargets) {
+	ckfree(auxPtr->continueTargets);
+	auxPtr->continueTargets = NULL;
+	auxPtr->numContinueTargets = 0;
+    }
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TclCreateAuxData --
@@ -2712,14 +3654,14 @@ int
 TclCreateAuxData(
     ClientData clientData,	/* The compilation auxiliary data to store in
 				 * the new aux data record. */
-    AuxDataType *typePtr,	/* Pointer to the type to attach to this
+    const 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) {
@@ -2734,14 +3676,16 @@ TclCreateAuxData(
 	size_t newBytes = newElems * sizeof(AuxData);
 
 	if (envPtr->mallocedAuxDataArray) {
-	    envPtr->auxDataArrayPtr = (AuxData *)
-		    ckrealloc((char *)(envPtr->auxDataArrayPtr), newBytes);
+	    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 = (AuxData *) ckalloc((unsigned) newBytes);
+
+	    AuxData *newPtr = ckalloc(newBytes);
+
 	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
 	    envPtr->auxDataArrayPtr = newPtr;
 	    envPtr->mallocedAuxDataArray = 1;
@@ -2750,7 +3694,7 @@ TclCreateAuxData(
     }
     envPtr->auxDataArrayNext++;
 
-    auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
+    auxDataPtr = &envPtr->auxDataArrayPtr[index];
     auxDataPtr->clientData = clientData;
     auxDataPtr->type = typePtr;
     return index;
@@ -2781,7 +3725,7 @@ TclInitJumpFixupArray(
 {
     fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
     fixupArrayPtr->next = 0;
-    fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
+    fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1;
     fixupArrayPtr->mallocedArray = 0;
 }
 
@@ -2808,8 +3752,8 @@ TclInitJumpFixupArray(
 void
 TclExpandJumpFixupArray(
     register JumpFixupArray *fixupArrayPtr)
-				/* Points to the JumpFixupArray structure
-				 * to enlarge. */
+				/* Points to the JumpFixupArray structure to
+				 * enlarge. */
 {
     /*
      * The currently allocated jump fixup entries are stored from fixup[0] up
@@ -2822,14 +3766,15 @@ TclExpandJumpFixupArray(
     size_t newBytes = newElems * sizeof(JumpFixup);
 
     if (fixupArrayPtr->mallocedArray) {
-	fixupArrayPtr->fixup = (JumpFixup *)
-		ckrealloc((char *)(fixupArrayPtr->fixup), newBytes);
+	fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes);
     } else {
 	/*
-	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must
-	 * code a ckrealloc equivalent for ourselves.
+	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
+	 * ckrealloc equivalent for ourselves.
 	 */
-	JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);
+
+	JumpFixup *newPtr = ckalloc(newBytes);
+
 	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
 	fixupArrayPtr->fixup = newPtr;
 	fixupArrayPtr->mallocedArray = 1;
@@ -2860,7 +3805,7 @@ TclFreeJumpFixupArray(
 				 * free. */
 {
     if (fixupArrayPtr->mallocedArray) {
-	ckfree((char *) fixupArrayPtr->fixup);
+	ckfree(fixupArrayPtr->fixup);
     }
 }
 
@@ -2905,7 +3850,7 @@ TclEmitForwardJump(
      */
 
     jumpFixupPtr->jumpType = jumpType;
-    jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
+    jumpFixupPtr->codeOffset = envPtr->codeNext - envPtr->codeStart;
     jumpFixupPtr->cmdIndex = envPtr->numCommands;
     jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
 
@@ -2963,7 +3908,7 @@ TclFixupForwardJump(
     unsigned 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);
@@ -2988,7 +3933,7 @@ TclFixupForwardJump(
     if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
 	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);
@@ -3013,19 +3958,19 @@ TclFixupForwardJump(
      */
 
     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]);
-	rangePtr->codeOffset += 3;
+	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[k];
 
+	rangePtr->codeOffset += 3;
 	switch (rangePtr->type) {
 	case LOOP_EXCEPTION_RANGE:
 	    rangePtr->breakOffset += 3;
@@ -3042,67 +3987,20 @@ TclFixupForwardJump(
 	}
     }
 
-    /*
-     * 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));
+    for (k = 0 ; k < envPtr->exceptArrayNext ; k++) {
+	ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k];
+	int i;
 
-	    if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
-		Tcl_DeleteHashEntry(hPtr);
-		map [n].pc += 3;
-		n++;
+	for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
+	    if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) {
+		auxPtr->breakTargets[i] += 3;
 	    }
 	}
-
-	/*
-	 * 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));
+	for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
+	    if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) {
+		auxPtr->continueTargets[i] += 3;
+	    }
 	}
-
-	ckfree ((char *) map);
     }
 
     return 1;			/* the jump was grown */
@@ -3111,184 +4009,219 @@ TclFixupForwardJump(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetInstructionTable --
+ * TclEmitInvoke --
  *
- *	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.
+ *	Emit one of the invoke-related instructions, wrapping it if necessary
+ *	in code that ensures that any break or continue operation passing
+ *	through it gets the stack unwinding correct, converting it into an
+ *	internal jump if in an appropriate context.
  *
  * Results:
- *	Returns a pointer to the global instruction table, same as the
- *	expression (&tclInstructionTable[0]).
+ *	None
  *
  * Side effects:
- *	None.
+ *	Issues the jump with all correct stack management. May create another
+ *	loop exception range; pointers to ExceptionRange and ExceptionAux
+ *	structures should not be held across this call.
  *
  *----------------------------------------------------------------------
  */
 
-void * /* == InstructionDesc* == */
-TclGetInstructionTable(void)
-{
-    return &tclInstructionTable[0];
-}
-
-/*
- *--------------------------------------------------------------
- *
- * RegisterAuxDataType --
- *
- *	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.
- *
- *--------------------------------------------------------------
- */
-
-static void
-RegisterAuxDataType(
-    AuxDataType *typePtr)	/* Information about object type; storage must
-				 * be statically allocated (must live forever;
-				 * will not be deallocated). */
+void
+TclEmitInvoke(
+    CompileEnv *envPtr,
+    int opcode,
+    ...)
 {
-    register Tcl_HashEntry *hPtr;
-    int isNew;
-
-    Tcl_MutexLock(&tableMutex);
-    if (!auxDataTypeTableInitialized) {
-	TclInitAuxDataTypeTable();
-    }
+    va_list argList;
+    ExceptionRange *rangePtr;
+    ExceptionAux *auxBreakPtr, *auxContinuePtr;
+    int arg1, arg2, wordCount = 0, expandCount = 0;
+    int loopRange = 0, breakRange = 0, continueRange = 0;
+    int cleanup, depth = TclGetStackDepth(envPtr);
 
     /*
-     * If there's already a type with the given name, remove it.
+     * Parse the arguments.
      */
 
-    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
-    if (hPtr != NULL) {
-	Tcl_DeleteHashEntry(hPtr);
+    va_start(argList, opcode);
+    switch (opcode) {
+    case INST_INVOKE_STK1:
+	wordCount = arg1 = cleanup = va_arg(argList, int);
+	arg2 = 0;
+	break;
+    case INST_INVOKE_STK4:
+	wordCount = arg1 = cleanup = va_arg(argList, int);
+	arg2 = 0;
+	break;
+    case INST_INVOKE_REPLACE:
+	arg1 = va_arg(argList, int);
+	arg2 = va_arg(argList, int);
+	wordCount = arg1 + arg2 - 1;
+	cleanup = arg1 + 1;
+	break;
+    default:
+	Tcl_Panic("unexpected opcode");
+    case INST_EVAL_STK:
+	wordCount = cleanup = 1;
+	arg1 = arg2 = 0;
+	break;
+    case INST_RETURN_STK:
+	wordCount = cleanup = 2;
+	arg1 = arg2 = 0;
+	break;
+    case INST_INVOKE_EXPANDED:
+	wordCount = arg1 = cleanup = va_arg(argList, int);
+	arg2 = 0;
+	expandCount = 1;
+	break;
     }
+    va_end(argList);
 
     /*
-     * Now insert the new object type.
+     * Determine if we need to handle break and continue exceptions with a
+     * special handling exception range (so that we can correctly unwind the
+     * stack).
+     *
+     * These must be done separately; they can be different (especially for
+     * calls from inside a [for] increment clause).
      */
 
-    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
-    if (isNew) {
-	Tcl_SetHashValue(hPtr, typePtr);
+    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
+	    &auxContinuePtr);
+    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+	auxContinuePtr = NULL;
+    } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
+	    && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
+	auxContinuePtr = NULL;
+    } else {
+	continueRange = auxContinuePtr - envPtr->exceptAuxArrayPtr;
     }
-    Tcl_MutexUnlock(&tableMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetAuxDataType --
- *
- *	This procedure looks up an Auxdata type by name.
- *
- * Results:
- *	If an AuxData type with name matching "typeName" is found, a pointer
- *	to its AuxDataType structure is returned; otherwise, NULL is returned.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
 
-AuxDataType *
-TclGetAuxDataType(
-    char *typeName)		/* Name of AuxData type to look up. */
-{
-    register Tcl_HashEntry *hPtr;
-    AuxDataType *typePtr = NULL;
-
-    Tcl_MutexLock(&tableMutex);
-    if (!auxDataTypeTableInitialized) {
-	TclInitAuxDataTypeTable();
+    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
+    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+	auxBreakPtr = NULL;
+    } else if (auxContinuePtr == NULL
+	    && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
+	    && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
+	auxBreakPtr = NULL;
+    } else {
+	breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
     }
 
-    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
-    if (hPtr != NULL) {
-	typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
+    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+	ExceptionRangeStarts(envPtr, loopRange);
     }
-    Tcl_MutexUnlock(&tableMutex);
 
-    return typePtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TclInitAuxDataTypeTable --
- *
- *	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:
- *	None.
- *
- * Side effects:
- *	Initializes the table of defined AuxData types "auxDataTypeTable" with
- *	builtin AuxData types defined in this file.
- *
- *--------------------------------------------------------------
- */
-
-void
-TclInitAuxDataTypeTable(void)
-{
     /*
-     * The table mutex must already be held before this routine is invoked.
+     * Issue the invoke itself.
      */
 
-    auxDataTypeTableInitialized = 1;
-    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+    switch (opcode) {
+    case INST_INVOKE_STK1:
+	TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
+	break;
+    case INST_INVOKE_STK4:
+	TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
+	break;
+    case INST_INVOKE_EXPANDED:
+	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+	envPtr->expandCount--;
+	TclAdjustStackDepth(1 - arg1, envPtr);
+	break;
+    case INST_EVAL_STK:
+	TclEmitOpcode(INST_EVAL_STK, envPtr);
+	break;
+    case INST_RETURN_STK:
+	TclEmitOpcode(INST_RETURN_STK, envPtr);
+	break;
+    case INST_INVOKE_REPLACE:
+	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
+	TclEmitInt1(arg2, envPtr);
+	TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+	break;
+    }
 
     /*
-     * There are only two AuxData type at this time, so register them here.
+     * If we're generating a special wrapper exception range, we need to
+     * finish that up now.
      */
 
-    RegisterAuxDataType(&tclForeachInfoType);
-    RegisterAuxDataType(&tclJumptableInfoType);
+    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+	int savedStackDepth = envPtr->currStackDepth;
+	int savedExpandCount = envPtr->expandCount;
+	JumpFixup nonTrapFixup;
+
+	if (auxBreakPtr != NULL) {
+	    auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
+	}
+	if (auxContinuePtr != NULL) {
+	    auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
+	}
+
+	ExceptionRangeEnds(envPtr, loopRange);
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);
+
+	/*
+	 * Careful! When generating these stack unwinding sequences, the depth
+	 * of stack in the cases where they are taken is not the same as if
+	 * the exception is not taken.
+	 */
+
+	if (auxBreakPtr != NULL) {
+	    TclAdjustStackDepth(-1, envPtr);
+
+	    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+	    TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
+	    TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+	    TclAdjustStackDepth(1, envPtr);
+
+	    envPtr->currStackDepth = savedStackDepth;
+	    envPtr->expandCount = savedExpandCount;
+	}
+
+	if (auxContinuePtr != NULL) {
+	    TclAdjustStackDepth(-1, envPtr);
+
+	    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+	    TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
+	    TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+	    TclAdjustStackDepth(1, envPtr);
+
+	    envPtr->currStackDepth = savedStackDepth;
+	    envPtr->expandCount = savedExpandCount;
+	}
+
+	TclFinalizeLoopExceptionRange(envPtr, loopRange);
+	TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
+    }
+    TclCheckStackDepth(depth+1-cleanup, envPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclFinalizeAuxDataTypeTable --
+ * TclGetInstructionTable --
  *
- *	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().
+ *	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:
- *	None.
+ *	Returns a pointer to the global instruction table, same as the
+ *	expression (&tclInstructionTable[0]).
  *
  * Side effects:
- *	Deletes all entries in the hash table of AuxData types.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclFinalizeAuxDataTypeTable(void)
+const void * /* == InstructionDesc* == */
+TclGetInstructionTable(void)
 {
-    Tcl_MutexLock(&tableMutex);
-    if (auxDataTypeTableInitialized) {
-	Tcl_DeleteHashTable(&auxDataTypeTable);
-	auxDataTypeTableInitialized = 0;
-    }
-    Tcl_MutexUnlock(&tableMutex);
+    return &tclInstructionTable[0];
 }
 
 /*
@@ -3326,13 +4259,13 @@ GetCmdLocEncodingSize(
     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");
 	} 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;
 
@@ -3342,14 +4275,14 @@ GetCmdLocEncodingSize(
 	} 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 = mapPtr[i].srcOffset - prevSrcOffset;
+	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
 	    srcDeltaNext++;
 	} else {
-	    srcDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for delta */
+	    srcDeltaNext += 5;	/* 1 byte for 0xFF, 4 for delta */
 	}
 	prevSrcOffset = mapPtr[i].srcOffset;
 
@@ -3359,7 +4292,7 @@ GetCmdLocEncodingSize(
 	} else if (srcLen <= 127) {
 	    srcLengthNext++;
 	} else {
-	    srcLengthNext += 5;	 /* 1 byte for 0xFF, 4 for length */
+	    srcLengthNext += 5;	/* 1 byte for 0xFF, 4 for length */
 	}
     }
 
@@ -3411,7 +4344,7 @@ 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");
 	} else if (codeDelta <= 127) {
@@ -3453,8 +4386,8 @@ EncodeCmdLocMap(
     codePtr->srcDeltaStart = p;
     prevOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
-	srcDelta = (mapPtr[i].srcOffset - prevOffset);
-	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+	srcDelta = mapPtr[i].srcOffset - prevOffset;
+	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
 	    TclStoreInt1AtPtr(srcDelta, p);
 	    p++;
 	} else {
@@ -3489,602 +4422,6 @@ EncodeCmdLocMap(
     return p;
 }
 
-#ifdef TCL_COMPILE_DEBUG
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
-    unsigned char *pc)		/* Points to first byte of instruction. */
-{
-    Tcl_Obj *bufferObj;
-    int numBytes;
-
-    TclNewObj(bufferObj);
-    numBytes = FormatInstruction(codePtr, pc, bufferObj);
-    fprintf(stdout, "%s", TclGetString(bufferObj));
-    Tcl_DecrRefCount(bufferObj);
-    return numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintObject --
- *
- *	This procedure prints up to a specified number of characters from the
- *	argument Tcl object's string representation to a specified file.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintObject(
-    FILE *outFile,		/* The file to print the source to. */
-    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
-				 * representation should be printed. */
-    int maxChars)		/* Maximum number of chars to print. */
-{
-    char *bytes;
-    int length;
-
-    bytes = Tcl_GetStringFromObj(objPtr, &length);
-    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintSource --
- *
- *	This procedure prints up to a specified number of characters from the
- *	argument string to a specified file. It tries to produce legible
- *	output by adding backslashes as necessary.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintSource(
-    FILE *outFile,		/* The file to print the source to. */
-    const char *stringPtr,	/* The string to print. */
-    int maxChars)		/* Maximum number of chars to print. */
-{
-    Tcl_Obj *bufferObj;
-
-    TclNewObj(bufferObj);
-    PrintSourceToObj(bufferObj, stringPtr, maxChars);
-    fprintf(outFile, "%s", TclGetString(bufferObj));
-    Tcl_DecrRefCount(bufferObj);
-}
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDisassembleByteCodeObj --
- *
- *	Given an object which is of bytecode type, return a disassembled
- *	version of the bytecode (in a new refcount 0 object). No guarantees
- *	are made about the details of the contents of the result.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclDisassembleByteCodeObj(
-    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
-{
-    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
-    unsigned char *codeStart, *codeLimit, *pc;
-    unsigned char *codeDeltaNext, *codeLengthNext;
-    unsigned char *srcDeltaNext, *srcLengthNext;
-    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
-    Interp *iPtr = (Interp *) *codePtr->interpHandle;
-    Tcl_Obj *bufferObj;
-    char ptrBuf1[20], ptrBuf2[20];
-
-    TclNewObj(bufferObj);
-    if (codePtr->refCount <= 0) {
-	return bufferObj;	/* Already freed. */
-    }
-
-    codeStart = codePtr->codeStart;
-    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,
-	    iPtr->compileEpoch);
-    Tcl_AppendToObj(bufferObj, "  Source ", -1);
-    PrintSourceToObj(bufferObj, 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",
-	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
-	    codePtr->numLitObjects, codePtr->numAuxDataItems,
-	    codePtr->maxStackDepth,
-#ifdef TCL_COMPILE_STATS
-	    codePtr->numSrcBytes?
-		    codePtr->structureSize/(float)codePtr->numSrcBytes :
-#endif
-	    0.0);
-
-#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)),
-	    codePtr->numCodeBytes,
-	    (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,
-		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" : "");
-		if (TclIsVarTemporary(localPtr)) {
-		    Tcl_AppendToObj(bufferObj, "\n", -1);
-		} else {
-		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
-			    localPtr->name);
-		}
-		localPtr = localPtr->nextPtr;
-	    }
-	}
-    }
-
-    /*
-     * Print the ExceptionRange array.
-     */
-
-    if (codePtr->numExceptRanges > 0) {
-	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
-		codePtr->numExceptRanges, codePtr->maxExceptDepth);
-	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
-	    ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);
-
-	    Tcl_AppendPrintfToObj(bufferObj,
-		    "      %d: level %d, %s, pc %d-%d, ",
-		    i, rangePtr->nestingLevel,
-		    (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);
-		break;
-	    case CATCH_EXCEPTION_RANGE:
-		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
-			rangePtr->catchOffset);
-		break;
-	    default:
-		Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
-			rangePtr->type);
-	    }
-	}
-    }
-
-    /*
-     * If there were no commands (e.g., an expression or an empty string was
-     * compiled), just print all instructions and return.
-     */
-
-    if (numCmds == 0) {
-	pc = codeStart;
-	while (pc < codeLimit) {
-	    Tcl_AppendToObj(bufferObj, "    ", -1);
-	    pc += FormatInstruction(codePtr, pc, bufferObj);
-	}
-	return bufferObj;
-    }
-
-    /*
-     * 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);
-    codeDeltaNext = codePtr->codeDeltaStart;
-    codeLengthNext = codePtr->codeLengthStart;
-    srcDeltaNext = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
-    codeOffset = srcOffset = 0;
-    for (i = 0;  i < numCmds;  i++) {
-	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
-	    codeDeltaNext++;
-	    delta = TclGetInt4AtPtr(codeDeltaNext);
-	    codeDeltaNext += 4;
-	} else {
-	    delta = TclGetInt1AtPtr(codeDeltaNext);
-	    codeDeltaNext++;
-	}
-	codeOffset += delta;
-
-	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
-	    codeLengthNext++;
-	    codeLen = TclGetInt4AtPtr(codeLengthNext);
-	    codeLengthNext += 4;
-	} else {
-	    codeLen = TclGetInt1AtPtr(codeLengthNext);
-	    codeLengthNext++;
-	}
-
-	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
-	    srcDeltaNext++;
-	    delta = TclGetInt4AtPtr(srcDeltaNext);
-	    srcDeltaNext += 4;
-	} else {
-	    delta = TclGetInt1AtPtr(srcDeltaNext);
-	    srcDeltaNext++;
-	}
-	srcOffset += delta;
-
-	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
-	    srcLengthNext++;
-	    srcLen = TclGetInt4AtPtr(srcLengthNext);
-	    srcLengthNext += 4;
-	} else {
-	    srcLen = TclGetInt1AtPtr(srcLengthNext);
-	    srcLengthNext++;
-	}
-
-	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
-		((i % 2)? "   	" : "\n   "),
-		(i+1), codeOffset, (codeOffset + codeLen - 1),
-		srcOffset, (srcOffset + srcLen - 1));
-    }
-    if (numCmds > 0) {
-	Tcl_AppendToObj(bufferObj, "\n", -1);
-    }
-
-    /*
-     * Print each instruction. If the instruction corresponds to the start of
-     * a command, print the command's source. Note that we don't need the code
-     * length here.
-     */
-
-    codeDeltaNext = codePtr->codeDeltaStart;
-    srcDeltaNext = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
-    codeOffset = srcOffset = 0;
-    pc = codeStart;
-    for (i = 0;  i < numCmds;  i++) {
-	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
-	    codeDeltaNext++;
-	    delta = TclGetInt4AtPtr(codeDeltaNext);
-	    codeDeltaNext += 4;
-	} else {
-	    delta = TclGetInt1AtPtr(codeDeltaNext);
-	    codeDeltaNext++;
-	}
-	codeOffset += delta;
-
-	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
-	    srcDeltaNext++;
-	    delta = TclGetInt4AtPtr(srcDeltaNext);
-	    srcDeltaNext += 4;
-	} else {
-	    delta = TclGetInt1AtPtr(srcDeltaNext);
-	    srcDeltaNext++;
-	}
-	srcOffset += delta;
-
-	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
-	    srcLengthNext++;
-	    srcLen = TclGetInt4AtPtr(srcLengthNext);
-	    srcLengthNext += 4;
-	} else {
-	    srcLen = TclGetInt1AtPtr(srcLengthNext);
-	    srcLengthNext++;
-	}
-
-	/*
-	 * Print instructions before command i.
-	 */
-
-	while ((pc-codeStart) < codeOffset) {
-	    Tcl_AppendToObj(bufferObj, "    ", -1);
-	    pc += FormatInstruction(codePtr, pc, bufferObj);
-	}
-
-	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
-	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
-		TclMin(srcLen, 55));
-	Tcl_AppendToObj(bufferObj, "\n", -1);
-    }
-    if (pc < codeLimit) {
-	/*
-	 * Print instructions after the last command.
-	 */
-
-	while (pc < codeLimit) {
-	    Tcl_AppendToObj(bufferObj, "    ", -1);
-	    pc += FormatInstruction(codePtr, pc, bufferObj);
-	}
-    }
-    return bufferObj;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FormatInstruction --
- *
- *	Appends a representation of a bytecode instruction to a Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FormatInstruction(
-    ByteCode *codePtr,		/* Bytecode containing the instruction. */
-    unsigned char *pc,		/* Points to first byte of instruction. */
-    Tcl_Obj *bufferObj)		/* Object to append instruction info to. */
-{
-    Proc *procPtr = codePtr->procPtr;
-    unsigned char opCode = *pc;
-    register InstructionDesc *instDesc = &tclInstructionTable[opCode];
-    unsigned char *codeStart = codePtr->codeStart;
-    unsigned pcOffset = pc - codeStart;
-    int opnd = 0, i, j, numBytes = 1;
-    int localCt = procPtr ? procPtr->numCompiledLocals : 0;
-    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
-    char suffixBuffer[128];	/* Additional info to print after main opcode
-				 * and immediates. */
-    char *suffixSrc = NULL;
-    Tcl_Obj *suffixObj = NULL;
-    AuxData *auxPtr = NULL;
-
-    suffixBuffer[0] = '\0';
-    Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
-    for (i = 0;  i < instDesc->numOperands;  i++) {
-	switch (instDesc->opTypes[i]) {
-	case OPERAND_INT1:
-	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
-	    if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
-		    || opCode == INST_JUMP_FALSE1) {
-		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
-	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
-	    break;
-	case OPERAND_INT4:
-	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
-	    if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
-		    || opCode == INST_JUMP_FALSE4) {
-		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
-	    } else if (opCode == INST_START_CMD) {
-		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
-	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
-	    break;
-	case OPERAND_UINT1:
-	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
-	    if (opCode == INST_PUSH1) {
-		suffixObj = codePtr->objArrayPtr[opnd];
-	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
-	    break;
-	case OPERAND_AUX4:
-	case OPERAND_UINT4:
-	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
-	    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) {
-		if (opnd >= localCt) {
-		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
-			    (unsigned) opnd, localCt);
-		}
-		for (j = 0;  j < opnd;  j++) {
-		    localPtr = localPtr->nextPtr;
-		}
-		if (TclIsVarTemporary(localPtr)) {
-		    sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
-		} else {
-		    sprintf(suffixBuffer, "var ");
-		    suffixSrc = localPtr->name;
-		}
-	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
-	    break;
-	case OPERAND_NONE:
-	default:
-	    break;
-	}
-    }
-    if (suffixObj) {
-	char *bytes;
-	int length;
-
-	Tcl_AppendToObj(bufferObj, "\t# ", -1);
-	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
-	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
-    } else if (suffixBuffer[0]) {
-	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
-	if (suffixSrc) {
-	    PrintSourceToObj(bufferObj, suffixSrc, 40);
-	}
-    }
-    Tcl_AppendToObj(bufferObj, "\n", -1);
-    if (auxPtr && auxPtr->type->printProc) {
-	Tcl_AppendToObj(bufferObj, "\t\t[", -1);
-	auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
-		pcOffset);
-	Tcl_AppendToObj(bufferObj, "]\n", -1);
-    }
-    return numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PrintSourceToObj --
- *
- *	Appends a quoted representation of a string to a Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrintSourceToObj(
-    Tcl_Obj *appendObj,		/* The object to print the source to. */
-    const char *stringPtr,	/* The string to print. */
-    int maxChars)		/* Maximum number of chars to print. */
-{
-    register const char *p;
-    register int i = 0;
-
-    if (stringPtr == NULL) {
-	Tcl_AppendToObj(appendObj, "\"\"", -1);
-	return;
-    }
-
-    Tcl_AppendToObj(appendObj, "\"", -1);
-    p = stringPtr;
-    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;
-	}
-    }
-    Tcl_AppendToObj(appendObj, "\"", -1);
-}
-
 #ifdef TCL_COMPILE_STATS
 /*
  *----------------------------------------------------------------------
@@ -4127,7 +4464,7 @@ RecordByteCodeStats(
     statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
 
     statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
-    statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;
+    statsPtr->byteCodeCount[TclLog2((int) codePtr->structureSize)]++;
 
     statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
     statsPtr->currentLitBytes += (double)
@@ -4145,5 +4482,6 @@ RecordByteCodeStats(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
  * End:
  */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index bc298ae..e5d026c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -48,6 +48,13 @@ MODULE_SCOPE int 	tclTraceCompile;
 
 MODULE_SCOPE int 	tclTraceExec;
 #endif
+
+/*
+ * The type of lambda expressions. Note that every lambda will *always* have a
+ * string representation.
+ */
+
+MODULE_SCOPE const Tcl_ObjType tclLambdaType;
 
 /*
  *------------------------------------------------------------------------
@@ -100,6 +107,54 @@ typedef struct ExceptionRange {
 } ExceptionRange;
 
 /*
+ * Auxiliary data used when issuing (currently just loop) exception ranges,
+ * but which is not required during execution.
+ */
+
+typedef struct ExceptionAux {
+    int supportsContinue;	/* Whether this exception range will have a
+				 * continueOffset created for it; if it is a
+				 * loop exception range that *doesn't* have
+				 * one (see [for] next-clause) then we must
+				 * not pick up the range when scanning for a
+				 * target to continue to. */
+    int stackDepth;		/* The stack depth at the point where the
+				 * exception range was created. This is used
+				 * to calculate the number of POPs required to
+				 * restore the stack to its prior state. */
+    int expandTarget;		/* The number of expansions expected on the
+				 * auxData stack at the time the loop starts;
+				 * we can't currently discard them except by
+				 * doing INST_INVOKE_EXPANDED; this is a known
+				 * problem. */
+    int expandTargetDepth;	/* The stack depth expected at the outermost
+				 * expansion within the loop. Not meaningful
+				 * if there are no open expansions between the
+				 * looping level and the point of jump
+				 * issue. */
+    int numBreakTargets;	/* The number of [break]s that want to be
+				 * targeted to the place where this loop
+				 * exception will be bound to. */
+    unsigned int *breakTargets;	/* The offsets of the INST_JUMP4 instructions
+				 * issued by the [break]s that we must
+				 * update. Note that resizing a jump (via
+				 * TclFixupForwardJump) can cause the contents
+				 * of this array to be updated. When
+				 * numBreakTargets==0, this is NULL. */
+    int allocBreakTargets;	/* The size of the breakTargets array. */
+    int numContinueTargets;	/* The number of [continue]s that want to be
+				 * targeted to the place where this loop
+				 * exception will be bound to. */
+    unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
+				 * issued by the [continue]s that we must
+				 * update. Note that resizing a jump (via
+				 * TclFixupForwardJump) can cause the contents
+				 * of this array to be updated. When
+				 * numContinueTargets==0, this is NULL. */
+    int allocContinueTargets;	/* The size of the continueTargets array. */
+} ExceptionAux;
+
+/*
  * 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
@@ -127,32 +182,24 @@ typedef struct CmdLocation {
 
 typedef struct ECL {
     int srcOffset;		/* Command location to find the entry. */
-    int nline;                  /* Number of words in the command */
+    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
+    int **next;			/* Transient information used by the compiler
 				 * for tracking of hidden continuation
 				 * lines. */
 } ECL;
 
 typedef struct ExtCmdLoc {
     int type;			/* Context type. */
-    int start;                  /* Starting line for compiled script. Needed
+    int start;			/* Starting line for compiled script. Needed
 				 * for the extended recompile check in
-				 * TclCompEvalObj. */
-
+				 * 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() */
 } ExtCmdLoc;
 
 /*
@@ -171,7 +218,7 @@ typedef struct ExtCmdLoc {
  */
 
 typedef ClientData (AuxDataDupProc)  (ClientData clientData);
-typedef void       (AuxDataFreeProc) (ClientData clientData);
+typedef void	   (AuxDataFreeProc) (ClientData clientData);
 typedef void	   (AuxDataPrintProc)(ClientData clientData,
 			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
 			    unsigned int pcOffset);
@@ -184,7 +231,7 @@ typedef void	   (AuxDataPrintProc)(ClientData clientData,
  */
 
 typedef struct AuxDataType {
-    char *name;			/* The name of the type. Types can be
+    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
@@ -198,6 +245,16 @@ typedef struct AuxDataType {
     AuxDataPrintProc *printProc;/* Callback function to invoke when printing
 				 * the aux data as part of debugging. NULL
 				 * means that the data can't be printed. */
+    AuxDataPrintProc *disassembleProc;
+				/* Callback function to invoke when doing a
+				 * disassembly of the aux data (like the
+				 * printProc, except that the output is
+				 * intended to be script-readable). The
+				 * appendObj argument should be filled in with
+				 * a descriptive dictionary; it will start out
+				 * with "name" mapped to the content of the
+				 * name field. NULL means that the printProc
+				 * should be used instead. */
 } AuxDataType;
 
 /*
@@ -207,7 +264,7 @@ typedef struct AuxDataType {
  */
 
 typedef struct AuxData {
-    AuxDataType *type;		/* Pointer to the AuxData type associated with
+    const AuxDataType *type;	/* Pointer to the AuxData type associated with
 				 * this ClientData. */
     ClientData clientData;	/* The compilation data itself. */
 } AuxData;
@@ -276,6 +333,11 @@ typedef struct CompileEnv {
 				 * entry. */
     int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
 				 * exceptArrayPtr points in heap, else 0. */
+    ExceptionAux *exceptAuxArrayPtr;
+				/* Array of information used to restore the
+				 * state when processing BREAK/CONTINUE
+				 * exceptions. Must be the same size as the
+				 * exceptArrayPtr. */
     CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
 				 * numCommands is the index of the next entry
 				 * to use; (numCommands-1) is the entry index
@@ -297,6 +359,9 @@ typedef struct CompileEnv {
 				/* Initial storage of LiteralEntry array. */
     ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
 				/* Initial ExceptionRange array storage. */
+    ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+				/* Initial static except auxiliary info array
+				 * storage. */
     CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
 				/* Initial storage for cmd location map. */
     AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
@@ -310,14 +375,16 @@ typedef struct CompileEnv {
     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. */
+				 * inefficient. If set to 2, that instruction
+				 * should not be issued at all (by the generic
+				 * part of the command compiler). */
+    int expandCount;		/* Number of INST_EXPAND_START instructions
+				 * encountered that have not yet been paired
+				 * with a corresponding
+				 * INST_INVOKE_EXPANDED. */
+    int *clNext;		/* If not NULL, it refers to the next slot in
+				 * clLoc to check for an invisible
+				 * continuation line. */
 } CompileEnv;
 
 /*
@@ -342,6 +409,8 @@ typedef struct CompileEnv {
 
 #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
@@ -437,7 +506,7 @@ typedef struct ByteCode {
 				 * 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
+    LocalCache *localCachePtr;	/* Pointer to the start of the cached variable
 				 * names and initialisation data for local
 				 * variables. */
 #ifdef TCL_COMPILE_STATS
@@ -460,7 +529,7 @@ typedef struct ByteCode {
 #define INST_PUSH4			2
 #define INST_POP			3
 #define INST_DUP			4
-#define INST_CONCAT1			5
+#define INST_STR_CONCAT1		5
 #define INST_INVOKE_STK1		6
 #define INST_INVOKE_STK4		7
 #define INST_EVAL_STK			8
@@ -534,8 +603,8 @@ typedef struct ByteCode {
 #define INST_CONTINUE			66
 
 /* Opcodes 67 to 68 */
-#define INST_FOREACH_START4		67
-#define INST_FOREACH_STEP4		68
+#define INST_FOREACH_START4		67 /* DEPRECATED */
+#define INST_FOREACH_STEP4		68 /* DEPRECATED */
 
 /* Opcodes 69 to 72 */
 #define INST_BEGIN_CATCH4		69
@@ -665,8 +734,97 @@ typedef struct ByteCode {
 #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], [dict exists], [dict create] and [dict merge] */
+#define INST_DICT_EXPAND		138
+#define INST_DICT_RECOMBINE_STK		139
+#define INST_DICT_RECOMBINE_IMM		140
+#define INST_DICT_EXISTS		141
+#define INST_DICT_VERIFY		142
+
+/* For [string map] and [regsub] compilation */
+#define INST_STR_MAP			143
+#define INST_STR_FIND			144
+#define INST_STR_FIND_LAST		145
+#define INST_STR_RANGE_IMM		146
+#define INST_STR_RANGE			147
+
+/* For operations to do with coroutines and other NRE-manipulators */
+#define INST_YIELD			148
+#define INST_COROUTINE_NAME		149
+#define INST_TAILCALL			150
+
+/* For compilation of basic information operations */
+#define INST_NS_CURRENT			151
+#define INST_INFO_LEVEL_NUM		152
+#define INST_INFO_LEVEL_ARGS		153
+#define INST_RESOLVE_COMMAND		154
+
+/* For compilation relating to TclOO */
+#define INST_TCLOO_SELF			155
+#define INST_TCLOO_CLASS		156
+#define INST_TCLOO_NS			157
+#define INST_TCLOO_IS_OBJECT		158
+
+/* For compilation of [array] subcommands */
+#define INST_ARRAY_EXISTS_STK		159
+#define INST_ARRAY_EXISTS_IMM		160
+#define INST_ARRAY_MAKE_STK		161
+#define INST_ARRAY_MAKE_IMM		162
+
+#define INST_INVOKE_REPLACE		163
+
+#define INST_LIST_CONCAT		164
+
+#define INST_EXPAND_DROP		165
+
+/* New foreach implementation */
+#define INST_FOREACH_START              166
+#define INST_FOREACH_STEP               167
+#define INST_FOREACH_END                168
+#define INST_LMAP_COLLECT               169
+
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM			170
+#define INST_STR_TRIM_LEFT		171
+#define INST_STR_TRIM_RIGHT		172
+
+#define INST_CONCAT_STK			173
+
+#define INST_STR_UPPER			174
+#define INST_STR_LOWER			175
+#define INST_STR_TITLE			176
+#define INST_STR_REPLACE		177
+
+#define INST_ORIGIN_COMMAND		178
+
+#define INST_TCLOO_NEXT			179
+#define INST_TCLOO_NEXT_CLASS		180
+
+#define INST_YIELD_TO_INVOKE		181
+
+#define INST_NUM_TYPE			182
+#define INST_TRY_CVT_TO_BOOLEAN		183
+#define INST_STR_CLASS			184
+
+#define INST_LAPPEND_LIST		185
+#define INST_LAPPEND_LIST_ARRAY		186
+#define INST_LAPPEND_LIST_ARRAY_STK	187
+#define INST_LAPPEND_LIST_STK		188
+
+#define INST_CLOCK_READ			189
+
 /* The last opcode */
-#define LAST_INST_OPCODE		131
+#define LAST_INST_OPCODE		189
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -691,12 +849,19 @@ typedef enum InstOperandType {
 				 * variable table. */
     OPERAND_LVT4,		/* Four byte unsigned index into the local
 				 * variable table. */
-    OPERAND_AUX4		/* Four byte unsigned index into the aux data
+    OPERAND_AUX4,		/* Four byte unsigned index into the aux data
 				 * table. */
+    OPERAND_OFFSET1,		/* One byte signed jump offset. */
+    OPERAND_OFFSET4,		/* Four byte signed jump offset. */
+    OPERAND_LIT1,		/* One byte unsigned index into table of
+				 * literals. */
+    OPERAND_LIT4,		/* Four byte unsigned index into table of
+				 * literals. */
+    OPERAND_SCLS1		/* Index into tclStringClassTable. */
 } InstOperandType;
 
 typedef struct InstructionDesc {
-    char *name;			/* Name of instruction. */
+    const 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
@@ -708,7 +873,41 @@ typedef struct InstructionDesc {
 				/* The type of each operand. */
 } InstructionDesc;
 
-MODULE_SCOPE InstructionDesc tclInstructionTable[];
+MODULE_SCOPE InstructionDesc const tclInstructionTable[];
+
+/*
+ * Constants used by INST_STRING_CLASS to indicate character classes. These
+ * correspond closely by name with what [string is] can support, but there is
+ * no requirement to keep the values the same.
+ */
+
+typedef enum InstStringClassType {
+    STR_CLASS_ALNUM,		/* Unicode alphabet or digit characters. */
+    STR_CLASS_ALPHA,		/* Unicode alphabet characters. */
+    STR_CLASS_ASCII,		/* Characters in range U+000000..U+00007F. */
+    STR_CLASS_CONTROL,		/* Unicode control characters. */
+    STR_CLASS_DIGIT,		/* Unicode digit characters. */
+    STR_CLASS_GRAPH,		/* Unicode printing characters, excluding
+				 * space. */
+    STR_CLASS_LOWER,		/* Unicode lower-case alphabet characters. */
+    STR_CLASS_PRINT,		/* Unicode printing characters, including
+				 * spaces. */
+    STR_CLASS_PUNCT,		/* Unicode punctuation characters. */
+    STR_CLASS_SPACE,		/* Unicode space characters. */
+    STR_CLASS_UPPER,		/* Unicode upper-case alphabet characters. */
+    STR_CLASS_WORD,		/* Unicode word (alphabetic, digit, connector
+				 * punctuation) characters. */
+    STR_CLASS_XDIGIT		/* Characters that can be used as digits in
+				 * hexadecimal numbers ([0-9A-Fa-f]). */
+} InstStringClassType;
+
+typedef struct StringClassDesc {
+    const char *name;		/* Name of the class. */
+    int (*comparator)(int);	/* Function to test if a single unicode
+				 * character is a member of the class. */
+} StringClassDesc;
+
+MODULE_SCOPE StringClassDesc const tclStringClassTable[];
 
 /*
  * Compilation of some Tcl constructs such as if commands and the logical or
@@ -731,7 +930,7 @@ typedef enum {
 
 typedef struct JumpFixup {
     TclJumpType jumpType;	/* Indicates the kind of jump. */
-    int codeOffset;		/* Offset of the first byte of the one-byte
+    unsigned int codeOffset;	/* Offset of the first byte of the one-byte
 				 * forward jump's code. */
     int cmdIndex;		/* Index of the first command after the one
 				 * for which the jump was emitted. Used to
@@ -798,8 +997,6 @@ typedef struct ForeachInfo {
 				 * LAST FIELD IN THE STRUCTURE! */
 } ForeachInfo;
 
-MODULE_SCOPE AuxDataType	tclForeachInfoType;
-
 /*
  * Structure used to hold information about a switch command that is needed
  * during program execution. These structures are stored in CompileEnv and
@@ -811,7 +1008,10 @@ typedef struct JumptableInfo {
 				 * offsets). */
 } JumptableInfo;
 
-MODULE_SCOPE AuxDataType	tclJumptableInfoType;
+MODULE_SCOPE const AuxDataType tclJumptableInfoType;
+
+#define JUMPTABLEINFO(envPtr, index) \
+    ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
 
 /*
  * Structure used to hold information about a [dict update] command that is
@@ -829,14 +1029,12 @@ typedef struct {
 				 * STRUCTURE. */
 } DictUpdateInfo;
 
-MODULE_SCOPE AuxDataType	tclDictUpdateInfoType;
-
 /*
  * ClientData type used by the math operator commands.
  */
 
 typedef struct {
-    const char *op;   /* Do not call it 'operator': C++ reserved */
+    const char *op;		/* Do not call it 'operator': C++ reserved */
     const char *expected;
     union {
 	int numArgs;
@@ -850,16 +1048,15 @@ typedef struct {
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE int	TclEvalObjvInternal(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[],
-			    CONST char *command, int length, int flags);
+MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;
+
 /*
  *----------------------------------------------------------------
  * Procedures exported by the engine to be used by tclBasic.c
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE int	TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    const CmdFrame *invoker, int word);
 
 /*
@@ -869,93 +1066,131 @@ MODULE_SCOPE int	TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
  *----------------------------------------------------------------
  */
 
+MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
+			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
+MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
+			    ExceptionAux *auxPtr);
 MODULE_SCOPE void	TclCompileCmdWord(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	TclCompileExpr(Tcl_Interp *interp, const char *script,
+			    int numBytes, CompileEnv *envPtr, int optimize);
 MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int numWords,
 			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
+			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
+			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
-			    CONST char *script, int numBytes,
+			    const char *script, int numBytes,
 			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
 			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
 			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
+			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
 MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
-			    AuxDataType *typePtr, CompileEnv *envPtr);
+			    const AuxDataType *typePtr, CompileEnv *envPtr);
 MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
 			    CompileEnv *envPtr);
-MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp);
-MODULE_SCOPE Tcl_Obj *  TclCreateLiteral(Interp *iPtr, char *bytes,
-	                    int length, unsigned int hash, int *newPtr,
-	                    Namespace *nsPtr, int flags,
-	                    LiteralEntry **globalPtrPtr);
+MODULE_SCOPE 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 void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
 MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
-			    int catchOnly, ByteCode* codePtr);
+			    int catchOnly, ByteCode *codePtr);
 MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
-MODULE_SCOPE int	TclExecuteByteCode(Tcl_Interp *interp,
+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, Proc *procPtr);
+MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
+MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
+			    int create, CompileEnv *envPtr);
 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	TclInitCompileEnv(Tcl_Interp *interp,
 			    CompileEnv *envPtr, const char *string,
-			    int numBytes, CONST CmdFrame* invoker, int word);
+			    int numBytes, const CmdFrame *invoker, int word);
 MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
 MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
+MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
+			    int returnCode, ExceptionAux **auxPtrPtr);
+MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
+			    ExceptionAux *auxPtr);
+MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
+			    ExceptionAux *auxPtr);
+MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
+			    int range);
 #ifdef TCL_COMPILE_STATS
 MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
 MODULE_SCOPE int	TclLog2(int value);
 #endif
+MODULE_SCOPE int	TclLocalScalar(const char *bytes, int numBytes,
+			    CompileEnv *envPtr);
+MODULE_SCOPE int	TclLocalScalarFromToken(Tcl_Token *tokenPtr,
+			    CompileEnv *envPtr);
+MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 #endif
-MODULE_SCOPE int	TclPrintInstruction(ByteCode* codePtr,
-			    unsigned char *pc);
+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 int	TclRegisterLiteral(CompileEnv *envPtr,
-			    char *bytes, int length, int flags);
+			    const char *string, int maxChars);
+MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
+			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
+			    int flags, int *localIndexPtr,
+			    int *isScalarPtr);
 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[]);
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]);
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	TclVariadicOpCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]);
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	TclNoIdentOpCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]);
+			    Tcl_Obj *const objv[]);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
 MODULE_SCOPE void	TclVerifyLocalLiteralTable(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);
+MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
+			    register Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[], int isLambda);
+
 
 /*
  *----------------------------------------------------------------
@@ -964,31 +1199,41 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  *----------------------------------------------------------------
  */
 
-#define LITERAL_ON_HEAP    0x01
-#define LITERAL_NS_SCOPE   0x02
+/*
+ * Simplified form to access AuxData.
+ *
+ * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
+ */
+
+#define TclFetchAuxData(envPtr, index) \
+    (envPtr)->auxDataArrayPtr[(index)].clientData
+
+#define LITERAL_ON_HEAP		0x01
+#define LITERAL_CMD_NAME	0x02
+#define LITERAL_UNSHARED	0x04
 
 /*
- * Form of TclRegisterLiteral with onHeap == 0. In that case, it is safe to
- * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ * Form of TclRegisterLiteral with 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);
  */
 
 #define TclRegisterNewLiteral(envPtr, bytes, length) \
-	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
+    TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
 
 /*
- * Form of TclRegisterNSLiteral with onHeap == 0. In that case, it is safe to
- * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ * 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 TclRegisterNewNSLiteral(envPtr, bytes, length) \
-	TclRegisterLiteral(envPtr, (char *)(bytes), length, \
-		/*flags*/ LITERAL_NS_SCOPE)
+#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
@@ -999,12 +1244,29 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclAdjustStackDepth(delta, envPtr) \
-    if ((delta) < 0) {\
-	if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
-	    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
-	}\
-    }\
-    (envPtr)->currStackDepth += (delta)
+    do {								\
+	if ((delta) < 0) {						\
+	    if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {	\
+		(envPtr)->maxStackDepth = (envPtr)->currStackDepth;	\
+	    }								\
+	}								\
+	(envPtr)->currStackDepth += (delta);				\
+    } while (0)
+
+#define TclGetStackDepth(envPtr)		\
+    ((envPtr)->currStackDepth)
+
+#define TclSetStackDepth(depth, envPtr)		\
+    (envPtr)->currStackDepth = (depth)
+
+#define TclCheckStackDepth(depth, envPtr)				\
+    do {								\
+	int dd = (depth);						\
+	if (dd != (envPtr)->currStackDepth) {				\
+	    Tcl_Panic("bad stack depth computations: is %i, should be %i", \
+		    (envPtr)->currStackDepth, dd);		\
+	}								\
+    } while (0)
 
 /*
  * Macro used to update the stack requirements. It is called by the macros
@@ -1017,14 +1279,26 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclUpdateStackReqs(op, i, envPtr) \
-    {\
-	int delta = tclInstructionTable[(op)].stackEffect;\
-	if (delta) {\
-	    if (delta == INT_MIN) {\
-		delta = 1 - (i);\
-	    }\
-	    TclAdjustStackDepth(delta, envPtr);\
-	}\
+    do {							\
+	int delta = tclInstructionTable[(op)].stackEffect;	\
+	if (delta) {						\
+	    if (delta == INT_MIN) {				\
+		delta = 1 - (i);				\
+	    }							\
+	    TclAdjustStackDepth(delta, envPtr);			\
+	}							\
+    } while (0)
+
+/*
+ * Macros used to update the flag that indicates if we are at the start of a
+ * command, based on whether the opcode is INST_START_COMMAND.
+ *
+ * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
+ */
+
+#define TclUpdateAtCmdStart(op, envPtr) \
+    if ((envPtr)->atCmdStart < 2) {				     \
+	(envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0);     \
     }
 
 /*
@@ -1035,12 +1309,14 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclEmitOpcode(op, envPtr) \
-    if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
-	TclExpandCodeArray(envPtr); \
-    } \
-    *(envPtr)->codeNext++ = (unsigned char) (op);\
-    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
-    TclUpdateStackReqs(op, 0, envPtr)
+    do {							\
+	if ((envPtr)->codeNext == (envPtr)->codeEnd) {		\
+	    TclExpandCodeArray(envPtr);				\
+	}							\
+	*(envPtr)->codeNext++ = (unsigned char) (op);		\
+	TclUpdateAtCmdStart(op, envPtr);			\
+	TclUpdateStackReqs(op, 0, envPtr);			\
+    } while (0)
 
 /*
  * Macros to emit an integer operand. The ANSI C "prototype" for these macros
@@ -1051,23 +1327,27 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclEmitInt1(i, envPtr) \
-    if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
-	TclExpandCodeArray(envPtr); \
-    } \
-    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
+    do {								\
+	if ((envPtr)->codeNext == (envPtr)->codeEnd) {			\
+	    TclExpandCodeArray(envPtr);					\
+	}								\
+	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
+    } while (0)
 
 #define TclEmitInt4(i, envPtr) \
-    if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
-	TclExpandCodeArray(envPtr); \
-    } \
-    *(envPtr)->codeNext++ = \
-	(unsigned char) ((unsigned int) (i) >> 24); \
-    *(envPtr)->codeNext++ = \
-	(unsigned char) ((unsigned int) (i) >> 16); \
-    *(envPtr)->codeNext++ = \
-	(unsigned char) ((unsigned int) (i) >>  8); \
-    *(envPtr)->codeNext++ = \
-	(unsigned char) ((unsigned int) (i)      )
+    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)
 
 /*
  * Macros to emit an instruction with signed or unsigned integer operands.
@@ -1080,29 +1360,33 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclEmitInstInt1(op, i, envPtr) \
-    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)
+    do {								\
+	if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) {		\
+	    TclExpandCodeArray(envPtr);					\
+	}								\
+	*(envPtr)->codeNext++ = (unsigned char) (op);			\
+	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
+	TclUpdateAtCmdStart(op, envPtr);				\
+	TclUpdateStackReqs(op, i, envPtr);				\
+    } while (0)
 
 #define TclEmitInstInt4(op, i, envPtr) \
-    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)
+    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)      );	\
+	TclUpdateAtCmdStart(op, envPtr);			\
+	TclUpdateStackReqs(op, i, envPtr);			\
+    } while (0)
 
 /*
  * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
@@ -1114,14 +1398,14 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclEmitPush(objIndex, envPtr) \
-    {\
-	register int objIndexCopy = (objIndex);\
-	if (objIndexCopy <= 255) { \
+    do {							 \
+	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
@@ -1136,10 +1420,12 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
     *(p)   = (unsigned char) ((unsigned int) (i))
 
 #define TclStoreInt4AtPtr(i, p) \
-    *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
-    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
-    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
-    *(p+3) = (unsigned char) ((unsigned int) (i)      )
+    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)
 
 /*
  * Macros to update instructions at a particular pc with a new op code and a
@@ -1151,12 +1437,16 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclUpdateInstInt1AtPc(op, i, pc) \
-    *(pc) = (unsigned char) (op); \
-    TclStoreInt1AtPtr((i), ((pc)+1))
+    do {					\
+	*(pc) = (unsigned char) (op);		\
+	TclStoreInt1AtPtr((i), ((pc)+1));	\
+    } while (0)
 
 #define TclUpdateInstInt4AtPc(op, i, pc) \
-    *(pc) = (unsigned char) (op); \
-    TclStoreInt4AtPtr((i), ((pc)+1))
+    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
@@ -1168,7 +1458,7 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  */
 
 #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
-    TclFixupForwardJump((envPtr), (fixupPtr), \
+    TclFixupForwardJump((envPtr), (fixupPtr),				\
 	    (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
 	    (threshold))
 
@@ -1194,25 +1484,26 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 
 #ifndef __CHAR_UNSIGNED__
 #   define TclGetInt1AtPtr(p) ((int) *((char *) p))
+#elif defined(HAVE_SIGNED_CHAR)
+#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
 #else
-#   ifdef HAVE_SIGNED_CHAR
-#	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
-#   else
-#	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
-		| ((*(p) & 0200) ? (-256) : 0))
-#   endif
+#   define TclGetInt1AtPtr(p) \
+    (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
 #endif
 
-#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(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)))
 
-#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
-#define TclGetUInt4AtPtr(p) ((unsigned int) (*(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)))
 
 /*
  * Macros used to compute the minimum and maximum of two integers. The ANSI C
@@ -1222,8 +1513,175 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  * 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 TclMin(i, j)	((((int) i) < ((int) j))? (i) : (j))
+#define TclMax(i, j)	((((int) i) > ((int) j))? (i) : (j))
+
+/*
+ * Convenience macros for use when compiling bodies of commands. The ANSI C
+ * "prototype" for these macros are:
+ *
+ * static void		BODY(Tcl_Token *tokenPtr, int word);
+ */
+
+#define BODY(tokenPtr, word)						\
+    SetLineInformation((word));						\
+    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 macros for use when pushing literals. The ANSI C "prototype" for
+ * these macros are:
+ *
+ * static void		PushLiteral(CompileEnv *envPtr,
+ *			    const char *string, int length);
+ * static void		PushStringLiteral(CompileEnv *envPtr,
+ *			    const char *string);
+ */
+
+#define PushLiteral(envPtr, string, length) \
+    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
+#define PushStringLiteral(envPtr, string) \
+    PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
+
+/*
+ * 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	ExceptionRangeStarts(CompileEnv *envPtr, int index);
+ * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
+ * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
+ */
+
+#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)
+
+/*
+ * Macros for making it easier to deal with tokens and DStrings.
+ */
+
+#define TclDStringAppendToken(dsPtr, tokenPtr) \
+    Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
+#define TclRegisterDStringLiteral(envPtr, dsPtr) \
+    TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
+	    Tcl_DStringLength(dsPtr), /*flags*/ 0)
+
+/*
+ * 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) {			\
+	PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size);	\
+    } else {								\
+	SetLineInformation((word));					\
+	CompileTokens((envPtr), (tokenPtr), (interp));			\
+    }
+
+/*
+ * 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,sc,word) \
+    SetLineInformation(word);						\
+    TclPushVarName(i,v,e,f,l,sc)
+
+/*
+ * 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.
+ */
+
+#define Emit14Inst(nm,idx,envPtr) \
+    if (idx <= 255) {							\
+	TclEmitInstInt1(nm##1,idx,envPtr);				\
+    } else {								\
+	TclEmitInstInt4(nm##4,idx,envPtr);				\
+    }
+
+/*
+ * How to get an anonymous local variable (used for holding temporary values
+ * off the stack) or a local simple scalar.
+ */
+
+#define AnonymousLocal(envPtr) \
+    (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
+#define LocalScalar(chars,len,envPtr) \
+    TclLocalScalar(chars, len, envPtr)
+#define LocalScalarFromToken(tokenPtr,envPtr) \
+    TclLocalScalarFromToken(tokenPtr, envPtr)
+
+/*
+ * Flags bits used by TclPushVarName.
+ */
+
+#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
+#define TCL_NO_ELEMENT 2	/* Do not push the array element. */
 
 /*
  * DTrace probe macros (NOPs if DTrace support is not enabled).
@@ -1237,7 +1695,7 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
  * 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).
  */
@@ -1252,10 +1710,10 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 
 #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)
@@ -1271,8 +1729,8 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
-#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
-	TCL_PROC_INFO(a0, a1, a2, a3, a4, a5)
+#define TCL_DTRACE_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())
@@ -1284,8 +1742,8 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
-#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
-	TCL_CMD_INFO(a0, a1, a2, a3, a4, a5)
+#define TCL_DTRACE_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())
@@ -1298,7 +1756,8 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 
 #define TCL_DTRACE_DEBUG_LOG()
 
-MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
+MODULE_SCOPE void	TclDTraceInfo(Tcl_Obj *info, const char **args,
+			    int *argsi);
 
 #else /* USE_DTRACE */
 
@@ -1307,11 +1766,11 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_PROC_RESULT_ENABLED()    0
 #define TCL_DTRACE_PROC_ARGS_ENABLED()	    0
 #define TCL_DTRACE_PROC_INFO_ENABLED()	    0
-#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   {}
-#define TCL_DTRACE_PROC_RETURN(a0, a1)	    {}
-#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {}
+#define TCL_DTRACE_PROC_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_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
-#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) {}
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
 
 #define TCL_DTRACE_CMD_ENTRY_ENABLED()	    0
 #define TCL_DTRACE_CMD_RETURN_ENABLED()	    0
@@ -1322,7 +1781,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_CMD_RETURN(a0, a1)	    {}
 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
-#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) {}
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
 
 #define TCL_DTRACE_INST_START_ENABLED()	    0
 #define TCL_DTRACE_INST_DONE_ENABLED()	    0
@@ -1353,27 +1812,36 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
 MODULE_SCOPE FILE *tclDTraceDebugLog;
 MODULE_SCOPE void TclDTraceOpenDebugLog(void);
-MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const 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
@@ -1391,9 +1859,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
 		a1, a2, a3, a4, a5, a6, a7, a8, a9)
-#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
-	TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d", a0, a1, \
-		a2, a3, a4, a5)
+#define TCL_DTRACE_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
@@ -1411,9 +1879,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
 	TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
 		a1, a2, a3, a4, a5, a6, a7, a8, a9)
-#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
-	TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d", a0, a1, \
-		a2, a3, a4, a5)
+#define TCL_DTRACE_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
@@ -1424,9 +1892,11 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, 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) \
-	tclDTraceDebugEnabled = 1; \
+    do {								\
+	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)
+		a1, a2, a3, a4, a5, a6, a7, a8, a9);			\
+    } while (0)
 
 #endif /* TCL_DTRACE_DEBUG */
 
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 0bbac5b..2fb3e92 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -43,7 +43,7 @@ typedef struct QCCD {
 
 static int		QueryConfigObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
-			    struct Tcl_Obj *CONST *objv);
+			    struct Tcl_Obj *const *objv);
 static void		QueryConfigDelete(ClientData clientData);
 static Tcl_Obj *	GetConfigDict(Tcl_Interp *interp);
 static void		ConfigDictDeleteProc(ClientData clientData,
@@ -69,17 +69,17 @@ void
 Tcl_RegisterConfig(
     Tcl_Interp *interp,		/* Interpreter the configuration command is
 				 * registered in. */
-    CONST char *pkgName,	/* Name of the package registering the
+    const char *pkgName,	/* Name of the package registering the
 				 * embedded configuration. ASCII, thus in
 				 * UTF-8 too. */
-    Tcl_Config *configuration,	/* Embedded configuration. */
-    CONST char *valEncoding)	/* Name of the encoding used to store the
+    const Tcl_Config *configuration,	/* Embedded configuration. */
+    const char *valEncoding)	/* Name of the encoding used to store the
 				 * configuration values, ASCII, thus UTF-8. */
 {
     Tcl_Obj *pDB, *pkgDict;
     Tcl_DString cmdName;
-    Tcl_Config *cfg;
-    QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));
+    const Tcl_Config *cfg;
+    QCCD *cdPtr = ckalloc(sizeof(QCCD));
 
     cdPtr->interp = interp;
     if (valEncoding) {
@@ -146,7 +146,7 @@ Tcl_RegisterConfig(
      */
 
     Tcl_DStringInit(&cmdName);
-    Tcl_DStringAppend(&cmdName, "::", -1);
+    TclDStringAppendLiteral(&cmdName, "::");
     Tcl_DStringAppend(&cmdName, pkgName, -1);
 
     /*
@@ -164,10 +164,10 @@ Tcl_RegisterConfig(
 	}
     }
 
-    Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);
+    TclDStringAppendLiteral(&cmdName, "::pkgconfig");
 
     if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
-	    QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) {
+	    QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
 	Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
 		"Unable to create query command for package configuration");
     }
@@ -197,13 +197,13 @@ QueryConfigObjCmd(
     ClientData clientData,
     Tcl_Interp *interp,
     int objc,
-    struct Tcl_Obj *CONST *objv)
+    struct Tcl_Obj *const *objv)
 {
-    QCCD *cdPtr = (QCCD *) clientData;
+    QCCD *cdPtr = clientData;
     Tcl_Obj *pkgName = cdPtr->pkg;
     Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
     int n, index;
-    static CONST char *subcmdStrings[] = {
+    static const char *const subcmdStrings[] = {
 	"get", "list", NULL
     };
     enum subcmds {
@@ -211,10 +211,10 @@ QueryConfigObjCmd(
     };
     Tcl_DString conv;
     Tcl_Encoding venc = NULL;
-    CONST char *value;
+    const char *value;
 
     if ((objc < 2) || (objc > 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
 	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
@@ -230,7 +230,9 @@ QueryConfigObjCmd(
 	 * present.
 	 */
 
-	Tcl_SetResult(interp, "package not known", TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
+	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
+		Tcl_GetString(pkgName), NULL);
 	return TCL_ERROR;
     }
 
@@ -243,7 +245,9 @@ QueryConfigObjCmd(
 
 	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
 		|| val == NULL) {
-	    Tcl_SetResult(interp, "key not known", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
+		    Tcl_GetString(objv[2]), NULL);
 	    return TCL_ERROR;
 	}
 
@@ -274,8 +278,9 @@ QueryConfigObjCmd(
 	listPtr = Tcl_NewListObj(n, NULL);
 
 	if (!listPtr) {
-	    Tcl_SetResult(interp, "insufficient memory to create list",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "insufficient memory to create list", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 	    return TCL_ERROR;
 	}
 
@@ -321,7 +326,7 @@ static void
 QueryConfigDelete(
     ClientData clientData)
 {
-    QCCD *cdPtr = (QCCD *) clientData;
+    QCCD *cdPtr = clientData;
     Tcl_Obj *pkgName = cdPtr->pkg;
     Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);
 
@@ -389,7 +394,7 @@ ConfigDictDeleteProc(
     ClientData clientData,	/* Pointer to Tcl_Obj. */
     Tcl_Interp *interp)		/* Interpreter being deleted. */
 {
-    Tcl_Obj *pDB = (Tcl_Obj *) clientData;
+    Tcl_Obj *pDB = clientData;
 
     Tcl_DecrRefCount(pDB);
 }
diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d
index 4e4d3a4..360bdff 100644
--- a/generic/tclDTrace.d
+++ b/generic/tclDTrace.d
@@ -3,13 +3,14 @@
  *
  *	Tcl DTrace provider.
  *
- * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * Copyright (c) 2007-2008 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
@@ -24,14 +25,14 @@ provider tcl {
      *		arg1: number of arguments		(int)
      *		arg2: array of proc argument objects	(Tcl_Obj**)
      */
-    probe proc__entry(char* name, int objc, struct Tcl_Obj **objv);
+    probe proc__entry(TclDTraceStr 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(char* name, int code);
+    probe proc__return(TclDTraceStr name, int code);
     /*
      *	tcl*:::proc-result probe
      *	    triggered after proc-return probe and result processing
@@ -40,7 +41,8 @@ provider tcl {
      *		arg2: proc result			(string)
      *		arg3: proc result object		(Tcl_Obj*)
      */
-    probe proc__result(char* name, int code, char* result, struct Tcl_Obj *resultobj);
+    probe proc__result(TclDTraceStr name, int code, TclDTraceStr result,
+	    struct Tcl_Obj *resultobj);
     /*
      *	tcl*:::proc-args probe
      *	    triggered before proc-entry probe, gives access to string
@@ -48,9 +50,10 @@ provider tcl {
      *		arg0: proc name				(string)
      *		arg1-arg9: proc arguments or NULL	(strings)
      */
-    probe proc__args(char* name, char* arg1, char* arg2, char* arg3,
-	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
-	    char* arg9);
+    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
@@ -61,9 +64,12 @@ provider tcl {
      *		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(char* cmd, char* type, char* proc, char* file, int line,
-	    int level);
+    probe proc__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
+	    TclDTraceStr file, int line, int level, TclDTraceStr method,
+	    TclDTraceStr class);
 
     /***************************** cmd probes ******************************/
     /*
@@ -73,14 +79,14 @@ provider tcl {
      *		arg1: number of arguments		(int)
      *		arg2: array of command argument objects	(Tcl_Obj**)
      */
-    probe cmd__entry(char* name, int objc, struct Tcl_Obj **objv);
+    probe cmd__entry(TclDTraceStr 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(char* name, int code);
+    probe cmd__return(TclDTraceStr name, int code);
     /*
      *	tcl*:::cmd-result probe
      *	    triggered after cmd-return probe and result processing
@@ -89,7 +95,8 @@ provider tcl {
      *		arg2: command result			(string)
      *		arg3: command result object		(Tcl_Obj*)
      */
-    probe cmd__result(char* name, int code, char* result, struct Tcl_Obj *resultobj);
+    probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result,
+	    struct Tcl_Obj *resultobj);
     /*
      *	tcl*:::cmd-args probe
      *	    triggered before cmd-entry probe, gives access to string
@@ -97,9 +104,10 @@ provider tcl {
      *		arg0: command name			(string)
      *		arg1-arg9: command arguments or NULL	(strings)
      */
-    probe cmd__args(char* name, char* arg1, char* arg2, char* arg3,
-	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
-	    char* arg9);
+    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
@@ -110,9 +118,12 @@ provider tcl {
      *		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(char* cmd, char* type, char* proc, char* file, int line,
-	    int level);
+    probe cmd__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
+	    TclDTraceStr file, int line, int level, TclDTraceStr method,
+	    TclDTraceStr class);
 
     /***************************** inst probes *****************************/
     /*
@@ -122,7 +133,7 @@ provider tcl {
      *		arg1: depth of stack			(int)
      *		arg2: top of stack			(Tcl_Obj**)
      */
-    probe inst__start(char* name, int depth, struct Tcl_Obj **stack);
+    probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
     /*
      *	tcl*:::inst-done probe
      *	    triggered immediately after execution of a bytecode
@@ -130,7 +141,7 @@ provider tcl {
      *		arg1: depth of stack			(int)
      *		arg2: top of stack			(Tcl_Obj**)
      */
-    probe inst__done(char* name, int depth, struct Tcl_Obj **stack);
+    probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
 
     /***************************** obj probes ******************************/
     /*
@@ -152,9 +163,10 @@ provider tcl {
      *	    triggered when the ::tcl::dtrace command is called
      *		arg0-arg9: command arguments		(strings)
      */
-    probe tcl__probe(char* arg0, char* arg1, char* arg2, char* arg3,
-	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
-	    char* arg9);
+    probe tcl__probe(TclDTraceStr arg0, TclDTraceStr arg1, TclDTraceStr arg2,
+	    TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
+	    TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
+	    TclDTraceStr arg9);
 };
 
 /*
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 1adcf1e..e4dd000 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -2285,10 +2285,6 @@ yyreturn:
 
 
 
-MODULE_SCOPE int yychar;
-MODULE_SCOPE YYSTYPE yylval;
-MODULE_SCOPE int yynerrs;
-
 /*
  * Month and day table.
  */
@@ -2318,7 +2314,7 @@ static const TABLE MonthDayTable[] = {
     { "thurs",		tDAY, 4 },
     { "friday",		tDAY, 5 },
     { "saturday",	tDAY, 6 },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -2336,7 +2332,7 @@ static const TABLE UnitsTable[] = {
     { "min",		tSEC_UNIT,	60 },
     { "second",		tSEC_UNIT,	 1 },
     { "sec",		tSEC_UNIT,	 1 },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -2368,7 +2364,7 @@ static const TABLE OtherTable[] = {
     { "ago",		tAGO,		1 },
     { "epoch",		tEPOCH,		0 },
     { "stardate",	tSTARDATE,	0 },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -2454,7 +2450,7 @@ static const TABLE TimezoneTable[] = {
     /* ADDED BY Marco Nijdam */
     { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
     /* End ADDED */
-    {  NULL  }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -2487,7 +2483,7 @@ static const TABLE MilitaryTable[] = {
     { "x",	tZONE,	HOUR( 11) },
     { "y",	tZONE,	HOUR( 12) },
     { "z",	tZONE,	HOUR( 0) },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -2750,7 +2746,7 @@ TclClockOldscanObjCmd(
     ClientData clientData,	/* Unused */
     Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Count of paraneters */
-    Tcl_Obj *CONST *objv)	/* Parameters */
+    Tcl_Obj *const *objv)	/* Parameters */
 {
     Tcl_Obj *result, *resultElement;
     int yr, mo, da;
@@ -2798,10 +2794,12 @@ TclClockOldscanObjCmd(
     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 "
@@ -2809,6 +2807,7 @@ TclClockOldscanObjCmd(
 						  "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);
@@ -2816,26 +2815,31 @@ TclClockOldscanObjCmd(
     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;
     }
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b11c0d8..3de71af 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -39,3502 +39,1851 @@ extern "C" {
  * Exported function declarations:
  */
 
-#ifndef Tcl_PkgProvideEx_TCL_DECLARED
-#define Tcl_PkgProvideEx_TCL_DECLARED
 /* 0 */
 EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
-				CONST char *name, CONST char *version,
-				ClientData clientData);
-#endif
-#ifndef Tcl_PkgRequireEx_TCL_DECLARED
-#define Tcl_PkgRequireEx_TCL_DECLARED
+				const char *name, const char *version,
+				const void *clientData);
 /* 1 */
 EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
-				CONST char *name, CONST char *version,
-				int exact, ClientData *clientDataPtr);
-#endif
-#ifndef Tcl_Panic_TCL_DECLARED
-#define Tcl_Panic_TCL_DECLARED
+				const char *name, const char *version,
+				int exact, void *clientDataPtr);
 /* 2 */
-EXTERN void		Tcl_Panic(CONST char *format, ...);
-#endif
-#ifndef Tcl_Alloc_TCL_DECLARED
-#define Tcl_Alloc_TCL_DECLARED
+EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
 /* 3 */
 EXTERN char *		Tcl_Alloc(unsigned int size);
-#endif
-#ifndef Tcl_Free_TCL_DECLARED
-#define Tcl_Free_TCL_DECLARED
 /* 4 */
 EXTERN void		Tcl_Free(char *ptr);
-#endif
-#ifndef Tcl_Realloc_TCL_DECLARED
-#define Tcl_Realloc_TCL_DECLARED
 /* 5 */
 EXTERN char *		Tcl_Realloc(char *ptr, unsigned int size);
-#endif
-#ifndef Tcl_DbCkalloc_TCL_DECLARED
-#define Tcl_DbCkalloc_TCL_DECLARED
 /* 6 */
-EXTERN char *		Tcl_DbCkalloc(unsigned int size, CONST char *file,
+EXTERN char *		Tcl_DbCkalloc(unsigned int size, const char *file,
 				int line);
-#endif
-#ifndef Tcl_DbCkfree_TCL_DECLARED
-#define Tcl_DbCkfree_TCL_DECLARED
 /* 7 */
-EXTERN void		Tcl_DbCkfree(char *ptr, CONST char *file, int line);
-#endif
-#ifndef Tcl_DbCkrealloc_TCL_DECLARED
-#define Tcl_DbCkrealloc_TCL_DECLARED
+EXTERN void		Tcl_DbCkfree(char *ptr, const char *file, int line);
 /* 8 */
 EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
-				CONST char *file, int line);
-#endif
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef Tcl_CreateFileHandler_TCL_DECLARED
-#define Tcl_CreateFileHandler_TCL_DECLARED
+				const char *file, int line);
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 9 */
 EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 				Tcl_FileProc *proc, ClientData clientData);
-#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_CreateFileHandler_TCL_DECLARED
-#define Tcl_CreateFileHandler_TCL_DECLARED
 /* 9 */
 EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 				Tcl_FileProc *proc, ClientData clientData);
-#endif
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
-#define Tcl_DeleteFileHandler_TCL_DECLARED
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 10 */
 EXTERN void		Tcl_DeleteFileHandler(int fd);
-#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
-#define Tcl_DeleteFileHandler_TCL_DECLARED
 /* 10 */
 EXTERN void		Tcl_DeleteFileHandler(int fd);
-#endif
 #endif /* MACOSX */
-#ifndef Tcl_SetTimer_TCL_DECLARED
-#define Tcl_SetTimer_TCL_DECLARED
 /* 11 */
-EXTERN void		Tcl_SetTimer(Tcl_Time *timePtr);
-#endif
-#ifndef Tcl_Sleep_TCL_DECLARED
-#define Tcl_Sleep_TCL_DECLARED
+EXTERN void		Tcl_SetTimer(const Tcl_Time *timePtr);
 /* 12 */
 EXTERN void		Tcl_Sleep(int ms);
-#endif
-#ifndef Tcl_WaitForEvent_TCL_DECLARED
-#define Tcl_WaitForEvent_TCL_DECLARED
 /* 13 */
-EXTERN int		Tcl_WaitForEvent(Tcl_Time *timePtr);
-#endif
-#ifndef Tcl_AppendAllObjTypes_TCL_DECLARED
-#define Tcl_AppendAllObjTypes_TCL_DECLARED
+EXTERN int		Tcl_WaitForEvent(const Tcl_Time *timePtr);
 /* 14 */
 EXTERN int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_AppendStringsToObj_TCL_DECLARED
-#define Tcl_AppendStringsToObj_TCL_DECLARED
 /* 15 */
 EXTERN void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
-#endif
-#ifndef Tcl_AppendToObj_TCL_DECLARED
-#define Tcl_AppendToObj_TCL_DECLARED
 /* 16 */
-EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, CONST char *bytes,
+EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
 				int length);
-#endif
-#ifndef Tcl_ConcatObj_TCL_DECLARED
-#define Tcl_ConcatObj_TCL_DECLARED
 /* 17 */
-EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[]);
-#endif
-#ifndef Tcl_ConvertToType_TCL_DECLARED
-#define Tcl_ConvertToType_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
 /* 18 */
 EXTERN int		Tcl_ConvertToType(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, Tcl_ObjType *typePtr);
-#endif
-#ifndef Tcl_DbDecrRefCount_TCL_DECLARED
-#define Tcl_DbDecrRefCount_TCL_DECLARED
+				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
 /* 19 */
-EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, CONST char *file,
+EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
 				int line);
-#endif
-#ifndef Tcl_DbIncrRefCount_TCL_DECLARED
-#define Tcl_DbIncrRefCount_TCL_DECLARED
 /* 20 */
-EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, CONST char *file,
+EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
 				int line);
-#endif
-#ifndef Tcl_DbIsShared_TCL_DECLARED
-#define Tcl_DbIsShared_TCL_DECLARED
 /* 21 */
-EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, CONST char *file,
+EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
 				int line);
-#endif
-#ifndef Tcl_DbNewBooleanObj_TCL_DECLARED
-#define Tcl_DbNewBooleanObj_TCL_DECLARED
 /* 22 */
-EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, CONST char *file,
+EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, const char *file,
 				int line);
-#endif
-#ifndef Tcl_DbNewByteArrayObj_TCL_DECLARED
-#define Tcl_DbNewByteArrayObj_TCL_DECLARED
 /* 23 */
-EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(CONST unsigned char *bytes,
-				int length, CONST char *file, int line);
-#endif
-#ifndef Tcl_DbNewDoubleObj_TCL_DECLARED
-#define Tcl_DbNewDoubleObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
+				int length, const char *file, int line);
 /* 24 */
 EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
-				CONST char *file, int line);
-#endif
-#ifndef Tcl_DbNewListObj_TCL_DECLARED
-#define Tcl_DbNewListObj_TCL_DECLARED
+				const char *file, int line);
 /* 25 */
-EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *CONST *objv,
-				CONST char *file, int line);
-#endif
-#ifndef Tcl_DbNewLongObj_TCL_DECLARED
-#define Tcl_DbNewLongObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
+				const char *file, int line);
 /* 26 */
-EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, CONST char *file,
+EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, const char *file,
 				int line);
-#endif
-#ifndef Tcl_DbNewObj_TCL_DECLARED
-#define Tcl_DbNewObj_TCL_DECLARED
 /* 27 */
-EXTERN Tcl_Obj *	Tcl_DbNewObj(CONST char *file, int line);
-#endif
-#ifndef Tcl_DbNewStringObj_TCL_DECLARED
-#define Tcl_DbNewStringObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
 /* 28 */
-EXTERN Tcl_Obj *	Tcl_DbNewStringObj(CONST char *bytes, int length,
-				CONST char *file, int line);
-#endif
-#ifndef Tcl_DuplicateObj_TCL_DECLARED
-#define Tcl_DuplicateObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, int length,
+				const char *file, int line);
 /* 29 */
 EXTERN Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
-#endif
-#ifndef TclFreeObj_TCL_DECLARED
-#define TclFreeObj_TCL_DECLARED
 /* 30 */
 EXTERN void		TclFreeObj(Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetBoolean_TCL_DECLARED
-#define Tcl_GetBoolean_TCL_DECLARED
 /* 31 */
-EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, CONST char *src,
+EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
 				int *boolPtr);
-#endif
-#ifndef Tcl_GetBooleanFromObj_TCL_DECLARED
-#define Tcl_GetBooleanFromObj_TCL_DECLARED
 /* 32 */
 EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, int *boolPtr);
-#endif
-#ifndef Tcl_GetByteArrayFromObj_TCL_DECLARED
-#define Tcl_GetByteArrayFromObj_TCL_DECLARED
 /* 33 */
 EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
 				int *lengthPtr);
-#endif
-#ifndef Tcl_GetDouble_TCL_DECLARED
-#define Tcl_GetDouble_TCL_DECLARED
 /* 34 */
-EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, CONST char *src,
+EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
 				double *doublePtr);
-#endif
-#ifndef Tcl_GetDoubleFromObj_TCL_DECLARED
-#define Tcl_GetDoubleFromObj_TCL_DECLARED
 /* 35 */
 EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, double *doublePtr);
-#endif
-#ifndef Tcl_GetIndexFromObj_TCL_DECLARED
-#define Tcl_GetIndexFromObj_TCL_DECLARED
 /* 36 */
 EXTERN int		Tcl_GetIndexFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, CONST84 char **tablePtr,
-				CONST char *msg, int flags, int *indexPtr);
-#endif
-#ifndef Tcl_GetInt_TCL_DECLARED
-#define Tcl_GetInt_TCL_DECLARED
+				Tcl_Obj *objPtr,
+				CONST84 char *const *tablePtr,
+				const char *msg, int flags, int *indexPtr);
 /* 37 */
-EXTERN int		Tcl_GetInt(Tcl_Interp *interp, CONST char *src,
+EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
 				int *intPtr);
-#endif
-#ifndef Tcl_GetIntFromObj_TCL_DECLARED
-#define Tcl_GetIntFromObj_TCL_DECLARED
 /* 38 */
 EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, int *intPtr);
-#endif
-#ifndef Tcl_GetLongFromObj_TCL_DECLARED
-#define Tcl_GetLongFromObj_TCL_DECLARED
 /* 39 */
 EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, long *longPtr);
-#endif
-#ifndef Tcl_GetObjType_TCL_DECLARED
-#define Tcl_GetObjType_TCL_DECLARED
 /* 40 */
-EXTERN Tcl_ObjType *	Tcl_GetObjType(CONST char *typeName);
-#endif
-#ifndef Tcl_GetStringFromObj_TCL_DECLARED
-#define Tcl_GetStringFromObj_TCL_DECLARED
+EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
 /* 41 */
 EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
-#endif
-#ifndef Tcl_InvalidateStringRep_TCL_DECLARED
-#define Tcl_InvalidateStringRep_TCL_DECLARED
 /* 42 */
 EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_ListObjAppendList_TCL_DECLARED
-#define Tcl_ListObjAppendList_TCL_DECLARED
 /* 43 */
 EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
-#endif
-#ifndef Tcl_ListObjAppendElement_TCL_DECLARED
-#define Tcl_ListObjAppendElement_TCL_DECLARED
 /* 44 */
 EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_ListObjGetElements_TCL_DECLARED
-#define Tcl_ListObjGetElements_TCL_DECLARED
 /* 45 */
 EXTERN int		Tcl_ListObjGetElements(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int *objcPtr,
 				Tcl_Obj ***objvPtr);
-#endif
-#ifndef Tcl_ListObjIndex_TCL_DECLARED
-#define Tcl_ListObjIndex_TCL_DECLARED
 /* 46 */
 EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int index,
 				Tcl_Obj **objPtrPtr);
-#endif
-#ifndef Tcl_ListObjLength_TCL_DECLARED
-#define Tcl_ListObjLength_TCL_DECLARED
 /* 47 */
 EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int *lengthPtr);
-#endif
-#ifndef Tcl_ListObjReplace_TCL_DECLARED
-#define Tcl_ListObjReplace_TCL_DECLARED
 /* 48 */
 EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int first, int count,
-				int objc, Tcl_Obj *CONST objv[]);
-#endif
-#ifndef Tcl_NewBooleanObj_TCL_DECLARED
-#define Tcl_NewBooleanObj_TCL_DECLARED
+				int objc, Tcl_Obj *const objv[]);
 /* 49 */
 EXTERN Tcl_Obj *	Tcl_NewBooleanObj(int boolValue);
-#endif
-#ifndef Tcl_NewByteArrayObj_TCL_DECLARED
-#define Tcl_NewByteArrayObj_TCL_DECLARED
 /* 50 */
-EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(CONST unsigned char *bytes,
+EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
 				int length);
-#endif
-#ifndef Tcl_NewDoubleObj_TCL_DECLARED
-#define Tcl_NewDoubleObj_TCL_DECLARED
 /* 51 */
 EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
-#endif
-#ifndef Tcl_NewIntObj_TCL_DECLARED
-#define Tcl_NewIntObj_TCL_DECLARED
 /* 52 */
 EXTERN Tcl_Obj *	Tcl_NewIntObj(int intValue);
-#endif
-#ifndef Tcl_NewListObj_TCL_DECLARED
-#define Tcl_NewListObj_TCL_DECLARED
 /* 53 */
-EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *CONST objv[]);
-#endif
-#ifndef Tcl_NewLongObj_TCL_DECLARED
-#define Tcl_NewLongObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
 /* 54 */
 EXTERN Tcl_Obj *	Tcl_NewLongObj(long longValue);
-#endif
-#ifndef Tcl_NewObj_TCL_DECLARED
-#define Tcl_NewObj_TCL_DECLARED
 /* 55 */
 EXTERN Tcl_Obj *	Tcl_NewObj(void);
-#endif
-#ifndef Tcl_NewStringObj_TCL_DECLARED
-#define Tcl_NewStringObj_TCL_DECLARED
 /* 56 */
-EXTERN Tcl_Obj *	Tcl_NewStringObj(CONST char *bytes, int length);
-#endif
-#ifndef Tcl_SetBooleanObj_TCL_DECLARED
-#define Tcl_SetBooleanObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, int length);
 /* 57 */
 EXTERN void		Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
-#endif
-#ifndef Tcl_SetByteArrayLength_TCL_DECLARED
-#define Tcl_SetByteArrayLength_TCL_DECLARED
 /* 58 */
 EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
-#endif
-#ifndef Tcl_SetByteArrayObj_TCL_DECLARED
-#define Tcl_SetByteArrayObj_TCL_DECLARED
 /* 59 */
 EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
-				CONST unsigned char *bytes, int length);
-#endif
-#ifndef Tcl_SetDoubleObj_TCL_DECLARED
-#define Tcl_SetDoubleObj_TCL_DECLARED
+				const unsigned char *bytes, int length);
 /* 60 */
 EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
-#endif
-#ifndef Tcl_SetIntObj_TCL_DECLARED
-#define Tcl_SetIntObj_TCL_DECLARED
 /* 61 */
 EXTERN void		Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
-#endif
-#ifndef Tcl_SetListObj_TCL_DECLARED
-#define Tcl_SetListObj_TCL_DECLARED
 /* 62 */
 EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
-				Tcl_Obj *CONST objv[]);
-#endif
-#ifndef Tcl_SetLongObj_TCL_DECLARED
-#define Tcl_SetLongObj_TCL_DECLARED
+				Tcl_Obj *const objv[]);
 /* 63 */
 EXTERN void		Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
-#endif
-#ifndef Tcl_SetObjLength_TCL_DECLARED
-#define Tcl_SetObjLength_TCL_DECLARED
 /* 64 */
 EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
-#endif
-#ifndef Tcl_SetStringObj_TCL_DECLARED
-#define Tcl_SetStringObj_TCL_DECLARED
 /* 65 */
-EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, CONST char *bytes,
+EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
 				int length);
-#endif
-#ifndef Tcl_AddErrorInfo_TCL_DECLARED
-#define Tcl_AddErrorInfo_TCL_DECLARED
 /* 66 */
 EXTERN void		Tcl_AddErrorInfo(Tcl_Interp *interp,
-				CONST char *message);
-#endif
-#ifndef Tcl_AddObjErrorInfo_TCL_DECLARED
-#define Tcl_AddObjErrorInfo_TCL_DECLARED
+				const char *message);
 /* 67 */
 EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
-				CONST char *message, int length);
-#endif
-#ifndef Tcl_AllowExceptions_TCL_DECLARED
-#define Tcl_AllowExceptions_TCL_DECLARED
+				const char *message, int length);
 /* 68 */
 EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_AppendElement_TCL_DECLARED
-#define Tcl_AppendElement_TCL_DECLARED
 /* 69 */
 EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
-				CONST char *element);
-#endif
-#ifndef Tcl_AppendResult_TCL_DECLARED
-#define Tcl_AppendResult_TCL_DECLARED
+				const char *element);
 /* 70 */
 EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
-#endif
-#ifndef Tcl_AsyncCreate_TCL_DECLARED
-#define Tcl_AsyncCreate_TCL_DECLARED
 /* 71 */
 EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_AsyncDelete_TCL_DECLARED
-#define Tcl_AsyncDelete_TCL_DECLARED
 /* 72 */
 EXTERN void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
-#endif
-#ifndef Tcl_AsyncInvoke_TCL_DECLARED
-#define Tcl_AsyncInvoke_TCL_DECLARED
 /* 73 */
 EXTERN int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
-#endif
-#ifndef Tcl_AsyncMark_TCL_DECLARED
-#define Tcl_AsyncMark_TCL_DECLARED
 /* 74 */
 EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
-#endif
-#ifndef Tcl_AsyncReady_TCL_DECLARED
-#define Tcl_AsyncReady_TCL_DECLARED
 /* 75 */
 EXTERN int		Tcl_AsyncReady(void);
-#endif
-#ifndef Tcl_BackgroundError_TCL_DECLARED
-#define Tcl_BackgroundError_TCL_DECLARED
 /* 76 */
 EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_Backslash_TCL_DECLARED
-#define Tcl_Backslash_TCL_DECLARED
 /* 77 */
-EXTERN char		Tcl_Backslash(CONST char *src, int *readPtr);
-#endif
-#ifndef Tcl_BadChannelOption_TCL_DECLARED
-#define Tcl_BadChannelOption_TCL_DECLARED
+EXTERN char		Tcl_Backslash(const char *src, int *readPtr);
 /* 78 */
 EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
-				CONST char *optionName,
-				CONST char *optionList);
-#endif
-#ifndef Tcl_CallWhenDeleted_TCL_DECLARED
-#define Tcl_CallWhenDeleted_TCL_DECLARED
+				const char *optionName,
+				const char *optionList);
 /* 79 */
 EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
 				Tcl_InterpDeleteProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_CancelIdleCall_TCL_DECLARED
-#define Tcl_CancelIdleCall_TCL_DECLARED
 /* 80 */
 EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_Close_TCL_DECLARED
-#define Tcl_Close_TCL_DECLARED
 /* 81 */
 EXTERN int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
-#endif
-#ifndef Tcl_CommandComplete_TCL_DECLARED
-#define Tcl_CommandComplete_TCL_DECLARED
 /* 82 */
-EXTERN int		Tcl_CommandComplete(CONST char *cmd);
-#endif
-#ifndef Tcl_Concat_TCL_DECLARED
-#define Tcl_Concat_TCL_DECLARED
+EXTERN int		Tcl_CommandComplete(const char *cmd);
 /* 83 */
-EXTERN char *		Tcl_Concat(int argc, CONST84 char *CONST *argv);
-#endif
-#ifndef Tcl_ConvertElement_TCL_DECLARED
-#define Tcl_ConvertElement_TCL_DECLARED
+EXTERN char *		Tcl_Concat(int argc, CONST84 char *const *argv);
 /* 84 */
-EXTERN int		Tcl_ConvertElement(CONST char *src, char *dst,
+EXTERN int		Tcl_ConvertElement(const char *src, char *dst,
 				int flags);
-#endif
-#ifndef Tcl_ConvertCountedElement_TCL_DECLARED
-#define Tcl_ConvertCountedElement_TCL_DECLARED
 /* 85 */
-EXTERN int		Tcl_ConvertCountedElement(CONST char *src,
+EXTERN int		Tcl_ConvertCountedElement(const char *src,
 				int length, char *dst, int flags);
-#endif
-#ifndef Tcl_CreateAlias_TCL_DECLARED
-#define Tcl_CreateAlias_TCL_DECLARED
 /* 86 */
 EXTERN int		Tcl_CreateAlias(Tcl_Interp *slave,
-				CONST char *slaveCmd, Tcl_Interp *target,
-				CONST char *targetCmd, int argc,
-				CONST84 char *CONST *argv);
-#endif
-#ifndef Tcl_CreateAliasObj_TCL_DECLARED
-#define Tcl_CreateAliasObj_TCL_DECLARED
+				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[]);
-#endif
-#ifndef Tcl_CreateChannel_TCL_DECLARED
-#define Tcl_CreateChannel_TCL_DECLARED
+				const char *slaveCmd, Tcl_Interp *target,
+				const char *targetCmd, int objc,
+				Tcl_Obj *const objv[]);
 /* 88 */
-EXTERN Tcl_Channel	Tcl_CreateChannel(Tcl_ChannelType *typePtr,
-				CONST char *chanName,
+EXTERN Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
+				const char *chanName,
 				ClientData instanceData, int mask);
-#endif
-#ifndef Tcl_CreateChannelHandler_TCL_DECLARED
-#define Tcl_CreateChannelHandler_TCL_DECLARED
 /* 89 */
 EXTERN void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
 				Tcl_ChannelProc *proc, ClientData clientData);
-#endif
-#ifndef Tcl_CreateCloseHandler_TCL_DECLARED
-#define Tcl_CreateCloseHandler_TCL_DECLARED
 /* 90 */
 EXTERN void		Tcl_CreateCloseHandler(Tcl_Channel chan,
 				Tcl_CloseProc *proc, ClientData clientData);
-#endif
-#ifndef Tcl_CreateCommand_TCL_DECLARED
-#define Tcl_CreateCommand_TCL_DECLARED
 /* 91 */
 EXTERN Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
-				CONST char *cmdName, Tcl_CmdProc *proc,
+				const char *cmdName, Tcl_CmdProc *proc,
 				ClientData clientData,
 				Tcl_CmdDeleteProc *deleteProc);
-#endif
-#ifndef Tcl_CreateEventSource_TCL_DECLARED
-#define Tcl_CreateEventSource_TCL_DECLARED
 /* 92 */
 EXTERN void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
 				Tcl_EventCheckProc *checkProc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_CreateExitHandler_TCL_DECLARED
-#define Tcl_CreateExitHandler_TCL_DECLARED
 /* 93 */
 EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_CreateInterp_TCL_DECLARED
-#define Tcl_CreateInterp_TCL_DECLARED
 /* 94 */
 EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
-#endif
-#ifndef Tcl_CreateMathFunc_TCL_DECLARED
-#define Tcl_CreateMathFunc_TCL_DECLARED
 /* 95 */
 EXTERN void		Tcl_CreateMathFunc(Tcl_Interp *interp,
-				CONST char *name, int numArgs,
+				const char *name, int numArgs,
 				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_CreateObjCommand_TCL_DECLARED
-#define Tcl_CreateObjCommand_TCL_DECLARED
 /* 96 */
 EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
-				CONST char *cmdName, Tcl_ObjCmdProc *proc,
+				const char *cmdName, Tcl_ObjCmdProc *proc,
 				ClientData clientData,
 				Tcl_CmdDeleteProc *deleteProc);
-#endif
-#ifndef Tcl_CreateSlave_TCL_DECLARED
-#define Tcl_CreateSlave_TCL_DECLARED
 /* 97 */
 EXTERN Tcl_Interp *	Tcl_CreateSlave(Tcl_Interp *interp,
-				CONST char *slaveName, int isSafe);
-#endif
-#ifndef Tcl_CreateTimerHandler_TCL_DECLARED
-#define Tcl_CreateTimerHandler_TCL_DECLARED
+				const char *slaveName, int isSafe);
 /* 98 */
 EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
 				Tcl_TimerProc *proc, ClientData clientData);
-#endif
-#ifndef Tcl_CreateTrace_TCL_DECLARED
-#define Tcl_CreateTrace_TCL_DECLARED
 /* 99 */
 EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
 				Tcl_CmdTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DeleteAssocData_TCL_DECLARED
-#define Tcl_DeleteAssocData_TCL_DECLARED
 /* 100 */
 EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
-				CONST char *name);
-#endif
-#ifndef Tcl_DeleteChannelHandler_TCL_DECLARED
-#define Tcl_DeleteChannelHandler_TCL_DECLARED
+				const char *name);
 /* 101 */
 EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
 				Tcl_ChannelProc *proc, ClientData clientData);
-#endif
-#ifndef Tcl_DeleteCloseHandler_TCL_DECLARED
-#define Tcl_DeleteCloseHandler_TCL_DECLARED
 /* 102 */
 EXTERN void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
 				Tcl_CloseProc *proc, ClientData clientData);
-#endif
-#ifndef Tcl_DeleteCommand_TCL_DECLARED
-#define Tcl_DeleteCommand_TCL_DECLARED
 /* 103 */
 EXTERN int		Tcl_DeleteCommand(Tcl_Interp *interp,
-				CONST char *cmdName);
-#endif
-#ifndef Tcl_DeleteCommandFromToken_TCL_DECLARED
-#define Tcl_DeleteCommandFromToken_TCL_DECLARED
+				const char *cmdName);
 /* 104 */
 EXTERN int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
 				Tcl_Command command);
-#endif
-#ifndef Tcl_DeleteEvents_TCL_DECLARED
-#define Tcl_DeleteEvents_TCL_DECLARED
 /* 105 */
 EXTERN void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DeleteEventSource_TCL_DECLARED
-#define Tcl_DeleteEventSource_TCL_DECLARED
 /* 106 */
 EXTERN void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
 				Tcl_EventCheckProc *checkProc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DeleteExitHandler_TCL_DECLARED
-#define Tcl_DeleteExitHandler_TCL_DECLARED
 /* 107 */
 EXTERN void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DeleteHashEntry_TCL_DECLARED
-#define Tcl_DeleteHashEntry_TCL_DECLARED
 /* 108 */
 EXTERN void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
-#endif
-#ifndef Tcl_DeleteHashTable_TCL_DECLARED
-#define Tcl_DeleteHashTable_TCL_DECLARED
 /* 109 */
 EXTERN void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
-#endif
-#ifndef Tcl_DeleteInterp_TCL_DECLARED
-#define Tcl_DeleteInterp_TCL_DECLARED
 /* 110 */
 EXTERN void		Tcl_DeleteInterp(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_DetachPids_TCL_DECLARED
-#define Tcl_DetachPids_TCL_DECLARED
 /* 111 */
 EXTERN void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
-#endif
-#ifndef Tcl_DeleteTimerHandler_TCL_DECLARED
-#define Tcl_DeleteTimerHandler_TCL_DECLARED
 /* 112 */
 EXTERN void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
-#endif
-#ifndef Tcl_DeleteTrace_TCL_DECLARED
-#define Tcl_DeleteTrace_TCL_DECLARED
 /* 113 */
 EXTERN void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
-#endif
-#ifndef Tcl_DontCallWhenDeleted_TCL_DECLARED
-#define Tcl_DontCallWhenDeleted_TCL_DECLARED
 /* 114 */
 EXTERN void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
 				Tcl_InterpDeleteProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DoOneEvent_TCL_DECLARED
-#define Tcl_DoOneEvent_TCL_DECLARED
 /* 115 */
 EXTERN int		Tcl_DoOneEvent(int flags);
-#endif
-#ifndef Tcl_DoWhenIdle_TCL_DECLARED
-#define Tcl_DoWhenIdle_TCL_DECLARED
 /* 116 */
 EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DStringAppend_TCL_DECLARED
-#define Tcl_DStringAppend_TCL_DECLARED
 /* 117 */
 EXTERN char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
-				CONST char *bytes, int length);
-#endif
-#ifndef Tcl_DStringAppendElement_TCL_DECLARED
-#define Tcl_DStringAppendElement_TCL_DECLARED
+				const char *bytes, int length);
 /* 118 */
 EXTERN char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
-				CONST char *element);
-#endif
-#ifndef Tcl_DStringEndSublist_TCL_DECLARED
-#define Tcl_DStringEndSublist_TCL_DECLARED
+				const char *element);
 /* 119 */
 EXTERN void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_DStringFree_TCL_DECLARED
-#define Tcl_DStringFree_TCL_DECLARED
 /* 120 */
 EXTERN void		Tcl_DStringFree(Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_DStringGetResult_TCL_DECLARED
-#define Tcl_DStringGetResult_TCL_DECLARED
 /* 121 */
 EXTERN void		Tcl_DStringGetResult(Tcl_Interp *interp,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_DStringInit_TCL_DECLARED
-#define Tcl_DStringInit_TCL_DECLARED
 /* 122 */
 EXTERN void		Tcl_DStringInit(Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_DStringResult_TCL_DECLARED
-#define Tcl_DStringResult_TCL_DECLARED
 /* 123 */
 EXTERN void		Tcl_DStringResult(Tcl_Interp *interp,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_DStringSetLength_TCL_DECLARED
-#define Tcl_DStringSetLength_TCL_DECLARED
 /* 124 */
 EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
-#endif
-#ifndef Tcl_DStringStartSublist_TCL_DECLARED
-#define Tcl_DStringStartSublist_TCL_DECLARED
 /* 125 */
 EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_Eof_TCL_DECLARED
-#define Tcl_Eof_TCL_DECLARED
 /* 126 */
 EXTERN int		Tcl_Eof(Tcl_Channel chan);
-#endif
-#ifndef Tcl_ErrnoId_TCL_DECLARED
-#define Tcl_ErrnoId_TCL_DECLARED
 /* 127 */
 EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
-#endif
-#ifndef Tcl_ErrnoMsg_TCL_DECLARED
-#define Tcl_ErrnoMsg_TCL_DECLARED
 /* 128 */
 EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
-#endif
-#ifndef Tcl_Eval_TCL_DECLARED
-#define Tcl_Eval_TCL_DECLARED
 /* 129 */
-EXTERN int		Tcl_Eval(Tcl_Interp *interp, CONST char *script);
-#endif
-#ifndef Tcl_EvalFile_TCL_DECLARED
-#define Tcl_EvalFile_TCL_DECLARED
+EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
 /* 130 */
 EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
-				CONST char *fileName);
-#endif
-#ifndef Tcl_EvalObj_TCL_DECLARED
-#define Tcl_EvalObj_TCL_DECLARED
+				const char *fileName);
 /* 131 */
 EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_EventuallyFree_TCL_DECLARED
-#define Tcl_EventuallyFree_TCL_DECLARED
 /* 132 */
 EXTERN void		Tcl_EventuallyFree(ClientData clientData,
 				Tcl_FreeProc *freeProc);
-#endif
-#ifndef Tcl_Exit_TCL_DECLARED
-#define Tcl_Exit_TCL_DECLARED
 /* 133 */
-EXTERN void		Tcl_Exit(int status);
-#endif
-#ifndef Tcl_ExposeCommand_TCL_DECLARED
-#define Tcl_ExposeCommand_TCL_DECLARED
+EXTERN TCL_NORETURN void Tcl_Exit(int status);
 /* 134 */
 EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
-				CONST char *hiddenCmdToken,
-				CONST char *cmdName);
-#endif
-#ifndef Tcl_ExprBoolean_TCL_DECLARED
-#define Tcl_ExprBoolean_TCL_DECLARED
+				const char *hiddenCmdToken,
+				const char *cmdName);
 /* 135 */
-EXTERN int		Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *expr,
+EXTERN int		Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr,
 				int *ptr);
-#endif
-#ifndef Tcl_ExprBooleanObj_TCL_DECLARED
-#define Tcl_ExprBooleanObj_TCL_DECLARED
 /* 136 */
 EXTERN int		Tcl_ExprBooleanObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, int *ptr);
-#endif
-#ifndef Tcl_ExprDouble_TCL_DECLARED
-#define Tcl_ExprDouble_TCL_DECLARED
 /* 137 */
-EXTERN int		Tcl_ExprDouble(Tcl_Interp *interp, CONST char *expr,
+EXTERN int		Tcl_ExprDouble(Tcl_Interp *interp, const char *expr,
 				double *ptr);
-#endif
-#ifndef Tcl_ExprDoubleObj_TCL_DECLARED
-#define Tcl_ExprDoubleObj_TCL_DECLARED
 /* 138 */
 EXTERN int		Tcl_ExprDoubleObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, double *ptr);
-#endif
-#ifndef Tcl_ExprLong_TCL_DECLARED
-#define Tcl_ExprLong_TCL_DECLARED
 /* 139 */
-EXTERN int		Tcl_ExprLong(Tcl_Interp *interp, CONST char *expr,
+EXTERN int		Tcl_ExprLong(Tcl_Interp *interp, const char *expr,
 				long *ptr);
-#endif
-#ifndef Tcl_ExprLongObj_TCL_DECLARED
-#define Tcl_ExprLongObj_TCL_DECLARED
 /* 140 */
 EXTERN int		Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 				long *ptr);
-#endif
-#ifndef Tcl_ExprObj_TCL_DECLARED
-#define Tcl_ExprObj_TCL_DECLARED
 /* 141 */
 EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 				Tcl_Obj **resultPtrPtr);
-#endif
-#ifndef Tcl_ExprString_TCL_DECLARED
-#define Tcl_ExprString_TCL_DECLARED
 /* 142 */
-EXTERN int		Tcl_ExprString(Tcl_Interp *interp, CONST char *expr);
-#endif
-#ifndef Tcl_Finalize_TCL_DECLARED
-#define Tcl_Finalize_TCL_DECLARED
+EXTERN int		Tcl_ExprString(Tcl_Interp *interp, const char *expr);
 /* 143 */
 EXTERN void		Tcl_Finalize(void);
-#endif
-#ifndef Tcl_FindExecutable_TCL_DECLARED
-#define Tcl_FindExecutable_TCL_DECLARED
 /* 144 */
-EXTERN void		Tcl_FindExecutable(CONST char *argv0);
-#endif
-#ifndef Tcl_FirstHashEntry_TCL_DECLARED
-#define Tcl_FirstHashEntry_TCL_DECLARED
+EXTERN void		Tcl_FindExecutable(const char *argv0);
 /* 145 */
 EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
 				Tcl_HashSearch *searchPtr);
-#endif
-#ifndef Tcl_Flush_TCL_DECLARED
-#define Tcl_Flush_TCL_DECLARED
 /* 146 */
 EXTERN int		Tcl_Flush(Tcl_Channel chan);
-#endif
-#ifndef Tcl_FreeResult_TCL_DECLARED
-#define Tcl_FreeResult_TCL_DECLARED
 /* 147 */
 EXTERN void		Tcl_FreeResult(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetAlias_TCL_DECLARED
-#define Tcl_GetAlias_TCL_DECLARED
 /* 148 */
 EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
-				CONST char *slaveCmd,
+				const char *slaveCmd,
 				Tcl_Interp **targetInterpPtr,
 				CONST84 char **targetCmdPtr, int *argcPtr,
 				CONST84 char ***argvPtr);
-#endif
-#ifndef Tcl_GetAliasObj_TCL_DECLARED
-#define Tcl_GetAliasObj_TCL_DECLARED
 /* 149 */
 EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
-				CONST char *slaveCmd,
+				const char *slaveCmd,
 				Tcl_Interp **targetInterpPtr,
 				CONST84 char **targetCmdPtr, int *objcPtr,
 				Tcl_Obj ***objv);
-#endif
-#ifndef Tcl_GetAssocData_TCL_DECLARED
-#define Tcl_GetAssocData_TCL_DECLARED
 /* 150 */
 EXTERN ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
-				CONST char *name,
+				const char *name,
 				Tcl_InterpDeleteProc **procPtr);
-#endif
-#ifndef Tcl_GetChannel_TCL_DECLARED
-#define Tcl_GetChannel_TCL_DECLARED
 /* 151 */
 EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
-				CONST char *chanName, int *modePtr);
-#endif
-#ifndef Tcl_GetChannelBufferSize_TCL_DECLARED
-#define Tcl_GetChannelBufferSize_TCL_DECLARED
+				const char *chanName, int *modePtr);
 /* 152 */
 EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
-#endif
-#ifndef Tcl_GetChannelHandle_TCL_DECLARED
-#define Tcl_GetChannelHandle_TCL_DECLARED
 /* 153 */
 EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
 				ClientData *handlePtr);
-#endif
-#ifndef Tcl_GetChannelInstanceData_TCL_DECLARED
-#define Tcl_GetChannelInstanceData_TCL_DECLARED
 /* 154 */
 EXTERN ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
-#endif
-#ifndef Tcl_GetChannelMode_TCL_DECLARED
-#define Tcl_GetChannelMode_TCL_DECLARED
 /* 155 */
 EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
-#endif
-#ifndef Tcl_GetChannelName_TCL_DECLARED
-#define Tcl_GetChannelName_TCL_DECLARED
 /* 156 */
 EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
-#endif
-#ifndef Tcl_GetChannelOption_TCL_DECLARED
-#define Tcl_GetChannelOption_TCL_DECLARED
 /* 157 */
 EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
-				Tcl_Channel chan, CONST char *optionName,
+				Tcl_Channel chan, const char *optionName,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_GetChannelType_TCL_DECLARED
-#define Tcl_GetChannelType_TCL_DECLARED
 /* 158 */
-EXTERN Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
-#endif
-#ifndef Tcl_GetCommandInfo_TCL_DECLARED
-#define Tcl_GetCommandInfo_TCL_DECLARED
+EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
 /* 159 */
 EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
-				CONST char *cmdName, Tcl_CmdInfo *infoPtr);
-#endif
-#ifndef Tcl_GetCommandName_TCL_DECLARED
-#define Tcl_GetCommandName_TCL_DECLARED
+				const char *cmdName, Tcl_CmdInfo *infoPtr);
 /* 160 */
 EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
 				Tcl_Command command);
-#endif
-#ifndef Tcl_GetErrno_TCL_DECLARED
-#define Tcl_GetErrno_TCL_DECLARED
 /* 161 */
 EXTERN int		Tcl_GetErrno(void);
-#endif
-#ifndef Tcl_GetHostName_TCL_DECLARED
-#define Tcl_GetHostName_TCL_DECLARED
 /* 162 */
 EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
-#endif
-#ifndef Tcl_GetInterpPath_TCL_DECLARED
-#define Tcl_GetInterpPath_TCL_DECLARED
 /* 163 */
 EXTERN int		Tcl_GetInterpPath(Tcl_Interp *askInterp,
 				Tcl_Interp *slaveInterp);
-#endif
-#ifndef Tcl_GetMaster_TCL_DECLARED
-#define Tcl_GetMaster_TCL_DECLARED
 /* 164 */
 EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetNameOfExecutable_TCL_DECLARED
-#define Tcl_GetNameOfExecutable_TCL_DECLARED
 /* 165 */
-EXTERN CONST char *	Tcl_GetNameOfExecutable(void);
-#endif
-#ifndef Tcl_GetObjResult_TCL_DECLARED
-#define Tcl_GetObjResult_TCL_DECLARED
+EXTERN const char *	Tcl_GetNameOfExecutable(void);
 /* 166 */
 EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
-#endif
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef Tcl_GetOpenFile_TCL_DECLARED
-#define Tcl_GetOpenFile_TCL_DECLARED
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 167 */
 EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
-				CONST char *chanID, int forWriting,
+				const char *chanID, int forWriting,
 				int checkUsage, ClientData *filePtr);
-#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_GetOpenFile_TCL_DECLARED
-#define Tcl_GetOpenFile_TCL_DECLARED
 /* 167 */
 EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
-				CONST char *chanID, int forWriting,
+				const char *chanID, int forWriting,
 				int checkUsage, ClientData *filePtr);
-#endif
 #endif /* MACOSX */
-#ifndef Tcl_GetPathType_TCL_DECLARED
-#define Tcl_GetPathType_TCL_DECLARED
 /* 168 */
-EXTERN Tcl_PathType	Tcl_GetPathType(CONST char *path);
-#endif
-#ifndef Tcl_Gets_TCL_DECLARED
-#define Tcl_Gets_TCL_DECLARED
+EXTERN Tcl_PathType	Tcl_GetPathType(const char *path);
 /* 169 */
 EXTERN int		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_GetsObj_TCL_DECLARED
-#define Tcl_GetsObj_TCL_DECLARED
 /* 170 */
 EXTERN int		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetServiceMode_TCL_DECLARED
-#define Tcl_GetServiceMode_TCL_DECLARED
 /* 171 */
 EXTERN int		Tcl_GetServiceMode(void);
-#endif
-#ifndef Tcl_GetSlave_TCL_DECLARED
-#define Tcl_GetSlave_TCL_DECLARED
 /* 172 */
 EXTERN Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
-				CONST char *slaveName);
-#endif
-#ifndef Tcl_GetStdChannel_TCL_DECLARED
-#define Tcl_GetStdChannel_TCL_DECLARED
+				const char *slaveName);
 /* 173 */
 EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
-#endif
-#ifndef Tcl_GetStringResult_TCL_DECLARED
-#define Tcl_GetStringResult_TCL_DECLARED
 /* 174 */
 EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetVar_TCL_DECLARED
-#define Tcl_GetVar_TCL_DECLARED
 /* 175 */
 EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
-				CONST char *varName, int flags);
-#endif
-#ifndef Tcl_GetVar2_TCL_DECLARED
-#define Tcl_GetVar2_TCL_DECLARED
+				const char *varName, int flags);
 /* 176 */
 EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
+				const char *part1, const char *part2,
 				int flags);
-#endif
-#ifndef Tcl_GlobalEval_TCL_DECLARED
-#define Tcl_GlobalEval_TCL_DECLARED
 /* 177 */
 EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
-				CONST char *command);
-#endif
-#ifndef Tcl_GlobalEvalObj_TCL_DECLARED
-#define Tcl_GlobalEvalObj_TCL_DECLARED
+				const char *command);
 /* 178 */
 EXTERN int		Tcl_GlobalEvalObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_HideCommand_TCL_DECLARED
-#define Tcl_HideCommand_TCL_DECLARED
 /* 179 */
 EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
-				CONST char *cmdName,
-				CONST char *hiddenCmdToken);
-#endif
-#ifndef Tcl_Init_TCL_DECLARED
-#define Tcl_Init_TCL_DECLARED
+				const char *cmdName,
+				const char *hiddenCmdToken);
 /* 180 */
 EXTERN int		Tcl_Init(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_InitHashTable_TCL_DECLARED
-#define Tcl_InitHashTable_TCL_DECLARED
 /* 181 */
 EXTERN void		Tcl_InitHashTable(Tcl_HashTable *tablePtr,
 				int keyType);
-#endif
-#ifndef Tcl_InputBlocked_TCL_DECLARED
-#define Tcl_InputBlocked_TCL_DECLARED
 /* 182 */
 EXTERN int		Tcl_InputBlocked(Tcl_Channel chan);
-#endif
-#ifndef Tcl_InputBuffered_TCL_DECLARED
-#define Tcl_InputBuffered_TCL_DECLARED
 /* 183 */
 EXTERN int		Tcl_InputBuffered(Tcl_Channel chan);
-#endif
-#ifndef Tcl_InterpDeleted_TCL_DECLARED
-#define Tcl_InterpDeleted_TCL_DECLARED
 /* 184 */
 EXTERN int		Tcl_InterpDeleted(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_IsSafe_TCL_DECLARED
-#define Tcl_IsSafe_TCL_DECLARED
 /* 185 */
 EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_JoinPath_TCL_DECLARED
-#define Tcl_JoinPath_TCL_DECLARED
 /* 186 */
-EXTERN char *		Tcl_JoinPath(int argc, CONST84 char *CONST *argv,
+EXTERN char *		Tcl_JoinPath(int argc, CONST84 char *const *argv,
 				Tcl_DString *resultPtr);
-#endif
-#ifndef Tcl_LinkVar_TCL_DECLARED
-#define Tcl_LinkVar_TCL_DECLARED
 /* 187 */
-EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName,
+EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
 				char *addr, int type);
-#endif
 /* Slot 188 is reserved */
-#ifndef Tcl_MakeFileChannel_TCL_DECLARED
-#define Tcl_MakeFileChannel_TCL_DECLARED
 /* 189 */
 EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
-#endif
-#ifndef Tcl_MakeSafe_TCL_DECLARED
-#define Tcl_MakeSafe_TCL_DECLARED
 /* 190 */
 EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_MakeTcpClientChannel_TCL_DECLARED
-#define Tcl_MakeTcpClientChannel_TCL_DECLARED
 /* 191 */
 EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
-#endif
-#ifndef Tcl_Merge_TCL_DECLARED
-#define Tcl_Merge_TCL_DECLARED
 /* 192 */
-EXTERN char *		Tcl_Merge(int argc, CONST84 char *CONST *argv);
-#endif
-#ifndef Tcl_NextHashEntry_TCL_DECLARED
-#define Tcl_NextHashEntry_TCL_DECLARED
+EXTERN char *		Tcl_Merge(int argc, CONST84 char *const *argv);
 /* 193 */
 EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
-#endif
-#ifndef Tcl_NotifyChannel_TCL_DECLARED
-#define Tcl_NotifyChannel_TCL_DECLARED
 /* 194 */
 EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
-#endif
-#ifndef Tcl_ObjGetVar2_TCL_DECLARED
-#define Tcl_ObjGetVar2_TCL_DECLARED
 /* 195 */
 EXTERN Tcl_Obj *	Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 				Tcl_Obj *part2Ptr, int flags);
-#endif
-#ifndef Tcl_ObjSetVar2_TCL_DECLARED
-#define Tcl_ObjSetVar2_TCL_DECLARED
 /* 196 */
 EXTERN Tcl_Obj *	Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 				Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
 				int flags);
-#endif
-#ifndef Tcl_OpenCommandChannel_TCL_DECLARED
-#define Tcl_OpenCommandChannel_TCL_DECLARED
 /* 197 */
 EXTERN Tcl_Channel	Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
 				CONST84 char **argv, int flags);
-#endif
-#ifndef Tcl_OpenFileChannel_TCL_DECLARED
-#define Tcl_OpenFileChannel_TCL_DECLARED
 /* 198 */
 EXTERN Tcl_Channel	Tcl_OpenFileChannel(Tcl_Interp *interp,
-				CONST char *fileName, CONST char *modeString,
+				const char *fileName, const char *modeString,
 				int permissions);
-#endif
-#ifndef Tcl_OpenTcpClient_TCL_DECLARED
-#define Tcl_OpenTcpClient_TCL_DECLARED
 /* 199 */
 EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
-				CONST char *address, CONST char *myaddr,
+				const char *address, const char *myaddr,
 				int myport, int async);
-#endif
-#ifndef Tcl_OpenTcpServer_TCL_DECLARED
-#define Tcl_OpenTcpServer_TCL_DECLARED
 /* 200 */
 EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
-				CONST char *host,
+				const char *host,
 				Tcl_TcpAcceptProc *acceptProc,
 				ClientData callbackData);
-#endif
-#ifndef Tcl_Preserve_TCL_DECLARED
-#define Tcl_Preserve_TCL_DECLARED
 /* 201 */
 EXTERN void		Tcl_Preserve(ClientData data);
-#endif
-#ifndef Tcl_PrintDouble_TCL_DECLARED
-#define Tcl_PrintDouble_TCL_DECLARED
 /* 202 */
 EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
 				char *dst);
-#endif
-#ifndef Tcl_PutEnv_TCL_DECLARED
-#define Tcl_PutEnv_TCL_DECLARED
 /* 203 */
-EXTERN int		Tcl_PutEnv(CONST char *assignment);
-#endif
-#ifndef Tcl_PosixError_TCL_DECLARED
-#define Tcl_PosixError_TCL_DECLARED
+EXTERN int		Tcl_PutEnv(const char *assignment);
 /* 204 */
 EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_QueueEvent_TCL_DECLARED
-#define Tcl_QueueEvent_TCL_DECLARED
 /* 205 */
 EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
 				Tcl_QueuePosition position);
-#endif
-#ifndef Tcl_Read_TCL_DECLARED
-#define Tcl_Read_TCL_DECLARED
 /* 206 */
 EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
-#endif
-#ifndef Tcl_ReapDetachedProcs_TCL_DECLARED
-#define Tcl_ReapDetachedProcs_TCL_DECLARED
 /* 207 */
 EXTERN void		Tcl_ReapDetachedProcs(void);
-#endif
-#ifndef Tcl_RecordAndEval_TCL_DECLARED
-#define Tcl_RecordAndEval_TCL_DECLARED
 /* 208 */
 EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
-				CONST char *cmd, int flags);
-#endif
-#ifndef Tcl_RecordAndEvalObj_TCL_DECLARED
-#define Tcl_RecordAndEvalObj_TCL_DECLARED
+				const char *cmd, int flags);
 /* 209 */
 EXTERN int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,
 				Tcl_Obj *cmdPtr, int flags);
-#endif
-#ifndef Tcl_RegisterChannel_TCL_DECLARED
-#define Tcl_RegisterChannel_TCL_DECLARED
 /* 210 */
 EXTERN void		Tcl_RegisterChannel(Tcl_Interp *interp,
 				Tcl_Channel chan);
-#endif
-#ifndef Tcl_RegisterObjType_TCL_DECLARED
-#define Tcl_RegisterObjType_TCL_DECLARED
 /* 211 */
-EXTERN void		Tcl_RegisterObjType(Tcl_ObjType *typePtr);
-#endif
-#ifndef Tcl_RegExpCompile_TCL_DECLARED
-#define Tcl_RegExpCompile_TCL_DECLARED
+EXTERN void		Tcl_RegisterObjType(const Tcl_ObjType *typePtr);
 /* 212 */
 EXTERN Tcl_RegExp	Tcl_RegExpCompile(Tcl_Interp *interp,
-				CONST char *pattern);
-#endif
-#ifndef Tcl_RegExpExec_TCL_DECLARED
-#define Tcl_RegExpExec_TCL_DECLARED
+				const char *pattern);
 /* 213 */
 EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
-				CONST char *text, CONST char *start);
-#endif
-#ifndef Tcl_RegExpMatch_TCL_DECLARED
-#define Tcl_RegExpMatch_TCL_DECLARED
+				const char *text, const char *start);
 /* 214 */
-EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *text,
-				CONST char *pattern);
-#endif
-#ifndef Tcl_RegExpRange_TCL_DECLARED
-#define Tcl_RegExpRange_TCL_DECLARED
+EXTERN int		Tcl_RegExpMatch(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);
-#endif
-#ifndef Tcl_Release_TCL_DECLARED
-#define Tcl_Release_TCL_DECLARED
 /* 216 */
 EXTERN void		Tcl_Release(ClientData clientData);
-#endif
-#ifndef Tcl_ResetResult_TCL_DECLARED
-#define Tcl_ResetResult_TCL_DECLARED
 /* 217 */
 EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_ScanElement_TCL_DECLARED
-#define Tcl_ScanElement_TCL_DECLARED
 /* 218 */
-EXTERN int		Tcl_ScanElement(CONST char *src, int *flagPtr);
-#endif
-#ifndef Tcl_ScanCountedElement_TCL_DECLARED
-#define Tcl_ScanCountedElement_TCL_DECLARED
+EXTERN int		Tcl_ScanElement(const char *src, int *flagPtr);
 /* 219 */
-EXTERN int		Tcl_ScanCountedElement(CONST char *src, int length,
+EXTERN int		Tcl_ScanCountedElement(const char *src, int length,
 				int *flagPtr);
-#endif
-#ifndef Tcl_SeekOld_TCL_DECLARED
-#define Tcl_SeekOld_TCL_DECLARED
 /* 220 */
 EXTERN int		Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
-#endif
-#ifndef Tcl_ServiceAll_TCL_DECLARED
-#define Tcl_ServiceAll_TCL_DECLARED
 /* 221 */
 EXTERN int		Tcl_ServiceAll(void);
-#endif
-#ifndef Tcl_ServiceEvent_TCL_DECLARED
-#define Tcl_ServiceEvent_TCL_DECLARED
 /* 222 */
 EXTERN int		Tcl_ServiceEvent(int flags);
-#endif
-#ifndef Tcl_SetAssocData_TCL_DECLARED
-#define Tcl_SetAssocData_TCL_DECLARED
 /* 223 */
 EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
-				CONST char *name, Tcl_InterpDeleteProc *proc,
+				const char *name, Tcl_InterpDeleteProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_SetChannelBufferSize_TCL_DECLARED
-#define Tcl_SetChannelBufferSize_TCL_DECLARED
 /* 224 */
 EXTERN void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
-#endif
-#ifndef Tcl_SetChannelOption_TCL_DECLARED
-#define Tcl_SetChannelOption_TCL_DECLARED
 /* 225 */
 EXTERN int		Tcl_SetChannelOption(Tcl_Interp *interp,
-				Tcl_Channel chan, CONST char *optionName,
-				CONST char *newValue);
-#endif
-#ifndef Tcl_SetCommandInfo_TCL_DECLARED
-#define Tcl_SetCommandInfo_TCL_DECLARED
+				Tcl_Channel chan, const char *optionName,
+				const char *newValue);
 /* 226 */
 EXTERN int		Tcl_SetCommandInfo(Tcl_Interp *interp,
-				CONST char *cmdName,
-				CONST Tcl_CmdInfo *infoPtr);
-#endif
-#ifndef Tcl_SetErrno_TCL_DECLARED
-#define Tcl_SetErrno_TCL_DECLARED
+				const char *cmdName,
+				const Tcl_CmdInfo *infoPtr);
 /* 227 */
 EXTERN void		Tcl_SetErrno(int err);
-#endif
-#ifndef Tcl_SetErrorCode_TCL_DECLARED
-#define Tcl_SetErrorCode_TCL_DECLARED
 /* 228 */
 EXTERN void		Tcl_SetErrorCode(Tcl_Interp *interp, ...);
-#endif
-#ifndef Tcl_SetMaxBlockTime_TCL_DECLARED
-#define Tcl_SetMaxBlockTime_TCL_DECLARED
 /* 229 */
-EXTERN void		Tcl_SetMaxBlockTime(Tcl_Time *timePtr);
-#endif
-#ifndef Tcl_SetPanicProc_TCL_DECLARED
-#define Tcl_SetPanicProc_TCL_DECLARED
+EXTERN void		Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
 /* 230 */
-EXTERN void		Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
-#endif
-#ifndef Tcl_SetRecursionLimit_TCL_DECLARED
-#define Tcl_SetRecursionLimit_TCL_DECLARED
+EXTERN void		Tcl_SetPanicProc(
+				TCL_NORETURN1 Tcl_PanicProc *panicProc);
 /* 231 */
 EXTERN int		Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
-#endif
-#ifndef Tcl_SetResult_TCL_DECLARED
-#define Tcl_SetResult_TCL_DECLARED
 /* 232 */
 EXTERN void		Tcl_SetResult(Tcl_Interp *interp, char *result,
 				Tcl_FreeProc *freeProc);
-#endif
-#ifndef Tcl_SetServiceMode_TCL_DECLARED
-#define Tcl_SetServiceMode_TCL_DECLARED
 /* 233 */
 EXTERN int		Tcl_SetServiceMode(int mode);
-#endif
-#ifndef Tcl_SetObjErrorCode_TCL_DECLARED
-#define Tcl_SetObjErrorCode_TCL_DECLARED
 /* 234 */
 EXTERN void		Tcl_SetObjErrorCode(Tcl_Interp *interp,
 				Tcl_Obj *errorObjPtr);
-#endif
-#ifndef Tcl_SetObjResult_TCL_DECLARED
-#define Tcl_SetObjResult_TCL_DECLARED
 /* 235 */
 EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
 				Tcl_Obj *resultObjPtr);
-#endif
-#ifndef Tcl_SetStdChannel_TCL_DECLARED
-#define Tcl_SetStdChannel_TCL_DECLARED
 /* 236 */
 EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
-#endif
-#ifndef Tcl_SetVar_TCL_DECLARED
-#define Tcl_SetVar_TCL_DECLARED
 /* 237 */
 EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
-				CONST char *varName, CONST char *newValue,
+				const char *varName, const char *newValue,
 				int flags);
-#endif
-#ifndef Tcl_SetVar2_TCL_DECLARED
-#define Tcl_SetVar2_TCL_DECLARED
 /* 238 */
 EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
-				CONST char *newValue, int flags);
-#endif
-#ifndef Tcl_SignalId_TCL_DECLARED
-#define Tcl_SignalId_TCL_DECLARED
+				const char *part1, const char *part2,
+				const char *newValue, int flags);
 /* 239 */
 EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
-#endif
-#ifndef Tcl_SignalMsg_TCL_DECLARED
-#define Tcl_SignalMsg_TCL_DECLARED
 /* 240 */
 EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
-#endif
-#ifndef Tcl_SourceRCFile_TCL_DECLARED
-#define Tcl_SourceRCFile_TCL_DECLARED
 /* 241 */
 EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_SplitList_TCL_DECLARED
-#define Tcl_SplitList_TCL_DECLARED
 /* 242 */
 EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
-				CONST char *listStr, int *argcPtr,
+				const char *listStr, int *argcPtr,
 				CONST84 char ***argvPtr);
-#endif
-#ifndef Tcl_SplitPath_TCL_DECLARED
-#define Tcl_SplitPath_TCL_DECLARED
 /* 243 */
-EXTERN void		Tcl_SplitPath(CONST char *path, int *argcPtr,
+EXTERN void		Tcl_SplitPath(const char *path, int *argcPtr,
 				CONST84 char ***argvPtr);
-#endif
-#ifndef Tcl_StaticPackage_TCL_DECLARED
-#define Tcl_StaticPackage_TCL_DECLARED
 /* 244 */
 EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
-				CONST char *pkgName,
+				const char *pkgName,
 				Tcl_PackageInitProc *initProc,
 				Tcl_PackageInitProc *safeInitProc);
-#endif
-#ifndef Tcl_StringMatch_TCL_DECLARED
-#define Tcl_StringMatch_TCL_DECLARED
 /* 245 */
-EXTERN int		Tcl_StringMatch(CONST char *str, CONST char *pattern);
-#endif
-#ifndef Tcl_TellOld_TCL_DECLARED
-#define Tcl_TellOld_TCL_DECLARED
+EXTERN int		Tcl_StringMatch(const char *str, const char *pattern);
 /* 246 */
 EXTERN int		Tcl_TellOld(Tcl_Channel chan);
-#endif
-#ifndef Tcl_TraceVar_TCL_DECLARED
-#define Tcl_TraceVar_TCL_DECLARED
 /* 247 */
-EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, CONST char *varName,
+EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
 				int flags, Tcl_VarTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_TraceVar2_TCL_DECLARED
-#define Tcl_TraceVar2_TCL_DECLARED
 /* 248 */
-EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, CONST char *part1,
-				CONST char *part2, int flags,
+EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
+				const char *part2, int flags,
 				Tcl_VarTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_TranslateFileName_TCL_DECLARED
-#define Tcl_TranslateFileName_TCL_DECLARED
 /* 249 */
 EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
-				CONST char *name, Tcl_DString *bufferPtr);
-#endif
-#ifndef Tcl_Ungets_TCL_DECLARED
-#define Tcl_Ungets_TCL_DECLARED
+				const char *name, Tcl_DString *bufferPtr);
 /* 250 */
-EXTERN int		Tcl_Ungets(Tcl_Channel chan, CONST char *str,
+EXTERN int		Tcl_Ungets(Tcl_Channel chan, const char *str,
 				int len, int atHead);
-#endif
-#ifndef Tcl_UnlinkVar_TCL_DECLARED
-#define Tcl_UnlinkVar_TCL_DECLARED
 /* 251 */
 EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
-				CONST char *varName);
-#endif
-#ifndef Tcl_UnregisterChannel_TCL_DECLARED
-#define Tcl_UnregisterChannel_TCL_DECLARED
+				const char *varName);
 /* 252 */
 EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
 				Tcl_Channel chan);
-#endif
-#ifndef Tcl_UnsetVar_TCL_DECLARED
-#define Tcl_UnsetVar_TCL_DECLARED
 /* 253 */
-EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName,
+EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
 				int flags);
-#endif
-#ifndef Tcl_UnsetVar2_TCL_DECLARED
-#define Tcl_UnsetVar2_TCL_DECLARED
 /* 254 */
-EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1,
-				CONST char *part2, int flags);
-#endif
-#ifndef Tcl_UntraceVar_TCL_DECLARED
-#define Tcl_UntraceVar_TCL_DECLARED
+EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
+				const char *part2, int flags);
 /* 255 */
 EXTERN void		Tcl_UntraceVar(Tcl_Interp *interp,
-				CONST char *varName, int flags,
+				const char *varName, int flags,
 				Tcl_VarTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_UntraceVar2_TCL_DECLARED
-#define Tcl_UntraceVar2_TCL_DECLARED
 /* 256 */
 EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
+				const char *part1, const char *part2,
 				int flags, Tcl_VarTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_UpdateLinkedVar_TCL_DECLARED
-#define Tcl_UpdateLinkedVar_TCL_DECLARED
 /* 257 */
 EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
-				CONST char *varName);
-#endif
-#ifndef Tcl_UpVar_TCL_DECLARED
-#define Tcl_UpVar_TCL_DECLARED
+				const char *varName);
 /* 258 */
-EXTERN int		Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName,
-				CONST char *varName, CONST char *localName,
+EXTERN int		Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
+				const char *varName, const char *localName,
 				int flags);
-#endif
-#ifndef Tcl_UpVar2_TCL_DECLARED
-#define Tcl_UpVar2_TCL_DECLARED
 /* 259 */
-EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName,
-				CONST char *part1, CONST char *part2,
-				CONST char *localName, int flags);
-#endif
-#ifndef Tcl_VarEval_TCL_DECLARED
-#define Tcl_VarEval_TCL_DECLARED
+EXTERN int		Tcl_UpVar2(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, ...);
-#endif
-#ifndef Tcl_VarTraceInfo_TCL_DECLARED
-#define Tcl_VarTraceInfo_TCL_DECLARED
 /* 261 */
 EXTERN ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
-				CONST char *varName, int flags,
+				const char *varName, int flags,
 				Tcl_VarTraceProc *procPtr,
 				ClientData prevClientData);
-#endif
-#ifndef Tcl_VarTraceInfo2_TCL_DECLARED
-#define Tcl_VarTraceInfo2_TCL_DECLARED
 /* 262 */
 EXTERN ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
-				CONST char *part1, CONST char *part2,
+				const char *part1, const char *part2,
 				int flags, Tcl_VarTraceProc *procPtr,
 				ClientData prevClientData);
-#endif
-#ifndef Tcl_Write_TCL_DECLARED
-#define Tcl_Write_TCL_DECLARED
 /* 263 */
-EXTERN int		Tcl_Write(Tcl_Channel chan, CONST char *s, int slen);
-#endif
-#ifndef Tcl_WrongNumArgs_TCL_DECLARED
-#define Tcl_WrongNumArgs_TCL_DECLARED
+EXTERN int		Tcl_Write(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);
-#endif
-#ifndef Tcl_DumpActiveMemory_TCL_DECLARED
-#define Tcl_DumpActiveMemory_TCL_DECLARED
+				Tcl_Obj *const objv[], const char *message);
 /* 265 */
-EXTERN int		Tcl_DumpActiveMemory(CONST char *fileName);
-#endif
-#ifndef Tcl_ValidateAllMemory_TCL_DECLARED
-#define Tcl_ValidateAllMemory_TCL_DECLARED
+EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
 /* 266 */
-EXTERN void		Tcl_ValidateAllMemory(CONST char *file, int line);
-#endif
-#ifndef Tcl_AppendResultVA_TCL_DECLARED
-#define Tcl_AppendResultVA_TCL_DECLARED
+EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
 /* 267 */
 EXTERN void		Tcl_AppendResultVA(Tcl_Interp *interp,
 				va_list argList);
-#endif
-#ifndef Tcl_AppendStringsToObjVA_TCL_DECLARED
-#define Tcl_AppendStringsToObjVA_TCL_DECLARED
 /* 268 */
 EXTERN void		Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
 				va_list argList);
-#endif
-#ifndef Tcl_HashStats_TCL_DECLARED
-#define Tcl_HashStats_TCL_DECLARED
 /* 269 */
 EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
-#endif
-#ifndef Tcl_ParseVar_TCL_DECLARED
-#define Tcl_ParseVar_TCL_DECLARED
 /* 270 */
 EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
-				CONST char *start, CONST84 char **termPtr);
-#endif
-#ifndef Tcl_PkgPresent_TCL_DECLARED
-#define Tcl_PkgPresent_TCL_DECLARED
+				const char *start, CONST84 char **termPtr);
 /* 271 */
 EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
-				CONST char *name, CONST char *version,
+				const char *name, const char *version,
 				int exact);
-#endif
-#ifndef Tcl_PkgPresentEx_TCL_DECLARED
-#define Tcl_PkgPresentEx_TCL_DECLARED
 /* 272 */
 EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
-				CONST char *name, CONST char *version,
-				int exact, ClientData *clientDataPtr);
-#endif
-#ifndef Tcl_PkgProvide_TCL_DECLARED
-#define Tcl_PkgProvide_TCL_DECLARED
+				const char *name, const char *version,
+				int exact, void *clientDataPtr);
 /* 273 */
-EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name,
-				CONST char *version);
-#endif
-#ifndef Tcl_PkgRequire_TCL_DECLARED
-#define Tcl_PkgRequire_TCL_DECLARED
+EXTERN int		Tcl_PkgProvide(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,
+				const char *name, const char *version,
 				int exact);
-#endif
-#ifndef Tcl_SetErrorCodeVA_TCL_DECLARED
-#define Tcl_SetErrorCodeVA_TCL_DECLARED
 /* 275 */
 EXTERN void		Tcl_SetErrorCodeVA(Tcl_Interp *interp,
 				va_list argList);
-#endif
-#ifndef Tcl_VarEvalVA_TCL_DECLARED
-#define Tcl_VarEvalVA_TCL_DECLARED
 /* 276 */
 EXTERN int		Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
-#endif
-#ifndef Tcl_WaitPid_TCL_DECLARED
-#define Tcl_WaitPid_TCL_DECLARED
 /* 277 */
 EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
-#endif
-#ifndef Tcl_PanicVA_TCL_DECLARED
-#define Tcl_PanicVA_TCL_DECLARED
 /* 278 */
-EXTERN void		Tcl_PanicVA(CONST char *format, va_list argList);
-#endif
-#ifndef Tcl_GetVersion_TCL_DECLARED
-#define Tcl_GetVersion_TCL_DECLARED
+EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
 /* 279 */
 EXTERN void		Tcl_GetVersion(int *major, int *minor,
 				int *patchLevel, int *type);
-#endif
-#ifndef Tcl_InitMemory_TCL_DECLARED
-#define Tcl_InitMemory_TCL_DECLARED
 /* 280 */
 EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_StackChannel_TCL_DECLARED
-#define Tcl_StackChannel_TCL_DECLARED
 /* 281 */
 EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
-				Tcl_ChannelType *typePtr,
+				const Tcl_ChannelType *typePtr,
 				ClientData instanceData, int mask,
 				Tcl_Channel prevChan);
-#endif
-#ifndef Tcl_UnstackChannel_TCL_DECLARED
-#define Tcl_UnstackChannel_TCL_DECLARED
 /* 282 */
 EXTERN int		Tcl_UnstackChannel(Tcl_Interp *interp,
 				Tcl_Channel chan);
-#endif
-#ifndef Tcl_GetStackedChannel_TCL_DECLARED
-#define Tcl_GetStackedChannel_TCL_DECLARED
 /* 283 */
 EXTERN Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
-#endif
-#ifndef Tcl_SetMainLoop_TCL_DECLARED
-#define Tcl_SetMainLoop_TCL_DECLARED
 /* 284 */
 EXTERN void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
-#endif
 /* Slot 285 is reserved */
-#ifndef Tcl_AppendObjToObj_TCL_DECLARED
-#define Tcl_AppendObjToObj_TCL_DECLARED
 /* 286 */
 EXTERN void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
 				Tcl_Obj *appendObjPtr);
-#endif
-#ifndef Tcl_CreateEncoding_TCL_DECLARED
-#define Tcl_CreateEncoding_TCL_DECLARED
 /* 287 */
-EXTERN Tcl_Encoding	Tcl_CreateEncoding(CONST Tcl_EncodingType *typePtr);
-#endif
-#ifndef Tcl_CreateThreadExitHandler_TCL_DECLARED
-#define Tcl_CreateThreadExitHandler_TCL_DECLARED
+EXTERN Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
 /* 288 */
 EXTERN void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DeleteThreadExitHandler_TCL_DECLARED
-#define Tcl_DeleteThreadExitHandler_TCL_DECLARED
 /* 289 */
 EXTERN void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_DiscardResult_TCL_DECLARED
-#define Tcl_DiscardResult_TCL_DECLARED
 /* 290 */
 EXTERN void		Tcl_DiscardResult(Tcl_SavedResult *statePtr);
-#endif
-#ifndef Tcl_EvalEx_TCL_DECLARED
-#define Tcl_EvalEx_TCL_DECLARED
 /* 291 */
-EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, CONST char *script,
+EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
 				int numBytes, int flags);
-#endif
-#ifndef Tcl_EvalObjv_TCL_DECLARED
-#define Tcl_EvalObjv_TCL_DECLARED
 /* 292 */
 EXTERN int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[], int flags);
-#endif
-#ifndef Tcl_EvalObjEx_TCL_DECLARED
-#define Tcl_EvalObjEx_TCL_DECLARED
+				Tcl_Obj *const objv[], int flags);
 /* 293 */
 EXTERN int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
 				int flags);
-#endif
-#ifndef Tcl_ExitThread_TCL_DECLARED
-#define Tcl_ExitThread_TCL_DECLARED
 /* 294 */
 EXTERN void		Tcl_ExitThread(int status);
-#endif
-#ifndef Tcl_ExternalToUtf_TCL_DECLARED
-#define Tcl_ExternalToUtf_TCL_DECLARED
 /* 295 */
 EXTERN int		Tcl_ExternalToUtf(Tcl_Interp *interp,
-				Tcl_Encoding encoding, CONST char *src,
+				Tcl_Encoding encoding, const char *src,
 				int srcLen, int flags,
 				Tcl_EncodingState *statePtr, char *dst,
 				int dstLen, int *srcReadPtr,
 				int *dstWrotePtr, int *dstCharsPtr);
-#endif
-#ifndef Tcl_ExternalToUtfDString_TCL_DECLARED
-#define Tcl_ExternalToUtfDString_TCL_DECLARED
 /* 296 */
 EXTERN char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
-				CONST char *src, int srcLen,
+				const char *src, int srcLen,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_FinalizeThread_TCL_DECLARED
-#define Tcl_FinalizeThread_TCL_DECLARED
 /* 297 */
 EXTERN void		Tcl_FinalizeThread(void);
-#endif
-#ifndef Tcl_FinalizeNotifier_TCL_DECLARED
-#define Tcl_FinalizeNotifier_TCL_DECLARED
 /* 298 */
 EXTERN void		Tcl_FinalizeNotifier(ClientData clientData);
-#endif
-#ifndef Tcl_FreeEncoding_TCL_DECLARED
-#define Tcl_FreeEncoding_TCL_DECLARED
 /* 299 */
 EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
-#endif
-#ifndef Tcl_GetCurrentThread_TCL_DECLARED
-#define Tcl_GetCurrentThread_TCL_DECLARED
 /* 300 */
 EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
-#endif
-#ifndef Tcl_GetEncoding_TCL_DECLARED
-#define Tcl_GetEncoding_TCL_DECLARED
 /* 301 */
-EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name);
-#endif
-#ifndef Tcl_GetEncodingName_TCL_DECLARED
-#define Tcl_GetEncodingName_TCL_DECLARED
+EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
 /* 302 */
 EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
-#endif
-#ifndef Tcl_GetEncodingNames_TCL_DECLARED
-#define Tcl_GetEncodingNames_TCL_DECLARED
 /* 303 */
 EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetIndexFromObjStruct_TCL_DECLARED
-#define Tcl_GetIndexFromObjStruct_TCL_DECLARED
 /* 304 */
 EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, CONST VOID *tablePtr,
-				int offset, CONST char *msg, int flags,
+				Tcl_Obj *objPtr, const void *tablePtr,
+				int offset, const char *msg, int flags,
 				int *indexPtr);
-#endif
-#ifndef Tcl_GetThreadData_TCL_DECLARED
-#define Tcl_GetThreadData_TCL_DECLARED
 /* 305 */
-EXTERN VOID *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
+EXTERN void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
 				int size);
-#endif
-#ifndef Tcl_GetVar2Ex_TCL_DECLARED
-#define Tcl_GetVar2Ex_TCL_DECLARED
 /* 306 */
-EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1,
-				CONST char *part2, int flags);
-#endif
-#ifndef Tcl_InitNotifier_TCL_DECLARED
-#define Tcl_InitNotifier_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
+				const char *part2, int flags);
 /* 307 */
 EXTERN ClientData	Tcl_InitNotifier(void);
-#endif
-#ifndef Tcl_MutexLock_TCL_DECLARED
-#define Tcl_MutexLock_TCL_DECLARED
 /* 308 */
 EXTERN void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
-#endif
-#ifndef Tcl_MutexUnlock_TCL_DECLARED
-#define Tcl_MutexUnlock_TCL_DECLARED
 /* 309 */
 EXTERN void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
-#endif
-#ifndef Tcl_ConditionNotify_TCL_DECLARED
-#define Tcl_ConditionNotify_TCL_DECLARED
 /* 310 */
 EXTERN void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
-#endif
-#ifndef Tcl_ConditionWait_TCL_DECLARED
-#define Tcl_ConditionWait_TCL_DECLARED
 /* 311 */
 EXTERN void		Tcl_ConditionWait(Tcl_Condition *condPtr,
-				Tcl_Mutex *mutexPtr, Tcl_Time *timePtr);
-#endif
-#ifndef Tcl_NumUtfChars_TCL_DECLARED
-#define Tcl_NumUtfChars_TCL_DECLARED
+				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
 /* 312 */
-EXTERN int		Tcl_NumUtfChars(CONST char *src, int length);
-#endif
-#ifndef Tcl_ReadChars_TCL_DECLARED
-#define Tcl_ReadChars_TCL_DECLARED
+EXTERN int		Tcl_NumUtfChars(const char *src, int length);
 /* 313 */
 EXTERN int		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
 				int charsToRead, int appendFlag);
-#endif
-#ifndef Tcl_RestoreResult_TCL_DECLARED
-#define Tcl_RestoreResult_TCL_DECLARED
 /* 314 */
 EXTERN void		Tcl_RestoreResult(Tcl_Interp *interp,
 				Tcl_SavedResult *statePtr);
-#endif
-#ifndef Tcl_SaveResult_TCL_DECLARED
-#define Tcl_SaveResult_TCL_DECLARED
 /* 315 */
 EXTERN void		Tcl_SaveResult(Tcl_Interp *interp,
 				Tcl_SavedResult *statePtr);
-#endif
-#ifndef Tcl_SetSystemEncoding_TCL_DECLARED
-#define Tcl_SetSystemEncoding_TCL_DECLARED
 /* 316 */
 EXTERN int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
-				CONST char *name);
-#endif
-#ifndef Tcl_SetVar2Ex_TCL_DECLARED
-#define Tcl_SetVar2Ex_TCL_DECLARED
+				const char *name);
 /* 317 */
-EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1,
-				CONST char *part2, Tcl_Obj *newValuePtr,
+EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
+				const char *part2, Tcl_Obj *newValuePtr,
 				int flags);
-#endif
-#ifndef Tcl_ThreadAlert_TCL_DECLARED
-#define Tcl_ThreadAlert_TCL_DECLARED
 /* 318 */
 EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
-#endif
-#ifndef Tcl_ThreadQueueEvent_TCL_DECLARED
-#define Tcl_ThreadQueueEvent_TCL_DECLARED
 /* 319 */
 EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
 				Tcl_Event *evPtr, Tcl_QueuePosition position);
-#endif
-#ifndef Tcl_UniCharAtIndex_TCL_DECLARED
-#define Tcl_UniCharAtIndex_TCL_DECLARED
 /* 320 */
-EXTERN Tcl_UniChar	Tcl_UniCharAtIndex(CONST char *src, int index);
-#endif
-#ifndef Tcl_UniCharToLower_TCL_DECLARED
-#define Tcl_UniCharToLower_TCL_DECLARED
+EXTERN Tcl_UniChar	Tcl_UniCharAtIndex(const char *src, int index);
 /* 321 */
 EXTERN Tcl_UniChar	Tcl_UniCharToLower(int ch);
-#endif
-#ifndef Tcl_UniCharToTitle_TCL_DECLARED
-#define Tcl_UniCharToTitle_TCL_DECLARED
 /* 322 */
 EXTERN Tcl_UniChar	Tcl_UniCharToTitle(int ch);
-#endif
-#ifndef Tcl_UniCharToUpper_TCL_DECLARED
-#define Tcl_UniCharToUpper_TCL_DECLARED
 /* 323 */
 EXTERN Tcl_UniChar	Tcl_UniCharToUpper(int ch);
-#endif
-#ifndef Tcl_UniCharToUtf_TCL_DECLARED
-#define Tcl_UniCharToUtf_TCL_DECLARED
 /* 324 */
 EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
-#endif
-#ifndef Tcl_UtfAtIndex_TCL_DECLARED
-#define Tcl_UtfAtIndex_TCL_DECLARED
 /* 325 */
-EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index);
-#endif
-#ifndef Tcl_UtfCharComplete_TCL_DECLARED
-#define Tcl_UtfCharComplete_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
 /* 326 */
-EXTERN int		Tcl_UtfCharComplete(CONST char *src, int length);
-#endif
-#ifndef Tcl_UtfBackslash_TCL_DECLARED
-#define Tcl_UtfBackslash_TCL_DECLARED
+EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
 /* 327 */
-EXTERN int		Tcl_UtfBackslash(CONST char *src, int *readPtr,
+EXTERN int		Tcl_UtfBackslash(const char *src, int *readPtr,
 				char *dst);
-#endif
-#ifndef Tcl_UtfFindFirst_TCL_DECLARED
-#define Tcl_UtfFindFirst_TCL_DECLARED
 /* 328 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch);
-#endif
-#ifndef Tcl_UtfFindLast_TCL_DECLARED
-#define Tcl_UtfFindLast_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
 /* 329 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch);
-#endif
-#ifndef Tcl_UtfNext_TCL_DECLARED
-#define Tcl_UtfNext_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
 /* 330 */
-EXTERN CONST84_RETURN char * Tcl_UtfNext(CONST char *src);
-#endif
-#ifndef Tcl_UtfPrev_TCL_DECLARED
-#define Tcl_UtfPrev_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
 /* 331 */
-EXTERN CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start);
-#endif
-#ifndef Tcl_UtfToExternal_TCL_DECLARED
-#define Tcl_UtfToExternal_TCL_DECLARED
+EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
 /* 332 */
 EXTERN int		Tcl_UtfToExternal(Tcl_Interp *interp,
-				Tcl_Encoding encoding, CONST char *src,
+				Tcl_Encoding encoding, const char *src,
 				int srcLen, int flags,
 				Tcl_EncodingState *statePtr, char *dst,
 				int dstLen, int *srcReadPtr,
 				int *dstWrotePtr, int *dstCharsPtr);
-#endif
-#ifndef Tcl_UtfToExternalDString_TCL_DECLARED
-#define Tcl_UtfToExternalDString_TCL_DECLARED
 /* 333 */
 EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
-				CONST char *src, int srcLen,
+				const char *src, int srcLen,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_UtfToLower_TCL_DECLARED
-#define Tcl_UtfToLower_TCL_DECLARED
 /* 334 */
 EXTERN int		Tcl_UtfToLower(char *src);
-#endif
-#ifndef Tcl_UtfToTitle_TCL_DECLARED
-#define Tcl_UtfToTitle_TCL_DECLARED
 /* 335 */
 EXTERN int		Tcl_UtfToTitle(char *src);
-#endif
-#ifndef Tcl_UtfToUniChar_TCL_DECLARED
-#define Tcl_UtfToUniChar_TCL_DECLARED
 /* 336 */
-EXTERN int		Tcl_UtfToUniChar(CONST char *src, Tcl_UniChar *chPtr);
-#endif
-#ifndef Tcl_UtfToUpper_TCL_DECLARED
-#define Tcl_UtfToUpper_TCL_DECLARED
+EXTERN int		Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr);
 /* 337 */
 EXTERN int		Tcl_UtfToUpper(char *src);
-#endif
-#ifndef Tcl_WriteChars_TCL_DECLARED
-#define Tcl_WriteChars_TCL_DECLARED
 /* 338 */
-EXTERN int		Tcl_WriteChars(Tcl_Channel chan, CONST char *src,
+EXTERN int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
 				int srcLen);
-#endif
-#ifndef Tcl_WriteObj_TCL_DECLARED
-#define Tcl_WriteObj_TCL_DECLARED
 /* 339 */
 EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetString_TCL_DECLARED
-#define Tcl_GetString_TCL_DECLARED
 /* 340 */
 EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetDefaultEncodingDir_TCL_DECLARED
-#define Tcl_GetDefaultEncodingDir_TCL_DECLARED
 /* 341 */
 EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
-#endif
-#ifndef Tcl_SetDefaultEncodingDir_TCL_DECLARED
-#define Tcl_SetDefaultEncodingDir_TCL_DECLARED
 /* 342 */
-EXTERN void		Tcl_SetDefaultEncodingDir(CONST char *path);
-#endif
-#ifndef Tcl_AlertNotifier_TCL_DECLARED
-#define Tcl_AlertNotifier_TCL_DECLARED
+EXTERN void		Tcl_SetDefaultEncodingDir(const char *path);
 /* 343 */
 EXTERN void		Tcl_AlertNotifier(ClientData clientData);
-#endif
-#ifndef Tcl_ServiceModeHook_TCL_DECLARED
-#define Tcl_ServiceModeHook_TCL_DECLARED
 /* 344 */
 EXTERN void		Tcl_ServiceModeHook(int mode);
-#endif
-#ifndef Tcl_UniCharIsAlnum_TCL_DECLARED
-#define Tcl_UniCharIsAlnum_TCL_DECLARED
 /* 345 */
 EXTERN int		Tcl_UniCharIsAlnum(int ch);
-#endif
-#ifndef Tcl_UniCharIsAlpha_TCL_DECLARED
-#define Tcl_UniCharIsAlpha_TCL_DECLARED
 /* 346 */
 EXTERN int		Tcl_UniCharIsAlpha(int ch);
-#endif
-#ifndef Tcl_UniCharIsDigit_TCL_DECLARED
-#define Tcl_UniCharIsDigit_TCL_DECLARED
 /* 347 */
 EXTERN int		Tcl_UniCharIsDigit(int ch);
-#endif
-#ifndef Tcl_UniCharIsLower_TCL_DECLARED
-#define Tcl_UniCharIsLower_TCL_DECLARED
 /* 348 */
 EXTERN int		Tcl_UniCharIsLower(int ch);
-#endif
-#ifndef Tcl_UniCharIsSpace_TCL_DECLARED
-#define Tcl_UniCharIsSpace_TCL_DECLARED
 /* 349 */
 EXTERN int		Tcl_UniCharIsSpace(int ch);
-#endif
-#ifndef Tcl_UniCharIsUpper_TCL_DECLARED
-#define Tcl_UniCharIsUpper_TCL_DECLARED
 /* 350 */
 EXTERN int		Tcl_UniCharIsUpper(int ch);
-#endif
-#ifndef Tcl_UniCharIsWordChar_TCL_DECLARED
-#define Tcl_UniCharIsWordChar_TCL_DECLARED
 /* 351 */
 EXTERN int		Tcl_UniCharIsWordChar(int ch);
-#endif
-#ifndef Tcl_UniCharLen_TCL_DECLARED
-#define Tcl_UniCharLen_TCL_DECLARED
 /* 352 */
-EXTERN int		Tcl_UniCharLen(CONST Tcl_UniChar *uniStr);
-#endif
-#ifndef Tcl_UniCharNcmp_TCL_DECLARED
-#define Tcl_UniCharNcmp_TCL_DECLARED
+EXTERN int		Tcl_UniCharLen(const Tcl_UniChar *uniStr);
 /* 353 */
-EXTERN int		Tcl_UniCharNcmp(CONST Tcl_UniChar *ucs,
-				CONST Tcl_UniChar *uct,
+EXTERN int		Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
+				const Tcl_UniChar *uct,
 				unsigned long numChars);
-#endif
-#ifndef Tcl_UniCharToUtfDString_TCL_DECLARED
-#define Tcl_UniCharToUtfDString_TCL_DECLARED
 /* 354 */
-EXTERN char *		Tcl_UniCharToUtfDString(CONST Tcl_UniChar *uniStr,
+EXTERN char *		Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
 				int uniLength, Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_UtfToUniCharDString_TCL_DECLARED
-#define Tcl_UtfToUniCharDString_TCL_DECLARED
 /* 355 */
-EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(CONST char *src, int length,
+EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src, int length,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_GetRegExpFromObj_TCL_DECLARED
-#define Tcl_GetRegExpFromObj_TCL_DECLARED
 /* 356 */
 EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
 				Tcl_Obj *patObj, int flags);
-#endif
-#ifndef Tcl_EvalTokens_TCL_DECLARED
-#define Tcl_EvalTokens_TCL_DECLARED
 /* 357 */
 EXTERN Tcl_Obj *	Tcl_EvalTokens(Tcl_Interp *interp,
 				Tcl_Token *tokenPtr, int count);
-#endif
-#ifndef Tcl_FreeParse_TCL_DECLARED
-#define Tcl_FreeParse_TCL_DECLARED
 /* 358 */
 EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
-#endif
-#ifndef Tcl_LogCommandInfo_TCL_DECLARED
-#define Tcl_LogCommandInfo_TCL_DECLARED
 /* 359 */
 EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
-				CONST char *script, CONST char *command,
+				const char *script, const char *command,
 				int length);
-#endif
-#ifndef Tcl_ParseBraces_TCL_DECLARED
-#define Tcl_ParseBraces_TCL_DECLARED
 /* 360 */
 EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
-				CONST char *start, int numBytes,
+				const char *start, int numBytes,
 				Tcl_Parse *parsePtr, int append,
 				CONST84 char **termPtr);
-#endif
-#ifndef Tcl_ParseCommand_TCL_DECLARED
-#define Tcl_ParseCommand_TCL_DECLARED
 /* 361 */
 EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
-				CONST char *start, int numBytes, int nested,
+				const char *start, int numBytes, int nested,
 				Tcl_Parse *parsePtr);
-#endif
-#ifndef Tcl_ParseExpr_TCL_DECLARED
-#define Tcl_ParseExpr_TCL_DECLARED
 /* 362 */
-EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, CONST char *start,
+EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
 				int numBytes, Tcl_Parse *parsePtr);
-#endif
-#ifndef Tcl_ParseQuotedString_TCL_DECLARED
-#define Tcl_ParseQuotedString_TCL_DECLARED
 /* 363 */
 EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
-				CONST char *start, int numBytes,
+				const char *start, int numBytes,
 				Tcl_Parse *parsePtr, int append,
 				CONST84 char **termPtr);
-#endif
-#ifndef Tcl_ParseVarName_TCL_DECLARED
-#define Tcl_ParseVarName_TCL_DECLARED
 /* 364 */
 EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
-				CONST char *start, int numBytes,
+				const char *start, int numBytes,
 				Tcl_Parse *parsePtr, int append);
-#endif
-#ifndef Tcl_GetCwd_TCL_DECLARED
-#define Tcl_GetCwd_TCL_DECLARED
 /* 365 */
 EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
-#endif
-#ifndef Tcl_Chdir_TCL_DECLARED
-#define Tcl_Chdir_TCL_DECLARED
 /* 366 */
-EXTERN int		Tcl_Chdir(CONST char *dirName);
-#endif
-#ifndef Tcl_Access_TCL_DECLARED
-#define Tcl_Access_TCL_DECLARED
+EXTERN int		Tcl_Chdir(const char *dirName);
 /* 367 */
-EXTERN int		Tcl_Access(CONST char *path, int mode);
-#endif
-#ifndef Tcl_Stat_TCL_DECLARED
-#define Tcl_Stat_TCL_DECLARED
+EXTERN int		Tcl_Access(const char *path, int mode);
 /* 368 */
-EXTERN int		Tcl_Stat(CONST char *path, struct stat *bufPtr);
-#endif
-#ifndef Tcl_UtfNcmp_TCL_DECLARED
-#define Tcl_UtfNcmp_TCL_DECLARED
+EXTERN int		Tcl_Stat(const char *path, struct stat *bufPtr);
 /* 369 */
-EXTERN int		Tcl_UtfNcmp(CONST char *s1, CONST char *s2,
+EXTERN int		Tcl_UtfNcmp(const char *s1, const char *s2,
 				unsigned long n);
-#endif
-#ifndef Tcl_UtfNcasecmp_TCL_DECLARED
-#define Tcl_UtfNcasecmp_TCL_DECLARED
 /* 370 */
-EXTERN int		Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2,
+EXTERN int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
 				unsigned long n);
-#endif
-#ifndef Tcl_StringCaseMatch_TCL_DECLARED
-#define Tcl_StringCaseMatch_TCL_DECLARED
 /* 371 */
-EXTERN int		Tcl_StringCaseMatch(CONST char *str,
-				CONST char *pattern, int nocase);
-#endif
-#ifndef Tcl_UniCharIsControl_TCL_DECLARED
-#define Tcl_UniCharIsControl_TCL_DECLARED
+EXTERN int		Tcl_StringCaseMatch(const char *str,
+				const char *pattern, int nocase);
 /* 372 */
 EXTERN int		Tcl_UniCharIsControl(int ch);
-#endif
-#ifndef Tcl_UniCharIsGraph_TCL_DECLARED
-#define Tcl_UniCharIsGraph_TCL_DECLARED
 /* 373 */
 EXTERN int		Tcl_UniCharIsGraph(int ch);
-#endif
-#ifndef Tcl_UniCharIsPrint_TCL_DECLARED
-#define Tcl_UniCharIsPrint_TCL_DECLARED
 /* 374 */
 EXTERN int		Tcl_UniCharIsPrint(int ch);
-#endif
-#ifndef Tcl_UniCharIsPunct_TCL_DECLARED
-#define Tcl_UniCharIsPunct_TCL_DECLARED
 /* 375 */
 EXTERN int		Tcl_UniCharIsPunct(int ch);
-#endif
-#ifndef Tcl_RegExpExecObj_TCL_DECLARED
-#define Tcl_RegExpExecObj_TCL_DECLARED
 /* 376 */
 EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
 				Tcl_RegExp regexp, Tcl_Obj *textObj,
 				int offset, int nmatches, int flags);
-#endif
-#ifndef Tcl_RegExpGetInfo_TCL_DECLARED
-#define Tcl_RegExpGetInfo_TCL_DECLARED
 /* 377 */
 EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
 				Tcl_RegExpInfo *infoPtr);
-#endif
-#ifndef Tcl_NewUnicodeObj_TCL_DECLARED
-#define Tcl_NewUnicodeObj_TCL_DECLARED
 /* 378 */
-EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(CONST Tcl_UniChar *unicode,
+EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
 				int numChars);
-#endif
-#ifndef Tcl_SetUnicodeObj_TCL_DECLARED
-#define Tcl_SetUnicodeObj_TCL_DECLARED
 /* 379 */
 EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
-				CONST Tcl_UniChar *unicode, int numChars);
-#endif
-#ifndef Tcl_GetCharLength_TCL_DECLARED
-#define Tcl_GetCharLength_TCL_DECLARED
+				const Tcl_UniChar *unicode, int numChars);
 /* 380 */
 EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetUniChar_TCL_DECLARED
-#define Tcl_GetUniChar_TCL_DECLARED
 /* 381 */
 EXTERN Tcl_UniChar	Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
-#endif
-#ifndef Tcl_GetUnicode_TCL_DECLARED
-#define Tcl_GetUnicode_TCL_DECLARED
 /* 382 */
 EXTERN Tcl_UniChar *	Tcl_GetUnicode(Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetRange_TCL_DECLARED
-#define Tcl_GetRange_TCL_DECLARED
 /* 383 */
 EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
-#endif
-#ifndef Tcl_AppendUnicodeToObj_TCL_DECLARED
-#define Tcl_AppendUnicodeToObj_TCL_DECLARED
 /* 384 */
 EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
-				CONST Tcl_UniChar *unicode, int length);
-#endif
-#ifndef Tcl_RegExpMatchObj_TCL_DECLARED
-#define Tcl_RegExpMatchObj_TCL_DECLARED
+				const Tcl_UniChar *unicode, int length);
 /* 385 */
 EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
 				Tcl_Obj *textObj, Tcl_Obj *patternObj);
-#endif
-#ifndef Tcl_SetNotifier_TCL_DECLARED
-#define Tcl_SetNotifier_TCL_DECLARED
 /* 386 */
 EXTERN void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
-#endif
-#ifndef Tcl_GetAllocMutex_TCL_DECLARED
-#define Tcl_GetAllocMutex_TCL_DECLARED
 /* 387 */
 EXTERN Tcl_Mutex *	Tcl_GetAllocMutex(void);
-#endif
-#ifndef Tcl_GetChannelNames_TCL_DECLARED
-#define Tcl_GetChannelNames_TCL_DECLARED
 /* 388 */
 EXTERN int		Tcl_GetChannelNames(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetChannelNamesEx_TCL_DECLARED
-#define Tcl_GetChannelNamesEx_TCL_DECLARED
 /* 389 */
 EXTERN int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
-				CONST char *pattern);
-#endif
-#ifndef Tcl_ProcObjCmd_TCL_DECLARED
-#define Tcl_ProcObjCmd_TCL_DECLARED
+				const char *pattern);
 /* 390 */
 EXTERN int		Tcl_ProcObjCmd(ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[]);
-#endif
-#ifndef Tcl_ConditionFinalize_TCL_DECLARED
-#define Tcl_ConditionFinalize_TCL_DECLARED
+				Tcl_Obj *const objv[]);
 /* 391 */
 EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
-#endif
-#ifndef Tcl_MutexFinalize_TCL_DECLARED
-#define Tcl_MutexFinalize_TCL_DECLARED
 /* 392 */
 EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
-#endif
-#ifndef Tcl_CreateThread_TCL_DECLARED
-#define Tcl_CreateThread_TCL_DECLARED
 /* 393 */
 EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
-				Tcl_ThreadCreateProc proc,
+				Tcl_ThreadCreateProc *proc,
 				ClientData clientData, int stackSize,
 				int flags);
-#endif
-#ifndef Tcl_ReadRaw_TCL_DECLARED
-#define Tcl_ReadRaw_TCL_DECLARED
 /* 394 */
 EXTERN int		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
 				int bytesToRead);
-#endif
-#ifndef Tcl_WriteRaw_TCL_DECLARED
-#define Tcl_WriteRaw_TCL_DECLARED
 /* 395 */
-EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, CONST char *src,
+EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
 				int srcLen);
-#endif
-#ifndef Tcl_GetTopChannel_TCL_DECLARED
-#define Tcl_GetTopChannel_TCL_DECLARED
 /* 396 */
 EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
-#endif
-#ifndef Tcl_ChannelBuffered_TCL_DECLARED
-#define Tcl_ChannelBuffered_TCL_DECLARED
 /* 397 */
 EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
-#endif
-#ifndef Tcl_ChannelName_TCL_DECLARED
-#define Tcl_ChannelName_TCL_DECLARED
 /* 398 */
 EXTERN CONST84_RETURN char * Tcl_ChannelName(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelVersion_TCL_DECLARED
-#define Tcl_ChannelVersion_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 399 */
 EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelBlockModeProc_TCL_DECLARED
-#define Tcl_ChannelBlockModeProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 400 */
 EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelCloseProc_TCL_DECLARED
-#define Tcl_ChannelCloseProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 401 */
 EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelClose2Proc_TCL_DECLARED
-#define Tcl_ChannelClose2Proc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 402 */
 EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelInputProc_TCL_DECLARED
-#define Tcl_ChannelInputProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 403 */
 EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelOutputProc_TCL_DECLARED
-#define Tcl_ChannelOutputProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 404 */
 EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelSeekProc_TCL_DECLARED
-#define Tcl_ChannelSeekProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 405 */
 EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelSetOptionProc_TCL_DECLARED
-#define Tcl_ChannelSetOptionProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 406 */
 EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelGetOptionProc_TCL_DECLARED
-#define Tcl_ChannelGetOptionProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 407 */
 EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelWatchProc_TCL_DECLARED
-#define Tcl_ChannelWatchProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 408 */
 EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelGetHandleProc_TCL_DECLARED
-#define Tcl_ChannelGetHandleProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 409 */
 EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelFlushProc_TCL_DECLARED
-#define Tcl_ChannelFlushProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 410 */
 EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_ChannelHandlerProc_TCL_DECLARED
-#define Tcl_ChannelHandlerProc_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 411 */
 EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_JoinThread_TCL_DECLARED
-#define Tcl_JoinThread_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 412 */
 EXTERN int		Tcl_JoinThread(Tcl_ThreadId threadId, int *result);
-#endif
-#ifndef Tcl_IsChannelShared_TCL_DECLARED
-#define Tcl_IsChannelShared_TCL_DECLARED
 /* 413 */
 EXTERN int		Tcl_IsChannelShared(Tcl_Channel channel);
-#endif
-#ifndef Tcl_IsChannelRegistered_TCL_DECLARED
-#define Tcl_IsChannelRegistered_TCL_DECLARED
 /* 414 */
 EXTERN int		Tcl_IsChannelRegistered(Tcl_Interp *interp,
 				Tcl_Channel channel);
-#endif
-#ifndef Tcl_CutChannel_TCL_DECLARED
-#define Tcl_CutChannel_TCL_DECLARED
 /* 415 */
 EXTERN void		Tcl_CutChannel(Tcl_Channel channel);
-#endif
-#ifndef Tcl_SpliceChannel_TCL_DECLARED
-#define Tcl_SpliceChannel_TCL_DECLARED
 /* 416 */
 EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
-#endif
-#ifndef Tcl_ClearChannelHandlers_TCL_DECLARED
-#define Tcl_ClearChannelHandlers_TCL_DECLARED
 /* 417 */
 EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
-#endif
-#ifndef Tcl_IsChannelExisting_TCL_DECLARED
-#define Tcl_IsChannelExisting_TCL_DECLARED
 /* 418 */
-EXTERN int		Tcl_IsChannelExisting(CONST char *channelName);
-#endif
-#ifndef Tcl_UniCharNcasecmp_TCL_DECLARED
-#define Tcl_UniCharNcasecmp_TCL_DECLARED
+EXTERN int		Tcl_IsChannelExisting(const char *channelName);
 /* 419 */
-EXTERN int		Tcl_UniCharNcasecmp(CONST Tcl_UniChar *ucs,
-				CONST Tcl_UniChar *uct,
+EXTERN int		Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
+				const Tcl_UniChar *uct,
 				unsigned long numChars);
-#endif
-#ifndef Tcl_UniCharCaseMatch_TCL_DECLARED
-#define Tcl_UniCharCaseMatch_TCL_DECLARED
 /* 420 */
-EXTERN int		Tcl_UniCharCaseMatch(CONST Tcl_UniChar *uniStr,
-				CONST Tcl_UniChar *uniPattern, int nocase);
-#endif
-#ifndef Tcl_FindHashEntry_TCL_DECLARED
-#define Tcl_FindHashEntry_TCL_DECLARED
+EXTERN int		Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
+				const Tcl_UniChar *uniPattern, int nocase);
 /* 421 */
 EXTERN Tcl_HashEntry *	Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
-				CONST char *key);
-#endif
-#ifndef Tcl_CreateHashEntry_TCL_DECLARED
-#define Tcl_CreateHashEntry_TCL_DECLARED
+				const void *key);
 /* 422 */
 EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
-				CONST char *key, int *newPtr);
-#endif
-#ifndef Tcl_InitCustomHashTable_TCL_DECLARED
-#define Tcl_InitCustomHashTable_TCL_DECLARED
+				const void *key, int *newPtr);
 /* 423 */
 EXTERN void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
-				int keyType, Tcl_HashKeyType *typePtr);
-#endif
-#ifndef Tcl_InitObjHashTable_TCL_DECLARED
-#define Tcl_InitObjHashTable_TCL_DECLARED
+				int keyType, const Tcl_HashKeyType *typePtr);
 /* 424 */
 EXTERN void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
-#endif
-#ifndef Tcl_CommandTraceInfo_TCL_DECLARED
-#define Tcl_CommandTraceInfo_TCL_DECLARED
 /* 425 */
 EXTERN ClientData	Tcl_CommandTraceInfo(Tcl_Interp *interp,
-				CONST char *varName, int flags,
+				const char *varName, int flags,
 				Tcl_CommandTraceProc *procPtr,
 				ClientData prevClientData);
-#endif
-#ifndef Tcl_TraceCommand_TCL_DECLARED
-#define Tcl_TraceCommand_TCL_DECLARED
 /* 426 */
 EXTERN int		Tcl_TraceCommand(Tcl_Interp *interp,
-				CONST char *varName, int flags,
+				const char *varName, int flags,
 				Tcl_CommandTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_UntraceCommand_TCL_DECLARED
-#define Tcl_UntraceCommand_TCL_DECLARED
 /* 427 */
 EXTERN void		Tcl_UntraceCommand(Tcl_Interp *interp,
-				CONST char *varName, int flags,
+				const char *varName, int flags,
 				Tcl_CommandTraceProc *proc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_AttemptAlloc_TCL_DECLARED
-#define Tcl_AttemptAlloc_TCL_DECLARED
 /* 428 */
 EXTERN char *		Tcl_AttemptAlloc(unsigned int size);
-#endif
-#ifndef Tcl_AttemptDbCkalloc_TCL_DECLARED
-#define Tcl_AttemptDbCkalloc_TCL_DECLARED
 /* 429 */
 EXTERN char *		Tcl_AttemptDbCkalloc(unsigned int size,
-				CONST char *file, int line);
-#endif
-#ifndef Tcl_AttemptRealloc_TCL_DECLARED
-#define Tcl_AttemptRealloc_TCL_DECLARED
+				const char *file, int line);
 /* 430 */
 EXTERN char *		Tcl_AttemptRealloc(char *ptr, unsigned int size);
-#endif
-#ifndef Tcl_AttemptDbCkrealloc_TCL_DECLARED
-#define Tcl_AttemptDbCkrealloc_TCL_DECLARED
 /* 431 */
 EXTERN char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
-				CONST char *file, int line);
-#endif
-#ifndef Tcl_AttemptSetObjLength_TCL_DECLARED
-#define Tcl_AttemptSetObjLength_TCL_DECLARED
+				const char *file, int line);
 /* 432 */
 EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
-#endif
-#ifndef Tcl_GetChannelThread_TCL_DECLARED
-#define Tcl_GetChannelThread_TCL_DECLARED
 /* 433 */
 EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
-#endif
-#ifndef Tcl_GetUnicodeFromObj_TCL_DECLARED
-#define Tcl_GetUnicodeFromObj_TCL_DECLARED
 /* 434 */
 EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
 				int *lengthPtr);
-#endif
-#ifndef Tcl_GetMathFuncInfo_TCL_DECLARED
-#define Tcl_GetMathFuncInfo_TCL_DECLARED
 /* 435 */
 EXTERN int		Tcl_GetMathFuncInfo(Tcl_Interp *interp,
-				CONST char *name, int *numArgsPtr,
+				const char *name, int *numArgsPtr,
 				Tcl_ValueType **argTypesPtr,
 				Tcl_MathProc **procPtr,
 				ClientData *clientDataPtr);
-#endif
-#ifndef Tcl_ListMathFuncs_TCL_DECLARED
-#define Tcl_ListMathFuncs_TCL_DECLARED
 /* 436 */
 EXTERN Tcl_Obj *	Tcl_ListMathFuncs(Tcl_Interp *interp,
-				CONST char *pattern);
-#endif
-#ifndef Tcl_SubstObj_TCL_DECLARED
-#define Tcl_SubstObj_TCL_DECLARED
+				const char *pattern);
 /* 437 */
 EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 				int flags);
-#endif
-#ifndef Tcl_DetachChannel_TCL_DECLARED
-#define Tcl_DetachChannel_TCL_DECLARED
 /* 438 */
 EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
 				Tcl_Channel channel);
-#endif
-#ifndef Tcl_IsStandardChannel_TCL_DECLARED
-#define Tcl_IsStandardChannel_TCL_DECLARED
 /* 439 */
 EXTERN int		Tcl_IsStandardChannel(Tcl_Channel channel);
-#endif
-#ifndef Tcl_FSCopyFile_TCL_DECLARED
-#define Tcl_FSCopyFile_TCL_DECLARED
 /* 440 */
 EXTERN int		Tcl_FSCopyFile(Tcl_Obj *srcPathPtr,
 				Tcl_Obj *destPathPtr);
-#endif
-#ifndef Tcl_FSCopyDirectory_TCL_DECLARED
-#define Tcl_FSCopyDirectory_TCL_DECLARED
 /* 441 */
 EXTERN int		Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
 				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
-#endif
-#ifndef Tcl_FSCreateDirectory_TCL_DECLARED
-#define Tcl_FSCreateDirectory_TCL_DECLARED
 /* 442 */
 EXTERN int		Tcl_FSCreateDirectory(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSDeleteFile_TCL_DECLARED
-#define Tcl_FSDeleteFile_TCL_DECLARED
 /* 443 */
 EXTERN int		Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSLoadFile_TCL_DECLARED
-#define Tcl_FSLoadFile_TCL_DECLARED
 /* 444 */
 EXTERN int		Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-				CONST char *sym1, CONST char *sym2,
+				const char *sym1, const char *sym2,
 				Tcl_PackageInitProc **proc1Ptr,
 				Tcl_PackageInitProc **proc2Ptr,
 				Tcl_LoadHandle *handlePtr,
 				Tcl_FSUnloadFileProc **unloadProcPtr);
-#endif
-#ifndef Tcl_FSMatchInDirectory_TCL_DECLARED
-#define Tcl_FSMatchInDirectory_TCL_DECLARED
 /* 445 */
 EXTERN int		Tcl_FSMatchInDirectory(Tcl_Interp *interp,
 				Tcl_Obj *result, Tcl_Obj *pathPtr,
-				CONST char *pattern, Tcl_GlobTypeData *types);
-#endif
-#ifndef Tcl_FSLink_TCL_DECLARED
-#define Tcl_FSLink_TCL_DECLARED
+				const char *pattern, Tcl_GlobTypeData *types);
 /* 446 */
 EXTERN Tcl_Obj *	Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
 				int linkAction);
-#endif
-#ifndef Tcl_FSRemoveDirectory_TCL_DECLARED
-#define Tcl_FSRemoveDirectory_TCL_DECLARED
 /* 447 */
 EXTERN int		Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
 				int recursive, Tcl_Obj **errorPtr);
-#endif
-#ifndef Tcl_FSRenameFile_TCL_DECLARED
-#define Tcl_FSRenameFile_TCL_DECLARED
 /* 448 */
 EXTERN int		Tcl_FSRenameFile(Tcl_Obj *srcPathPtr,
 				Tcl_Obj *destPathPtr);
-#endif
-#ifndef Tcl_FSLstat_TCL_DECLARED
-#define Tcl_FSLstat_TCL_DECLARED
 /* 449 */
 EXTERN int		Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-#endif
-#ifndef Tcl_FSUtime_TCL_DECLARED
-#define Tcl_FSUtime_TCL_DECLARED
 /* 450 */
 EXTERN int		Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
-#endif
-#ifndef Tcl_FSFileAttrsGet_TCL_DECLARED
-#define Tcl_FSFileAttrsGet_TCL_DECLARED
 /* 451 */
 EXTERN int		Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
 				Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
-#endif
-#ifndef Tcl_FSFileAttrsSet_TCL_DECLARED
-#define Tcl_FSFileAttrsSet_TCL_DECLARED
 /* 452 */
 EXTERN int		Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
 				Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_FSFileAttrStrings_TCL_DECLARED
-#define Tcl_FSFileAttrStrings_TCL_DECLARED
 /* 453 */
-EXTERN CONST char **	Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
+EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
 				Tcl_Obj **objPtrRef);
-#endif
-#ifndef Tcl_FSStat_TCL_DECLARED
-#define Tcl_FSStat_TCL_DECLARED
 /* 454 */
 EXTERN int		Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-#endif
-#ifndef Tcl_FSAccess_TCL_DECLARED
-#define Tcl_FSAccess_TCL_DECLARED
 /* 455 */
 EXTERN int		Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
-#endif
-#ifndef Tcl_FSOpenFileChannel_TCL_DECLARED
-#define Tcl_FSOpenFileChannel_TCL_DECLARED
 /* 456 */
 EXTERN Tcl_Channel	Tcl_FSOpenFileChannel(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr, CONST char *modeString,
+				Tcl_Obj *pathPtr, const char *modeString,
 				int permissions);
-#endif
-#ifndef Tcl_FSGetCwd_TCL_DECLARED
-#define Tcl_FSGetCwd_TCL_DECLARED
 /* 457 */
 EXTERN Tcl_Obj *	Tcl_FSGetCwd(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_FSChdir_TCL_DECLARED
-#define Tcl_FSChdir_TCL_DECLARED
 /* 458 */
 EXTERN int		Tcl_FSChdir(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSConvertToPathType_TCL_DECLARED
-#define Tcl_FSConvertToPathType_TCL_DECLARED
 /* 459 */
 EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
 				Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSJoinPath_TCL_DECLARED
-#define Tcl_FSJoinPath_TCL_DECLARED
 /* 460 */
 EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, int elements);
-#endif
-#ifndef Tcl_FSSplitPath_TCL_DECLARED
-#define Tcl_FSSplitPath_TCL_DECLARED
 /* 461 */
 EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
-#endif
-#ifndef Tcl_FSEqualPaths_TCL_DECLARED
-#define Tcl_FSEqualPaths_TCL_DECLARED
 /* 462 */
 EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
 				Tcl_Obj *secondPtr);
-#endif
-#ifndef Tcl_FSGetNormalizedPath_TCL_DECLARED
-#define Tcl_FSGetNormalizedPath_TCL_DECLARED
 /* 463 */
 EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
 				Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSJoinToPath_TCL_DECLARED
-#define Tcl_FSJoinToPath_TCL_DECLARED
 /* 464 */
 EXTERN Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
-				Tcl_Obj *CONST objv[]);
-#endif
-#ifndef Tcl_FSGetInternalRep_TCL_DECLARED
-#define Tcl_FSGetInternalRep_TCL_DECLARED
+				Tcl_Obj *const objv[]);
 /* 465 */
 EXTERN ClientData	Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
-				Tcl_Filesystem *fsPtr);
-#endif
-#ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED
-#define Tcl_FSGetTranslatedPath_TCL_DECLARED
+				const Tcl_Filesystem *fsPtr);
 /* 466 */
 EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
 				Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSEvalFile_TCL_DECLARED
-#define Tcl_FSEvalFile_TCL_DECLARED
 /* 467 */
 EXTERN int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
-#endif
-#ifndef Tcl_FSNewNativePath_TCL_DECLARED
-#define Tcl_FSNewNativePath_TCL_DECLARED
 /* 468 */
-EXTERN Tcl_Obj *	Tcl_FSNewNativePath(Tcl_Filesystem *fromFilesystem,
+EXTERN Tcl_Obj *	Tcl_FSNewNativePath(
+				const Tcl_Filesystem *fromFilesystem,
 				ClientData clientData);
-#endif
-#ifndef Tcl_FSGetNativePath_TCL_DECLARED
-#define Tcl_FSGetNativePath_TCL_DECLARED
 /* 469 */
-EXTERN CONST char *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSFileSystemInfo_TCL_DECLARED
-#define Tcl_FSFileSystemInfo_TCL_DECLARED
+EXTERN const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
 /* 470 */
 EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSPathSeparator_TCL_DECLARED
-#define Tcl_FSPathSeparator_TCL_DECLARED
 /* 471 */
 EXTERN Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSListVolumes_TCL_DECLARED
-#define Tcl_FSListVolumes_TCL_DECLARED
 /* 472 */
 EXTERN Tcl_Obj *	Tcl_FSListVolumes(void);
-#endif
-#ifndef Tcl_FSRegister_TCL_DECLARED
-#define Tcl_FSRegister_TCL_DECLARED
 /* 473 */
 EXTERN int		Tcl_FSRegister(ClientData clientData,
-				Tcl_Filesystem *fsPtr);
-#endif
-#ifndef Tcl_FSUnregister_TCL_DECLARED
-#define Tcl_FSUnregister_TCL_DECLARED
+				const Tcl_Filesystem *fsPtr);
 /* 474 */
-EXTERN int		Tcl_FSUnregister(Tcl_Filesystem *fsPtr);
-#endif
-#ifndef Tcl_FSData_TCL_DECLARED
-#define Tcl_FSData_TCL_DECLARED
+EXTERN int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
 /* 475 */
-EXTERN ClientData	Tcl_FSData(Tcl_Filesystem *fsPtr);
-#endif
-#ifndef Tcl_FSGetTranslatedStringPath_TCL_DECLARED
-#define Tcl_FSGetTranslatedStringPath_TCL_DECLARED
+EXTERN ClientData	Tcl_FSData(const Tcl_Filesystem *fsPtr);
 /* 476 */
-EXTERN CONST char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
+EXTERN const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
 				Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSGetFileSystemForPath_TCL_DECLARED
-#define Tcl_FSGetFileSystemForPath_TCL_DECLARED
 /* 477 */
-EXTERN Tcl_Filesystem *	 Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_FSGetPathType_TCL_DECLARED
-#define Tcl_FSGetPathType_TCL_DECLARED
+EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
 /* 478 */
 EXTERN Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
-#endif
-#ifndef Tcl_OutputBuffered_TCL_DECLARED
-#define Tcl_OutputBuffered_TCL_DECLARED
 /* 479 */
 EXTERN int		Tcl_OutputBuffered(Tcl_Channel chan);
-#endif
-#ifndef Tcl_FSMountsChanged_TCL_DECLARED
-#define Tcl_FSMountsChanged_TCL_DECLARED
 /* 480 */
-EXTERN void		Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr);
-#endif
-#ifndef Tcl_EvalTokensStandard_TCL_DECLARED
-#define Tcl_EvalTokensStandard_TCL_DECLARED
+EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
 /* 481 */
 EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
 				Tcl_Token *tokenPtr, int count);
-#endif
-#ifndef Tcl_GetTime_TCL_DECLARED
-#define Tcl_GetTime_TCL_DECLARED
 /* 482 */
 EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
-#endif
-#ifndef Tcl_CreateObjTrace_TCL_DECLARED
-#define Tcl_CreateObjTrace_TCL_DECLARED
 /* 483 */
 EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
 				int flags, Tcl_CmdObjTraceProc *objProc,
 				ClientData clientData,
 				Tcl_CmdObjTraceDeleteProc *delProc);
-#endif
-#ifndef Tcl_GetCommandInfoFromToken_TCL_DECLARED
-#define Tcl_GetCommandInfoFromToken_TCL_DECLARED
 /* 484 */
 EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
 				Tcl_CmdInfo *infoPtr);
-#endif
-#ifndef Tcl_SetCommandInfoFromToken_TCL_DECLARED
-#define Tcl_SetCommandInfoFromToken_TCL_DECLARED
 /* 485 */
 EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
-				CONST Tcl_CmdInfo *infoPtr);
-#endif
-#ifndef Tcl_DbNewWideIntObj_TCL_DECLARED
-#define Tcl_DbNewWideIntObj_TCL_DECLARED
+				const Tcl_CmdInfo *infoPtr);
 /* 486 */
 EXTERN Tcl_Obj *	Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
-				CONST char *file, int line);
-#endif
-#ifndef Tcl_GetWideIntFromObj_TCL_DECLARED
-#define Tcl_GetWideIntFromObj_TCL_DECLARED
+				const char *file, int line);
 /* 487 */
 EXTERN int		Tcl_GetWideIntFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
-#endif
-#ifndef Tcl_NewWideIntObj_TCL_DECLARED
-#define Tcl_NewWideIntObj_TCL_DECLARED
 /* 488 */
 EXTERN Tcl_Obj *	Tcl_NewWideIntObj(Tcl_WideInt wideValue);
-#endif
-#ifndef Tcl_SetWideIntObj_TCL_DECLARED
-#define Tcl_SetWideIntObj_TCL_DECLARED
 /* 489 */
 EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
 				Tcl_WideInt wideValue);
-#endif
-#ifndef Tcl_AllocStatBuf_TCL_DECLARED
-#define Tcl_AllocStatBuf_TCL_DECLARED
 /* 490 */
 EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
-#endif
-#ifndef Tcl_Seek_TCL_DECLARED
-#define Tcl_Seek_TCL_DECLARED
 /* 491 */
 EXTERN Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
 				int mode);
-#endif
-#ifndef Tcl_Tell_TCL_DECLARED
-#define Tcl_Tell_TCL_DECLARED
 /* 492 */
 EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
-#endif
-#ifndef Tcl_ChannelWideSeekProc_TCL_DECLARED
-#define Tcl_ChannelWideSeekProc_TCL_DECLARED
 /* 493 */
 EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_DictObjPut_TCL_DECLARED
-#define Tcl_DictObjPut_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 494 */
 EXTERN int		Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 				Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
-#endif
-#ifndef Tcl_DictObjGet_TCL_DECLARED
-#define Tcl_DictObjGet_TCL_DECLARED
 /* 495 */
 EXTERN int		Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 				Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
-#endif
-#ifndef Tcl_DictObjRemove_TCL_DECLARED
-#define Tcl_DictObjRemove_TCL_DECLARED
 /* 496 */
 EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
 				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
-#endif
-#ifndef Tcl_DictObjSize_TCL_DECLARED
-#define Tcl_DictObjSize_TCL_DECLARED
 /* 497 */
 EXTERN int		Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 				int *sizePtr);
-#endif
-#ifndef Tcl_DictObjFirst_TCL_DECLARED
-#define Tcl_DictObjFirst_TCL_DECLARED
 /* 498 */
 EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
 				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
 				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
 				int *donePtr);
-#endif
-#ifndef Tcl_DictObjNext_TCL_DECLARED
-#define Tcl_DictObjNext_TCL_DECLARED
 /* 499 */
 EXTERN void		Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
 				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
 				int *donePtr);
-#endif
-#ifndef Tcl_DictObjDone_TCL_DECLARED
-#define Tcl_DictObjDone_TCL_DECLARED
 /* 500 */
 EXTERN void		Tcl_DictObjDone(Tcl_DictSearch *searchPtr);
-#endif
-#ifndef Tcl_DictObjPutKeyList_TCL_DECLARED
-#define Tcl_DictObjPutKeyList_TCL_DECLARED
 /* 501 */
 EXTERN int		Tcl_DictObjPutKeyList(Tcl_Interp *interp,
 				Tcl_Obj *dictPtr, int keyc,
-				Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr);
-#endif
-#ifndef Tcl_DictObjRemoveKeyList_TCL_DECLARED
-#define Tcl_DictObjRemoveKeyList_TCL_DECLARED
+				Tcl_Obj *const *keyv, Tcl_Obj *valuePtr);
 /* 502 */
 EXTERN int		Tcl_DictObjRemoveKeyList(Tcl_Interp *interp,
 				Tcl_Obj *dictPtr, int keyc,
-				Tcl_Obj *CONST *keyv);
-#endif
-#ifndef Tcl_NewDictObj_TCL_DECLARED
-#define Tcl_NewDictObj_TCL_DECLARED
+				Tcl_Obj *const *keyv);
 /* 503 */
 EXTERN Tcl_Obj *	Tcl_NewDictObj(void);
-#endif
-#ifndef Tcl_DbNewDictObj_TCL_DECLARED
-#define Tcl_DbNewDictObj_TCL_DECLARED
 /* 504 */
-EXTERN Tcl_Obj *	Tcl_DbNewDictObj(CONST char *file, int line);
-#endif
-#ifndef Tcl_RegisterConfig_TCL_DECLARED
-#define Tcl_RegisterConfig_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_DbNewDictObj(const char *file, int line);
 /* 505 */
 EXTERN void		Tcl_RegisterConfig(Tcl_Interp *interp,
-				CONST char *pkgName,
-				Tcl_Config *configuration,
-				CONST char *valEncoding);
-#endif
-#ifndef Tcl_CreateNamespace_TCL_DECLARED
-#define Tcl_CreateNamespace_TCL_DECLARED
+				const char *pkgName,
+				const Tcl_Config *configuration,
+				const char *valEncoding);
 /* 506 */
 EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
-				CONST char *name, ClientData clientData,
+				const char *name, ClientData clientData,
 				Tcl_NamespaceDeleteProc *deleteProc);
-#endif
-#ifndef Tcl_DeleteNamespace_TCL_DECLARED
-#define Tcl_DeleteNamespace_TCL_DECLARED
 /* 507 */
 EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
-#endif
-#ifndef Tcl_AppendExportList_TCL_DECLARED
-#define Tcl_AppendExportList_TCL_DECLARED
 /* 508 */
 EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
 				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_Export_TCL_DECLARED
-#define Tcl_Export_TCL_DECLARED
 /* 509 */
 EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				CONST char *pattern, int resetListFirst);
-#endif
-#ifndef Tcl_Import_TCL_DECLARED
-#define Tcl_Import_TCL_DECLARED
+				const char *pattern, int resetListFirst);
 /* 510 */
 EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				CONST char *pattern, int allowOverwrite);
-#endif
-#ifndef Tcl_ForgetImport_TCL_DECLARED
-#define Tcl_ForgetImport_TCL_DECLARED
+				const char *pattern, int allowOverwrite);
 /* 511 */
 EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, CONST char *pattern);
-#endif
-#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
-#define Tcl_GetCurrentNamespace_TCL_DECLARED
+				Tcl_Namespace *nsPtr, const char *pattern);
 /* 512 */
 EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
-#define Tcl_GetGlobalNamespace_TCL_DECLARED
 /* 513 */
 EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_FindNamespace_TCL_DECLARED
-#define Tcl_FindNamespace_TCL_DECLARED
 /* 514 */
 EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
-				CONST char *name,
+				const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
-#endif
-#ifndef Tcl_FindCommand_TCL_DECLARED
-#define Tcl_FindCommand_TCL_DECLARED
 /* 515 */
-EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
+EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
-#endif
-#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
-#define Tcl_GetCommandFromObj_TCL_DECLARED
 /* 516 */
 EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetCommandFullName_TCL_DECLARED
-#define Tcl_GetCommandFullName_TCL_DECLARED
 /* 517 */
 EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
 				Tcl_Command command, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_FSEvalFileEx_TCL_DECLARED
-#define Tcl_FSEvalFileEx_TCL_DECLARED
 /* 518 */
 EXTERN int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
-				Tcl_Obj *fileName, CONST char *encodingName);
-#endif
-#ifndef Tcl_SetExitProc_TCL_DECLARED
-#define Tcl_SetExitProc_TCL_DECLARED
+				Tcl_Obj *fileName, const char *encodingName);
 /* 519 */
-EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
-#endif
-#ifndef Tcl_LimitAddHandler_TCL_DECLARED
-#define Tcl_LimitAddHandler_TCL_DECLARED
+EXTERN Tcl_ExitProc *	Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
 /* 520 */
 EXTERN void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
 				Tcl_LimitHandlerProc *handlerProc,
 				ClientData clientData,
 				Tcl_LimitHandlerDeleteProc *deleteProc);
-#endif
-#ifndef Tcl_LimitRemoveHandler_TCL_DECLARED
-#define Tcl_LimitRemoveHandler_TCL_DECLARED
 /* 521 */
 EXTERN void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
 				Tcl_LimitHandlerProc *handlerProc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_LimitReady_TCL_DECLARED
-#define Tcl_LimitReady_TCL_DECLARED
 /* 522 */
 EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_LimitCheck_TCL_DECLARED
-#define Tcl_LimitCheck_TCL_DECLARED
 /* 523 */
 EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_LimitExceeded_TCL_DECLARED
-#define Tcl_LimitExceeded_TCL_DECLARED
 /* 524 */
 EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_LimitSetCommands_TCL_DECLARED
-#define Tcl_LimitSetCommands_TCL_DECLARED
 /* 525 */
 EXTERN void		Tcl_LimitSetCommands(Tcl_Interp *interp,
 				int commandLimit);
-#endif
-#ifndef Tcl_LimitSetTime_TCL_DECLARED
-#define Tcl_LimitSetTime_TCL_DECLARED
 /* 526 */
 EXTERN void		Tcl_LimitSetTime(Tcl_Interp *interp,
 				Tcl_Time *timeLimitPtr);
-#endif
-#ifndef Tcl_LimitSetGranularity_TCL_DECLARED
-#define Tcl_LimitSetGranularity_TCL_DECLARED
 /* 527 */
 EXTERN void		Tcl_LimitSetGranularity(Tcl_Interp *interp, int type,
 				int granularity);
-#endif
-#ifndef Tcl_LimitTypeEnabled_TCL_DECLARED
-#define Tcl_LimitTypeEnabled_TCL_DECLARED
 /* 528 */
 EXTERN int		Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type);
-#endif
-#ifndef Tcl_LimitTypeExceeded_TCL_DECLARED
-#define Tcl_LimitTypeExceeded_TCL_DECLARED
 /* 529 */
 EXTERN int		Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
-#endif
-#ifndef Tcl_LimitTypeSet_TCL_DECLARED
-#define Tcl_LimitTypeSet_TCL_DECLARED
 /* 530 */
 EXTERN void		Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
-#endif
-#ifndef Tcl_LimitTypeReset_TCL_DECLARED
-#define Tcl_LimitTypeReset_TCL_DECLARED
 /* 531 */
 EXTERN void		Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
-#endif
-#ifndef Tcl_LimitGetCommands_TCL_DECLARED
-#define Tcl_LimitGetCommands_TCL_DECLARED
 /* 532 */
 EXTERN int		Tcl_LimitGetCommands(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_LimitGetTime_TCL_DECLARED
-#define Tcl_LimitGetTime_TCL_DECLARED
 /* 533 */
 EXTERN void		Tcl_LimitGetTime(Tcl_Interp *interp,
 				Tcl_Time *timeLimitPtr);
-#endif
-#ifndef Tcl_LimitGetGranularity_TCL_DECLARED
-#define Tcl_LimitGetGranularity_TCL_DECLARED
 /* 534 */
 EXTERN int		Tcl_LimitGetGranularity(Tcl_Interp *interp, int type);
-#endif
-#ifndef Tcl_SaveInterpState_TCL_DECLARED
-#define Tcl_SaveInterpState_TCL_DECLARED
 /* 535 */
 EXTERN Tcl_InterpState	Tcl_SaveInterpState(Tcl_Interp *interp, int status);
-#endif
-#ifndef Tcl_RestoreInterpState_TCL_DECLARED
-#define Tcl_RestoreInterpState_TCL_DECLARED
 /* 536 */
 EXTERN int		Tcl_RestoreInterpState(Tcl_Interp *interp,
 				Tcl_InterpState state);
-#endif
-#ifndef Tcl_DiscardInterpState_TCL_DECLARED
-#define Tcl_DiscardInterpState_TCL_DECLARED
 /* 537 */
 EXTERN void		Tcl_DiscardInterpState(Tcl_InterpState state);
-#endif
-#ifndef Tcl_SetReturnOptions_TCL_DECLARED
-#define Tcl_SetReturnOptions_TCL_DECLARED
 /* 538 */
 EXTERN int		Tcl_SetReturnOptions(Tcl_Interp *interp,
 				Tcl_Obj *options);
-#endif
-#ifndef Tcl_GetReturnOptions_TCL_DECLARED
-#define Tcl_GetReturnOptions_TCL_DECLARED
 /* 539 */
 EXTERN Tcl_Obj *	Tcl_GetReturnOptions(Tcl_Interp *interp, int result);
-#endif
-#ifndef Tcl_IsEnsemble_TCL_DECLARED
-#define Tcl_IsEnsemble_TCL_DECLARED
 /* 540 */
 EXTERN int		Tcl_IsEnsemble(Tcl_Command token);
-#endif
-#ifndef Tcl_CreateEnsemble_TCL_DECLARED
-#define Tcl_CreateEnsemble_TCL_DECLARED
 /* 541 */
 EXTERN Tcl_Command	Tcl_CreateEnsemble(Tcl_Interp *interp,
-				CONST char *name,
+				const char *name,
 				Tcl_Namespace *namespacePtr, int flags);
-#endif
-#ifndef Tcl_FindEnsemble_TCL_DECLARED
-#define Tcl_FindEnsemble_TCL_DECLARED
 /* 542 */
 EXTERN Tcl_Command	Tcl_FindEnsemble(Tcl_Interp *interp,
 				Tcl_Obj *cmdNameObj, int flags);
-#endif
-#ifndef Tcl_SetEnsembleSubcommandList_TCL_DECLARED
-#define Tcl_SetEnsembleSubcommandList_TCL_DECLARED
 /* 543 */
 EXTERN int		Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj *subcmdList);
-#endif
-#ifndef Tcl_SetEnsembleMappingDict_TCL_DECLARED
-#define Tcl_SetEnsembleMappingDict_TCL_DECLARED
 /* 544 */
 EXTERN int		Tcl_SetEnsembleMappingDict(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj *mapDict);
-#endif
-#ifndef Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
-#define Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
 /* 545 */
 EXTERN int		Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj *unknownList);
-#endif
-#ifndef Tcl_SetEnsembleFlags_TCL_DECLARED
-#define Tcl_SetEnsembleFlags_TCL_DECLARED
 /* 546 */
 EXTERN int		Tcl_SetEnsembleFlags(Tcl_Interp *interp,
 				Tcl_Command token, int flags);
-#endif
-#ifndef Tcl_GetEnsembleSubcommandList_TCL_DECLARED
-#define Tcl_GetEnsembleSubcommandList_TCL_DECLARED
 /* 547 */
 EXTERN int		Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj **subcmdListPtr);
-#endif
-#ifndef Tcl_GetEnsembleMappingDict_TCL_DECLARED
-#define Tcl_GetEnsembleMappingDict_TCL_DECLARED
 /* 548 */
 EXTERN int		Tcl_GetEnsembleMappingDict(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj **mapDictPtr);
-#endif
-#ifndef Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
-#define Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
 /* 549 */
 EXTERN int		Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj **unknownListPtr);
-#endif
-#ifndef Tcl_GetEnsembleFlags_TCL_DECLARED
-#define Tcl_GetEnsembleFlags_TCL_DECLARED
 /* 550 */
 EXTERN int		Tcl_GetEnsembleFlags(Tcl_Interp *interp,
 				Tcl_Command token, int *flagsPtr);
-#endif
-#ifndef Tcl_GetEnsembleNamespace_TCL_DECLARED
-#define Tcl_GetEnsembleNamespace_TCL_DECLARED
 /* 551 */
 EXTERN int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
 				Tcl_Command token,
 				Tcl_Namespace **namespacePtrPtr);
-#endif
-#ifndef Tcl_SetTimeProc_TCL_DECLARED
-#define Tcl_SetTimeProc_TCL_DECLARED
 /* 552 */
 EXTERN void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
 				Tcl_ScaleTimeProc *scaleProc,
 				ClientData clientData);
-#endif
-#ifndef Tcl_QueryTimeProc_TCL_DECLARED
-#define Tcl_QueryTimeProc_TCL_DECLARED
 /* 553 */
 EXTERN void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
 				Tcl_ScaleTimeProc **scaleProc,
 				ClientData *clientData);
-#endif
-#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
-#define Tcl_ChannelThreadActionProc_TCL_DECLARED
 /* 554 */
 EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_NewBignumObj_TCL_DECLARED
-#define Tcl_NewBignumObj_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 555 */
 EXTERN Tcl_Obj *	Tcl_NewBignumObj(mp_int *value);
-#endif
-#ifndef Tcl_DbNewBignumObj_TCL_DECLARED
-#define Tcl_DbNewBignumObj_TCL_DECLARED
 /* 556 */
-EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, CONST char *file,
+EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, const char *file,
 				int line);
-#endif
-#ifndef Tcl_SetBignumObj_TCL_DECLARED
-#define Tcl_SetBignumObj_TCL_DECLARED
 /* 557 */
 EXTERN void		Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value);
-#endif
-#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
-#define Tcl_GetBignumFromObj_TCL_DECLARED
 /* 558 */
 EXTERN int		Tcl_GetBignumFromObj(Tcl_Interp *interp,
 				Tcl_Obj *obj, mp_int *value);
-#endif
-#ifndef Tcl_TakeBignumFromObj_TCL_DECLARED
-#define Tcl_TakeBignumFromObj_TCL_DECLARED
 /* 559 */
 EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
 				Tcl_Obj *obj, mp_int *value);
-#endif
-#ifndef Tcl_TruncateChannel_TCL_DECLARED
-#define Tcl_TruncateChannel_TCL_DECLARED
 /* 560 */
 EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
 				Tcl_WideInt length);
-#endif
-#ifndef Tcl_ChannelTruncateProc_TCL_DECLARED
-#define Tcl_ChannelTruncateProc_TCL_DECLARED
 /* 561 */
 EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
-				CONST Tcl_ChannelType *chanTypePtr);
-#endif
-#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
-#define Tcl_SetChannelErrorInterp_TCL_DECLARED
+				const Tcl_ChannelType *chanTypePtr);
 /* 562 */
 EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
 				Tcl_Obj *msg);
-#endif
-#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
-#define Tcl_GetChannelErrorInterp_TCL_DECLARED
 /* 563 */
 EXTERN void		Tcl_GetChannelErrorInterp(Tcl_Interp *interp,
 				Tcl_Obj **msg);
-#endif
-#ifndef Tcl_SetChannelError_TCL_DECLARED
-#define Tcl_SetChannelError_TCL_DECLARED
 /* 564 */
 EXTERN void		Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
-#endif
-#ifndef Tcl_GetChannelError_TCL_DECLARED
-#define Tcl_GetChannelError_TCL_DECLARED
 /* 565 */
 EXTERN void		Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg);
-#endif
-#ifndef Tcl_InitBignumFromDouble_TCL_DECLARED
-#define Tcl_InitBignumFromDouble_TCL_DECLARED
 /* 566 */
 EXTERN int		Tcl_InitBignumFromDouble(Tcl_Interp *interp,
 				double initval, mp_int *toInit);
-#endif
-#ifndef Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
-#define Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
 /* 567 */
 EXTERN Tcl_Obj *	Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
 				Tcl_Namespace *nsPtr);
-#endif
-#ifndef Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
-#define Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
 /* 568 */
 EXTERN int		Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
 				Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
-#endif
-#ifndef Tcl_GetEncodingFromObj_TCL_DECLARED
-#define Tcl_GetEncodingFromObj_TCL_DECLARED
 /* 569 */
 EXTERN int		Tcl_GetEncodingFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
-#endif
-#ifndef Tcl_GetEncodingSearchPath_TCL_DECLARED
-#define Tcl_GetEncodingSearchPath_TCL_DECLARED
 /* 570 */
 EXTERN Tcl_Obj *	Tcl_GetEncodingSearchPath(void);
-#endif
-#ifndef Tcl_SetEncodingSearchPath_TCL_DECLARED
-#define Tcl_SetEncodingSearchPath_TCL_DECLARED
 /* 571 */
 EXTERN int		Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath);
-#endif
-#ifndef Tcl_GetEncodingNameFromEnvironment_TCL_DECLARED
-#define Tcl_GetEncodingNameFromEnvironment_TCL_DECLARED
 /* 572 */
-EXTERN CONST char *	Tcl_GetEncodingNameFromEnvironment(
+EXTERN const char *	Tcl_GetEncodingNameFromEnvironment(
 				Tcl_DString *bufPtr);
-#endif
-#ifndef Tcl_PkgRequireProc_TCL_DECLARED
-#define Tcl_PkgRequireProc_TCL_DECLARED
 /* 573 */
 EXTERN int		Tcl_PkgRequireProc(Tcl_Interp *interp,
-				CONST char *name, int objc,
-				Tcl_Obj *CONST objv[],
-				ClientData *clientDataPtr);
-#endif
-#ifndef Tcl_AppendObjToErrorInfo_TCL_DECLARED
-#define Tcl_AppendObjToErrorInfo_TCL_DECLARED
+				const char *name, int objc,
+				Tcl_Obj *const objv[], void *clientDataPtr);
 /* 574 */
 EXTERN void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_AppendLimitedToObj_TCL_DECLARED
-#define Tcl_AppendLimitedToObj_TCL_DECLARED
 /* 575 */
 EXTERN void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
-				CONST char *bytes, int length, int limit,
-				CONST char *ellipsis);
-#endif
-#ifndef Tcl_Format_TCL_DECLARED
-#define Tcl_Format_TCL_DECLARED
+				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[]);
-#endif
-#ifndef Tcl_AppendFormatToObj_TCL_DECLARED
-#define Tcl_AppendFormatToObj_TCL_DECLARED
+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[]);
-#endif
-#ifndef Tcl_ObjPrintf_TCL_DECLARED
-#define Tcl_ObjPrintf_TCL_DECLARED
+				Tcl_Obj *objPtr, const char *format,
+				int objc, Tcl_Obj *const objv[]);
 /* 578 */
-EXTERN Tcl_Obj *	Tcl_ObjPrintf(CONST char *format, ...);
-#endif
-#ifndef Tcl_AppendPrintfToObj_TCL_DECLARED
-#define Tcl_AppendPrintfToObj_TCL_DECLARED
+EXTERN Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
 /* 579 */
 EXTERN void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
-				CONST char *format, ...);
-#endif
-/* Slot 580 is reserved */
-/* Slot 581 is reserved */
-/* Slot 582 is reserved */
-/* Slot 583 is reserved */
-/* Slot 584 is reserved */
-/* Slot 585 is reserved */
-/* Slot 586 is reserved */
-/* Slot 587 is reserved */
-/* Slot 588 is reserved */
-/* Slot 589 is reserved */
-/* Slot 590 is reserved */
-/* Slot 591 is reserved */
-/* Slot 592 is reserved */
-/* Slot 593 is reserved */
-/* Slot 594 is reserved */
-/* Slot 595 is reserved */
-/* Slot 596 is reserved */
-/* Slot 597 is reserved */
-/* Slot 598 is reserved */
-/* Slot 599 is reserved */
-/* Slot 600 is reserved */
-/* Slot 601 is reserved */
-/* Slot 602 is reserved */
-/* Slot 603 is reserved */
-/* Slot 604 is reserved */
-/* Slot 605 is reserved */
-/* Slot 606 is reserved */
-/* Slot 607 is reserved */
-/* Slot 608 is reserved */
-/* Slot 609 is reserved */
-/* Slot 610 is reserved */
-/* Slot 611 is reserved */
-/* Slot 612 is reserved */
-/* Slot 613 is reserved */
-/* Slot 614 is reserved */
-/* Slot 615 is reserved */
-/* Slot 616 is reserved */
-/* Slot 617 is reserved */
-/* Slot 618 is reserved */
-/* Slot 619 is reserved */
-/* Slot 620 is reserved */
-/* Slot 621 is reserved */
-/* Slot 622 is reserved */
-/* Slot 623 is reserved */
-/* Slot 624 is reserved */
-/* Slot 625 is reserved */
-/* Slot 626 is reserved */
-/* Slot 627 is reserved */
-/* Slot 628 is reserved */
-/* Slot 629 is reserved */
-#ifndef TclUnusedStubEntry_TCL_DECLARED
-#define TclUnusedStubEntry_TCL_DECLARED
+				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);
 /* 630 */
-EXTERN void		TclUnusedStubEntry(void);
-#endif
+EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
+				Tcl_ZlibStream zhandle,
+				Tcl_Obj *compressionDictionaryObj);
 
-typedef struct TclStubHooks {
-    struct TclPlatStubs *tclPlatStubs;
-    struct TclIntStubs *tclIntStubs;
-    struct TclIntPlatStubs *tclIntPlatStubs;
+typedef struct {
+    const struct TclPlatStubs *tclPlatStubs;
+    const struct TclIntStubs *tclIntStubs;
+    const struct TclIntPlatStubs *tclIntPlatStubs;
 } TclStubHooks;
 
 typedef struct TclStubs {
     int magic;
-    struct TclStubHooks *hooks;
+    const TclStubHooks *hooks;
 
-    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData); /* 0 */
-    CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr); /* 1 */
-    void (*tcl_Panic) (CONST char *format, ...); /* 2 */
+    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 */
+    TCL_NORETURN1 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 */
+    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 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
-    VOID *reserved9;
+#if defined(_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 */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tcl_DeleteFileHandler) (int fd); /* 10 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
-    VOID *reserved10;
+#if defined(_WIN32) /* WIN */
+    void (*reserved10)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     void (*tcl_DeleteFileHandler) (int fd); /* 10 */
 #endif /* MACOSX */
-    void (*tcl_SetTimer) (Tcl_Time *timePtr); /* 11 */
+    void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
     void (*tcl_Sleep) (int ms); /* 12 */
-    int (*tcl_WaitForEvent) (Tcl_Time *timePtr); /* 13 */
+    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, 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 */
+    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_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_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
     int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
-    int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr); /* 36 */
-    int (*tcl_GetInt) (Tcl_Interp *interp, CONST char *src, int *intPtr); /* 37 */
+    int (*tcl_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 */
-    Tcl_ObjType * (*tcl_GetObjType) (CONST char *typeName); /* 40 */
+    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 */
@@ -3542,28 +1891,28 @@ typedef struct TclStubs {
     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 */
+    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_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_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 */
+    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_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_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_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_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 */
@@ -3571,33 +1920,33 @@ typedef struct TclStubs {
     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 */
+    char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
+    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
     void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
     void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
     int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
-    int (*tcl_CommandComplete) (CONST char *cmd); /* 82 */
-    char * (*tcl_Concat) (int argc, CONST84 char *CONST *argv); /* 83 */
-    int (*tcl_ConvertElement) (CONST char *src, char *dst, int flags); /* 84 */
-    int (*tcl_ConvertCountedElement) (CONST char *src, int length, char *dst, int flags); /* 85 */
-    int (*tcl_CreateAlias) (Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv); /* 86 */
-    int (*tcl_CreateAliasObj) (Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]); /* 87 */
-    Tcl_Channel (*tcl_CreateChannel) (Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask); /* 88 */
+    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 */
+    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 */
+    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_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_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 */
@@ -3611,8 +1960,8 @@ typedef struct TclStubs {
     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 */
+    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 */
@@ -3623,228 +1972,228 @@ typedef struct TclStubs {
     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_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 */
+    TCL_NORETURN1 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_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_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 */
+    int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
     void (*tcl_Finalize) (void); /* 143 */
-    void (*tcl_FindExecutable) (CONST char *argv0); /* 144 */
+    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_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
+    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
+    ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
+    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
     int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
     int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
     ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
     int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
     CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
-    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr); /* 157 */
-    Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
-    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
+    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 */
+    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 */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
+    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
-    VOID *reserved167;
+#if defined(_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 */
+    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 */
+    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_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 */
+    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_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;
+    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 */
+    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 */
+    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 */
+    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_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
     int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
     void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
-    void (*tcl_RegisterObjType) (Tcl_ObjType *typePtr); /* 211 */
-    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, CONST char *pattern); /* 212 */
-    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *text, CONST char *start); /* 213 */
-    int (*tcl_RegExpMatch) (Tcl_Interp *interp, CONST char *text, CONST char *pattern); /* 214 */
+    void (*tcl_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_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_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 */
+    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
+    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
     void (*tcl_SetErrno) (int err); /* 227 */
     void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
-    void (*tcl_SetMaxBlockTime) (Tcl_Time *timePtr); /* 229 */
-    void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */
+    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
+    void (*tcl_SetPanicProc) (TCL_NORETURN1 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_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_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_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_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 */
+    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
+    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
+    int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
+    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
+    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
+    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
     void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
     void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
     char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
-    CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, CONST char *start, CONST84 char **termPtr); /* 270 */
-    CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact); /* 271 */
-    CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr); /* 272 */
-    int (*tcl_PkgProvide) (Tcl_Interp *interp, CONST char *name, CONST char *version); /* 273 */
-    CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact); /* 274 */
+    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 */
+    TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
     void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
     void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
-    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
+    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 (*reserved285)(void);
     void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
-    Tcl_Encoding (*tcl_CreateEncoding) (CONST Tcl_EncodingType *typePtr); /* 287 */
+    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_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 */
+    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 */
+    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 */
+    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
+    void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
+    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
     ClientData (*tcl_InitNotifier) (void); /* 307 */
     void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
     void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
     void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
-    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr); /* 311 */
-    int (*tcl_NumUtfChars) (CONST char *src, int length); /* 312 */
+    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 */
+    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_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 */
+    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_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_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_SetDefaultEncodingDir) (const char *path); /* 342 */
     void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
     void (*tcl_ServiceModeHook) (int mode); /* 344 */
     int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
@@ -3854,91 +2203,91 @@ typedef struct TclStubs {
     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 */
+    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 */
+    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_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 */
+    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 */
+    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 */
+    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_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 */
+    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 */
+    CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
+    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
+    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
+    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
+    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
+    Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
+    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
+    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */
+    Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */
+    Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */
+    Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */
+    Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr); /* 409 */
+    Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr); /* 410 */
+    Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (const Tcl_ChannelType *chanTypePtr); /* 411 */
     int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
     int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
     int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
     void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
     void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
     void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
-    int (*tcl_IsChannelExisting) (CONST char *channelName); /* 418 */
-    int (*tcl_UniCharNcasecmp) (CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars); /* 419 */
-    int (*tcl_UniCharCaseMatch) (CONST Tcl_UniChar *uniStr, CONST Tcl_UniChar *uniPattern, int nocase); /* 420 */
-    Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, CONST char *key); /* 421 */
-    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, CONST char *key, int *newPtr); /* 422 */
-    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr); /* 423 */
+    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 */
+    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_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 */
+    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 */
+    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 */
@@ -3946,8 +2295,8 @@ typedef struct TclStubs {
     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 */
+    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 */
@@ -3955,10 +2304,10 @@ typedef struct TclStubs {
     int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
     int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
     int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
-    CONST char ** (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
+    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_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 */
@@ -3966,36 +2315,36 @@ typedef struct TclStubs {
     Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
     int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
     Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
-    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *CONST objv[]); /* 464 */
-    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr); /* 465 */
+    Tcl_Obj * (*tcl_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) (Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
-    CONST char * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
+    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, Tcl_Filesystem *fsPtr); /* 473 */
-    int (*tcl_FSUnregister) (Tcl_Filesystem *fsPtr); /* 474 */
-    ClientData (*tcl_FSData) (Tcl_Filesystem *fsPtr); /* 475 */
-    CONST char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
-    Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
+    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) (Tcl_Filesystem *fsPtr); /* 480 */
+    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_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 */
+    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 */
@@ -4003,25 +2352,25 @@ typedef struct TclStubs {
     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 */
+    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
+    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */
     Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
-    Tcl_Obj * (*tcl_DbNewDictObj) (CONST char *file, int line); /* 504 */
-    void (*tcl_RegisterConfig) (Tcl_Interp *interp, CONST char *pkgName, Tcl_Config *configuration, CONST char *valEncoding); /* 505 */
-    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
+    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 */
+    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_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 */
+    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
+    Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 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 */
@@ -4043,7 +2392,7 @@ typedef struct TclStubs {
     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_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 */
@@ -4056,14 +2405,14 @@ typedef struct TclStubs {
     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_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 */
+    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 */
+    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 */
@@ -4074,2481 +2423,1394 @@ typedef struct TclStubs {
     int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */
     Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
     int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
-    CONST char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
-    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr); /* 573 */
+    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, ...); /* 578 */
-    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, CONST char *format, ...); /* 579 */
-    VOID *reserved580;
-    VOID *reserved581;
-    VOID *reserved582;
-    VOID *reserved583;
-    VOID *reserved584;
-    VOID *reserved585;
-    VOID *reserved586;
-    VOID *reserved587;
-    VOID *reserved588;
-    VOID *reserved589;
-    VOID *reserved590;
-    VOID *reserved591;
-    VOID *reserved592;
-    VOID *reserved593;
-    VOID *reserved594;
-    VOID *reserved595;
-    VOID *reserved596;
-    VOID *reserved597;
-    VOID *reserved598;
-    VOID *reserved599;
-    VOID *reserved600;
-    VOID *reserved601;
-    VOID *reserved602;
-    VOID *reserved603;
-    VOID *reserved604;
-    VOID *reserved605;
-    VOID *reserved606;
-    VOID *reserved607;
-    VOID *reserved608;
-    VOID *reserved609;
-    VOID *reserved610;
-    VOID *reserved611;
-    VOID *reserved612;
-    VOID *reserved613;
-    VOID *reserved614;
-    VOID *reserved615;
-    VOID *reserved616;
-    VOID *reserved617;
-    VOID *reserved618;
-    VOID *reserved619;
-    VOID *reserved620;
-    VOID *reserved621;
-    VOID *reserved622;
-    VOID *reserved623;
-    VOID *reserved624;
-    VOID *reserved625;
-    VOID *reserved626;
-    VOID *reserved627;
-    VOID *reserved628;
-    VOID *reserved629;
-    void (*tclUnusedStubEntry) (void); /* 630 */
+    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 */
+    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
 } TclStubs;
 
-extern TclStubs *tclStubsPtr;
+extern const TclStubs *tclStubsPtr;
 
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
 
 /*
  * 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 */
-#endif
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef Tcl_CreateFileHandler
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
-#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_CreateFileHandler
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
-#endif
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef Tcl_DeleteFileHandler
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_DeleteFileHandler \
 	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
-#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_DeleteFileHandler
 #define Tcl_DeleteFileHandler \
 	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
-#endif
 #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
-#ifndef Tcl_DetachPids
 #define Tcl_DetachPids \
 	(tclStubsPtr->tcl_DetachPids) /* 111 */
-#endif
-#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 */
-#endif
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef Tcl_GetOpenFile
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_GetOpenFile \
 	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
-#endif
 #endif /* UNIX */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_GetOpenFile
 #define Tcl_GetOpenFile \
 	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
-#endif
 #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
-#ifndef Tcl_OpenCommandChannel
 #define Tcl_OpenCommandChannel \
 	(tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
-#endif
-#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
-#ifndef Tcl_ReapDetachedProcs
 #define Tcl_ReapDetachedProcs \
 	(tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
-#endif
-#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 */
-#endif
-#ifndef Tcl_DictObjPut
 #define Tcl_DictObjPut \
 	(tclStubsPtr->tcl_DictObjPut) /* 494 */
-#endif
-#ifndef Tcl_DictObjGet
 #define Tcl_DictObjGet \
 	(tclStubsPtr->tcl_DictObjGet) /* 495 */
-#endif
-#ifndef Tcl_DictObjRemove
 #define Tcl_DictObjRemove \
 	(tclStubsPtr->tcl_DictObjRemove) /* 496 */
-#endif
-#ifndef Tcl_DictObjSize
 #define Tcl_DictObjSize \
 	(tclStubsPtr->tcl_DictObjSize) /* 497 */
-#endif
-#ifndef Tcl_DictObjFirst
 #define Tcl_DictObjFirst \
 	(tclStubsPtr->tcl_DictObjFirst) /* 498 */
-#endif
-#ifndef Tcl_DictObjNext
 #define Tcl_DictObjNext \
 	(tclStubsPtr->tcl_DictObjNext) /* 499 */
-#endif
-#ifndef Tcl_DictObjDone
 #define Tcl_DictObjDone \
 	(tclStubsPtr->tcl_DictObjDone) /* 500 */
-#endif
-#ifndef Tcl_DictObjPutKeyList
 #define Tcl_DictObjPutKeyList \
 	(tclStubsPtr->tcl_DictObjPutKeyList) /* 501 */
-#endif
-#ifndef Tcl_DictObjRemoveKeyList
 #define Tcl_DictObjRemoveKeyList \
 	(tclStubsPtr->tcl_DictObjRemoveKeyList) /* 502 */
-#endif
-#ifndef Tcl_NewDictObj
 #define Tcl_NewDictObj \
 	(tclStubsPtr->tcl_NewDictObj) /* 503 */
-#endif
-#ifndef Tcl_DbNewDictObj
 #define Tcl_DbNewDictObj \
 	(tclStubsPtr->tcl_DbNewDictObj) /* 504 */
-#endif
-#ifndef Tcl_RegisterConfig
 #define Tcl_RegisterConfig \
 	(tclStubsPtr->tcl_RegisterConfig) /* 505 */
-#endif
-#ifndef Tcl_CreateNamespace
 #define Tcl_CreateNamespace \
 	(tclStubsPtr->tcl_CreateNamespace) /* 506 */
-#endif
-#ifndef Tcl_DeleteNamespace
 #define Tcl_DeleteNamespace \
 	(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
-#endif
-#ifndef Tcl_AppendExportList
 #define Tcl_AppendExportList \
 	(tclStubsPtr->tcl_AppendExportList) /* 508 */
-#endif
-#ifndef Tcl_Export
 #define Tcl_Export \
 	(tclStubsPtr->tcl_Export) /* 509 */
-#endif
-#ifndef Tcl_Import
 #define Tcl_Import \
 	(tclStubsPtr->tcl_Import) /* 510 */
-#endif
-#ifndef Tcl_ForgetImport
 #define Tcl_ForgetImport \
 	(tclStubsPtr->tcl_ForgetImport) /* 511 */
-#endif
-#ifndef Tcl_GetCurrentNamespace
 #define Tcl_GetCurrentNamespace \
 	(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
-#endif
-#ifndef Tcl_GetGlobalNamespace
 #define Tcl_GetGlobalNamespace \
 	(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
-#endif
-#ifndef Tcl_FindNamespace
 #define Tcl_FindNamespace \
 	(tclStubsPtr->tcl_FindNamespace) /* 514 */
-#endif
-#ifndef Tcl_FindCommand
 #define Tcl_FindCommand \
 	(tclStubsPtr->tcl_FindCommand) /* 515 */
-#endif
-#ifndef Tcl_GetCommandFromObj
 #define Tcl_GetCommandFromObj \
 	(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
-#endif
-#ifndef Tcl_GetCommandFullName
 #define Tcl_GetCommandFullName \
 	(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
-#endif
-#ifndef Tcl_FSEvalFileEx
 #define Tcl_FSEvalFileEx \
 	(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */
-#endif
-#ifndef Tcl_SetExitProc
 #define Tcl_SetExitProc \
 	(tclStubsPtr->tcl_SetExitProc) /* 519 */
-#endif
-#ifndef Tcl_LimitAddHandler
 #define Tcl_LimitAddHandler \
 	(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
-#endif
-#ifndef Tcl_LimitRemoveHandler
 #define Tcl_LimitRemoveHandler \
 	(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
-#endif
-#ifndef Tcl_LimitReady
 #define Tcl_LimitReady \
 	(tclStubsPtr->tcl_LimitReady) /* 522 */
-#endif
-#ifndef Tcl_LimitCheck
 #define Tcl_LimitCheck \
 	(tclStubsPtr->tcl_LimitCheck) /* 523 */
-#endif
-#ifndef Tcl_LimitExceeded
 #define Tcl_LimitExceeded \
 	(tclStubsPtr->tcl_LimitExceeded) /* 524 */
-#endif
-#ifndef Tcl_LimitSetCommands
 #define Tcl_LimitSetCommands \
 	(tclStubsPtr->tcl_LimitSetCommands) /* 525 */
-#endif
-#ifndef Tcl_LimitSetTime
 #define Tcl_LimitSetTime \
 	(tclStubsPtr->tcl_LimitSetTime) /* 526 */
-#endif
-#ifndef Tcl_LimitSetGranularity
 #define Tcl_LimitSetGranularity \
 	(tclStubsPtr->tcl_LimitSetGranularity) /* 527 */
-#endif
-#ifndef Tcl_LimitTypeEnabled
 #define Tcl_LimitTypeEnabled \
 	(tclStubsPtr->tcl_LimitTypeEnabled) /* 528 */
-#endif
-#ifndef Tcl_LimitTypeExceeded
 #define Tcl_LimitTypeExceeded \
 	(tclStubsPtr->tcl_LimitTypeExceeded) /* 529 */
-#endif
-#ifndef Tcl_LimitTypeSet
 #define Tcl_LimitTypeSet \
 	(tclStubsPtr->tcl_LimitTypeSet) /* 530 */
-#endif
-#ifndef Tcl_LimitTypeReset
 #define Tcl_LimitTypeReset \
 	(tclStubsPtr->tcl_LimitTypeReset) /* 531 */
-#endif
-#ifndef Tcl_LimitGetCommands
 #define Tcl_LimitGetCommands \
 	(tclStubsPtr->tcl_LimitGetCommands) /* 532 */
-#endif
-#ifndef Tcl_LimitGetTime
 #define Tcl_LimitGetTime \
 	(tclStubsPtr->tcl_LimitGetTime) /* 533 */
-#endif
-#ifndef Tcl_LimitGetGranularity
 #define Tcl_LimitGetGranularity \
 	(tclStubsPtr->tcl_LimitGetGranularity) /* 534 */
-#endif
-#ifndef Tcl_SaveInterpState
 #define Tcl_SaveInterpState \
 	(tclStubsPtr->tcl_SaveInterpState) /* 535 */
-#endif
-#ifndef Tcl_RestoreInterpState
 #define Tcl_RestoreInterpState \
 	(tclStubsPtr->tcl_RestoreInterpState) /* 536 */
-#endif
-#ifndef Tcl_DiscardInterpState
 #define Tcl_DiscardInterpState \
 	(tclStubsPtr->tcl_DiscardInterpState) /* 537 */
-#endif
-#ifndef Tcl_SetReturnOptions
 #define Tcl_SetReturnOptions \
 	(tclStubsPtr->tcl_SetReturnOptions) /* 538 */
-#endif
-#ifndef Tcl_GetReturnOptions
 #define Tcl_GetReturnOptions \
 	(tclStubsPtr->tcl_GetReturnOptions) /* 539 */
-#endif
-#ifndef Tcl_IsEnsemble
 #define Tcl_IsEnsemble \
 	(tclStubsPtr->tcl_IsEnsemble) /* 540 */
-#endif
-#ifndef Tcl_CreateEnsemble
 #define Tcl_CreateEnsemble \
 	(tclStubsPtr->tcl_CreateEnsemble) /* 541 */
-#endif
-#ifndef Tcl_FindEnsemble
 #define Tcl_FindEnsemble \
 	(tclStubsPtr->tcl_FindEnsemble) /* 542 */
-#endif
-#ifndef Tcl_SetEnsembleSubcommandList
 #define Tcl_SetEnsembleSubcommandList \
 	(tclStubsPtr->tcl_SetEnsembleSubcommandList) /* 543 */
-#endif
-#ifndef Tcl_SetEnsembleMappingDict
 #define Tcl_SetEnsembleMappingDict \
 	(tclStubsPtr->tcl_SetEnsembleMappingDict) /* 544 */
-#endif
-#ifndef Tcl_SetEnsembleUnknownHandler
 #define Tcl_SetEnsembleUnknownHandler \
 	(tclStubsPtr->tcl_SetEnsembleUnknownHandler) /* 545 */
-#endif
-#ifndef Tcl_SetEnsembleFlags
 #define Tcl_SetEnsembleFlags \
 	(tclStubsPtr->tcl_SetEnsembleFlags) /* 546 */
-#endif
-#ifndef Tcl_GetEnsembleSubcommandList
 #define Tcl_GetEnsembleSubcommandList \
 	(tclStubsPtr->tcl_GetEnsembleSubcommandList) /* 547 */
-#endif
-#ifndef Tcl_GetEnsembleMappingDict
 #define Tcl_GetEnsembleMappingDict \
 	(tclStubsPtr->tcl_GetEnsembleMappingDict) /* 548 */
-#endif
-#ifndef Tcl_GetEnsembleUnknownHandler
 #define Tcl_GetEnsembleUnknownHandler \
 	(tclStubsPtr->tcl_GetEnsembleUnknownHandler) /* 549 */
-#endif
-#ifndef Tcl_GetEnsembleFlags
 #define Tcl_GetEnsembleFlags \
 	(tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */
-#endif
-#ifndef Tcl_GetEnsembleNamespace
 #define Tcl_GetEnsembleNamespace \
 	(tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */
-#endif
-#ifndef Tcl_SetTimeProc
 #define Tcl_SetTimeProc \
 	(tclStubsPtr->tcl_SetTimeProc) /* 552 */
-#endif
-#ifndef Tcl_QueryTimeProc
 #define Tcl_QueryTimeProc \
 	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
-#endif
-#ifndef Tcl_ChannelThreadActionProc
 #define Tcl_ChannelThreadActionProc \
 	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
-#endif
-#ifndef Tcl_NewBignumObj
 #define Tcl_NewBignumObj \
 	(tclStubsPtr->tcl_NewBignumObj) /* 555 */
-#endif
-#ifndef Tcl_DbNewBignumObj
 #define Tcl_DbNewBignumObj \
 	(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
-#endif
-#ifndef Tcl_SetBignumObj
 #define Tcl_SetBignumObj \
 	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
-#endif
-#ifndef Tcl_GetBignumFromObj
 #define Tcl_GetBignumFromObj \
 	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
-#endif
-#ifndef Tcl_TakeBignumFromObj
 #define Tcl_TakeBignumFromObj \
 	(tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */
-#endif
-#ifndef Tcl_TruncateChannel
 #define Tcl_TruncateChannel \
 	(tclStubsPtr->tcl_TruncateChannel) /* 560 */
-#endif
-#ifndef Tcl_ChannelTruncateProc
 #define Tcl_ChannelTruncateProc \
 	(tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */
-#endif
-#ifndef Tcl_SetChannelErrorInterp
 #define Tcl_SetChannelErrorInterp \
 	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */
-#endif
-#ifndef Tcl_GetChannelErrorInterp
 #define Tcl_GetChannelErrorInterp \
 	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */
-#endif
-#ifndef Tcl_SetChannelError
 #define Tcl_SetChannelError \
 	(tclStubsPtr->tcl_SetChannelError) /* 564 */
-#endif
-#ifndef Tcl_GetChannelError
 #define Tcl_GetChannelError \
 	(tclStubsPtr->tcl_GetChannelError) /* 565 */
-#endif
-#ifndef Tcl_InitBignumFromDouble
 #define Tcl_InitBignumFromDouble \
 	(tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */
-#endif
-#ifndef Tcl_GetNamespaceUnknownHandler
 #define Tcl_GetNamespaceUnknownHandler \
 	(tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */
-#endif
-#ifndef Tcl_SetNamespaceUnknownHandler
 #define Tcl_SetNamespaceUnknownHandler \
 	(tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */
-#endif
-#ifndef Tcl_GetEncodingFromObj
 #define Tcl_GetEncodingFromObj \
 	(tclStubsPtr->tcl_GetEncodingFromObj) /* 569 */
-#endif
-#ifndef Tcl_GetEncodingSearchPath
 #define Tcl_GetEncodingSearchPath \
 	(tclStubsPtr->tcl_GetEncodingSearchPath) /* 570 */
-#endif
-#ifndef Tcl_SetEncodingSearchPath
 #define Tcl_SetEncodingSearchPath \
 	(tclStubsPtr->tcl_SetEncodingSearchPath) /* 571 */
-#endif
-#ifndef Tcl_GetEncodingNameFromEnvironment
 #define Tcl_GetEncodingNameFromEnvironment \
 	(tclStubsPtr->tcl_GetEncodingNameFromEnvironment) /* 572 */
-#endif
-#ifndef Tcl_PkgRequireProc
 #define Tcl_PkgRequireProc \
 	(tclStubsPtr->tcl_PkgRequireProc) /* 573 */
-#endif
-#ifndef Tcl_AppendObjToErrorInfo
 #define Tcl_AppendObjToErrorInfo \
 	(tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */
-#endif
-#ifndef Tcl_AppendLimitedToObj
 #define Tcl_AppendLimitedToObj \
 	(tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */
-#endif
-#ifndef Tcl_Format
 #define Tcl_Format \
 	(tclStubsPtr->tcl_Format) /* 576 */
-#endif
-#ifndef Tcl_AppendFormatToObj
 #define Tcl_AppendFormatToObj \
 	(tclStubsPtr->tcl_AppendFormatToObj) /* 577 */
-#endif
-#ifndef Tcl_ObjPrintf
 #define Tcl_ObjPrintf \
 	(tclStubsPtr->tcl_ObjPrintf) /* 578 */
-#endif
-#ifndef Tcl_AppendPrintfToObj
 #define Tcl_AppendPrintfToObj \
 	(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
-#endif
-/* Slot 580 is reserved */
-/* Slot 581 is reserved */
-/* Slot 582 is reserved */
-/* Slot 583 is reserved */
-/* Slot 584 is reserved */
-/* Slot 585 is reserved */
-/* Slot 586 is reserved */
-/* Slot 587 is reserved */
-/* Slot 588 is reserved */
-/* Slot 589 is reserved */
-/* Slot 590 is reserved */
-/* Slot 591 is reserved */
-/* Slot 592 is reserved */
-/* Slot 593 is reserved */
-/* Slot 594 is reserved */
-/* Slot 595 is reserved */
-/* Slot 596 is reserved */
-/* Slot 597 is reserved */
-/* Slot 598 is reserved */
-/* Slot 599 is reserved */
-/* Slot 600 is reserved */
-/* Slot 601 is reserved */
-/* Slot 602 is reserved */
-/* Slot 603 is reserved */
-/* Slot 604 is reserved */
-/* Slot 605 is reserved */
-/* Slot 606 is reserved */
-/* Slot 607 is reserved */
-/* Slot 608 is reserved */
-/* Slot 609 is reserved */
-/* Slot 610 is reserved */
-/* Slot 611 is reserved */
-/* Slot 612 is reserved */
-/* Slot 613 is reserved */
-/* Slot 614 is reserved */
-/* Slot 615 is reserved */
-/* Slot 616 is reserved */
-/* Slot 617 is reserved */
-/* Slot 618 is reserved */
-/* Slot 619 is reserved */
-/* Slot 620 is reserved */
-/* Slot 621 is reserved */
-/* Slot 622 is reserved */
-/* Slot 623 is reserved */
-/* Slot 624 is reserved */
-/* Slot 625 is reserved */
-/* Slot 626 is reserved */
-/* Slot 627 is reserved */
-/* Slot 628 is reserved */
-/* Slot 629 is reserved */
-#ifndef TclUnusedStubEntry
-#define TclUnusedStubEntry \
-	(tclStubsPtr->tclUnusedStubEntry) /* 630 */
-#endif
+#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 */
+#define Tcl_ZlibStreamSetCompressionDictionary \
+	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
 
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
 
-#undef TclUnusedStubEntry
+#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_ObjSetVar2
+#   undef Tcl_StaticPackage
+#   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))
+#   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
+	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, 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
 
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT
 
+#undef Tcl_SeekOld
+#undef Tcl_TellOld
+
 #undef Tcl_PkgPresent
 #define Tcl_PkgPresent(interp, name, version, exact) \
 	Tcl_PkgPresentEx(interp, name, version, exact, NULL)
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 4fec2c1..428173d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -4,7 +4,7 @@
  *	This file contains functions that implement the Tcl dict object type
  *	and its accessor command.
  *
- * Copyright (c) 2002 by Donal K. Fellows.
+ * 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.
@@ -31,8 +31,6 @@ static int		DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const *objv);
 static int		DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const *objv);
-static int		DictForCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const *objv);
 static int		DictGetCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const *objv);
 static int		DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
@@ -72,32 +70,39 @@ 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 Tcl_NRPostProc	FinalizeDictUpdate;
+static Tcl_NRPostProc	FinalizeDictWith;
+static Tcl_ObjCmdProc	DictForNRCmd;
+static Tcl_ObjCmdProc	DictMapNRCmd;
+static Tcl_NRPostProc	DictForLoopCallback;
+static Tcl_NRPostProc	DictMapLoopCallback;
 
 /*
  * Table of dict subcommand names and implementations.
  */
 
 static const EnsembleImplMap implementationMap[] = {
-    {"append",	DictAppendCmd,	TclCompileDictAppendCmd },
-    {"create",	DictCreateCmd,	NULL },
-    {"exists",	DictExistsCmd,	NULL },
-    {"filter",	DictFilterCmd,	NULL },
-    {"for",	DictForCmd,	TclCompileDictForCmd },
-    {"get",	DictGetCmd,	TclCompileDictGetCmd },
-    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd },
-    {"info",	DictInfoCmd,	NULL },
-    {"keys",	DictKeysCmd,	NULL },
-    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd },
-    {"merge",	DictMergeCmd,	NULL },
-    {"remove",	DictRemoveCmd,	NULL },
-    {"replace",	DictReplaceCmd,	NULL },
-    {"set",	DictSetCmd,	TclCompileDictSetCmd },
-    {"size",	DictSizeCmd,	NULL },
-    {"unset",	DictUnsetCmd,	NULL },
-    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd },
-    {"values",	DictValuesCmd,	NULL },
-    {"with",	DictWithCmd,	NULL },
-    {NULL, NULL, NULL}
+    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
+    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
+    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, 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,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+    {"keys",	DictKeysCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
+    {"map", 	NULL,       	TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
+    {"merge",	DictMergeCmd,	TclCompileDictMergeCmd, NULL, NULL, 0 },
+    {"remove",	DictRemoveCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
+    {"replace",	DictReplaceCmd, NULL, NULL, NULL, 0 },
+    {"set",	DictSetCmd,	TclCompileDictSetCmd, NULL, NULL, 0 },
+    {"size",	DictSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+    {"unset",	DictUnsetCmd,	TclCompileDictUnsetCmd, NULL, NULL, 0 },
+    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd, NULL, NULL, 0 },
+    {"values",	DictValuesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
+    {"with",	DictWithCmd,	TclCompileDictWithCmd, NULL, NULL, 0 },
+    {NULL, NULL, NULL, NULL, NULL, 0}
 };
 
 /*
@@ -144,14 +149,21 @@ typedef struct Dict {
 } Dict;
 
 /*
+ * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
+ * must be assignable as well as readable.
+ */
+
+#define DICT(dictObj)   (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
+
+/*
  * The structure below defines the dictionary object type by means of
  * functions that can be invoked by generic object code.
  */
 
-Tcl_ObjType tclDictType = {
+const Tcl_ObjType tclDictType = {
     "dict",
     FreeDictInternalRep,		/* freeIntRepProc */
-    DupDictInternalRep,		        /* dupIntRepProc */
+    DupDictInternalRep,			/* dupIntRepProc */
     UpdateStringOfDict,			/* updateStringProc */
     SetDictFromAny			/* setFromAnyProc */
 };
@@ -166,7 +178,7 @@ Tcl_ObjType tclDictType = {
  * *this* file. Everything else should use the dict iterator API.
  */
 
-static Tcl_HashKeyType chainHashType = {
+static const Tcl_HashKeyType chainHashType = {
     TCL_HASH_KEY_TYPE_VERSION,
     0,
     TclHashObjKey,
@@ -174,6 +186,23 @@ static Tcl_HashKeyType chainHashType = {
     AllocChainEntry,
     TclFreeObjEntry
 };
+
+/*
+ * Structure used in implementation of 'dict map' to hold the state that gets
+ * passed between parts of the implementation.
+ */
+
+typedef struct {
+    Tcl_Obj *keyVarObj;		/* The name of the variable that will have
+				 * keys assigned to it. */
+    Tcl_Obj *valueVarObj;	/* The name of the variable that will have
+				 * values assigned to it. */
+    Tcl_DictSearch search;	/* The dictionary search structure. */
+    Tcl_Obj *scriptObj;		/* The script to evaluate each time through
+				 * the loop. */
+    Tcl_Obj *accumulatorObj;	/* The dictionary used to accumulate the
+				 * results. */
+} DictMapStorage;
 
 /***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
 
@@ -203,8 +232,8 @@ AllocChainEntry(
     Tcl_Obj *objPtr = keyPtr;
     ChainEntry *cPtr;
 
-    cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
-    cPtr->entry.key.oneWordValue = (char *) objPtr;
+    cPtr = ckalloc(sizeof(ChainEntry));
+    cPtr->entry.key.objPtr = objPtr;
     Tcl_IncrRefCount(objPtr);
     cPtr->entry.clientData = NULL;
     cPtr->prevPtr = cPtr->nextPtr = NULL;
@@ -250,7 +279,7 @@ CreateChainEntry(
     int *newPtr)
 {
     ChainEntry *cPtr = (ChainEntry *)
-	    Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);
+	    Tcl_CreateHashEntry(&dict->table, keyPtr, newPtr);
 
     /*
      * If this is a new entry in the hash table, stitch it into the chain.
@@ -278,12 +307,13 @@ DeleteChainEntry(
     Tcl_Obj *keyPtr)
 {
     ChainEntry *cPtr = (ChainEntry *)
-	    Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+	    Tcl_FindHashEntry(&dict->table, keyPtr);
 
     if (cPtr == NULL) {
 	return 0;
     } else {
 	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
 	TclDecrRefCount(valuePtr);
     }
 
@@ -333,8 +363,8 @@ DupDictInternalRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *copyPtr)
 {
-    Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
-    Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
+    Dict *oldDict = DICT(srcPtr);
+    Dict *newDict = ckalloc(sizeof(Dict));
     ChainEntry *cPtr;
 
     /*
@@ -343,7 +373,7 @@ DupDictInternalRep(
 
     InitChainTable(newDict);
     for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
-	void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+	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);
@@ -352,7 +382,7 @@ DupDictInternalRep(
 	 * Fill in the contents.
 	 */
 
-	Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
+	Tcl_SetHashValue(hPtr, valuePtr);
 	Tcl_IncrRefCount(valuePtr);
     }
 
@@ -368,7 +398,8 @@ DupDictInternalRep(
      * Store in the object.
      */
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
+    DICT(copyPtr) = newDict;
+    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
     copyPtr->typePtr = &tclDictType;
 }
 
@@ -394,9 +425,9 @@ static void
 FreeDictInternalRep(
     Tcl_Obj *dictPtr)
 {
-    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    Dict *dict = DICT(dictPtr);
 
-    --dict->refcount;
+    dict->refcount--;
     if (dict->refcount <= 0) {
 	DeleteDict(dict);
     }
@@ -428,7 +459,7 @@ DeleteDict(
     Dict *dict)
 {
     DeleteChainTable(dict);
-    ckfree((char *) dict);
+    ckfree(dict);
 }
 
 /*
@@ -459,11 +490,12 @@ UpdateStringOfDict(
 {
 #define LOCAL_SIZE 20
     int localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    Dict *dict = DICT(dictPtr);
     ChainEntry *cPtr;
     Tcl_Obj *keyPtr, *valuePtr;
     int i, length, bytesNeeded = 0;
-    char *elem, *dst;
+    const char *elem;
+    char *dst;
     const int maxFlags = UINT_MAX / sizeof(int);
 
     /*
@@ -489,7 +521,7 @@ UpdateStringOfDict(
     } else if (numElems > maxFlags) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     } else {
-	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
+	flagPtr = ckalloc(numElems * sizeof(int));
     }
     for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
 	/*
@@ -498,7 +530,7 @@ UpdateStringOfDict(
 	 */
 
 	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
-	keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
+	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
 	elem = TclGetStringFromObj(keyPtr, &length);
 	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
 	if (bytesNeeded < 0) {
@@ -523,11 +555,11 @@ UpdateStringOfDict(
      */
 
     dictPtr->length = bytesNeeded - 1;
-    dictPtr->bytes = ckalloc((unsigned) bytesNeeded);
+    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_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
+	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
 	elem = TclGetStringFromObj(keyPtr, &length);
 	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
 	*dst++ = ' ';
@@ -541,7 +573,7 @@ UpdateStringOfDict(
     dictPtr->bytes[dictPtr->length] = '\0';
 
     if (flagPtr != localFlags) {
-	ckfree((char *) flagPtr);
+	ckfree(flagPtr);
     }
 }
 
@@ -571,8 +603,8 @@ SetDictFromAny(
     Tcl_Obj *objPtr)
 {
     Tcl_HashEntry *hPtr;
-    int isNew, result;
-    Dict *dict = (Dict *) ckalloc(sizeof(Dict));
+    int isNew;
+    Dict *dict = ckalloc(sizeof(Dict));
 
     InitChainTable(dict);
 
@@ -622,10 +654,9 @@ SetDictFromAny(
 	    const char *elemStart;
 	    int elemSize, literal;
 
-	    result = TclFindElement(interp, nextElem, (limit - nextElem),
-		    &elemStart, &nextElem, &elemSize, &literal);
-	    if (result != TCL_OK) {
-		goto errorExit;
+	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
+		goto errorInFindDictElement;
 	    }
 	    if (elemStart == limit) {
 		break;
@@ -644,11 +675,10 @@ SetDictFromAny(
 			keyPtr->bytes);
 	    }
 
-	    result = TclFindElement(interp, nextElem, (limit - nextElem),
-		    &elemStart, &nextElem, &elemSize, &literal);
-	    if (result != TCL_OK) {
+	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
 		TclDecrRefCount(keyPtr);
-		goto errorExit;
+		goto errorInFindDictElement;
 	    }
 
 	    if (literal) {
@@ -684,20 +714,21 @@ SetDictFromAny(
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
-    objPtr->internalRep.twoPtrValue.ptr1 = dict;
+    DICT(objPtr) = dict;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     objPtr->typePtr = &tclDictType;
     return TCL_OK;
 
   missingValue:
     if (interp != NULL) {
-	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"missing value to go with key", -1));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
     }
-    result = TCL_ERROR;
-
-  errorExit:
+  errorInFindDictElement:
     DeleteChainTable(dict);
-    ckfree((char *) dict);
-    return result;
+    ckfree(dict);
+    return TCL_ERROR;
 }
 
 /*
@@ -743,18 +774,17 @@ TclTraceDictPath(
     Dict *dict, *newDict;
     int i;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
-	    return NULL;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return NULL;
     }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     if (flags & DICT_PATH_UPDATE) {
 	dict->chain = NULL;
     }
 
     for (i=0 ; i<keyc ; i++) {
-	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
 	Tcl_Obj *tmpObj;
 
 	if (hPtr == NULL) {
@@ -765,9 +795,9 @@ TclTraceDictPath(
 	    }
 	    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_SetObjResult(interp, Tcl_ObjPrintf(
+			    "key \"%s\" not known in dictionary",
+			    TclGetString(keyv[i])));
 		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
 			    TclGetString(keyv[i]), NULL);
 		}
@@ -784,22 +814,21 @@ TclTraceDictPath(
 	    Tcl_SetHashValue(hPtr, tmpObj);
 	} else {
 	    tmpObj = Tcl_GetHashValue(hPtr);
-	    if (tmpObj->typePtr != &tclDictType) {
-		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
-		    return NULL;
-		}
+	    if (tmpObj->typePtr != &tclDictType
+		    && SetDictFromAny(interp, tmpObj) != TCL_OK) {
+		return NULL;
 	    }
 	}
 
-	newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+	newDict = DICT(tmpObj);
 	if (flags & DICT_PATH_UPDATE) {
 	    if (Tcl_IsShared(tmpObj)) {
 		TclDecrRefCount(tmpObj);
 		tmpObj = Tcl_DuplicateObj(tmpObj);
 		Tcl_IncrRefCount(tmpObj);
-		Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+		Tcl_SetHashValue(hPtr, tmpObj);
 		dict->epoch++;
-		newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+		newDict = DICT(tmpObj);
 	    }
 
 	    newDict->chain = dictPtr;
@@ -834,7 +863,7 @@ static void
 InvalidateDictChain(
     Tcl_Obj *dictObj)
 {
-    Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
+    Dict *dict = DICT(dictObj);
 
     do {
 	TclInvalidateStringRep(dictObj);
@@ -844,7 +873,7 @@ InvalidateDictChain(
 	    break;
 	}
 	dict->chain = NULL;
-	dict = dictObj->internalRep.twoPtrValue.ptr1;
+	dict = DICT(dictObj);
     } while (dict != NULL);
 }
 
@@ -882,18 +911,15 @@ Tcl_DictObjPut(
 	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->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     if (dictPtr->bytes != NULL) {
 	TclInvalidateStringRep(dictPtr);
     }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
@@ -936,16 +962,14 @@ Tcl_DictObjGet(
     Dict *dict;
     Tcl_HashEntry *hPtr;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    *valuePtrPtr = NULL;
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	*valuePtrPtr = NULL;
+	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
-    hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+    dict = DICT(dictPtr);
+    hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
     if (hPtr == NULL) {
 	*valuePtrPtr = NULL;
     } else {
@@ -985,18 +1009,16 @@ Tcl_DictObjRemove(
 	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->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     if (DeleteChainEntry(dict, keyPtr)) {
+	if (dictPtr->bytes != NULL) {
+	    TclInvalidateStringRep(dictPtr);
+	}
 	dict->epoch++;
     }
     return TCL_OK;
@@ -1028,14 +1050,12 @@ Tcl_DictObjSize(
 {
     Dict *dict;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     *sizePtr = dict->table.numEntries;
     return TCL_OK;
 }
@@ -1082,15 +1102,12 @@ Tcl_DictObjFirst(
     Dict *dict;
     ChainEntry *cPtr;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     cPtr = dict->entryChainHead;
     if (cPtr == NULL) {
 	searchPtr->epoch = -1;
@@ -1102,8 +1119,7 @@ Tcl_DictObjFirst(
 	searchPtr->next = cPtr->nextPtr;
 	dict->refcount++;
 	if (keyPtrPtr != NULL) {
-	    *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
-		    &cPtr->entry);
+	    *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
 	}
 	if (valuePtrPtr != NULL) {
 	    *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
@@ -1179,7 +1195,7 @@ Tcl_DictObjNext(
     searchPtr->next = cPtr->nextPtr;
     *donePtr = 0;
     if (keyPtrPtr != NULL) {
-	*keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
+	*keyPtrPtr = Tcl_GetHashKey(
 		&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
     }
     if (valuePtrPtr != NULL) {
@@ -1266,11 +1282,12 @@ Tcl_DictObjPutKeyList(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
 	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
 	TclDecrRefCount(oldValuePtr);
     }
     Tcl_SetHashValue(hPtr, valuePtr);
@@ -1322,7 +1339,7 @@ Tcl_DictObjRemoveKeyList(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     DeleteChainEntry(dict, keyv[keyc-1]);
     InvalidateDictChain(dictPtr);
     return TCL_OK;
@@ -1363,12 +1380,13 @@ Tcl_NewDictObj(void)
 
     TclNewObj(dictPtr);
     TclInvalidateStringRep(dictPtr);
-    dict = (Dict *) ckalloc(sizeof(Dict));
+    dict = ckalloc(sizeof(Dict));
     InitChainTable(dict);
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
-    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+    DICT(dictPtr) = dict;
+    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
     dictPtr->typePtr = &tclDictType;
     return dictPtr;
 #endif
@@ -1412,12 +1430,13 @@ Tcl_DbNewDictObj(
 
     TclDbNewObj(dictPtr, file, line);
     TclInvalidateStringRep(dictPtr);
-    dict = (Dict *) ckalloc(sizeof(Dict));
+    dict = ckalloc(sizeof(Dict));
     InitChainTable(dict);
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
-    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+    DICT(dictPtr) = dict;
+    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
     dictPtr->typePtr = &tclDictType;
     return dictPtr;
 #else /* !TCL_MEM_DEBUG */
@@ -1471,7 +1490,7 @@ DictCreateCmd(
 	/*
 	 * The next command is assumed to never fail...
 	 */
-	Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
+	Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]);
     }
     Tcl_SetObjResult(interp, dictObj);
     return TCL_OK;
@@ -1506,7 +1525,7 @@ DictGetCmd(
     int result;
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
 	return TCL_ERROR;
     }
 
@@ -1517,7 +1536,7 @@ DictGetCmd(
      */
 
     if (objc == 2) {
-	Tcl_Obj *keyPtr, *listPtr;
+	Tcl_Obj *keyPtr = NULL, *listPtr;
 	Tcl_DictSearch search;
 	int done;
 
@@ -1559,9 +1578,11 @@ DictGetCmd(
 	return result;
     }
     if (valuePtr == NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
-		"\" not known in dictionary", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"key \"%s\" not known in dictionary",
+		TclGetString(objv[objc-1])));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+		TclGetString(objv[objc-1]), NULL);
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, valuePtr);
@@ -1594,8 +1615,7 @@ DictReplaceCmd(
     Tcl_Obj *const *objv)
 {
     Tcl_Obj *dictPtr;
-    int i, result;
-    int allocatedDict = 0;
+    int i;
 
     if ((objc < 2) || (objc & 1)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
@@ -1603,18 +1623,18 @@ DictReplaceCmd(
     }
 
     dictPtr = objv[1];
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
-	allocatedDict = 1;
+    }
+    if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
     }
     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_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
     }
     Tcl_SetObjResult(interp, dictPtr);
     return TCL_OK;
@@ -1646,8 +1666,7 @@ DictRemoveCmd(
     Tcl_Obj *const *objv)
 {
     Tcl_Obj *dictPtr;
-    int i, result;
-    int allocatedDict = 0;
+    int i;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
@@ -1655,18 +1674,18 @@ DictRemoveCmd(
     }
 
     dictPtr = objv[1];
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
-	allocatedDict = 1;
+    }
+    if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
     }
     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_DictObjRemove(NULL, dictPtr, objv[i]);
     }
     Tcl_SetObjResult(interp, dictPtr);
     return TCL_OK;
@@ -1697,7 +1716,7 @@ DictMergeCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Tcl_Obj *targetObj, *keyObj, *valueObj;
+    Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
     int allocatedDict = 0;
     int i, done;
     Tcl_DictSearch search;
@@ -1715,10 +1734,9 @@ DictMergeCmd(
      */
 
     targetObj = objv[1];
-    if (targetObj->typePtr != &tclDictType) {
-	if (SetDictFromAny(interp, targetObj) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+    if (targetObj->typePtr != &tclDictType
+	    && SetDictFromAny(interp, targetObj) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     if (objc == 2) {
@@ -1787,7 +1805,7 @@ DictKeysCmd(
     Tcl_Obj *const *objv)
 {
     Tcl_Obj *listPtr;
-    char *pattern = NULL;
+    const char *pattern = NULL;
 
     if (objc!=2 && objc!=3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
@@ -1800,12 +1818,9 @@ DictKeysCmd(
      * need. [Bug 1705778, leak K04]
      */
 
-    if (objv[1]->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, objv[1]);
-
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (objv[1]->typePtr != &tclDictType
+	    && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     if (objc == 3) {
@@ -1821,8 +1836,8 @@ DictKeysCmd(
 	}
     } else {
 	Tcl_DictSearch search;
-	Tcl_Obj *keyPtr;
-	int done;
+	Tcl_Obj *keyPtr = NULL;
+	int done = 0;
 
 	/*
 	 * At this point, we know we have a dictionary (or at least something
@@ -1869,10 +1884,10 @@ DictValuesCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Tcl_Obj *valuePtr, *listPtr;
+    Tcl_Obj *valuePtr = NULL, *listPtr;
     Tcl_DictSearch search;
     int done;
-    char *pattern;
+    const char *pattern;
 
     if (objc!=2 && objc!=3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
@@ -2013,6 +2028,7 @@ DictInfoCmd(
 {
     Tcl_Obj *dictPtr;
     Dict *dict;
+    char *statsStr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
@@ -2020,19 +2036,15 @@ DictInfoCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
 
-    /*
-     * This next cast is actually OK.
-     */
-
-    Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+    statsStr = Tcl_HashStats(&dict->table);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
+    ckfree(statsStr);
     return TCL_OK;
 }
 
@@ -2065,7 +2077,7 @@ DictIncrCmd(
     Tcl_Obj *dictPtr, *valuePtr = NULL;
 
     if (objc < 3 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
 	return TCL_ERROR;
     }
 
@@ -2118,10 +2130,10 @@ DictIncrCmd(
 		 */
 
 		mp_clear(&increment);
-		Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
+		Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]);
 	    }
 	} else {
-	    Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
+	    Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1));
 	}
     } else {
 	/*
@@ -2130,7 +2142,7 @@ DictIncrCmd(
 
 	if (Tcl_IsShared(valuePtr)) {
 	    valuePtr = Tcl_DuplicateObj(valuePtr);
-	    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+	    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
 	}
 	if (objc == 4) {
 	    code = TclIncrObj(interp, valuePtr, objv[3]);
@@ -2139,7 +2151,7 @@ DictIncrCmd(
 
 	    Tcl_IncrRefCount(incrPtr);
 	    code = TclIncrObj(interp, valuePtr, incrPtr);
-	    Tcl_DecrRefCount(incrPtr);
+	    TclDecrRefCount(incrPtr);
 	}
     }
     if (code == TCL_OK) {
@@ -2152,7 +2164,7 @@ DictIncrCmd(
 	    Tcl_SetObjResult(interp, valuePtr);
 	}
     } else if (dictPtr->refCount == 0) {
-	Tcl_DecrRefCount(dictPtr);
+	TclDecrRefCount(dictPtr);
     }
     return code;
 }
@@ -2186,7 +2198,7 @@ DictLappendCmd(
     int i, allocatedDict = 0, allocatedValue = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
 	return TCL_ERROR;
     }
 
@@ -2230,7 +2242,7 @@ DictLappendCmd(
     }
 
     if (allocatedValue) {
-	Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
     } else if (dictPtr->bytes != NULL) {
 	TclInvalidateStringRep(dictPtr);
     }
@@ -2273,7 +2285,7 @@ DictAppendCmd(
     int i, allocatedDict = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
 	return TCL_ERROR;
     }
 
@@ -2295,17 +2307,15 @@ DictAppendCmd(
 
     if (valuePtr == NULL) {
 	TclNewObj(valuePtr);
-    } else {
-	if (Tcl_IsShared(valuePtr)) {
-	    valuePtr = Tcl_DuplicateObj(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);
+    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
 
     resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
@@ -2319,9 +2329,9 @@ DictAppendCmd(
 /*
  *----------------------------------------------------------------------
  *
- * DictForCmd --
+ * DictForNRCmd --
  *
- *	This function implements the "dict for" Tcl command. See the user
+ *	These functions implement the "dict for" Tcl command.  See the user
  *	documentation for details on what it does, and TIP#111 for the formal
  *	specification.
  *
@@ -2335,7 +2345,7 @@ DictAppendCmd(
  */
 
 static int
-DictForCmd(
+DictForNRCmd(
     ClientData dummy,
     Tcl_Interp *interp,
     int objc,
@@ -2344,31 +2354,42 @@ DictForCmd(
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
     Tcl_Obj **varv, *keyObj, *valueObj;
-    Tcl_DictSearch search;
-    int varc, done, result;
+    Tcl_DictSearch *searchPtr;
+    int varc, done;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"{keyVar valueVar} dictionary script");
+		"{keyVarName valueVarName} 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);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"must have exactly two variable names", -1));
+	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
 	return TCL_ERROR;
     }
-    keyVarObj = varv[0];
-    valueVarObj = varv[1];
-    scriptObj = objv[3];
-
-    if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj,
+    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
@@ -2380,64 +2401,335 @@ DictForCmd(
     Tcl_IncrRefCount(valueVarObj);
     Tcl_IncrRefCount(scriptObj);
 
-    result = TCL_OK;
-    while (!done) {
-	/*
-	 * Stop the value from getting hit in any way by any traces on the key
-	 * variable.
-	 */
+    /*
+     * Stop the value from getting hit in any way by any traces on the key
+     * variable.
+     */
 
-	Tcl_IncrRefCount(valueObj);
-	if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "couldn't set key variable: \"",
-		    TclGetString(keyVarObj), "\"", NULL);
-	    TclDecrRefCount(valueObj);
-	    result = TCL_ERROR;
-	    break;
-	}
+    Tcl_IncrRefCount(valueObj);
+    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
 	TclDecrRefCount(valueObj);
-	if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "couldn't set value variable: \"",
-		    TclGetString(valueVarObj), "\"", NULL);
-	    result = TCL_ERROR;
-	    break;
-	}
+	goto error;
+    }
+    TclDecrRefCount(valueObj);
+    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	goto error;
+    }
 
-	/*
-	 * TIP #280. Make invoking context available to loop body.
-	 */
+    /*
+     * Run the script.
+     */
 
-	result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
-	if (result == TCL_CONTINUE) {
+    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_OK) {
-	    if (result == TCL_BREAK) {
-		result = TCL_OK;
-	    } else if (result == TCL_ERROR) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (\"dict for\" body line %d)",
-			interp->errorLine));
-	    }
-	    break;
+	} 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(&search, &keyObj, &valueObj, &done);
+    Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
+    if (done) {
+	Tcl_ResetResult(interp);
+	goto done;
     }
 
     /*
-     * Stop holding a reference to these objects.
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictMapNRCmd --
+ *
+ *	These functions implement the "dict map" Tcl command.  See the user
+ *	documentation for details on what it does, and TIP#405 for the formal
+ *	specification.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    Tcl_DictObjDone(&search);
-    if (result == TCL_OK) {
-	Tcl_ResetResult(interp);
+static int
+DictMapNRCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj **varv, *keyObj, *valueObj;
+    DictMapStorage *storagePtr;
+    int varc, done;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"{keyVarName valueVarName} dictionary script");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse arguments.
+     */
+
+    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (varc != 2) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"must have exactly two variable names", -1));
+	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
+	return TCL_ERROR;
+    }
+    storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
+    if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
+	    &valueObj, &done) != TCL_OK) {
+	TclStackFree(interp, storagePtr);
+	return TCL_ERROR;
+    }
+    if (done) {
+	/*
+	 * Note that this exit leaves an empty value in the result (due to
+	 * command calling conventions) but that is OK since an empty value is
+	 * an empty dictionary.
+	 */
+
+	TclStackFree(interp, storagePtr);
+	return TCL_OK;
+    }
+    TclNewObj(storagePtr->accumulatorObj);
+    TclListObjGetElements(NULL, objv[1], &varc, &varv);
+    storagePtr->keyVarObj = varv[0];
+    storagePtr->valueVarObj = varv[1];
+    storagePtr->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(storagePtr->accumulatorObj);
+    Tcl_IncrRefCount(storagePtr->keyVarObj);
+    Tcl_IncrRefCount(storagePtr->valueVarObj);
+    Tcl_IncrRefCount(storagePtr->scriptObj);
+
+    /*
+     * Stop the value from getting hit in any way by any traces on the key
+     * variable.
+     */
+
+    Tcl_IncrRefCount(valueObj);
+    if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	TclDecrRefCount(valueObj);
+	goto error;
     }
+    if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	TclDecrRefCount(valueObj);
+	goto error;
+    }
+    TclDecrRefCount(valueObj);
+
+    /*
+     * Run the script.
+     */
+
+    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
+    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
+	    iPtr->cmdFramePtr, 3);
+
+    /*
+     * For unwinding everything on error.
+     */
+
+  error:
+    TclDecrRefCount(storagePtr->keyVarObj);
+    TclDecrRefCount(storagePtr->valueVarObj);
+    TclDecrRefCount(storagePtr->scriptObj);
+    TclDecrRefCount(storagePtr->accumulatorObj);
+    Tcl_DictObjDone(&storagePtr->search);
+    TclStackFree(interp, storagePtr);
+    return TCL_ERROR;
+}
+
+static int
+DictMapLoopCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    DictMapStorage *storagePtr = data[0];
+    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 map\" body line %d)",
+		    Tcl_GetErrorLine(interp)));
+	}
+	goto done;
+    } else {
+	keyObj = Tcl_ObjGetVar2(interp, storagePtr->keyVarObj, NULL,
+		TCL_LEAVE_ERR_MSG);
+	if (keyObj == NULL) {
+	    result = TCL_ERROR;
+	    goto done;
+	}
+	Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj,
+		Tcl_GetObjResult(interp));
+    }
+
+    /*
+     * Get the next mapping from the dictionary.
+     */
+
+    Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done);
+    if (done) {
+	Tcl_SetObjResult(interp, storagePtr->accumulatorObj);
+	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, storagePtr->keyVarObj, NULL, keyObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	TclDecrRefCount(valueObj);
+	result = TCL_ERROR;
+	goto done;
+    }
+    if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
+	TclDecrRefCount(valueObj);
+	result = TCL_ERROR;
+	goto done;
+    }
+    TclDecrRefCount(valueObj);
+
+    /*
+     * Run the script.
+     */
+
+    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
+    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
+	    iPtr->cmdFramePtr, 3);
+
+    /*
+     * For unwinding everything once the iterating is done.
+     */
+
+  done:
+    TclDecrRefCount(storagePtr->keyVarObj);
+    TclDecrRefCount(storagePtr->valueVarObj);
+    TclDecrRefCount(storagePtr->scriptObj);
+    TclDecrRefCount(storagePtr->accumulatorObj);
+    Tcl_DictObjDone(&storagePtr->search);
+    TclStackFree(interp, storagePtr);
     return result;
 }
 
@@ -2470,7 +2762,7 @@ DictSetCmd(
     int result, allocatedDict = 0;
 
     if (objc < 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
 	return TCL_ERROR;
     }
 
@@ -2530,7 +2822,7 @@ DictUnsetCmd(
     int result, allocatedDict = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
 	return TCL_ERROR;
     }
 
@@ -2586,20 +2878,20 @@ DictFilterCmd(
     Tcl_Obj *const *objv)
 {
     Interp *iPtr = (Interp *) interp;
-    static const char *filters[] = {
+    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, *valueObj, *resultObj, *boolObj;
+    Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
     Tcl_DictSearch search;
     int index, varc, done, result, satisfied;
-    char *pattern;
+    const char *pattern;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ...");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
 	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
@@ -2609,11 +2901,6 @@ DictFilterCmd(
 
     switch ((enum FilterTypes) index) {
     case FILTER_KEYS:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern");
-	    return TCL_ERROR;
-	}
-
 	/*
 	 * Create a dictionary whose keys all match a certain pattern.
 	 */
@@ -2622,23 +2909,52 @@ DictFilterCmd(
 		&keyObj, &valueObj, &done) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	pattern = TclGetString(objv[3]);
-	resultObj = Tcl_NewDictObj();
-	if (TclMatchIsTrivial(pattern)) {
+	if (objc == 3) {
 	    /*
-	     * Must release the search lock here to prevent a memory leak
-	     * since we are not exhausing the search. [Bug 1705778, leak K05]
+	     * Nothing to match, so return nothing (== empty dictionary).
 	     */
 
 	    Tcl_DictObjDone(&search);
-	    Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
-	    if (valueObj != NULL) {
-		Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+	    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(NULL, resultObj, objv[3], valueObj);
+		}
+	    } else {
+		while (!done) {
+		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+			Tcl_DictObjPut(NULL, 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) {
-		if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
-		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+		int i;
+
+		for (i=3 ; i<objc ; i++) {
+		    pattern = TclGetString(objv[i]);
+		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
+			break;		/* stop inner loop */
+		    }
 		}
 		Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
 	    }
@@ -2647,11 +2963,6 @@ DictFilterCmd(
 	return TCL_OK;
 
     case FILTER_VALUES:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern");
-	    return TCL_ERROR;
-	}
-
 	/*
 	 * Create a dictionary whose values all match a certain pattern.
 	 */
@@ -2660,11 +2971,16 @@ DictFilterCmd(
 		&keyObj, &valueObj, &done) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	pattern = TclGetString(objv[3]);
 	resultObj = Tcl_NewDictObj();
 	while (!done) {
-	    if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
-		Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+	    int i;
+
+	    for (i=3 ; i<objc ; i++) {
+		pattern = TclGetString(objv[i]);
+		if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
+		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
+		    break;		/* stop inner loop */
+		}
 	    }
 	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
 	}
@@ -2674,7 +2990,7 @@ DictFilterCmd(
     case FILTER_SCRIPT:
 	if (objc != 5) {
 	    Tcl_WrongNumArgs(interp, 1, objv,
-		    "dictionary script {keyVar valueVar} filterScript");
+		    "dictionary script {keyVarName valueVarName} filterScript");
 	    return TCL_ERROR;
 	}
 
@@ -2688,8 +3004,9 @@ DictFilterCmd(
 	    return TCL_ERROR;
 	}
 	if (varc != 2) {
-	    Tcl_SetResult(interp, "must have exactly two variable names",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "must have exactly two variable names", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
 	    return TCL_ERROR;
 	}
 	keyVarObj = varv[0];
@@ -2728,17 +3045,16 @@ DictFilterCmd(
 	    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);
+		Tcl_AddErrorInfo(interp,
+			"\n    (\"dict filter\" filter script key variable)");
 		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);
+		Tcl_AddErrorInfo(interp,
+			"\n    (\"dict filter\" filter script value variable)");
+		result = TCL_ERROR;
 		goto abnormalResult;
 	    }
 
@@ -2760,7 +3076,7 @@ DictFilterCmd(
 		}
 		TclDecrRefCount(boolObj);
 		if (satisfied) {
-		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
 		}
 		break;
 	    case TCL_BREAK:
@@ -2778,7 +3094,7 @@ DictFilterCmd(
 	    case TCL_ERROR:
 		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 			"\n    (\"dict filter\" script line %d)",
-			interp->errorLine));
+			Tcl_GetErrorLine(interp)));
 	    default:
 		goto abnormalResult;
 	    }
@@ -2847,12 +3163,11 @@ DictUpdateCmd(
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *dictPtr, *objPtr;
-    int i, result, dummy;
-    Tcl_InterpState state;
+    int i, dummy;
 
     if (objc < 5 || !(objc & 1)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"varName key varName ?key varName ...? script");
+		"dictVarName key varName ?key varName ...? script");
 	return TCL_ERROR;
     }
 
@@ -2881,10 +3196,34 @@ DictUpdateCmd(
     TclDecrRefCount(dictPtr);
 
     /*
-     * Execute the body.
+     * 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.
      */
 
-    result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
     if (result == TCL_ERROR) {
 	Tcl_AddErrorInfo(interp, "\n    (body of \"dict update\")");
     }
@@ -2893,8 +3232,10 @@ DictUpdateCmd(
      * If the dictionary variable doesn't exist, drop everything silently.
      */
 
-    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
     if (dictPtr == NULL) {
+	TclDecrRefCount(varName);
+	TclDecrRefCount(argsObj);
 	return result;
     }
 
@@ -2903,8 +3244,10 @@ DictUpdateCmd(
      */
 
     state = Tcl_SaveInterpState(interp, result);
-    if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
+    if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
 	Tcl_DiscardInterpState(state);
+	TclDecrRefCount(varName);
+	TclDecrRefCount(argsObj);
 	return TCL_ERROR;
     }
 
@@ -2917,34 +3260,37 @@ DictUpdateCmd(
      * an instruction to remove the key.
      */
 
-    for (i=2 ; i+2<objc ; i+=2) {
+    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]);
+	    Tcl_DictObjRemove(NULL, 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));
+	    Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr));
 	} else {
 	    /* Shouldn't fail */
-	    Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
+	    Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr);
 	}
     }
+    TclDecrRefCount(argsObj);
 
     /*
      * Write the dictionary back to its variable.
      */
 
-    if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+    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);
 }
 
@@ -2974,13 +3320,10 @@ DictWithCmd(
     Tcl_Obj *const *objv)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
-    Tcl_DictSearch s;
-    Tcl_InterpState state;
-    int done, result, keyc, i, allocdict = 0;
+    Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
 	return TCL_ERROR;
     }
 
@@ -2992,11 +3335,126 @@ DictWithCmd(
     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) {
-	dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
+	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 TCL_ERROR;
+	    return NULL;
 	}
     }
 
@@ -3009,11 +3467,10 @@ DictWithCmd(
 
     if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
 	    &done) != TCL_OK) {
-	return TCL_ERROR;
+	return NULL;
     }
 
     TclNewObj(keysPtr);
-    Tcl_IncrRefCount(keysPtr);
 
     for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
 	Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
@@ -3021,47 +3478,87 @@ DictWithCmd(
 		TCL_LEAVE_ERR_MSG) == NULL) {
 	    TclDecrRefCount(keysPtr);
 	    Tcl_DictObjDone(&s);
-	    return TCL_ERROR;
+	    return NULL;
 	}
     }
 
-    /*
-     * Execute the body, while making the invoking context available to the
-     * loop body (TIP#280).
-     */
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
-    if (result == TCL_ERROR) {
-	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
-    }
+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 = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+    dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+	    TCL_LEAVE_ERR_MSG, index);
     if (dictPtr == NULL) {
-	TclDecrRefCount(keysPtr);
-	return result;
+	return TCL_OK;
     }
 
     /*
      * Double-check that it is still a dictionary.
      */
 
-    state = Tcl_SaveInterpState(interp, result);
     if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
-	TclDecrRefCount(keysPtr);
-	Tcl_DiscardInterpState(state);
 	return TCL_ERROR;
     }
 
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
 	allocdict = 1;
+    } else {
+	allocdict = 0;
     }
 
-    if (objc > 3) {
+    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
@@ -3071,22 +3568,19 @@ DictWithCmd(
 	 * perfectly efficient (but no memory should be leaked).
 	 */
 
-	leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
+	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
 		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
 	if (leafPtr == NULL) {
-	    TclDecrRefCount(keysPtr);
 	    if (allocdict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    Tcl_DiscardInterpState(state);
 	    return TCL_ERROR;
 	}
 	if (leafPtr == DICT_PATH_NON_EXISTENT) {
-	    TclDecrRefCount(keysPtr);
 	    if (allocdict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    return Tcl_RestoreInterpState(interp, state);
+	    return TCL_OK;
 	}
     } else {
 	leafPtr = dictPtr;
@@ -3112,14 +3606,13 @@ DictWithCmd(
 	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
 	}
     }
-    TclDecrRefCount(keysPtr);
 
     /*
      * Ensure that none of the dictionaries in the chain still have a string
      * rep.
      */
 
-    if (objc > 3) {
+    if (pathc > 0) {
 	InvalidateDictChain(leafPtr);
     }
 
@@ -3127,12 +3620,14 @@ DictWithCmd(
      * Write back the outermost dictionary to the variable.
      */
 
-    if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
-	    TCL_LEAVE_ERR_MSG) == NULL) {
-	Tcl_DiscardInterpState(state);
+    if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
+	    TCL_LEAVE_ERR_MSG, index) == NULL) {
+	if (allocdict) {
+	    TclDecrRefCount(dictPtr);
+	}
 	return TCL_ERROR;
     }
-    return Tcl_RestoreInterpState(interp, state);
+    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
new file mode 100644
index 0000000..f62c260
--- /dev/null
+++ b/generic/tclDisassemble.c
@@ -0,0 +1,1634 @@
+/*
+ * tclDisassemble.c --
+ *
+ *	This file contains procedures that disassemble bytecode into either
+ *	human-readable or Tcl-processable forms.
+ *
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2013-2016 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"
+#include "tclOOInt.h"
+#include <assert.h>
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+static int		FormatInstruction(ByteCode *codePtr,
+			    const unsigned char *pc, Tcl_Obj *bufferObj);
+static void		GetLocationInformation(Proc *procPtr,
+			    Tcl_Obj **fileObjPtr, int *linePtr);
+static void		PrintSourceToObj(Tcl_Obj *appendObj,
+			    const char *stringPtr, int maxChars);
+static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
+
+/*
+ * The structure below defines an instruction name Tcl object to allow
+ * reporting of inner contexts in errorstack without string allocation.
+ */
+
+static const Tcl_ObjType tclInstNameType = {
+    "instname",			/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    UpdateStringOfInstName,	/* updateStringProc */
+    NULL,			/* setFromAnyProc */
+};
+
+/*
+ * How to get the bytecode out of a Tcl_Obj.
+ */
+
+#define BYTECODE(objPtr)					\
+    ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetLocationInformation --
+ *
+ *	This procedure looks up the information about where a procedure was
+ *	originally declared.
+ *
+ * Results:
+ *	Writes to the variables pointed at by fileObjPtr and linePtr.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetLocationInformation(
+    Proc *procPtr,		/* What to look up the information for. */
+    Tcl_Obj **fileObjPtr,	/* Where to write the information about what
+				 * file the code came from. Will be written
+				 * to, either with the object (assume shared!)
+				 * that describes what the file was, or with
+				 * NULL if the information is not
+				 * available. */
+    int *linePtr)		/* Where to write the information about what
+				 * line number represented the start of the
+				 * code in question. Will be written to,
+				 * either with the line number or with -1 if
+				 * the information is not available. */
+{
+    CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr);
+
+    *fileObjPtr = NULL;
+    *linePtr = -1;
+    if (cfPtr == NULL) {
+	return;
+    }
+
+    /*
+     * Get the source location data out of the CmdFrame.
+     */
+
+    *linePtr = cfPtr->line[0];
+    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	*fileObjPtr = cfPtr->data.eval.path;
+    }
+}
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 getting location info. */
+    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
+{
+    Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, 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.
+ *
+ * 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 */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisassembleByteCodeObj --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DisassembleByteCodeObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
+{
+    ByteCode *codePtr = BYTECODE(objPtr);
+    unsigned char *codeStart, *codeLimit, *pc;
+    unsigned char *codeDeltaNext, *codeLengthNext;
+    unsigned char *srcDeltaNext, *srcLengthNext;
+    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+    Interp *iPtr = (Interp *) *codePtr->interpHandle;
+    Tcl_Obj *bufferObj, *fileObj;
+    char ptrBuf1[20], ptrBuf2[20];
+
+    TclNewObj(bufferObj);
+    if (codePtr->refCount <= 0) {
+	return bufferObj;	/* Already freed. */
+    }
+
+    codeStart = codePtr->codeStart;
+    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,
+	    iPtr->compileEpoch);
+    Tcl_AppendToObj(bufferObj, "  Source ", -1);
+    PrintSourceToObj(bufferObj, codePtr->source,
+	    TclMin(codePtr->numSrcBytes, 55));
+    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
+    if (line > -1 && fileObj != NULL) {
+	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
+		Tcl_GetString(fileObj), line);
+    }
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
+	    codePtr->numLitObjects, codePtr->numAuxDataItems,
+	    codePtr->maxStackDepth,
+#ifdef TCL_COMPILE_STATS
+	    codePtr->numSrcBytes?
+		    codePtr->structureSize/(float)codePtr->numSrcBytes :
+#endif
+	    0.0);
+
+#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)),
+	    codePtr->numCodeBytes,
+	    (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,
+		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" : "");
+		if (TclIsVarTemporary(localPtr)) {
+		    Tcl_AppendToObj(bufferObj, "\n", -1);
+		} else {
+		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
+			    localPtr->name);
+		}
+		localPtr = localPtr->nextPtr;
+	    }
+	}
+    }
+
+    /*
+     * Print the ExceptionRange array.
+     */
+
+    if (codePtr->numExceptRanges > 0) {
+	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
+		codePtr->numExceptRanges, codePtr->maxExceptDepth);
+	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
+	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+	    Tcl_AppendPrintfToObj(bufferObj,
+		    "      %d: level %d, %s, pc %d-%d, ",
+		    i, rangePtr->nestingLevel,
+		    (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);
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
+			rangePtr->catchOffset);
+		break;
+	    default:
+		Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
+			rangePtr->type);
+	    }
+	}
+    }
+
+    /*
+     * If there were no commands (e.g., an expression or an empty string was
+     * compiled), just print all instructions and return.
+     */
+
+    if (numCmds == 0) {
+	pc = codeStart;
+	while (pc < codeLimit) {
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	}
+	return bufferObj;
+    }
+
+    /*
+     * 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);
+    codeDeltaNext = codePtr->codeDeltaStart;
+    codeLengthNext = codePtr->codeLengthStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
+	    codeLengthNext++;
+	    codeLen = TclGetInt4AtPtr(codeLengthNext);
+	    codeLengthNext += 4;
+	} else {
+	    codeLen = TclGetInt1AtPtr(codeLengthNext);
+	    codeLengthNext++;
+	}
+
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+
+	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
+		((i % 2)? "     " : "\n   "),
+		(i+1), codeOffset, (codeOffset + codeLen - 1),
+		srcOffset, (srcOffset + srcLen - 1));
+    }
+    if (numCmds > 0) {
+	Tcl_AppendToObj(bufferObj, "\n", -1);
+    }
+
+    /*
+     * Print each instruction. If the instruction corresponds to the start of
+     * a command, print the command's source. Note that we don't need the code
+     * length here.
+     */
+
+    codeDeltaNext = codePtr->codeDeltaStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    pc = codeStart;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+
+	/*
+	 * Print instructions before command i.
+	 */
+
+	while ((pc-codeStart) < codeOffset) {
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	}
+
+	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
+	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
+		TclMin(srcLen, 55));
+	Tcl_AppendToObj(bufferObj, "\n", -1);
+    }
+    if (pc < codeLimit) {
+	/*
+	 * Print instructions after the last command.
+	 */
+
+	while (pc < codeLimit) {
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	}
+    }
+    return bufferObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatInstruction --
+ *
+ *	Appends a representation of a bytecode instruction to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    Proc *procPtr = codePtr->procPtr;
+    unsigned char opCode = *pc;
+    register const 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);
+    for (i = 0;  i < instDesc->numOperands;  i++) {
+	switch (instDesc->opTypes[i]) {
+	case OPERAND_INT1:
+	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+	    break;
+	case OPERAND_INT4:
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+	    break;
+	case OPERAND_UINT1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_UINT4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opCode == INST_START_CMD) {
+		sprintf(suffixBuffer+strlen(suffixBuffer),
+			", %u cmds start here", opnd);
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_OFFSET1:
+	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+	    sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+	    break;
+	case OPERAND_OFFSET4:
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opCode == INST_START_CMD) {
+		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
+	    } else {
+		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+	    break;
+	case OPERAND_LIT1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+	    suffixObj = codePtr->objArrayPtr[opnd];
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_LIT4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+	    suffixObj = codePtr->objArrayPtr[opnd];
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_AUX4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    auxPtr = &codePtr->auxDataArrayPtr[opnd];
+	    break;
+	case OPERAND_IDX4:
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opnd >= -1) {
+		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
+	    } else if (opnd == -2) {
+		Tcl_AppendPrintfToObj(bufferObj, "end ");
+	    } else {
+		Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
+	    }
+	    break;
+	case OPERAND_LVT1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes);
+	    numBytes++;
+	    goto printLVTindex;
+	case OPERAND_LVT4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes);
+	    numBytes += 4;
+	printLVTindex:
+	    if (localPtr != NULL) {
+		if (opnd >= localCt) {
+		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+			    (unsigned) opnd, localCt);
+		}
+		for (j = 0;  j < opnd;  j++) {
+		    localPtr = localPtr->nextPtr;
+		}
+		if (TclIsVarTemporary(localPtr)) {
+		    sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
+		} else {
+		    sprintf(suffixBuffer, "var ");
+		    suffixSrc = localPtr->name;
+		}
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_SCLS1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
+		    tclStringClassTable[opnd].name);
+	    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInnerContext --
+ *
+ *	If possible, returns a list capturing the inner context. Otherwise
+ *	return NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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)
+#ifdef TCL_MEM_DEBUG
+                || (objPtr->refCount==0x61616161)
+#endif
+        ) {
+            Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
+                    objPtr);
+        }
+        Tcl_ListObjAppendElement(NULL, result, objPtr);
+    }
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewInstNameObj --
+ *
+ *	Creates a new InstName Tcl_Obj based on the given instruction
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewInstNameObj(
+    unsigned char inst)
+{
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    objPtr->typePtr = &tclInstNameType;
+    objPtr->internalRep.longValue = (long) inst;
+    objPtr->bytes = NULL;
+
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInstName --
+ *
+ *	Update the string representation for an instruction name object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintSourceToObj --
+ *
+ *	Appends a quoted representation of a string to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintSourceToObj(
+    Tcl_Obj *appendObj,		/* The object to print the source to. */
+    const char *stringPtr,	/* The string to print. */
+    int maxChars)		/* Maximum number of chars to print. */
+{
+    register const char *p;
+    register int i = 0, len;
+    Tcl_UniChar ch = 0;
+
+    if (stringPtr == NULL) {
+	Tcl_AppendToObj(appendObj, "\"\"", -1);
+	return;
+    }
+
+    Tcl_AppendToObj(appendObj, "\"", -1);
+    p = stringPtr;
+    for (;  (*p != '\0') && (i < maxChars);  p+=len) {
+
+	len = TclUtfToUniChar(p, &ch);
+	switch (ch) {
+	case '"':
+	    Tcl_AppendToObj(appendObj, "\\\"", -1);
+	    i += 2;
+	    continue;
+	case '\f':
+	    Tcl_AppendToObj(appendObj, "\\f", -1);
+	    i += 2;
+	    continue;
+	case '\n':
+	    Tcl_AppendToObj(appendObj, "\\n", -1);
+	    i += 2;
+	    continue;
+	case '\r':
+	    Tcl_AppendToObj(appendObj, "\\r", -1);
+	    i += 2;
+	    continue;
+	case '\t':
+	    Tcl_AppendToObj(appendObj, "\\t", -1);
+	    i += 2;
+	    continue;
+	case '\v':
+	    Tcl_AppendToObj(appendObj, "\\v", -1);
+	    i += 2;
+	    continue;
+	default:
+#if TCL_UTF_MAX > 4
+	    if (ch > 0xffff) {
+		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
+		i += 10;
+	    } else
+#elif TCL_UTF_MAX > 3
+	    /* If len == 0, this means we have a char > 0xffff, resulting in
+	     * TclUtfToUniChar producing a surrogate pair. We want to output
+	     * this pair as a single Unicode character.
+	     */
+	    if (len == 0) {
+		int upper = ((ch & 0x3ff) + 1) << 10;
+		len = TclUtfToUniChar(p, &ch);
+		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", upper + (ch & 0x3ff));
+		i += 10;
+	    } else
+#endif
+	    if (ch < 0x20 || ch >= 0x7f) {
+		Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
+		i += 6;
+	    } else {
+		Tcl_AppendPrintfToObj(appendObj, "%c", ch);
+		i++;
+	    }
+	    continue;
+	}
+    }
+    if (*p != '\0') {
+	Tcl_AppendToObj(appendObj, "...", -1);
+    }
+    Tcl_AppendToObj(appendObj, "\"", -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisassembleByteCodeAsDicts --
+ *
+ *	Given an object which is of bytecode type, return a disassembled
+ *	version of the bytecode (in a new refcount 0 object) in a dictionary.
+ *	No guarantees are made about the details of the contents of the
+ *	result, but it is intended to be more readable than the old output
+ *	format.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DisassembleByteCodeAsDicts(
+    Tcl_Interp *interp,		/* Used for looking up the CmdFrame for the
+				 * procedure, if one exists. */
+    Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
+{
+    ByteCode *codePtr = BYTECODE(objPtr);
+    Tcl_Obj *description, *literals, *variables, *instructions, *inst;
+    Tcl_Obj *aux, *exn, *commands, *file;
+    unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
+    int codeOffset, codeLength, sourceOffset, sourceLength;
+    int i, val, line;
+
+    /*
+     * Get the literals from the bytecode.
+     */
+
+    literals = Tcl_NewObj();
+    for (i=0 ; i<codePtr->numLitObjects ; i++) {
+	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
+    }
+
+    /*
+     * Get the variables from the bytecode.
+     */
+
+    variables = Tcl_NewObj();
+    if (codePtr->procPtr) {
+	int localCount = codePtr->procPtr->numCompiledLocals;
+	CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
+
+	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
+	    Tcl_Obj *descriptor[2];
+
+	    descriptor[0] = Tcl_NewObj();
+	    if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {
+		Tcl_ListObjAppendElement(NULL, descriptor[0],
+			Tcl_NewStringObj("scalar", -1));
+	    }
+	    if (localPtr->flags & VAR_ARRAY) {
+		Tcl_ListObjAppendElement(NULL, descriptor[0],
+			Tcl_NewStringObj("array", -1));
+	    }
+	    if (localPtr->flags & VAR_LINK) {
+		Tcl_ListObjAppendElement(NULL, descriptor[0],
+			Tcl_NewStringObj("link", -1));
+	    }
+	    if (localPtr->flags & VAR_ARGUMENT) {
+		Tcl_ListObjAppendElement(NULL, descriptor[0],
+			Tcl_NewStringObj("arg", -1));
+	    }
+	    if (localPtr->flags & VAR_TEMPORARY) {
+		Tcl_ListObjAppendElement(NULL, descriptor[0],
+			Tcl_NewStringObj("temp", -1));
+	    }
+	    if (localPtr->flags & VAR_RESOLVED) {
+		Tcl_ListObjAppendElement(NULL, descriptor[0],
+			Tcl_NewStringObj("resolved", -1));
+	    }
+	    if (localPtr->flags & VAR_TEMPORARY) {
+		Tcl_ListObjAppendElement(NULL, variables,
+			Tcl_NewListObj(1, descriptor));
+	    } else {
+		descriptor[1] = Tcl_NewStringObj(localPtr->name, -1);
+		Tcl_ListObjAppendElement(NULL, variables,
+			Tcl_NewListObj(2, descriptor));
+	    }
+	}
+    }
+
+    /*
+     * Get the instructions from the bytecode.
+     */
+
+    instructions = Tcl_NewObj();
+    for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){
+	const InstructionDesc *instDesc = &tclInstructionTable[*pc];
+	int address = pc - codePtr->codeStart;
+
+	inst = Tcl_NewObj();
+	Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
+		instDesc->name, -1));
+	opnd = pc + 1;
+	for (i=0 ; i<instDesc->numOperands ; i++) {
+	    switch (instDesc->opTypes[i]) {
+	    case OPERAND_INT1:
+		val = TclGetInt1AtPtr(opnd);
+		opnd += 1;
+		goto formatNumber;
+	    case OPERAND_UINT1:
+		val = TclGetUInt1AtPtr(opnd);
+		opnd += 1;
+		goto formatNumber;
+	    case OPERAND_INT4:
+		val = TclGetInt4AtPtr(opnd);
+		opnd += 4;
+		goto formatNumber;
+	    case OPERAND_UINT4:
+		val = TclGetUInt4AtPtr(opnd);
+		opnd += 4;
+	    formatNumber:
+		Tcl_ListObjAppendElement(NULL, inst, Tcl_NewIntObj(val));
+		break;
+
+	    case OPERAND_OFFSET1:
+		val = TclGetInt1AtPtr(opnd);
+		opnd += 1;
+		goto formatAddress;
+	    case OPERAND_OFFSET4:
+		val = TclGetInt4AtPtr(opnd);
+		opnd += 4;
+	    formatAddress:
+		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			"pc %d", address + val));
+		break;
+
+	    case OPERAND_LIT1:
+		val = TclGetUInt1AtPtr(opnd);
+		opnd += 1;
+		goto formatLiteral;
+	    case OPERAND_LIT4:
+		val = TclGetUInt4AtPtr(opnd);
+		opnd += 4;
+	    formatLiteral:
+		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			"@%d", val));
+		break;
+
+	    case OPERAND_LVT1:
+		val = TclGetUInt1AtPtr(opnd);
+		opnd += 1;
+		goto formatVariable;
+	    case OPERAND_LVT4:
+		val = TclGetUInt4AtPtr(opnd);
+		opnd += 4;
+	    formatVariable:
+		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			"%%%d", val));
+		break;
+	    case OPERAND_IDX4:
+		val = TclGetInt4AtPtr(opnd);
+		opnd += 4;
+		if (val >= -1) {
+		    Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			    ".%d", val));
+		} else if (val == -2) {
+		    Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
+			    ".end", -1));
+		} else {
+		    Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			    ".end-%d", -2-val));
+		}
+		break;
+	    case OPERAND_AUX4:
+		val = TclGetInt4AtPtr(opnd);
+		opnd += 4;
+		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			"?%d", val));
+		break;
+	    case OPERAND_SCLS1:
+		val = TclGetUInt1AtPtr(opnd);
+		opnd++;
+		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+			"=%s", tclStringClassTable[val].name));
+		break;
+	    case OPERAND_NONE:
+		Tcl_Panic("opcode %d with more than zero 'no' operands", *pc);
+	    }
+	}
+	Tcl_DictObjPut(NULL, instructions, Tcl_NewIntObj(address), inst);
+	pc += instDesc->numBytes;
+    }
+
+    /*
+     * Get the auxiliary data from the bytecode.
+     */
+
+    aux = Tcl_NewObj();
+    for (i=0 ; i<codePtr->numAuxDataItems ; i++) {
+	AuxData *auxData = &codePtr->auxDataArrayPtr[i];
+	Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1);
+
+	if (auxData->type->disassembleProc) {
+	    Tcl_Obj *desc = Tcl_NewObj();
+
+	    Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
+	    auxDesc = desc;
+	    auxData->type->disassembleProc(auxData->clientData, auxDesc,
+		    codePtr, 0);
+	} else if (auxData->type->printProc) {
+	    Tcl_Obj *desc = Tcl_NewObj();
+
+	    auxData->type->printProc(auxData->clientData, desc, codePtr, 0);
+	    Tcl_ListObjAppendElement(NULL, auxDesc, desc);
+	}
+	Tcl_ListObjAppendElement(NULL, aux, auxDesc);
+    }
+
+    /*
+     * Get the exception ranges from the bytecode.
+     */
+
+    exn = Tcl_NewObj();
+    for (i=0 ; i<codePtr->numExceptRanges ; i++) {
+	ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+	switch (rangePtr->type) {
+	case LOOP_EXCEPTION_RANGE:
+	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
+		    "type %s level %d from %d to %d break %d continue %d",
+		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
+		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
+		    rangePtr->breakOffset, rangePtr->continueOffset));
+	    break;
+	case CATCH_EXCEPTION_RANGE:
+	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
+		    "type %s level %d from %d to %d catch %d",
+		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
+		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
+		    rangePtr->catchOffset));
+	    break;
+	}
+    }
+
+    /*
+     * Get the command information from the bytecode.
+     *
+     * The way these are encoded in the bytecode is non-trivial; the Decode
+     * macro (which updates its argument and returns the next decoded value)
+     * handles this so that the rest of the code does not.
+     */
+
+#define Decode(ptr) \
+    ((TclGetUInt1AtPtr(ptr) == 0xFF)			\
+	? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4))		\
+	: ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1)))
+
+    commands = Tcl_NewObj();
+    codeOffPtr = codePtr->codeDeltaStart;
+    codeLenPtr = codePtr->codeLengthStart;
+    srcOffPtr = codePtr->srcDeltaStart;
+    srcLenPtr = codePtr->srcLengthStart;
+    codeOffset = sourceOffset = 0;
+    for (i=0 ; i<codePtr->numCommands ; i++) {
+	Tcl_Obj *cmd;
+
+	codeOffset += Decode(codeOffPtr);
+	codeLength = Decode(codeLenPtr);
+	sourceOffset += Decode(srcOffPtr);
+	sourceLength = Decode(srcLenPtr);
+	cmd = Tcl_NewObj();
+	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1),
+		Tcl_NewIntObj(codeOffset));
+	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1),
+		Tcl_NewIntObj(codeOffset + codeLength - 1));
+
+	/*
+	 * Convert byte offsets to character offsets; important if multibyte
+	 * characters are present in the source!
+	 */
+
+	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1),
+		Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+			sourceOffset)));
+	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1),
+		Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+			sourceOffset + sourceLength - 1)));
+	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1),
+		Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
+	Tcl_ListObjAppendElement(NULL, commands, cmd);
+    }
+
+#undef Decode
+
+    /*
+     * Get the source file and line number information from the CmdFrame
+     * system if it is available.
+     */
+
+    GetLocationInformation(codePtr->procPtr, &file, &line);
+
+    /*
+     * Build the overall result.
+     */
+
+    description = Tcl_NewObj();
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1),
+	    literals);
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1),
+	    variables);
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn);
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1),
+	    instructions);
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux);
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1),
+	    commands);
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1),
+	    Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1),
+	    Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
+	    Tcl_NewIntObj(codePtr->maxStackDepth));
+    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
+	    Tcl_NewIntObj(codePtr->maxExceptDepth));
+    if (line > -1) {
+	Tcl_DictObjPut(NULL, description,
+		Tcl_NewStringObj("initiallinenumber", -1),
+		Tcl_NewIntObj(line));
+    }
+    if (file) {
+	Tcl_DictObjPut(NULL, description,
+		Tcl_NewStringObj("sourcefile", -1), file);
+    }
+    return description;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 clientData,	/* What type of operation. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *const types[] = {
+	"constructor", "destructor",
+	"lambda", "method", "objmethod", "proc", "script", NULL
+    };
+    enum Types {
+	DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR,
+	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;
+    Method *methodPtr;
+
+    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.
+	 *
+	 * WARNING! Pokes inside the lambda objtype.
+	 */
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
+	    return TCL_ERROR;
+	}
+	if (objv[2]->typePtr == &tclLambdaType) {
+	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+	}
+	if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
+	    result = tclLambdaType.setFromAnyProc(interp, objv[2]);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+	}
+
+	memset(&cmd, 0, sizeof(Command));
+	nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
+	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	cmd.nsPtr = (Namespace *) nsPtr;
+	procPtr->cmdPtr = &cmd;
+	result = TclPushProcCallFrame(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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" isn't a procedure", TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+		    TclGetString(objv[2]), NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Compile (if uncompiled) and disassemble a procedure.
+	 */
+
+	result = TclPushProcCallFrame(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)
+		&& (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
+	codeObjPtr = objv[2];
+	break;
+
+    case DISAS_CLASS_CONSTRUCTOR:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "className");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Look up the body of a constructor.
+	 */
+
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+	if (oPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (oPtr->classPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" is not a class", TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+		    TclGetString(objv[2]), NULL);
+	    return TCL_ERROR;
+	}
+
+	methodPtr = oPtr->classPtr->constructorPtr;
+	if (methodPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" has no defined constructor",
+		    TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		    "CONSRUCTOR", NULL);
+	    return TCL_ERROR;
+	}
+	procPtr = TclOOGetProcFromMethod(methodPtr);
+	if (procPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "body not available for this kind of constructor", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		    "METHODTYPE", NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Compile if necessary.
+	 */
+
+	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 constructor",
+		    TclGetString(objv[2]));
+	    procPtr->cmdPtr = NULL;
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	codeObjPtr = procPtr->bodyPtr;
+	break;
+
+    case DISAS_CLASS_DESTRUCTOR:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "className");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Look up the body of a destructor.
+	 */
+
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+	if (oPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (oPtr->classPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" is not a class", TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+		    TclGetString(objv[2]), NULL);
+	    return TCL_ERROR;
+	}
+
+	methodPtr = oPtr->classPtr->destructorPtr;
+	if (methodPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" has no defined destructor",
+		    TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		    "DESRUCTOR", NULL);
+	    return TCL_ERROR;
+	}
+	procPtr = TclOOGetProcFromMethod(methodPtr);
+	if (procPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "body not available for this kind of destructor", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		    "METHODTYPE", NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Compile if necessary.
+	 */
+
+	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 destructor",
+		    TclGetString(objv[2]));
+	    procPtr->cmdPtr = NULL;
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	codeObjPtr = procPtr->bodyPtr;
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" is not a class", TclGetString(objv[2])));
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "unknown method \"%s\"", TclGetString(objv[3])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		    TclGetString(objv[3]), NULL);
+	    return TCL_ERROR;
+	}
+	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+	if (procPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "body not available for this kind of method", -1));
+	    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)->flags & TCL_BYTECODE_PRECOMPILED) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"may not disassemble prebuilt bytecode", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		"BYTECODE", NULL);
+	return TCL_ERROR;
+    }
+    if (PTR2INT(clientData)) {
+	Tcl_SetObjResult(interp,
+		DisassembleByteCodeAsDicts(interp, codeObjPtr));
+    } else {
+	Tcl_SetObjResult(interp,
+		DisassembleByteCodeObj(interp, codeObjPtr));
+    }
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 6c16827..6820faa 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -92,7 +92,7 @@ typedef struct TableEncodingData {
  */
 
 typedef struct EscapeSubTable {
-    unsigned int sequenceLen;	/* Length of following string. */
+    unsigned 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
@@ -104,10 +104,10 @@ typedef struct EscapeEncodingData {
     int fallback;		/* Character (in this encoding) to substitute
 				 * when this encoding cannot represent a UTF-8
 				 * character. */
-    unsigned int initLen;	/* Length of following string. */
+    unsigned initLen;		/* Length of following string. */
     char init[16];		/* String to emit or expect before first char
 				 * in conversion. */
-    unsigned int finalLen;	/* Length of following string. */
+    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
@@ -123,7 +123,7 @@ typedef struct EscapeEncodingData {
 } EscapeEncodingData;
 
 /*
- * constants used when loading an encoding file to identify the type of the
+ * Constants used when loading an encoding file to identify the type of the
  * file.
  */
 
@@ -180,9 +180,9 @@ TCL_DECLARE_MUTEX(encodingMutex)
  * the system encoding will be used to perform the conversion.
  */
 
-static Tcl_Encoding defaultEncoding;
-static Tcl_Encoding systemEncoding;
-Tcl_Encoding tclIdentityEncoding;
+static Tcl_Encoding defaultEncoding = NULL;
+static Tcl_Encoding systemEncoding = NULL;
+Tcl_Encoding tclIdentityEncoding = NULL;
 
 /*
  * The following variable is used in the sparse matrix code for a
@@ -276,7 +276,7 @@ static int		Iso88591ToUtfProc(ClientData clientData,
  * See concerns raised in [Bug 1077262].
  */
 
-static Tcl_ObjType encodingType = {
+static const Tcl_ObjType encodingType = {
     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
 };
 
@@ -294,7 +294,7 @@ static Tcl_ObjType encodingType = {
  *	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).
  *
  *----------------------------------------------------------------------
  */
@@ -306,6 +306,7 @@ Tcl_GetEncodingFromObj(
     Tcl_Encoding *encodingPtr)
 {
     const char *name = Tcl_GetString(objPtr);
+
     if (objPtr->typePtr != &encodingType) {
 	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
 
@@ -313,7 +314,7 @@ Tcl_GetEncodingFromObj(
 	    return TCL_ERROR;
 	}
 	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) encoding;
+	objPtr->internalRep.twoPtrValue.ptr1 = encoding;
 	objPtr->typePtr = &encodingType;
     }
     *encodingPtr = Tcl_GetEncoding(NULL, name);
@@ -334,7 +335,7 @@ static void
 FreeEncodingIntRep(
     Tcl_Obj *objPtr)
 {
-    Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.twoPtrValue.ptr1);
+    Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
     objPtr->typePtr = NULL;
 }
 
@@ -353,8 +354,7 @@ DupEncodingIntRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *)
-	    Tcl_GetEncoding(NULL, srcPtr->bytes);
+    dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
 }
 
 /*
@@ -453,8 +453,8 @@ TclSetLibraryPath(
  *
  * FillEncodingFileMap --
  *
- * 	Called to bring the encoding file map in sync with the current value
- * 	of the encoding search path.
+ *	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
@@ -507,12 +507,12 @@ FillEncodingFileMap(void)
 
 	Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev);
 	for (j=0; j<numFiles; j++) {
-	    Tcl_Obj *encodingName, *file;
+	    Tcl_Obj *encodingName, *fileObj;
 
-	    file = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
-	    encodingName = TclPathPart(NULL, file, TCL_PATH_ROOT);
+	    fileObj = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
+	    encodingName = TclPathPart(NULL, fileObj, TCL_PATH_ROOT);
 	    Tcl_DictObjPut(NULL, map, encodingName, directory);
-	    Tcl_DecrRefCount(file);
+	    Tcl_DecrRefCount(fileObj);
 	    Tcl_DecrRefCount(encodingName);
 	}
 	Tcl_DecrRefCount(matchFileList);
@@ -544,6 +544,9 @@ void
 TclInitEncodingSubsystem(void)
 {
     Tcl_EncodingType type;
+    TableEncodingData *dataPtr;
+    unsigned size;
+    unsigned short i;
 
     if (encodingsInitialized) {
 	return;
@@ -565,10 +568,7 @@ TclInitEncodingSubsystem(void)
     type.freeProc	= NULL;
     type.nullSize	= 1;
     type.clientData	= NULL;
-
-    defaultEncoding	= Tcl_CreateEncoding(&type);
-    tclIdentityEncoding = Tcl_GetEncoding(NULL, type.encodingName);
-    systemEncoding	= Tcl_GetEncoding(NULL, type.encodingName);
+    tclIdentityEncoding = Tcl_CreateEncoding(&type);
 
     type.encodingName	= "utf-8";
     type.toUtfProc	= UtfExtToUtfIntProc;
@@ -593,43 +593,37 @@ TclInitEncodingSubsystem(void)
      * code to duplicate the structure of a table encoding here.
      */
 
-    {
-	TableEncodingData *dataPtr = (TableEncodingData *)
-		ckalloc(sizeof(TableEncodingData));
-	unsigned size;
-	unsigned short i;
-
-	memset(dataPtr, 0, sizeof(TableEncodingData));
-	dataPtr->fallback = '?';
-
-	size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
-	dataPtr->toUnicode = (unsigned short **) ckalloc(size);
-	memset(dataPtr->toUnicode, 0, size);
-	dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
-	memset(dataPtr->fromUnicode, 0, size);
-
-	dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
-	dataPtr->fromUnicode[0] = (unsigned short *)
-		(dataPtr->fromUnicode + 256);
-	for (i=1 ; i<256 ; i++) {
-	    dataPtr->toUnicode[i] = emptyPage;
-	    dataPtr->fromUnicode[i] = emptyPage;
-	}
+    dataPtr = ckalloc(sizeof(TableEncodingData));
+    memset(dataPtr, 0, sizeof(TableEncodingData));
+    dataPtr->fallback = '?';
 
-	for (i=0 ; i<256 ; i++) {
-	    dataPtr->toUnicode[0][i] = i;
-	    dataPtr->fromUnicode[0][i] = i;
-	}
+    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);
 
-	type.encodingName	= "iso8859-1";
-	type.toUtfProc		= Iso88591ToUtfProc;
-	type.fromUtfProc	= Iso88591FromUtfProc;
-	type.freeProc		= TableFreeProc;
-	type.nullSize		= 1;
-	type.clientData		= dataPtr;
-	Tcl_CreateEncoding(&type);
+    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;
 }
 
@@ -658,7 +652,10 @@ TclFinalizeEncodingSubsystem(void)
     Tcl_MutexLock(&encodingMutex);
     encodingsInitialized = 0;
     FreeEncoding(systemEncoding);
+    systemEncoding = NULL;
+    defaultEncoding = NULL;
     FreeEncoding(tclIdentityEncoding);
+    tclIdentityEncoding = NULL;
 
     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     while (hPtr != NULL) {
@@ -669,7 +666,7 @@ TclFinalizeEncodingSubsystem(void)
 	 * cleaned up.
 	 */
 
-	FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
+	FreeEncoding(Tcl_GetHashValue(hPtr));
 	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     }
 
@@ -682,15 +679,15 @@ TclFinalizeEncodingSubsystem(void)
  *
  * Tcl_GetDefaultEncodingDir --
  *
- * 	Legacy public interface to retrieve first directory in the encoding
- * 	searchPath.
+ *	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.
+ *	None.
  *
  *-------------------------------------------------------------------------
  */
@@ -715,14 +712,14 @@ Tcl_GetDefaultEncodingDir(void)
  *
  * Tcl_SetDefaultEncodingDir --
  *
- * 	Legacy public interface to set the first directory in the encoding
- * 	search path.
+ *	Legacy public interface to set the first directory in the encoding
+ *	search path.
  *
  * Results:
- * 	None.
+ *	None.
  *
  * Side effects:
- * 	Modifies the encoding search path.
+ *	Modifies the encoding search path.
  *
  *-------------------------------------------------------------------------
  */
@@ -782,7 +779,7 @@ Tcl_GetEncoding(
 
     hPtr = Tcl_FindHashEntry(&encodingTable, name);
     if (hPtr != NULL) {
-	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+	encodingPtr = Tcl_GetHashValue(hPtr);
 	encodingPtr->refCount++;
 	Tcl_MutexUnlock(&encodingMutex);
 	return (Tcl_Encoding) encodingPtr;
@@ -841,9 +838,8 @@ static void
 FreeEncoding(
     Tcl_Encoding encoding)
 {
-    Encoding *encodingPtr;
+    Encoding *encodingPtr = (Encoding *) encoding;
 
-    encodingPtr = (Encoding *) encoding;
     if (encodingPtr == NULL) {
 	return;
     }
@@ -853,13 +849,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((char *) encodingPtr->name);
-	ckfree((char *) encodingPtr);
+	ckfree(encodingPtr->name);
+	ckfree(encodingPtr);
     }
 }
 
@@ -929,9 +925,10 @@ Tcl_GetEncodingNames(
     Tcl_MutexLock(&encodingMutex);
     for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&search)) {
-	Encoding *encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+	Encoding *encodingPtr = Tcl_GetHashValue(hPtr);
+
 	Tcl_CreateHashEntry(&table,
-		(char *) Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
+		Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
     }
     Tcl_MutexUnlock(&encodingMutex);
 
@@ -944,7 +941,7 @@ Tcl_GetEncodingNames(
 
     Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done);
     for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) {
-	Tcl_CreateHashEntry(&table, (char *) name, &dummy);
+	Tcl_CreateHashEntry(&table, name, &dummy);
     }
 
     /*
@@ -1059,13 +1056,13 @@ Tcl_CreateEncoding(
 	 * reference goes away.
 	 */
 
-	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+	encodingPtr = Tcl_GetHashValue(hPtr);
 	encodingPtr->hPtr = NULL;
     }
 
-    name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
+    name = ckalloc(strlen(typePtr->encodingName) + 1);
 
-    encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
+    encodingPtr = ckalloc(sizeof(Encoding));
     encodingPtr->name		= strcpy(name, typePtr->encodingName);
     encodingPtr->toUtfProc	= typePtr->toUtfProc;
     encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
@@ -1119,7 +1116,7 @@ Tcl_ExternalToUtfDString(
 {
     char *dst;
     Tcl_EncodingState state;
-    Encoding *encodingPtr;
+    const Encoding *encodingPtr;
     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
 
     Tcl_DStringInit(dstPtr);
@@ -1134,15 +1131,14 @@ 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) {
@@ -1210,8 +1206,11 @@ Tcl_ExternalToUtf(
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    Encoding *encodingPtr;
-    int result, srcRead, dstWrote, dstChars;
+    const Encoding *encodingPtr;
+    int result, srcRead, dstWrote, dstChars = 0;
+    int noTerminate = flags & TCL_ENCODING_NO_TERMINATE;
+    int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr;
+    int maxChars = INT_MAX;
     Tcl_EncodingState state;
 
     if (encoding == NULL) {
@@ -1222,7 +1221,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;
@@ -1236,19 +1235,40 @@ Tcl_ExternalToUtf(
     }
     if (dstCharsPtr == NULL) {
 	dstCharsPtr = &dstChars;
+	flags &= ~TCL_ENCODING_CHAR_LIMIT;
+    } else if (charLimited) {
+	maxChars = *dstCharsPtr;
     }
 
-    /*
-     * 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.
-     */
+    if (!noTerminate) {
+	/*
+	 * 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.  First make room for it...
+	 */
 
-    dstLen--;
-    result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
-	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
-	    dstCharsPtr);
-    dst[*dstWrotePtr] = '\0';
+	dstLen--;
+    }
+    do {
+	int savedFlags = flags;
+	Tcl_EncodingState savedState = *statePtr;
+
+	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
+		flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+		dstCharsPtr);
+	if (*dstCharsPtr <= maxChars) {
+	    break;
+	}
+	dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX;
+	flags = savedFlags;
+	*statePtr = savedState;
+    } while (1);
+    if (!noTerminate) {
+	/* ...and then append it */
+
+	dst[*dstWrotePtr] = '\0';
+    }
 
     return result;
 }
@@ -1286,7 +1306,7 @@ Tcl_UtfToExternalDString(
 {
     char *dst;
     Tcl_EncodingState state;
-    Encoding *encodingPtr;
+    const Encoding *encodingPtr;
     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
 
     Tcl_DStringInit(dstPtr);
@@ -1305,7 +1325,7 @@ 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);
@@ -1378,7 +1398,7 @@ Tcl_UtfToExternal(
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    Encoding *encodingPtr;
+    const Encoding *encodingPtr;
     int result, srcRead, dstWrote, dstChars;
     Tcl_EncodingState state;
 
@@ -1407,7 +1427,7 @@ 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) {
@@ -1431,11 +1451,11 @@ Tcl_UtfToExternal(
  *
  * Side effects:
  *	The absolute pathname for the application is computed and stored to be
- *	returned later be [info nameofexecutable].
+ *	returned later by [info nameofexecutable].
  *
  *---------------------------------------------------------------------------
  */
-
+#undef Tcl_FindExecutable
 void
 Tcl_FindExecutable(
     const char *argv0)		/* The value of the application's argv[0]
@@ -1454,9 +1474,9 @@ Tcl_FindExecutable(
  *	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.
+ *	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
@@ -1499,6 +1519,7 @@ OpenEncodingFileChannel(
 	}
 	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;
@@ -1551,7 +1572,8 @@ OpenEncodingFileChannel(
     }
 
     if ((NULL == chan) && (interp != NULL)) {
-	Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown encoding \"%s\"", name));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
     }
     Tcl_DecrRefCount(fileNameObj);
@@ -1625,7 +1647,9 @@ LoadEncodingFile(
 	break;
     }
     if ((encoding == NULL) && (interp != NULL)) {
-	Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"invalid encoding file \"%s\"", name));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
     }
     Tcl_Close(NULL, chan);
 
@@ -1664,11 +1688,11 @@ LoadTableEncoding(
     Tcl_DString lineString;
     Tcl_Obj *objPtr;
     char *line;
-    int i, hi, lo, numPages, symbol, fallback;
+    int i, hi, lo, numPages, symbol, fallback, len;
     unsigned char used[256];
-    unsigned int size;
+    unsigned size;
     TableEncodingData *dataPtr;
-    unsigned short *pageMemPtr;
+    unsigned short *pageMemPtr, *page;
     Tcl_EncodingType encType;
 
     /*
@@ -1715,7 +1739,7 @@ LoadTableEncoding(
 #undef PAGESIZE
 #define PAGESIZE    (256 * sizeof(unsigned short))
 
-    dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
+    dataPtr = ckalloc(sizeof(TableEncodingData));
     memset(dataPtr, 0, sizeof(TableEncodingData));
 
     dataPtr->fallback = fallback;
@@ -1727,7 +1751,7 @@ LoadTableEncoding(
      */
 
     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
-    dataPtr->toUnicode = (unsigned short **) ckalloc(size);
+    dataPtr->toUnicode = ckalloc(size);
     memset(dataPtr->toUnicode, 0, size);
     pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
 
@@ -1735,7 +1759,7 @@ LoadTableEncoding(
     Tcl_IncrRefCount(objPtr);
     for (i = 0; i < numPages; i++) {
 	int ch;
-	char *p;
+	const char *p;
 
 	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
 	p = Tcl_GetString(objPtr);
@@ -1785,29 +1809,26 @@ LoadTableEncoding(
 	}
     }
     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
-    dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
+    dataPtr->fromUnicode = 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;
-	} 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);
+	    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;
 		}
+		page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
 	    }
 	}
     }
@@ -1826,8 +1847,6 @@ 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
@@ -1835,7 +1854,7 @@ LoadTableEncoding(
 	 * 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.
+	 * font doesn't have glyphs for those low ASCII chars.
 	 */
 
 	page = dataPtr->fromUnicode[0];
@@ -1860,57 +1879,77 @@ LoadTableEncoding(
      */
 
     Tcl_DStringInit(&lineString);
-    do {
-	int len;
+
+    /*
+     * 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 (TclDStringClear(&lineString);
+	    (len = Tcl_Gets(chan, &lineString)) >= 0;
+	    TclDStringClear(&lineString)) {
+	const unsigned char *p;
+	int to, from;
 
 	/*
-	 * Skip leading empty lines.
+	 * Skip short lines.
 	 */
 
-	while ((len = Tcl_Gets(chan, &lineString)) == 0) {
-	    /* empty body */
+	if (len < 5) {
+	    continue;
 	}
 
-	if (len < 0) {
-	    break;
-	}
-	line = Tcl_DStringValue(&lineString);
-	if (line[0] != 'R') {
-	    break;
-	}
-	for (Tcl_DStringSetLength(&lineString, 0);
-		(len = Tcl_Gets(chan, &lineString)) >= 0;
-		Tcl_DStringSetLength(&lineString, 0)) {
-	    unsigned char* p;
-	    int to, from;
+	/*
+	 * Parse the line as a sequence of hex digits.
+	 */
 
-	    if (len < 5) {
-		continue;
-	    }
-	    p = (unsigned char*) Tcl_DStringValue(&lineString);
-	    to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
+	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;
+	}
+	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 (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;
+	    if (from == 0) {
+		continue;
 	    }
+	    dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
 	}
-    } while (0);
+    }
+  doneParse:
     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	    = (ClientData) dataPtr;
+    encType.clientData	    = dataPtr;
 
     return Tcl_CreateEncoding(&encType);
 }
@@ -1943,7 +1982,7 @@ LoadEscapeEncoding(
     Tcl_Channel chan)		/* File containing new encoding. */
 {
     int i;
-    unsigned int size;
+    unsigned size;
     Tcl_DString escapeData;
     char init[16], final[16];
     EscapeEncodingData *dataPtr;
@@ -1965,6 +2004,7 @@ LoadEscapeEncoding(
 	}
 	line = Tcl_DStringValue(&lineString);
 	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
+	    Tcl_DStringFree(&lineString);
 	    continue;
 	}
 	if (argc >= 2) {
@@ -1992,8 +2032,8 @@ LoadEscapeEncoding(
 		 */
 
 		e = (Encoding *) Tcl_GetEncoding(NULL, est.name);
-		if (e && e->toUtfProc != TableToUtfProc &&
-			e->toUtfProc != Iso88591ToUtfProc) {
+		if ((e != NULL) && (e->toUtfProc != TableToUtfProc)
+			&& (e->toUtfProc != Iso88591ToUtfProc)) {
 		   Tcl_FreeEncoding((Tcl_Encoding) e);
 		   e = NULL;
 		}
@@ -2001,17 +2041,17 @@ LoadEscapeEncoding(
 		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
 	    }
 	}
-	ckfree((char *) argv);
+	ckfree(argv);
 	Tcl_DStringFree(&lineString);
     }
 
     size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
 	    + Tcl_DStringLength(&escapeData);
-    dataPtr = (EscapeEncodingData *) ckalloc(size);
+    dataPtr = ckalloc(size);
     dataPtr->initLen = strlen(init);
-    strcpy(dataPtr->init, init);
+    memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
     dataPtr->finalLen = strlen(final);
-    strcpy(dataPtr->final, final);
+    memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
     dataPtr->numSubTables =
 	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
     memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
@@ -2029,12 +2069,16 @@ 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	= (ClientData) dataPtr;
+    type.clientData	= dataPtr;
 
     return Tcl_CreateEncoding(&type);
 }
@@ -2088,6 +2132,9 @@ BinaryProc(
     if (dstLen < 0) {
 	dstLen = 0;
     }
+    if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
+	srcLen = *dstCharsPtr;
+    }
     if (srcLen > dstLen) {
 	srcLen = dstLen;
 	result = TCL_CONVERT_NOSPACE;
@@ -2166,6 +2213,7 @@ UtfIntToUtfExtProc(
  *
  *-------------------------------------------------------------------------
  */
+
 static int
 UtfExtToUtfIntProc(
     ClientData clientData,	/* Not used. */
@@ -2246,8 +2294,8 @@ UtfToUtfProc(
 				 * versa. */
 {
     const char *srcStart, *srcEnd, *srcClose;
-    char *dstStart, *dstEnd;
-    int result, numChars;
+    const char *dstStart, *dstEnd;
+    int result, numChars, charLimit = INT_MAX;
     Tcl_UniChar ch;
 
     result = TCL_OK;
@@ -2258,11 +2306,14 @@ UtfToUtfProc(
     if ((flags & TCL_ENCODING_END) == 0) {
 	srcClose -= TCL_UTF_MAX;
     }
+    if (flags & TCL_ENCODING_CHAR_LIMIT) {
+	charLimit = *dstCharsPtr;
+    }
 
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
-    for (numChars = 0; src < srcEnd; numChars++) {
+    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
 	    /*
 	     * If there is more string to follow, this will ensure that the
@@ -2357,10 +2408,13 @@ UnicodeToUtfProc(
 				 * output buffer. */
 {
     const char *srcStart, *srcEnd;
-    char *dstEnd, *dstStart;
-    int result, numChars;
+    const char *dstEnd, *dstStart;
+    int result, numChars, charLimit = INT_MAX;
     Tcl_UniChar ch;
 
+    if (flags & TCL_ENCODING_CHAR_LIMIT) {
+	charLimit = *dstCharsPtr;
+    }
     result = TCL_OK;
     if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
 	result = TCL_CONVERT_MULTIBYTE;
@@ -2374,15 +2428,17 @@ UnicodeToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
-    for (numChars = 0; src < srcEnd; numChars++) {
+    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 	if (dst > dstEnd) {
 	    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);
@@ -2470,20 +2526,35 @@ UtfToUnicodeProc(
 	if (dst > dstEnd) {
 	    result = TCL_CONVERT_NOSPACE;
 	    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]
-	 * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
+	 * Need to handle this in a way that won't cause misalignment by
+	 * casting dst to a Tcl_UniChar. [Bug 1122671]
 	 */
+
 #ifdef WORDS_BIGENDIAN
+#if TCL_UTF_MAX > 4
+	*dst++ = (ch >> 24);
+	*dst++ = ((ch >> 16) & 0xFF);
+	*dst++ = ((ch >> 8) & 0xFF);
+	*dst++ = (ch & 0xFF);
+#else
 	*dst++ = (ch >> 8);
 	*dst++ = (ch & 0xFF);
+#endif
+#else
+#if TCL_UTF_MAX > 4
+	*dst++ = (ch & 0xFF);
+	*dst++ = ((ch >> 8) & 0xFF);
+	*dst++ = ((ch >> 16) & 0xFF);
+	*dst++ = (ch >> 24);
 #else
 	*dst++ = (ch & 0xFF);
 	*dst++ = (ch >> 8);
 #endif
+#endif
     }
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
@@ -2537,26 +2608,28 @@ TableToUtfProc(
 				 * output buffer. */
 {
     const char *srcStart, *srcEnd;
-    char *dstEnd, *dstStart, *prefixBytes;
-    int result, byte, numChars;
+    const char *dstEnd, *dstStart, *prefixBytes;
+    int result, byte, numChars, charLimit = INT_MAX;
     Tcl_UniChar ch;
-    unsigned short **toUnicode;
-    unsigned short *pageZero;
-    TableEncodingData *dataPtr;
+    const unsigned short *const *toUnicode;
+    const unsigned short *pageZero;
+    TableEncodingData *dataPtr = clientData;
 
+    if (flags & TCL_ENCODING_CHAR_LIMIT) {
+	charLimit = *dstCharsPtr;
+    }
     srcStart = src;
     srcEnd = src + srcLen;
 
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
-    dataPtr = (TableEncodingData *) clientData;
-    toUnicode = dataPtr->toUnicode;
+    toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
     prefixBytes = dataPtr->prefixBytes;
     pageZero = toUnicode[0];
 
     result = TCL_OK;
-    for (numChars = 0; src < srcEnd; numChars++) {
+    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 	if (dst > dstEnd) {
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
@@ -2583,9 +2656,11 @@ TableToUtfProc(
 	    }
 	    ch = (Tcl_UniChar) byte;
 	}
+
 	/*
 	 * Special case for 1-byte utf chars for speed.
 	 */
+
 	if (ch && ch < 0x80) {
 	    *dst++ = (char) ch;
 	} else {
@@ -2646,17 +2721,16 @@ TableFromUtfProc(
 				 * output buffer. */
 {
     const char *srcStart, *srcEnd, *srcClose;
-    char *dstStart, *dstEnd, *prefixBytes;
+    const char *dstStart, *dstEnd, *prefixBytes;
     Tcl_UniChar ch;
     int result, len, word, numChars;
-    TableEncodingData *dataPtr;
-    unsigned short **fromUnicode;
+    TableEncodingData *dataPtr = clientData;
+    const unsigned short *const *fromUnicode;
 
     result = TCL_OK;
 
-    dataPtr = (TableEncodingData *) clientData;
     prefixBytes = dataPtr->prefixBytes;
-    fromUnicode = dataPtr->fromUnicode;
+    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;
 
     srcStart = src;
     srcEnd = src + srcLen;
@@ -2768,9 +2842,12 @@ Iso88591ToUtfProc(
 				 * output buffer. */
 {
     const char *srcStart, *srcEnd;
-    char *dstEnd, *dstStart;
-    int result, numChars;
+    const char *dstEnd, *dstStart;
+    int result, numChars, charLimit = INT_MAX;
 
+    if (flags & TCL_ENCODING_CHAR_LIMIT) {
+	charLimit = *dstCharsPtr;
+    }
     srcStart = src;
     srcEnd = src + srcLen;
 
@@ -2778,7 +2855,7 @@ Iso88591ToUtfProc(
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
     result = TCL_OK;
-    for (numChars = 0; src < srcEnd; numChars++) {
+    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 	Tcl_UniChar ch;
 
 	if (dst > dstEnd) {
@@ -2786,9 +2863,11 @@ Iso88591ToUtfProc(
 	    break;
 	}
 	ch = (Tcl_UniChar) *((unsigned char *) src);
+
 	/*
 	 * Special case for 1-byte utf chars for speed.
 	 */
+
 	if (ch && ch < 0x80) {
 	    *dst++ = (char) ch;
 	} else {
@@ -2847,7 +2926,7 @@ Iso88591FromUtfProc(
 				 * output buffer. */
 {
     const char *srcStart, *srcEnd, *srcClose;
-    char *dstStart, *dstEnd;
+    const char *dstStart, *dstEnd;
     int result, numChars;
 
     result = TCL_OK;
@@ -2930,16 +3009,17 @@ TableFreeProc(
     ClientData clientData)	/* TableEncodingData that specifies
 				 * encoding. */
 {
-    TableEncodingData *dataPtr;
+    TableEncodingData *dataPtr = clientData;
 
     /*
      * Make sure we aren't freeing twice on shutdown. [Bug 219314]
      */
 
-    dataPtr = (TableEncodingData *) clientData;
-    ckfree((char *) dataPtr->toUnicode);
-    ckfree((char *) dataPtr->fromUnicode);
-    ckfree((char *) dataPtr);
+    ckfree(dataPtr->toUnicode);
+    dataPtr->toUnicode = NULL;
+    ckfree(dataPtr->fromUnicode);
+    dataPtr->fromUnicode = NULL;
+    ckfree(dataPtr);
 }
 
 /*
@@ -2987,20 +3067,19 @@ EscapeToUtfProc(
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    EscapeEncodingData *dataPtr;
-    char *prefixBytes, *tablePrefixBytes;
-    unsigned short **tableToUnicode;
-    Encoding *encodingPtr;
-    int state, result, numChars;
-    const char *srcStart, *srcEnd;
-    char *dstStart, *dstEnd;
+    EscapeEncodingData *dataPtr = clientData;
+    const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
+    const unsigned short *const *tableToUnicode;
+    const Encoding *encodingPtr;
+    int state, result, numChars, charLimit = INT_MAX;
+    const char *dstStart, *dstEnd;
 
+    if (flags & TCL_ENCODING_CHAR_LIMIT) {
+	charLimit = *dstCharsPtr;
+    }
     result = TCL_OK;
-
     tablePrefixBytes = NULL;	/* lint. */
     tableToUnicode = NULL;	/* lint. */
-
-    dataPtr = (EscapeEncodingData *) clientData;
     prefixBytes = dataPtr->prefixBytes;
     encodingPtr = NULL;
 
@@ -3015,7 +3094,7 @@ EscapeToUtfProc(
 	state = 0;
     }
 
-    for (numChars = 0; src < srcEnd; ) {
+    for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {
 	int byte, hi, lo, ch;
 
 	if (dst > dstEnd) {
@@ -3024,9 +3103,9 @@ EscapeToUtfProc(
 	}
 	byte = *((unsigned char *) src);
 	if (prefixBytes[byte]) {
-	    unsigned int left, len, longest;
+	    unsigned left, len, longest;
 	    int checked, i;
-	    EscapeSubTable *subTablePtr;
+	    const EscapeSubTable *subTablePtr;
 
 	    /*
 	     * Saw the beginning of an escape sequence.
@@ -3124,9 +3203,10 @@ EscapeToUtfProc(
 	    TableEncodingData *tableDataPtr;
 
 	    encodingPtr = GetTableEncoding(dataPtr, state);
-	    tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+	    tableDataPtr = encodingPtr->clientData;
 	    tablePrefixBytes = tableDataPtr->prefixBytes;
-	    tableToUnicode = tableDataPtr->toUnicode;
+	    tableToUnicode = (const unsigned short *const*)
+		    tableDataPtr->toUnicode;
 	}
 
 	if (tablePrefixBytes[byte]) {
@@ -3201,19 +3281,17 @@ EscapeFromUtfProc(
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    EscapeEncodingData *dataPtr;
-    Encoding *encodingPtr;
+    EscapeEncodingData *dataPtr = clientData;
+    const Encoding *encodingPtr;
     const char *srcStart, *srcEnd, *srcClose;
-    char *dstStart, *dstEnd;
+    const char *dstStart, *dstEnd;
     int state, result, numChars;
-    TableEncodingData *tableDataPtr;
-    char *tablePrefixBytes;
-    unsigned short **tableFromUnicode;
+    const TableEncodingData *tableDataPtr;
+    const char *tablePrefixBytes;
+    const unsigned short *const *tableFromUnicode;
 
     result = TCL_OK;
 
-    dataPtr = (EscapeEncodingData *) clientData;
-
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -3225,7 +3303,7 @@ EscapeFromUtfProc(
     dstEnd = dst + dstLen - 1;
 
     /*
-     * RFC1468 states that the text starts in ASCII, and switches to Japanese
+     * RFC 1468 states that the text starts in ASCII, and switches to Japanese
      * characters, and that the text must end in ASCII. [Patch 474358]
      */
 
@@ -3243,12 +3321,13 @@ EscapeFromUtfProc(
     }
 
     encodingPtr = GetTableEncoding(dataPtr, state);
-    tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+    tableDataPtr = encodingPtr->clientData;
     tablePrefixBytes = tableDataPtr->prefixBytes;
-    tableFromUnicode = tableDataPtr->fromUnicode;
+    tableFromUnicode = (const unsigned short *const *)
+	    tableDataPtr->fromUnicode;
 
     for (numChars = 0; src < srcEnd; numChars++) {
-	unsigned int len;
+	unsigned len;
 	int word;
 	Tcl_UniChar ch;
 
@@ -3266,13 +3345,13 @@ EscapeFromUtfProc(
 
 	if ((word == 0) && (ch != 0)) {
 	    int oldState;
-	    EscapeSubTable *subTablePtr;
+	    const EscapeSubTable *subTablePtr;
 
 	    oldState = state;
 	    for (state = 0; state < dataPtr->numSubTables; state++) {
 		encodingPtr = GetTableEncoding(dataPtr, state);
-		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
-	    	word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
+		tableDataPtr = encodingPtr->clientData;
+		word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
 		if (word != 0) {
 		    break;
 		}
@@ -3285,12 +3364,13 @@ EscapeFromUtfProc(
 		    break;
 		}
 		encodingPtr = GetTableEncoding(dataPtr, state);
-		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+		tableDataPtr = encodingPtr->clientData;
 		word = tableDataPtr->fallback;
 	    }
 
-	    tablePrefixBytes = tableDataPtr->prefixBytes;
-	    tableFromUnicode = tableDataPtr->fromUnicode;
+	    tablePrefixBytes = (const char *) tableDataPtr->prefixBytes;
+	    tableFromUnicode = (const unsigned short *const *)
+		    tableDataPtr->fromUnicode;
 
 	    /*
 	     * The state variable has the value of oldState when word is 0.
@@ -3338,22 +3418,22 @@ EscapeFromUtfProc(
     }
 
     if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
-	unsigned int len = dataPtr->subTables[0].sequenceLen;
+	unsigned 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.
+	 * 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, (size_t) len);
+		memcpy(dst, dataPtr->subTables[0].sequence, len);
 		dst += len;
 	    }
 	    memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen);
@@ -3391,33 +3471,34 @@ EscapeFreeProc(
     ClientData clientData)	/* EscapeEncodingData that specifies
 				 * encoding. */
 {
-    EscapeEncodingData *dataPtr;
+    EscapeEncodingData *dataPtr = clientData;
     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 (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.
+     * 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.
      */
-    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->encodingPtr = NULL;
+	    subTablePtr++;
 	}
-    ckfree((char *) dataPtr);
+    }
+    ckfree(dataPtr);
 }
 
 /*
@@ -3445,11 +3526,8 @@ GetTableEncoding(
     EscapeEncodingData *dataPtr,/* Contains names of encodings. */
     int state)			/* Index in dataPtr of desired Encoding. */
 {
-    EscapeSubTable *subTablePtr;
-    Encoding *encodingPtr;
-
-    subTablePtr = &dataPtr->subTables[state];
-    encodingPtr = subTablePtr->encodingPtr;
+    EscapeSubTable *subTablePtr = &dataPtr->subTables[state];
+    Encoding *encodingPtr = subTablePtr->encodingPtr;
 
     if (encodingPtr == NULL) {
 	encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
@@ -3524,43 +3602,43 @@ InitializeEncodingSearchPath(
     int *lengthPtr,
     Tcl_Encoding *encodingPtr)
 {
-    char *bytes;
+    const char *bytes;
     int i, numDirs, numBytes;
-    Tcl_Obj *libPath, *encodingObj, *searchPath;
+    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
 
     TclNewLiteralStringObj(encodingObj, "encoding");
-    TclNewObj(searchPath);
+    TclNewObj(searchPathObj);
     Tcl_IncrRefCount(encodingObj);
-    Tcl_IncrRefCount(searchPath);
-    libPath = TclGetLibraryPath();
-    Tcl_IncrRefCount(libPath);
-    Tcl_ListObjLength(NULL, libPath, &numDirs);
+    Tcl_IncrRefCount(searchPathObj);
+    libPathObj = TclGetLibraryPath();
+    Tcl_IncrRefCount(libPathObj);
+    Tcl_ListObjLength(NULL, libPathObj, &numDirs);
 
     for (i = 0; i < numDirs; i++) {
-	Tcl_Obj *directory, *path;
+	Tcl_Obj *directoryObj, *pathObj;
 	Tcl_StatBuf stat;
 
-	Tcl_ListObjIndex(NULL, libPath, i, &directory);
-	path = Tcl_FSJoinToPath(directory, 1, &encodingObj);
-	Tcl_IncrRefCount(path);
-	if ((0 == Tcl_FSStat(path, &stat)) && S_ISDIR(stat.st_mode)) {
-	    Tcl_ListObjAppendElement(NULL, searchPath, path);
+	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(path);
+	Tcl_DecrRefCount(pathObj);
     }
 
-    Tcl_DecrRefCount(libPath);
+    Tcl_DecrRefCount(libPathObj);
     Tcl_DecrRefCount(encodingObj);
     *encodingPtr = libraryPath.encoding;
     if (*encodingPtr) {
 	((Encoding *)(*encodingPtr))->refCount++;
     }
-    bytes = Tcl_GetStringFromObj(searchPath, &numBytes);
+    bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
 
     *lengthPtr = numBytes;
-    *valuePtr = ckalloc((unsigned int) numBytes + 1);
+    *valuePtr = ckalloc(numBytes + 1);
     memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
-    Tcl_DecrRefCount(searchPath);
+    Tcl_DecrRefCount(searchPathObj);
 }
 
 /*
@@ -3570,4 +3648,3 @@ InitializeEncodingSearchPath(
  * fill-column: 78
  * End:
  */
-
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
new file mode 100644
index 0000000..c1b0890
--- /dev/null
+++ b/generic/tclEnsemble.c
@@ -0,0 +1,3668 @@
+/*
+ * tclEnsemble.c --
+ *
+ *	Contains support for ensembles (see TIP#112), which provide simple
+ *	mechanism for creating composite commands on top of namespaces.
+ *
+ * Copyright (c) 2005-2013 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 Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
+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, Tcl_HashEntry *hPtr,
+			    Tcl_Obj *fix);
+static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
+static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static void		CompileToInvokedCommand(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Tcl_Obj *replacements,
+			    Command *cmdPtr, CompileEnv *envPtr);
+static int		CompileBasicNArgCommand(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    CompileEnv *envPtr);
+
+static Tcl_NRPostProc	FreeER;
+
+/*
+ * 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.
+ */
+
+static const Tcl_ObjType ensembleCmdType = {
+    "ensembleCommand",		/* the type's name */
+    FreeEnsembleCmdRep,		/* freeIntRepProc */
+    DupEnsembleCmdRep,		/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    NULL			/* setFromAnyProc */
+};
+
+/*
+ * The internal rep for caching ensemble subcommand lookups and
+ * spell corrections.
+ */
+
+typedef struct {
+    int epoch;                  /* Used to confirm when the data in this
+                                 * really structure matches up with the
+                                 * ensemble. */
+    Command *token;             /* Reference to the command for which this
+                                 * structure is a cache of the resolution. */
+    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
+    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand
+                                 * hash table. */
+} EnsembleCmdRep;
+
+
+static inline Tcl_Obj *
+NewNsObj(
+    Tcl_Namespace *namespacePtr)
+{
+    register Namespace *nsPtr = (Namespace *) namespacePtr;
+
+    if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
+	return Tcl_NewStringObj("::", 2);
+    } else {
+	return Tcl_NewStringObj(nsPtr->fullName, -1);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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_SetObjResult(interp, Tcl_NewStringObj(
+		    "tried to manipulate ensemble of deleted namespace",
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", 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_SetObjResult(interp, Tcl_NewStringObj(
+				"ensemble subcommand implementations "
+				"must be non-empty lists", -1));
+			Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+				"EMPTY_TARGET", NULL);
+			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 = NewNsObj((Tcl_Namespace *) nsPtr);
+
+			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_SetObjResult(interp, NewNsObj(namespacePtr));
+		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, NewNsObj(namespacePtr));
+
+	    /* -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_SetObjResult(interp, Tcl_NewStringObj(
+				    "ensemble subcommand implementations "
+				    "must be non-empty lists", -1));
+			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+				    "EMPTY_TARGET", NULL);
+			    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 = NewNsObj((Tcl_Namespace*)nsPtr);
+
+			    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_SetObjResult(interp, Tcl_NewStringObj(
+			    "option -namespace is read-only", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "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 = NewNsObj((Tcl_Namespace *) nsPtr);
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"command is not an ensemble", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		"command is not an ensemble", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		"command is not an ensemble", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+			"ensemble target is not a fully-qualified command",
+			-1));
+		Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+			"UNQUALIFIED_TARGET", 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_SetObjResult(interp, Tcl_NewStringObj(
+		"command is not an ensemble", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		"command is not an ensemble", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command is not an ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command is not an ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command is not an ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command is not an ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command is not an ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command is not an ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_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_SetObjResult(interp, Tcl_ObjPrintf(
+			"\"%s\" is not an ensemble command",
+			TclGetString(cmdNameObj)));
+		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);
+    TclDStringAppendLiteral(&hiddenBuf, "tcl:");
+    Tcl_DStringAppend(&hiddenBuf, name, -1);
+    TclDStringAppendLiteral(&hiddenBuf, ":");
+    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.
+	 */
+
+	TclDStringAppendLiteral(&buf, "::tcl");
+
+	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
+	    Tcl_Panic("invalid ensemble name '%s'", name);
+	}
+
+	for (i = 0; i < nameCount; ++i) {
+	    TclDStringAppendLiteral(&buf, "::");
+	    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];
+	}
+    }
+
+    /*
+     * Switch on compilation always for core ensembles now that we can do
+     * nice bytecode things with them.  Do it now.  Waiting until later will
+     * just cause pointless epoch bumps.
+     */
+
+    ensembleFlags |= ENSEMBLE_COMPILE;
+    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;
+
+	TclDStringAppendLiteral(&buf, "::");
+	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;
+	    }
+	}
+	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
+    }
+
+    Tcl_DStringFree(&buf);
+    Tcl_DStringFree(&hiddenBuf);
+    if (nameParts != NULL) {
+	ckfree((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. */
+    Tcl_Obj *errorObj;		/* Used for building error messages. */
+    Tcl_Obj *subObj;
+    int subIdx;
+
+    /*
+     * Must recheck objc, since numParameters might have changed. Cf. test
+     * namespace-53.9.
+     */
+
+  restartEnsembleParse:
+    subIdx = 1 + ensemblePtr->numParameters;
+    if (objc < subIdx + 1) {
+	/*
+	 * We don't have a subcommand argument. Make error message.
+	 */
+
+	Tcl_DString buf;	/* Message being built */
+
+	Tcl_DStringInit(&buf);
+	if (ensemblePtr->parameterList) {
+	    Tcl_DStringAppend(&buf,
+		    TclGetString(ensemblePtr->parameterList), -1);
+	    TclDStringAppendLiteral(&buf, " ");
+	}
+	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "ensemble activated for deleted namespace", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", 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.
+     */
+
+    subObj = objv[subIdx];
+
+    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 (subObj->typePtr==&ensembleCmdType){
+	    EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
+
+	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
+		    ensembleCmd->token == (Command *)ensemblePtr->token) {
+		prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
+		Tcl_IncrRefCount(prefixObj);
+		if (ensembleCmd->fix) {
+		    TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
+		}
+		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(subObj));
+    if (hPtr != NULL) {
+
+	/*
+	 * Cache for later in the subcommand object.
+	 */
+
+	MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL);
+    } 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;
+	Tcl_Obj *fix;
+
+	subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
+	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);
+	}
+
+	/*
+	 * Record the spelling correction for usage message.
+	 */
+
+	fix = Tcl_NewStringObj(fullName, -1);
+
+	/*
+	 * Cache for later in the subcommand object.
+	 */
+
+	MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
+	TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
+    }
+
+    prefixObj = Tcl_GetHashValue(hPtr);
+    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 *copyPtr;	/* The actual list of words to dispatch to.
+				 * Will be freed by the dispatch engine. */
+	Tcl_Obj **copyObjv;
+	int copyObjc, prefixObjc;
+
+	Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
+
+	if (objc == 2) {
+	    copyPtr = TclListObjCopy(NULL, prefixObj);
+	} else {
+	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
+	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
+	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+		    ensemblePtr->numParameters, objv + 1);
+	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+		    objc - 2 - ensemblePtr->numParameters,
+		    objv + 2 + ensemblePtr->numParameters);
+	}
+	Tcl_IncrRefCount(copyPtr);
+	TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
+	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 (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters,
+		prefixObjc + ensemblePtr->numParameters, objv)) {
+	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
+		    NULL);
+	}
+
+	/*
+	 * Hand off to the target command.
+	 */
+
+	TclSkipTailcall(interp);
+	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
+    }
+
+  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", "SUBCOMMAND",
+	    TclGetString(subObj), NULL);
+    if (ensemblePtr->subcommandTable.numEntries == 0) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown subcommand \"%s\": namespace %s does not"
+		" export any commands", TclGetString(subObj),
+		ensemblePtr->nsPtr->fullName));
+	return TCL_ERROR;
+    }
+    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
+	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
+	    TclGetString(subObj));
+    if (ensemblePtr->subcommandTable.numEntries == 1) {
+	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
+    } else {
+	int i;
+
+	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
+	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
+	    Tcl_AppendToObj(errorObj, ", ", 2);
+	}
+	Tcl_AppendPrintfToObj(errorObj, "or %s",
+		ensemblePtr->subcommandArrayPtr[i]);
+    }
+    Tcl_SetObjResult(interp, errorObj);
+    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;
+	} 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;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSpellFix --
+ *
+ *	Record a spelling correction that needs making in the
+ *	generation of the WrongNumArgs usage message.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Can create an alternative ensemble rewrite structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FreeER(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_Obj **tmp = (Tcl_Obj **)data[0];
+
+    ckfree(tmp[2]);
+    ckfree(tmp);
+    return result;
+}
+
+void
+TclSpellFix(
+    Tcl_Interp *interp,
+    Tcl_Obj *const *objv,
+    int objc,
+    int badIdx,
+    Tcl_Obj *bad,
+    Tcl_Obj *fix)
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *const *search;
+    Tcl_Obj **store;
+    int idx;
+    int size;
+
+    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+	iPtr->ensembleRewrite.sourceObjs = objv;
+	iPtr->ensembleRewrite.numRemovedObjs = 0;
+	iPtr->ensembleRewrite.numInsertedObjs = 0;
+    }
+
+    /* Compute the valid length of the ensemble root */
+
+    size = iPtr->ensembleRewrite.numRemovedObjs + objc
+		- iPtr->ensembleRewrite.numInsertedObjs;
+
+    search = iPtr->ensembleRewrite.sourceObjs;
+    if (search[0] == NULL) {
+	/* Awful casting abuse here */
+	search = (Tcl_Obj *const *) search[1];
+    }
+
+    if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
+	/*
+	 * Misspelled value was inserted. We cannot directly jump
+	 * to the bad value, but have to search.
+	 */
+	idx = 1;
+	while (idx < size) {
+	    if (search[idx] == bad) {
+		break;
+	    }
+	    idx++;
+	}
+	if (idx == size) {
+	    return;
+	}
+    } else {
+	/* Jump to the misspelled value. */
+	idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
+		- iPtr->ensembleRewrite.numInsertedObjs;
+
+	/* Verify */
+	if (search[idx] != bad) {
+	    Tcl_Panic("SpellFix: programming error");
+	}
+    }
+
+    search = iPtr->ensembleRewrite.sourceObjs;
+    if (search[0] == NULL) {
+	store = (Tcl_Obj **)search[2];
+    }  else {
+	Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
+	tmp[0] = NULL;
+	tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
+	tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
+	memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
+
+	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
+	TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
+	store = (Tcl_Obj **)tmp[2];
+    }
+
+    store[idx] = fix;
+    Tcl_IncrRefCount(fix);
+    TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFetchEnsembleRoot --
+ *
+ *	Returns the root of ensemble rewriting, if any.
+ *	If no root exists, returns objv instead.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *const *
+TclFetchEnsembleRoot(
+    Tcl_Interp *interp,
+    Tcl_Obj *const *objv,
+    int objc,
+    int *objcPtr)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->ensembleRewrite.sourceObjs) {
+	*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
+		- iPtr->ensembleRewrite.numInsertedObjs;
+	return iPtr->ensembleRewrite.sourceObjs;
+    }
+    *objcPtr = objc;
+    return objv;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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;
+
+    /*
+     * 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);
+    TclSkipTailcall(interp);
+    result = Tcl_EvalObjv(interp, paramc, paramv, 0);
+    if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
+	if (!Tcl_InterpDeleted(interp)) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "unknown subcommand handler deleted its ensemble", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED",
+		    NULL);
+	}
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "unknown subcommand handler returned bad code: ", -1));
+	    switch (result) {
+	    case TCL_RETURN:
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1);
+		break;
+	    case TCL_BREAK:
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1);
+		break;
+	    case TCL_CONTINUE:
+		Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1);
+		break;
+	    default:
+		Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);
+	    }
+	    Tcl_AddErrorInfo(interp, "\n    result of "
+		    "ensemble unknown subcommand handler: ");
+	    Tcl_AppendObjToErrorInfo(interp, unknownCmd);
+	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
+		    NULL);
+	} 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,
+    Tcl_HashEntry *hPtr,
+    Tcl_Obj *fix)
+{
+    register EnsembleCmdRep *ensembleCmd;
+
+    if (objPtr->typePtr == &ensembleCmdType) {
+	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+	TclCleanupCommandMacro(ensembleCmd->token);
+	if (ensembleCmd->fix) {
+	    Tcl_DecrRefCount(ensembleCmd->fix);
+	}
+    } 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.twoPtrValue.ptr1 = ensembleCmd;
+	objPtr->typePtr = &ensembleCmdType;
+    }
+
+    /*
+     * Populate the internal rep.
+     */
+
+    ensembleCmd->epoch = ensemblePtr->epoch;
+    ensembleCmd->token = (Command *) ensemblePtr->token;
+    ensembleCmd->token->refCount++;
+    if (fix) {
+	Tcl_IncrRefCount(fix);
+    }
+    ensembleCmd->fix = fix;
+    ensembleCmd->hPtr = hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
+	    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.twoPtrValue.ptr1;
+
+    TclCleanupCommandMacro(ensembleCmd->token);
+    if (ensembleCmd->fix) {
+	Tcl_DecrRefCount(ensembleCmd->fix);
+    }
+    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.twoPtrValue.ptr1;
+    EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
+
+    copyPtr->typePtr = &ensembleCmdType;
+    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+    ensembleCopy->epoch = ensembleCmd->epoch;
+    ensembleCopy->token = ensembleCmd->token;
+    ensembleCopy->token->refCount++;
+    ensembleCopy->fix = ensembleCmd->fix;
+    if (ensembleCopy->fix) {
+	Tcl_IncrRefCount(ensembleCopy->fix);
+    }
+    ensembleCopy->hPtr = ensembleCmd->hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = TokenAfter(parsePtr->tokenPtr);
+    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
+    Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
+    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
+    Command *oldCmdPtr = cmdPtr, *newCmdPtr;
+    int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
+    int ourResult = TCL_ERROR;
+    unsigned numBytes;
+    const char *word;
+    DefineLineInformation;
+
+    Tcl_IncrRefCount(replaced);
+    if (parsePtr->numWords < depth + 1) {
+	goto failed;
+    }
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	/*
+	 * Too hard.
+	 */
+
+	goto failed;
+    }
+
+    /*
+     * This is where we return to if we are parsing multiple nested compiled
+     * ensembles. [info object] is such a beast.
+     */
+
+  checkNextWord:
+    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.
+	 */
+
+	goto failed;
+    }
+
+    /*
+     * 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.
+	 */
+
+	goto failed;
+    }
+
+    /*
+     * 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) {
+	    goto failed;
+	}
+	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) {
+		    goto failed;
+		}
+		replacement = elems[i];
+		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) {
+		    goto failed;
+		}
+		matchObj = elems[i];
+	    }
+	}
+	if (matchObj == NULL) {
+	    goto failed;
+	}
+	result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
+	if (result != TCL_OK || targetCmdObj == NULL) {
+	    goto failed;
+	}
+	replacement = matchObj;
+    } 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);
+	if (result == TCL_OK && targetCmdObj != NULL) {
+	    /*
+	     * Got it. Skip the fiddling around with prefixes.
+	     */
+
+	    replacement = subcmdObj;
+	    goto doneMapLookup;
+	}
+	TclDecrRefCount(subcmdObj);
+
+	/*
+	 * 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)) {
+	    goto failed;
+	}
+
+	/*
+	 * 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;
+	replacement = NULL;		/* Silence, fool compiler! */
+	while (!done) {
+	    if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) {
+		if (matched++) {
+		    /*
+		     * Must have matched twice! Not unique, so no point
+		     * looking further.
+		     */
+
+		    break;
+		}
+		replacement = subcmdObj;
+		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) {
+	    invokeAnyway = 1;
+	    goto failed;
+	}
+    }
+
+    /*
+     * 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:
+    Tcl_ListObjAppendElement(NULL, replaced, replacement);
+    if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
+	goto failed;
+    } else if (len != 1) {
+	/*
+	 * Note that at this point we know we can't issue any special
+	 * instruction sequence as the mapping isn't one that we support at
+	 * the compiled level.
+	 */
+
+	goto cleanup;
+    }
+    targetCmdObj = elems[0];
+
+    oldCmdPtr = cmdPtr;
+    Tcl_IncrRefCount(targetCmdObj);
+    newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
+    TclDecrRefCount(targetCmdObj);
+    if (newCmdPtr == NULL || Tcl_IsSafe(interp)
+	    || newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
+	    || newCmdPtr->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.
+	 */
+
+	goto cleanup;
+    }
+    cmdPtr = newCmdPtr;
+    depth++;
+
+    /*
+     * See whether we have a nested ensemble. If we do, we can go round the
+     * mulberry bush again, consuming the next word.
+     */
+
+    if (cmdPtr->compileProc == TclCompileEnsemble) {
+	tokenPtr = TokenAfter(tokenPtr);
+	if (parsePtr->numWords < depth + 1
+		|| tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    /*
+	     * Too hard because the user has done something unpleasant like
+	     * omitting the sub-ensemble's command name or used a non-constant
+	     * name for a sub-ensemble's command name; we respond by bailing
+	     * out completely (this is a rare case). [Bug 6d2f249a01]
+	     */
+
+	    goto cleanup;
+	}
+	ensemble = (Tcl_Command) cmdPtr;
+	goto checkNextWord;
+    }
+
+    /*
+     * Now we've done the mapping process, can now actually try to compile.
+     * If there is a subcommand compiler and that successfully produces code,
+     * we'll use that. Otherwise, we fall back to generating opcodes to do the
+     * invoke at runtime.
+     */
+
+    invokeAnyway = 1;
+    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr,
+	    envPtr)) {
+	ourResult = TCL_OK;
+	goto cleanup;
+    }
+
+    /*
+     * Throw out any line information generated by the failed compile attempt.
+     */
+
+    while (mapPtr->nuloc - 1 > eclIndex) {
+        mapPtr->nuloc--;
+        ckfree(mapPtr->loc[mapPtr->nuloc].line);
+        mapPtr->loc[mapPtr->nuloc].line = NULL;
+    }
+
+    /*
+     * Reset the index of next command.  Toss out any from failed nested
+     * partial compiles.
+     */
+
+    envPtr->numCommands = mapPtr->nuloc;
+
+    /*
+     * Failed to do a full compile for some reason. Try to do a direct invoke
+     * instead of going through the ensemble lookup process again.
+     */
+
+  failed:
+    if (depth < 250) {
+	if (depth > 1) {
+	    if (!invokeAnyway) {
+		cmdPtr = oldCmdPtr;
+		depth--;
+	    }
+	}
+	/*
+	 * The length of the "replaced" list must be depth-1.  Trim back
+	 * any extra elements that might have been appended by failing
+	 * pathways above.
+	 */
+	(void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL);
+
+	/*
+	 * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
+	 * when depth==1.  In that case we are choosing to emit the
+	 * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
+	 * to be done.  It would be equally functional and presumably more
+	 * performant to fall through to cleanup below, return TCL_ERROR,
+	 * and let the compiler harness emit the INST_INVOKE_STK
+	 * implementation for us.
+	 */
+
+	CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
+	ourResult = TCL_OK;
+    }
+
+    /*
+     * Release the memory we allocated. If we've got here, we've either done
+     * something useful or we're in a case that we can't compile at all and
+     * we're just giving up.
+     */
+
+  cleanup:
+    Tcl_DecrRefCount(replaced);
+    return ourResult;
+}
+
+int
+TclAttemptCompileProc(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    int depth,
+    Command *cmdPtr,
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    int result, i;
+    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
+    int savedStackDepth = envPtr->currStackDepth;
+    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+    int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
+    int savedExceptArrayNext = envPtr->exceptArrayNext;
+#ifdef TCL_COMPILE_DEBUG
+    int savedExceptDepth = envPtr->exceptDepth;
+#endif
+    DefineLineInformation;
+
+    if (cmdPtr->compileProc == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Advance parsePtr->tokenPtr so that it points at the last subcommand.
+     * This will be wrong, but it will not matter, and it will put the
+     * tokens for the arguments in the right place without the needed to
+     * allocate a synthetic Tcl_Parse struct, or copy tokens around.
+     */
+
+    for (i = 0; i < depth - 1; i++) {
+	parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    }
+    parsePtr->numWords -= (depth - 1);
+
+    /*
+     * Shift the line information arrays to account for different word
+     * index values.
+     */
+
+    mapPtr->loc[eclIndex].line += (depth - 1);
+    mapPtr->loc[eclIndex].next += (depth - 1);
+
+    /*
+     * Hand off compilation to the subcommand compiler. At last!
+     */
+
+    result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
+
+    /*
+     * Undo the shift.
+     */
+
+    mapPtr->loc[eclIndex].line -= (depth - 1);
+    mapPtr->loc[eclIndex].next -= (depth - 1);
+
+    parsePtr->numWords += (depth - 1);
+    parsePtr->tokenPtr = saveTokenPtr;
+
+    /*
+     * If our target failed to compile, revert any data from failed partial
+     * compiles.  Note that envPtr->numCommands need not be checked because
+     * we avoid compiling subcommands that recursively call TclCompileScript().
+     */
+
+#ifdef TCL_COMPILE_DEBUG
+    if (envPtr->exceptDepth != savedExceptDepth) {
+	Tcl_Panic("ExceptionRange Starts and Ends do not balance");
+    }
+#endif
+
+    if (result != TCL_OK) {
+	ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
+
+	for (i = 0; i < savedExceptArrayNext; i++) {
+	    while (auxPtr->numBreakTargets > 0
+		    && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
+		    >= savedCodeNext) {
+		auxPtr->numBreakTargets--;
+	    }
+	    while (auxPtr->numContinueTargets > 0
+		    && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
+		    >= savedCodeNext) {
+		auxPtr->numContinueTargets--;
+	    }
+	    auxPtr++;
+	}
+	envPtr->exceptArrayNext = savedExceptArrayNext;
+
+	if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) {
+	    AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+	    AuxData *auxDataEnd = auxDataPtr;
+
+	    auxDataPtr += savedAuxDataArrayNext;
+	    auxDataEnd += envPtr->auxDataArrayNext;
+
+	    while (auxDataPtr < auxDataEnd) {
+		if (auxDataPtr->type->freeProc != NULL) {
+		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
+		}
+		auxDataPtr++;
+	    }
+	    envPtr->auxDataArrayNext = savedAuxDataArrayNext;
+	}
+	envPtr->currStackDepth = savedStackDepth;
+	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+#ifdef TCL_COMPILE_DEBUG
+    } else {
+	/*
+	 * Confirm that the command compiler generated a single value on
+	 * the stack as its result. This is only done in debugging mode,
+	 * as it *should* be correct and normal users have no reasonable
+	 * way to fix it anyway.
+	 */
+
+	int diff = envPtr->currStackDepth - savedStackDepth;
+
+	if (diff != 1) {
+	    Tcl_Panic("bad stack adjustment when compiling"
+		    " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
+		    parsePtr->tokenPtr->start, diff);
+	}
+#endif
+    }
+
+    return result;
+}
+
+/*
+ * How to compile a subcommand to a _replacing_ invoke of its implementation
+ * command.
+ */
+
+static void
+CompileToInvokedCommand(
+    Tcl_Interp *interp,
+    Tcl_Parse *parsePtr,
+    Tcl_Obj *replacements,
+    Command *cmdPtr,
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokPtr;
+    Tcl_Obj *objPtr, **words;
+    char *bytes;
+    int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
+    DefineLineInformation;
+
+    /*
+     * Push the words of the command. Take care; the command words may be
+     * scripts that have backslashes in them, and [info frame 0] can see the
+     * difference. Hence the call to TclContinuationsEnterDerived...
+     */
+
+    Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
+    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
+	    i++, tokPtr = TokenAfter(tokPtr)) {
+	if (i > 0 && i < numWords+1) {
+	    bytes = Tcl_GetStringFromObj(words[i-1], &length);
+	    PushLiteral(envPtr, bytes, length);
+	    continue;
+	}
+
+	SetLineInformation(i);
+	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    int literal = TclRegisterNewLiteral(envPtr,
+		    tokPtr[1].start, tokPtr[1].size);
+
+	    if (envPtr->clNext) {
+		TclContinuationsEnterDerived(
+			TclFetchLiteral(envPtr, literal),
+			tokPtr[1].start - envPtr->source,
+			envPtr->clNext);
+	    }
+	    TclEmitPush(literal, envPtr);
+	} else {
+	    CompileTokens(envPtr, tokPtr, interp);
+	}
+    }
+
+    /*
+     * Push the name of the command we're actually dispatching to as part of
+     * the implementation.
+     */
+
+    objPtr = Tcl_NewObj();
+    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
+	extraLiteralFlags |= LITERAL_UNSHARED;
+    }
+    cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags);
+    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
+    TclEmitPush(cmdLit, envPtr);
+    TclDecrRefCount(objPtr);
+
+    /*
+     * Do the replacing dispatch.
+     */
+
+    TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1);
+}
+
+/*
+ * Helpers that do issuing of instructions for commands that "don't have
+ * compilers" (well, they do; these). They all work by just generating base
+ * code to invoke the command; they're intended for ensemble subcommands so
+ * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out
+ * that they're not needed.
+ *
+ * Note that these are NOT suitable for commands where there's an argument
+ * that is a script, as an [info level] or [info frame] in the inner context
+ * can see the difference.
+ */
+
+static int
+CompileBasicNArgCommand(
+    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_Obj *objPtr = Tcl_NewObj();
+
+    Tcl_IncrRefCount(objPtr);
+    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+    TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
+	    parsePtr->numWords, envPtr);
+    Tcl_DecrRefCount(objPtr);
+    return TCL_OK;
+}
+
+int
+TclCompileBasic0ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 1) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic2ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic3ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 4) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic0Or1ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 1 && parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1Or2ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic2Or3ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic0To2ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords < 1 || parsePtr->numWords > 3) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasic1To3ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin0ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords < 1) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin1ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
+TclCompileBasicMin2ArgCmd(
+    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. */
+{
+    /*
+     * Verify that the number of arguments is correct; that's the only case
+     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
+     * which is the only code that sees the shenanigans of ensemble dispatch.
+     */
+
+    if (parsePtr->numWords < 3) {
+	return TCL_ERROR;
+    }
+
+    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index caa80f1..66ddb57 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -71,36 +71,56 @@ TclSetupEnv(
     Tcl_Interp *interp)		/* Interpreter whose "env" array is to be
 				 * managed. */
 {
+    Var *varPtr, *arrayPtr;
+    Tcl_Obj *varNamePtr;
     Tcl_DString envString;
-    char *p1, *p2;
-    int i;
+    Tcl_HashTable namesHash;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
 
     /*
      * 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.
-     *    4) Add a trace that synchronizes the "env" array.
+     *    1) Remove the trace that fires when the "env" var is updated.
+     *    2) Find the existing contents of the "env", storing in a hash table.
+     *    3) Create/update elements for each environ variable, removing
+     *	     elements from the hash table as we go.
+     *    4) Remove the elements for each remaining entry in the hash table,
+     *	     which must have existed before yet have no analog in the environ
+     *	     variable.
+     *    5) Add a trace that synchronizes the "env" array.
      */
 
     Tcl_UntraceVar2(interp, "env", 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);
+    /*
+     * Find out what elements are currently in the global env array.
+     */
 
-    if (environ[0] == NULL) {
-	Tcl_Obj *varNamePtr;
+    TclNewLiteralStringObj(varNamePtr, "env");
+    Tcl_IncrRefCount(varNamePtr);
+    Tcl_InitObjHashTable(&namesHash);
+    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    TclFindArrayPtrElements(varPtr, &namesHash);
+
+    /*
+     * Go through the environment array and transfer its values into Tcl. At
+     * the same time, remove those elements we add/update from the hash table
+     * of existing elements, so that after this part processes, that table
+     * will hold just the parts to remove.
+     */
+
+    if (environ[0] != NULL) {
+	int i;
 
-	TclNewLiteralStringObj(varNamePtr, "env");
-	Tcl_IncrRefCount(varNamePtr);
-	TclArraySet(interp, varNamePtr, NULL);
-	Tcl_DecrRefCount(varNamePtr);
-    } else {
 	Tcl_MutexLock(&envMutex);
 	for (i = 0; environ[i] != NULL; i++) {
+	    Tcl_Obj *obj1, *obj2;
+	    char *p1, *p2;
+
 	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
 	    p2 = strchr(p1, '=');
 	    if (p2 == NULL) {
@@ -114,12 +134,41 @@ TclSetupEnv(
 	    }
 	    p2++;
 	    p2[-1] = '\0';
-	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
+	    obj1 = Tcl_NewStringObj(p1, -1);
+	    obj2 = Tcl_NewStringObj(p2, -1);
 	    Tcl_DStringFree(&envString);
+
+	    Tcl_IncrRefCount(obj1);
+	    Tcl_IncrRefCount(obj2);
+	    Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
+	    hPtr = Tcl_FindHashEntry(&namesHash, obj1);
+	    if (hPtr != NULL) {
+		Tcl_DeleteHashEntry(hPtr);
+	    }
+	    Tcl_DecrRefCount(obj1);
+	    Tcl_DecrRefCount(obj2);
 	}
 	Tcl_MutexUnlock(&envMutex);
     }
 
+    /*
+     * Delete those elements that existed in the array but which had no
+     * counterparts in the environment array.
+     */
+
+    for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
+	    hPtr=Tcl_NextHashEntry(&search)) {
+	Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
+
+	TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
+    }
+    Tcl_DeleteHashTable(&namesHash);
+    Tcl_DecrRefCount(varNamePtr);
+
+    /*
+     * Re-establish the trace.
+     */
+
     Tcl_TraceVar2(interp, "env", NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
 	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
@@ -153,7 +202,8 @@ TclSetEnv(
     const char *value)		/* New value for variable (UTF-8). */
 {
     Tcl_DString envString;
-    int index, length, nameLength;
+    unsigned nameLength, valueLength;
+    int index, length;
     char *p, *oldValue;
     const char *p2;
 
@@ -175,12 +225,11 @@ TclSetEnv(
 	 */
 
 	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
-	    char **newEnviron = (char **)
-		    ckalloc(((unsigned) length + 5) * sizeof(char *));
+	    char **newEnviron = ckalloc((length + 5) * sizeof(char *));
 
 	    memcpy(newEnviron, environ, length * sizeof(char *));
 	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
-		ckfree((char *) env.ourEnviron);
+		ckfree(env.ourEnviron);
 	    }
 	    environ = env.ourEnviron = newEnviron;
 	    env.ourEnvironSize = length + 5;
@@ -210,7 +259,7 @@ TclSetEnv(
 	Tcl_DStringFree(&envString);
 
 	oldValue = environ[index];
-	nameLength = length;
+	nameLength = (unsigned) length;
     }
 
     /*
@@ -219,18 +268,19 @@ TclSetEnv(
      * and set the environ array value.
      */
 
-    p = ckalloc((unsigned) nameLength + strlen(value) + 2);
-    strcpy(p, name);
+    valueLength = strlen(value);
+    p = ckalloc(nameLength + valueLength + 2);
+    memcpy(p, name, nameLength);
     p[nameLength] = '=';
-    strcpy(p+nameLength+1, value);
+    memcpy(p+nameLength+1, value, valueLength+1);
     p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
 
     /*
      * Copy the native string to heap memory.
      */
 
-    p = ckrealloc(p, strlen(p2) + 1);
-    strcpy(p, p2);
+    p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
+    memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
     Tcl_DStringFree(&envString);
 
 #ifdef USE_PUTENV
@@ -389,20 +439,21 @@ TclUnsetEnv(
      * that no = should be included, and Windows requires it.
      */
 
-#if defined(__WIN32__)
-    string = ckalloc((unsigned) length+2);
+#if defined(_WIN32)
+    string = ckalloc(length + 2);
     memcpy(string, name, (size_t) length);
     string[length] = '=';
     string[length+1] = '\0';
 #else
-    string = ckalloc((unsigned) length+1);
+    string = ckalloc(length + 1);
     memcpy(string, name, (size_t) length);
     string[length] = '\0';
-#endif /* WIN32 */
+#endif /* _WIN32 */
 
     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
-    string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
-    strcpy(string, Tcl_DStringValue(&envString));
+    string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
+    memcpy(string, Tcl_DStringValue(&envString),
+	    (unsigned) Tcl_DStringLength(&envString)+1);
     Tcl_DStringFree(&envString);
 
     putenv(string);
@@ -500,7 +551,8 @@ TclGetEnv(
  *	array.
  *
  * Results:
- *	Always returns NULL to indicate success.
+ *	Returns NULL to indicate success, or an error-message if the array
+ *	element being handled doesn't exist.
  *
  * Side effects:
  *	Environment variable changes get propagated. If the whole "env" array
@@ -558,7 +610,7 @@ EnvTraceProc(
 	const char *value = TclGetEnv(name2, &valueString);
 
 	if (value == NULL) {
-	    return "no such variable";
+	    return (char *) "no such variable";
 	}
 	Tcl_SetVar2(interp, name1, name2, value, 0);
 	Tcl_DStringFree(&valueString);
@@ -635,11 +687,11 @@ ReplaceString(
 
 	const int growth = 5;
 
-	env.cache = (char **) ckrealloc((char *) env.cache,
+	env.cache = ckrealloc(env.cache,
 		(env.cacheSize + growth) * sizeof(char *));
 	env.cache[env.cacheSize] = newStr;
-	(void) memset(env.cache+env.cacheSize+1, (int) 0,
-		(size_t) (growth-1) * sizeof(char*));
+	(void) memset(env.cache+env.cacheSize+1, 0,
+		(size_t) (growth-1) * sizeof(char *));
 	env.cacheSize += growth;
     }
 }
@@ -674,7 +726,7 @@ TclFinalizeEnvironment(void)
      */
 
     if (env.cache) {
-	ckfree((char *) env.cache);
+	ckfree(env.cache);
 	env.cache = NULL;
 	env.cacheSize = 0;
 #ifndef USE_PUTENV
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 4db524c..b0b8188 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -49,8 +49,8 @@ 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 {
@@ -74,22 +74,22 @@ static ExitHandler *firstLateExitPtr = NULL;
 TCL_DECLARE_MUTEX(exitMutex)
 
 /*
- * This variable is set to 1 when Tcl_Finalize is called, and at the end of
- * its work, it is reset to 0. The variable is checked by TclInExit() to allow
- * different behavior for exit-time processing, e.g. in closing of files and
- * pipes.
+ * 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.
  */
 
-static int inFinalize = 0;
+static int inExit = 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.
+ * 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;
+static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL;
 
 typedef struct ThreadSpecificData {
     ExitHandler *firstExitPtr;	/* First in list of all exit handlers for this
@@ -115,8 +115,11 @@ static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
 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 char *		VwaitVarProc(ClientData clientData,
+			    Tcl_Interp *interp, const char *name1,
+			    const char *name2, int flags);
+static void		InvokeExitHandlers(void);
+static void		FinalizeThread(int quick);
 
 /*
  *----------------------------------------------------------------------
@@ -141,10 +144,11 @@ Tcl_BackgroundError(
     Tcl_Interp *interp)		/* Interpreter in which an error has
 				 * occurred. */
 {
-    TclBackgroundException(interp, TCL_ERROR);
+    Tcl_BackgroundException(interp, TCL_ERROR);
 }
+
 void
-TclBackgroundException(
+Tcl_BackgroundException(
     Tcl_Interp *interp,		/* Interpreter in which an exception has
 				 * occurred. */
     int code)			/* The exception code value */
@@ -156,7 +160,7 @@ TclBackgroundException(
 	return;
     }
 
-    errPtr = (BgError *) ckalloc(sizeof(BgError));
+    errPtr = ckalloc(sizeof(BgError));
     errPtr->errorMsg = Tcl_GetObjResult(interp);
     Tcl_IncrRefCount(errPtr->errorMsg);
     errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
@@ -164,10 +168,10 @@ TclBackgroundException(
     errPtr->nextPtr = NULL;
 
     (void) TclGetBgErrorHandler(interp);
-    assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError", NULL);
+    assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
     if (assocPtr->firstBgPtr == NULL) {
 	assocPtr->firstBgPtr = errPtr;
-	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
+	Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
     } else {
 	assocPtr->lastBgPtr->nextPtr = errPtr;
     }
@@ -196,7 +200,7 @@ static void
 HandleBgErrors(
     ClientData clientData)	/* Pointer to ErrAssocData structure. */
 {
-    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+    ErrAssocData *assocPtr = clientData;
     Tcl_Interp *interp = assocPtr->interp;
     BgError *errPtr;
 
@@ -207,15 +211,15 @@ HandleBgErrors(
      * that could lead us here.
      */
 
-    Tcl_Preserve((ClientData) assocPtr);
-    Tcl_Preserve((ClientData) interp);
+    Tcl_Preserve(assocPtr);
+    Tcl_Preserve(interp);
     while (assocPtr->firstBgPtr != NULL) {
 	int code, prefixObjc;
 	Tcl_Obj **prefixObjv, **tempObjv;
 
 	/*
-	 * Note we copy the handler command prefix each pass through, so
-	 * we do support one handler setting another handler.
+	 * Note we copy the handler command prefix each pass through, so we do
+	 * support one handler setting another handler.
 	 */
 
 	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
@@ -223,7 +227,7 @@ HandleBgErrors(
 	errPtr = assocPtr->firstBgPtr;
 
 	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
-	tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *));
+	tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
 	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
 	tempObjv[prefixObjc] = errPtr->errorMsg;
 	tempObjv[prefixObjc+1] = errPtr->returnOpts;
@@ -238,8 +242,8 @@ HandleBgErrors(
 	Tcl_DecrRefCount(errPtr->errorMsg);
 	Tcl_DecrRefCount(errPtr->returnOpts);
 	assocPtr->firstBgPtr = errPtr->nextPtr;
-	ckfree((char *) errPtr);
-	ckfree((char *) tempObjv);
+	ckfree(errPtr);
+	ckfree(tempObjv);
 
 	if (code == TCL_BREAK) {
 	    /*
@@ -252,12 +256,12 @@ HandleBgErrors(
 		assocPtr->firstBgPtr = errPtr->nextPtr;
 		Tcl_DecrRefCount(errPtr->errorMsg);
 		Tcl_DecrRefCount(errPtr->returnOpts);
-		ckfree((char *) errPtr);
+		ckfree(errPtr);
 	    }
 	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
 	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
 
-	    if (errChannel != (Tcl_Channel) NULL) {
+	    if (errChannel != NULL) {
 		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
 		Tcl_Obj *keyPtr, *valuePtr = NULL;
 
@@ -280,8 +284,8 @@ HandleBgErrors(
 	}
     }
     assocPtr->lastBgPtr = NULL;
-    Tcl_Release((ClientData) interp);
-    Tcl_Release((ClientData) assocPtr);
+    Tcl_Release(interp);
+    Tcl_Release(assocPtr);
 }
 
 /*
@@ -307,7 +311,7 @@ TclDefaultBgErrorHandlerObjCmd(
     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. */
 {
     Tcl_Obj *keyPtr, *valuePtr;
     Tcl_Obj *tempObjv[2];
@@ -330,6 +334,7 @@ TclDefaultBgErrorHandlerObjCmd(
     if (result != TCL_OK || 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) {
@@ -342,6 +347,7 @@ TclDefaultBgErrorHandlerObjCmd(
     if (result != TCL_OK || 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) {
@@ -349,19 +355,26 @@ TclDefaultBgErrorHandlerObjCmd(
     }
 
     if (level != 0) {
-	/* We're handling a TCL_RETURN exception */
+	/*
+	 * 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 TclBackgroundException()?)
-	 * Just return without doing anything.
+	 * Somehow we got to exception handling with no exception. (Pass
+	 * TCL_OK to Tcl_BackgroundException()?) Just return without doing
+	 * anything.
 	 */
+
 	return TCL_OK;
     }
 
-    /* Construct the bgerror command */
+    /*
+     * Construct the bgerror command.
+     */
+
     TclNewLiteralStringObj(tempObjv[0], "bgerror");
     Tcl_IncrRefCount(tempObjv[0]);
 
@@ -419,7 +432,10 @@ TclDefaultBgErrorHandlerObjCmd(
 
     saved = Tcl_SaveInterpState(interp, code);
 
-    /* Invoke the bgerror command. */
+    /*
+     * Invoke the bgerror command.
+     */
+
     Tcl_AllowExceptions(interp);
     code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL);
     if (code == TCL_ERROR) {
@@ -438,7 +454,8 @@ TclDefaultBgErrorHandlerObjCmd(
 	    TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN);
 	} else {
 	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	    if (errChannel != (Tcl_Channel) NULL) {
+
+	    if (errChannel != NULL) {
 		Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
 
 		Tcl_IncrRefCount(resultPtr);
@@ -498,8 +515,7 @@ TclSetBgErrorHandler(
     Tcl_Interp *interp,
     Tcl_Obj *cmdPrefix)
 {
-    ErrAssocData *assocPtr = (ErrAssocData *)
-	    Tcl_GetAssocData(interp, "tclBgError", NULL);
+    ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
 
     if (cmdPrefix == NULL) {
 	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
@@ -509,13 +525,12 @@ TclSetBgErrorHandler(
 	 * First access: initialize.
 	 */
 
-	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+	assocPtr = ckalloc(sizeof(ErrAssocData));
 	assocPtr->interp = interp;
 	assocPtr->cmdPrefix = NULL;
 	assocPtr->firstBgPtr = NULL;
 	assocPtr->lastBgPtr = NULL;
-	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
-		(ClientData) assocPtr);
+	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
     }
     if (assocPtr->cmdPrefix) {
 	Tcl_DecrRefCount(assocPtr->cmdPrefix);
@@ -545,16 +560,14 @@ Tcl_Obj *
 TclGetBgErrorHandler(
     Tcl_Interp *interp)
 {
-    ErrAssocData *assocPtr = (ErrAssocData *)
-	    Tcl_GetAssocData(interp, "tclBgError", NULL);
+    ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
 
     if (assocPtr == NULL) {
 	Tcl_Obj *bgerrorObj;
 
 	TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
 	TclSetBgErrorHandler(interp, bgerrorObj);
-	assocPtr = (ErrAssocData *)
-		Tcl_GetAssocData(interp, "tclBgError", NULL);
+	assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
     }
     return assocPtr->cmdPrefix;
 }
@@ -573,7 +586,7 @@ TclGetBgErrorHandler(
  *
  * Side effects:
  *	Background error information is freed: if there were any pending error
- *	reports, they are cancelled.
+ *	reports, they are canceled.
  *
  *----------------------------------------------------------------------
  */
@@ -583,7 +596,7 @@ BgErrorDeleteProc(
     ClientData clientData,	/* Pointer to ErrAssocData structure. */
     Tcl_Interp *interp)		/* Interpreter being deleted. */
 {
-    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+    ErrAssocData *assocPtr = clientData;
     BgError *errPtr;
 
     while (assocPtr->firstBgPtr != NULL) {
@@ -591,11 +604,11 @@ BgErrorDeleteProc(
 	assocPtr->firstBgPtr = errPtr->nextPtr;
 	Tcl_DecrRefCount(errPtr->errorMsg);
 	Tcl_DecrRefCount(errPtr->returnOpts);
-	ckfree((char *) errPtr);
+	ckfree(errPtr);
     }
-    Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
+    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
     Tcl_DecrRefCount(assocPtr->cmdPrefix);
-    Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
+    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
 }
 
 /*
@@ -621,9 +634,8 @@ Tcl_CreateExitHandler(
     Tcl_ExitProc *proc,		/* Function to invoke. */
     ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
-    ExitHandler *exitPtr;
+    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
 
-    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
     Tcl_MutexLock(&exitMutex);
@@ -637,7 +649,8 @@ 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.
@@ -654,9 +667,8 @@ TclCreateLateExitHandler(
     Tcl_ExitProc *proc,		/* Function to invoke. */
     ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
-    ExitHandler *exitPtr;
+    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
 
-    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
     Tcl_MutexLock(&exitMutex);
@@ -678,7 +690,7 @@ TclCreateLateExitHandler(
  *
  * Side effects:
  *	If there is an exit handler corresponding to proc and clientData then
- *	it is cancelled; if no such handler exists then nothing happens.
+ *	it is canceled; if no such handler exists then nothing happens.
  *
  *----------------------------------------------------------------------
  */
@@ -700,7 +712,7 @@ Tcl_DeleteExitHandler(
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    ckfree((char *) exitPtr);
+	    ckfree(exitPtr);
 	    break;
 	}
     }
@@ -720,8 +732,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.
  *
  *----------------------------------------------------------------------
  */
@@ -743,7 +755,7 @@ TclDeleteLateExitHandler(
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    ckfree((char *) exitPtr);
+	    ckfree(exitPtr);
 	    break;
 	}
     }
@@ -777,7 +789,7 @@ Tcl_CreateThreadExitHandler(
     ExitHandler *exitPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+    exitPtr = ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
     exitPtr->nextPtr = tsdPtr->firstExitPtr;
@@ -797,7 +809,7 @@ Tcl_CreateThreadExitHandler(
  *
  * Side effects:
  *	If there is an exit handler corresponding to proc and clientData then
- *	it is cancelled; if no such handler exists then nothing happens.
+ *	it is canceled; if no such handler exists then nothing happens.
  *
  *----------------------------------------------------------------------
  */
@@ -819,7 +831,7 @@ Tcl_DeleteThreadExitHandler(
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    ckfree((char *) exitPtr);
+	    ckfree(exitPtr);
 	    return;
 	}
     }
@@ -845,7 +857,7 @@ Tcl_DeleteThreadExitHandler(
 
 Tcl_ExitProc *
 Tcl_SetExitProc(
-    Tcl_ExitProc *proc)		/* New exit handler for app or NULL */
+    TCL_NORETURN1 Tcl_ExitProc *proc)		/* New exit handler for app or NULL */
 {
     Tcl_ExitProc *prevExitProc;
 
@@ -861,6 +873,49 @@ Tcl_SetExitProc(
 
     return prevExitProc;
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeExitHandlers --
+ *
+ *      Call the registered exit handlers.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The exit handlers are invoked, and the ExitHandler struct is
+ *      freed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+InvokeExitHandlers(void)
+{
+    ExitHandler *exitPtr;
+
+    Tcl_MutexLock(&exitMutex);
+    inExit = 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(exitPtr);
+	Tcl_MutexLock(&exitMutex);
+    }
+    firstExitPtr = NULL;
+    Tcl_MutexUnlock(&exitMutex);
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -878,12 +933,12 @@ Tcl_SetExitProc(
  *----------------------------------------------------------------------
  */
 
-void
+TCL_NORETURN void
 Tcl_Exit(
     int status)			/* Exit status for application; typically 0
 				 * for normal return, 1 for error return. */
 {
-    Tcl_ExitProc *currentAppExitPtr;
+    TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr;
 
     Tcl_MutexLock(&exitMutex);
     currentAppExitPtr = appExitPtr;
@@ -896,14 +951,41 @@ Tcl_Exit(
 	 * returns, so critical is this dependcy.
 	 */
 
-	currentAppExitPtr((ClientData) INT2PTR(status));
+	currentAppExitPtr(INT2PTR(status));
 	Tcl_Panic("AppExitProc returned unexpectedly");
     } else {
-	/*
-	 * Use default handling.
-	 */
 
-	Tcl_Finalize();
+	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.
+	     */
+
+	    FinalizeThread(/* quick */ 1);
+	}
 	TclpExit(status);
 	Tcl_Panic("OS exit failed!");
     }
@@ -937,8 +1019,8 @@ Tcl_Exit(
 void
 TclInitSubsystems(void)
 {
-    if (inFinalize != 0) {
-	Tcl_Panic("TclInitSubsystems called while finalizing");
+    if (inExit != 0) {
+	Tcl_Panic("TclInitSubsystems called while exiting");
     }
 
     if (subsystemsInitialized == 0) {
@@ -987,8 +1069,8 @@ TclInitSubsystems(void)
  * Tcl_Finalize --
  *
  *	Shut down Tcl. First calls registered exit handlers, then carefully
- *	shuts down various subsystems. Called by Tcl_Exit or when the Tcl
- *	shared library is being unloaded.
+ *	shuts down various subsystems.  Should be invoked by user before the
+ *	Tcl shared library is being unloaded in an embedded context.
  *
  * Results:
  *	None.
@@ -1008,23 +1090,7 @@ Tcl_Finalize(void)
      * Invoke exit handlers first.
      */
 
-    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);
+    InvokeExitHandlers();
 
     TclpInitLock();
     if (subsystemsInitialized == 0) {
@@ -1053,7 +1119,8 @@ 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
@@ -1063,7 +1130,7 @@ Tcl_Finalize(void)
 	firstLateExitPtr = exitPtr->nextPtr;
 	Tcl_MutexUnlock(&exitMutex);
 	exitPtr->proc(exitPtr->clientData);
-	ckfree((char *) exitPtr);
+	ckfree(exitPtr);
 	Tcl_MutexLock(&exitMutex);
     }
     firstLateExitPtr = NULL;
@@ -1074,6 +1141,7 @@ Tcl_Finalize(void)
      * after the exit handlers, because there are order dependencies.
      */
 
+    TclFinalizeEvaluation();
     TclFinalizeExecution();
     TclFinalizeEnvironment();
 
@@ -1104,8 +1172,6 @@ Tcl_Finalize(void)
 
     TclFinalizeEncodingSubsystem();
 
-    Tcl_SetPanicProc(NULL);
-
     /*
      * Repeat finalization of the thread local storage once more. Although
      * this step is already done by the Tcl_FinalizeThread call above, series
@@ -1118,7 +1184,7 @@ Tcl_Finalize(void)
      * This fixes the Tcl Bug #990552.
      */
 
-    TclFinalizeThreadData();
+    TclFinalizeThreadData(/* quick */ 0);
 
     /*
      * Now we can free constants for conversions to/from double.
@@ -1129,10 +1195,10 @@ Tcl_Finalize(void)
     /*
      * 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.
+     * 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 (firstExitPtr != NULL) {
@@ -1179,7 +1245,6 @@ Tcl_Finalize(void)
      */
 
     TclFinalizeMemorySubsystem();
-    inFinalize = 0;
 
   alreadyFinalized:
     TclFinalizeLock();
@@ -1205,6 +1270,13 @@ Tcl_Finalize(void)
 void
 Tcl_FinalizeThread(void)
 {
+    FinalizeThread(/* quick */ 0);
+}
+
+void
+FinalizeThread(
+    int quick)
+{
     ExitHandler *exitPtr;
     ThreadSpecificData *tsdPtr;
 
@@ -1214,7 +1286,7 @@ Tcl_FinalizeThread(void)
      * initialized already.
      */
 
-    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+    tsdPtr = TclThreadDataKeyGet(&dataKey);
     if (tsdPtr != NULL) {
 	tsdPtr->inExit = 1;
 
@@ -1227,8 +1299,8 @@ Tcl_FinalizeThread(void)
 	     */
 
 	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
-	    (*exitPtr->proc)(exitPtr->clientData);
-	    ckfree((char *) exitPtr);
+	    exitPtr->proc(exitPtr->clientData);
+	    ckfree(exitPtr);
 	}
 	TclFinalizeIOSubsystem();
 	TclFinalizeNotifier();
@@ -1245,8 +1317,7 @@ Tcl_FinalizeThread(void)
      *
      * Fix [Bug #571002]
      */
-
-    TclFinalizeThreadData();
+    TclFinalizeThreadData(quick);
 }
 
 /*
@@ -1268,7 +1339,7 @@ Tcl_FinalizeThread(void)
 int
 TclInExit(void)
 {
-    return inFinalize;
+    return inExit;
 }
 
 /*
@@ -1290,13 +1361,12 @@ TclInExit(void)
 int
 TclInThreadExit(void)
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-	    TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
     if (tsdPtr == NULL) {
 	return 0;
-    } else {
-	return tsdPtr->inExit;
     }
+    return tsdPtr->inExit;
 }
 
 /*
@@ -1322,48 +1392,61 @@ Tcl_VwaitObjCmd(
     ClientData clientData,	/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int done, foundEvent;
-    char *nameString;
+    const char *nameString;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
     nameString = Tcl_GetString(objv[1]);
-    if (Tcl_TraceVar(interp, nameString,
+    if (Tcl_TraceVar2(interp, nameString, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
+	    VwaitVarProc, &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_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
 	    break;
 	}
     }
-    Tcl_UntraceVar(interp, nameString,
+    Tcl_UntraceVar2(interp, nameString, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    VwaitVarProc, (ClientData) &done);
+	    VwaitVarProc, &done);
 
-    /*
-     * 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", NULL);
+	Tcl_ResetResult(interp);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't wait for variable \"%s\": would wait forever",
+		nameString));
+	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
 	return TCL_ERROR;
     }
     if (!done) {
-	Tcl_AppendResult(interp, "limit exceeded", NULL);
+	/*
+	 * The interpreter's result was already set to the right error message
+	 * prior to exiting the loop above.
+	 */
+
 	return TCL_ERROR;
     }
+
+    /*
+     * Clear out the interpreter's result, since it may have been set by event
+     * handlers.
+     */
+
+    Tcl_ResetResult(interp);
     return TCL_OK;
 }
 
@@ -1372,11 +1455,11 @@ 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. */
+    const char *name1,		/* Name of variable. */
+    const char *name2,		/* Second part of variable name. */
     int flags)			/* Information about what happened. */
 {
-    int *donePtr = (int *) clientData;
+    int *donePtr = clientData;
 
     *donePtr = 1;
     Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
@@ -1407,12 +1490,12 @@ Tcl_UpdateObjCmd(
     ClientData clientData,	/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int optionIndex;
     int flags = 0;		/* Initialized to avoid compiler warning. */
-    static CONST char *updateOptions[] = {"idletasks", NULL};
-    enum updateOptions {REGEXP_IDLETASKS};
+    static const char *const updateOptions[] = {"idletasks", NULL};
+    enum updateOptions {OPT_IDLETASKS};
 
     if (objc == 1) {
 	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
@@ -1422,7 +1505,7 @@ Tcl_UpdateObjCmd(
 	    return TCL_ERROR;
 	}
 	switch ((enum updateOptions) optionIndex) {
-	case REGEXP_IDLETASKS:
+	case OPT_IDLETASKS:
 	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
 	    break;
 	default:
@@ -1434,9 +1517,12 @@ Tcl_UpdateObjCmd(
     }
 
     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);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
 	    return TCL_ERROR;
 	}
     }
@@ -1452,11 +1538,11 @@ Tcl_UpdateObjCmd(
 
 #ifdef TCL_THREADS
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * NewThreadProc --
  *
- * 	Bootstrap function of a new Tcl thread.
+ *	Bootstrap function of a new Tcl thread.
  *
  * Results:
  *	None.
@@ -1464,23 +1550,22 @@ Tcl_UpdateObjCmd(
  * Side Effects:
  *	Initializes Tcl notifier for the current thread.
  *
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static Tcl_ThreadCreateType
 NewThreadProc(
     ClientData clientData)
 {
-    ThreadClientData *cdPtr;
+    ThreadClientData *cdPtr = clientData;
     ClientData threadClientData;
     Tcl_ThreadCreateProc *threadProc;
 
-    cdPtr = (ThreadClientData *) clientData;
     threadProc = cdPtr->proc;
     threadClientData = cdPtr->clientData;
-    ckfree((char *) clientData);	/* Allocated in Tcl_CreateThread() */
+    ckfree(clientData);		/* Allocated in Tcl_CreateThread() */
 
-    (*threadProc)(threadClientData);
+    threadProc(threadClientData);
 
     TCL_THREAD_CREATE_RETURN;
 }
@@ -1508,21 +1593,23 @@ NewThreadProc(
 int
 Tcl_CreateThread(
     Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
-    Tcl_ThreadCreateProc proc,	/* Main() function 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;
+    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
+    int result;
 
-    cdPtr = (ThreadClientData *) ckalloc(sizeof(ThreadClientData));
     cdPtr->proc = proc;
     cdPtr->clientData = clientData;
-
-    return TclpThreadCreate(idPtr, NewThreadProc, (ClientData) cdPtr,
-	    stackSize, flags);
+    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
+    if (result != TCL_OK) {
+	ckfree(cdPtr);
+    }
+    return result;
 #else
     return TCL_ERROR;
 #endif /* TCL_THREADS */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e85863d..6499cf8 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6,9 +6,10 @@
  * 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-2005 by Miguel Sofer.
+ * 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.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -16,10 +17,10 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include "tclOOInt.h"
 #include "tommath.h"
-
 #include <math.h>
-#include <float.h>
+#include <assert.h>
 
 /*
  * Hack to determine whether we may expect IEEE floating point. The hack is
@@ -50,6 +51,8 @@
 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,
@@ -115,7 +118,7 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 
 typedef struct {
     const char *name;		/* Name of function. */
-    int numArgs;	/* Number of arguments for function. */
+    int numArgs;		/* Number of arguments for function. */
 } BuiltinFunc;
 
 /*
@@ -124,7 +127,7 @@ typedef struct {
  * operand byte.
  */
 
-static const BuiltinFunc tclBuiltinFuncTable[] = {
+static BuiltinFunc const tclBuiltinFuncTable[] = {
     {"acos", 1},
     {"asin", 1},
     {"atan", 1},
@@ -156,7 +159,53 @@ static const BuiltinFunc tclBuiltinFuncTable[] = {
 
 #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 */
+				/* -----------------------------------------*/
+    ptrdiff_t *catchTop;	/* These fields are used on return TO this */
+    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
+    CmdFrame cmdFrame;		/* new codePtr was received for NR */
+                                /* execution. */
+    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;				\
+	TclNRAddCallback(interp, TEBCresume,		\
+		TD, pc, INT2PTR(cleanup), NULL);	\
+    } while (0)
+
+#define TEBC_DATA_DIG() \
+    do {					\
+	tosPtr = esPtr->tosPtr;			\
+    } while (0)
+
+#define PUSH_TAUX_OBJ(objPtr) \
+    do {							\
+	if (auxObjList) {					\
+	    objPtr->length += auxObjList->length;		\
+	}							\
+	objPtr->internalRep.twoPtrValue.ptr1 = auxObjList;	\
+	auxObjList = objPtr;					\
+    } while (0)
+
+#define POP_TAUX_OBJ() \
+    do {							\
+	tmpPtr = auxObjList;					\
+	auxObjList = tmpPtr->internalRep.twoPtrValue.ptr1;	\
+	Tcl_DecrRefCount(tmpPtr);				\
+    } while (0)
+
 /*
  * These variable-access macros have to coincide with those in tclVar.c
  */
@@ -170,8 +219,8 @@ VarHashCreateVar(
     Tcl_Obj *key,
     int *newPtr)
 {
-    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
-	    (char *) key, newPtr);
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
+	    key, newPtr);
 
     if (!hPtr) {
 	return NULL;
@@ -181,7 +230,7 @@ VarHashCreateVar(
 
 #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;
@@ -194,56 +243,143 @@ VarHashCreateVar(
  *    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 check that nCleanup is constant
+ * and within range.
  */
 
-#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
-    if (nCleanup == 0) {\
-	if (resultHandling != 0) {\
-	    if ((resultHandling) > 0) {\
-		PUSH_OBJECT(objResultPtr);\
-	    } else {\
-		*(++tosPtr) = objResultPtr;\
-	    }\
-	} \
-	pc += (pcAdjustment);\
-	goto cleanup0;\
-    } else if (resultHandling != 0) {\
-	if ((resultHandling) > 0) {\
-	    Tcl_IncrRefCount(objResultPtr);\
-	}\
-	pc += (pcAdjustment);\
-	switch (nCleanup) {\
-	    case 1: goto cleanup1_pushObjResultPtr;\
-	    case 2: goto cleanup2_pushObjResultPtr;\
-	    default: Tcl_Panic("bad usage of macro NEXT_INST_F");\
-	}\
-    } else {\
-	pc += (pcAdjustment);\
-	switch (nCleanup) {\
-	    case 1: goto cleanup1;\
-	    case 2: goto cleanup2;\
-	    default: Tcl_Panic("bad usage of macro NEXT_INST_F");\
-	}\
-    }
-
-#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
-    pc += (pcAdjustment);\
-    cleanup = (nCleanup);\
-    if (resultHandling) {\
-	if ((resultHandling) > 0) {\
-	    Tcl_IncrRefCount(objResultPtr);\
-	}\
-	goto cleanupV_pushObjResultPtr;\
-    } else {\
-	goto cleanupV;\
-    }
+/* Verify the stack depth, only when no expansion is in progress */
+
+#ifdef TCL_COMPILE_DEBUG
+#define CHECK_STACK()							\
+    do {								\
+	ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH,			\
+		/*checkStack*/ !(starting || auxObjList));		\
+	starting = 0;							\
+    } while (0)
+#else
+#define CHECK_STACK()
+#endif
+
+#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling)	\
+    do {							\
+	TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2));	\
+	CHECK_STACK();						\
+	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;		\
+	    case 0: break;					\
+	    }							\
+	} else {						\
+	    pc += (pcAdjustment);				\
+	    switch (nCleanup) {					\
+	    case 1: goto cleanup1;				\
+	    case 2: goto cleanup2;				\
+	    case 0: break;					\
+	    }							\
+	}							\
+    } while (0)
+
+#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling)	\
+    CHECK_STACK();						\
+    do {							\
+	pc += (pcAdjustment);					\
+	cleanup = (nCleanup);					\
+	if (resultHandling) {					\
+	    if ((resultHandling) > 0) {				\
+		Tcl_IncrRefCount(objResultPtr);			\
+	    }							\
+	    goto cleanupV_pushObjResultPtr;			\
+	} else {						\
+	    goto cleanupV;					\
+	}							\
+    } while (0)
+
+#ifndef TCL_COMPILE_DEBUG
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+    do {								\
+	pc += (pcAdjustment);						\
+	switch (*pc) {							\
+	case INST_JUMP_FALSE1:						\
+	    NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE1:						\
+	    NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+	case INST_JUMP_FALSE4:						\
+	    NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE4:						\
+	    NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+	default:							\
+	    if ((condition) < 0) {					\
+		TclNewIntObj(objResultPtr, -1);				\
+	    } else {							\
+		objResultPtr = TCONST((condition) > 0);			\
+	    }								\
+	    NEXT_INST_F(0, (cleanup), 1);				\
+	}								\
+    } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+    do {								\
+	pc += (pcAdjustment);						\
+	switch (*pc) {							\
+	case INST_JUMP_FALSE1:						\
+	    NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE1:						\
+	    NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+	case INST_JUMP_FALSE4:						\
+	    NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE4:						\
+	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+	default:							\
+	    if ((condition) < 0) {					\
+		TclNewIntObj(objResultPtr, -1);				\
+	    } else {							\
+		objResultPtr = TCONST((condition) > 0);			\
+	    }								\
+	    NEXT_INST_V(0, (cleanup), 1);				\
+	}								\
+    } while (0)
+#else /* TCL_COMPILE_DEBUG */
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+    do{									\
+	if ((condition) < 0) {						\
+	    TclNewIntObj(objResultPtr, -1);				\
+	} else {							\
+	    objResultPtr = TCONST((condition) > 0);			\
+	}								\
+	NEXT_INST_F((pcAdjustment), (cleanup), 1);			\
+    } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+    do{									\
+	if ((condition) < 0) {						\
+	    TclNewIntObj(objResultPtr, -1);				\
+	} else {							\
+	    objResultPtr = TCONST((condition) > 0);			\
+	}								\
+	NEXT_INST_V((pcAdjustment), (cleanup), 1);			\
+    } while (0)
+#endif
 
 /*
  * 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 TclExecuteByteCode (and a few other
+ * pair must surround any call inside TclNRExecuteByteCode (and a few other
  * procedures that use this scheme) that could result in a recursive call
- * to TclExecuteByteCode.
+ * to TclNRExecuteByteCode.
  */
 
 #define CACHE_STACK_INFO() \
@@ -278,44 +414,50 @@ VarHashCreateVar(
 
 #define OBJ_AT_DEPTH(n)	*(tosPtr-(n))
 
-#define CURR_DEPTH	(tosPtr - initTosPtr)
+#define CURR_DEPTH	((ptrdiff_t) (tosPtr - initTosPtr))
 
 #define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
 
 /*
  * Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
+ * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
  * only used in TRACE* calls to get a string from an object.
  */
 
 #ifdef TCL_COMPILE_DEBUG
 #   define TRACE(a) \
-    if (traceInstructions) { \
-	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
-		(int) CURR_DEPTH, \
-		(unsigned)(pc - codePtr->codeStart), \
-		GetOpcodeName(pc)); \
-	printf a; \
+    while (traceInstructions) {					\
+	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels,	\
+		(int) CURR_DEPTH,				\
+		(unsigned) (pc - codePtr->codeStart),		\
+		GetOpcodeName(pc));				\
+	printf a;						\
+	break;							\
     }
 #   define TRACE_APPEND(a) \
-    if (traceInstructions) { \
-	printf a; \
+    while (traceInstructions) {		\
+	printf a;			\
+	break;				\
     }
+#   define TRACE_ERROR(interp) \
+    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 #   define TRACE_WITH_OBJ(a, objPtr) \
-    if (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"); \
+    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;							\
     }
 #   define O2S(objPtr) \
     (objPtr ? TclGetString(objPtr) : "")
 #else /* !TCL_COMPILE_DEBUG */
 #   define TRACE(a)
 #   define TRACE_APPEND(a)
+#   define TRACE_ERROR(interp)
 #   define TRACE_WITH_OBJ(a, objPtr)
 #   define O2S(objPtr)
 #endif /* TCL_COMPILE_DEBUG */
@@ -325,23 +467,29 @@ VarHashCreateVar(
  */
 
 #define TCL_DTRACE_INST_NEXT() \
-    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);\
-    }
+    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)
 #define TCL_DTRACE_INST_LAST() \
-    if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {\
-	TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
-    }
-
+    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:
@@ -350,9 +498,8 @@ VarHashCreateVar(
  *			ClientData *ptrPtr, int *tPtr);
  */
 
-#ifdef NO_WIDE_TYPE
-
-#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr)			\
+#ifdef TCL_WIDE_INT_IS_LONG
+#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
     (((objPtr)->typePtr == &tclIntType)					\
 	?	(*(tPtr) = TCL_NUMBER_LONG,				\
 		*(ptrPtr) = (ClientData)				\
@@ -363,12 +510,11 @@ VarHashCreateVar(
 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
 		*(ptrPtr) = (ClientData)				\
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
-    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))? TCL_ERROR : \
+    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
+	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-
-#else
-
-#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr)			\
+#else /* !TCL_WIDE_INT_IS_LONG */
+#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
     (((objPtr)->typePtr == &tclIntType)					\
 	?	(*(tPtr) = TCL_NUMBER_LONG,				\
 		*(ptrPtr) = (ClientData)				\
@@ -383,10 +529,10 @@ VarHashCreateVar(
 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
 		*(ptrPtr) = (ClientData)				\
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
-    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))? TCL_ERROR :	\
+    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
+	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-
-#endif
+#endif /* TCL_WIDE_INT_IS_LONG */
 
 /*
  * Macro used in this file to save a function call for common uses of
@@ -396,37 +542,13 @@ VarHashCreateVar(
  *			int *boolPtr);
  */
 
-#define TclGetBooleanFromObj(interp, objPtr, 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
-#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
-
-/*
  * 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:
@@ -440,24 +562,25 @@ VarHashCreateVar(
 #define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0))
 
 /*
- * Custom object type only used in this file; values of its type should never
- * be seen by user scripts.
+ * Macro for checking whether the type is NaN, used when we're thinking about
+ * throwing an error for supplying a non-number number.
  */
 
-static Tcl_ObjType dictIteratorType = {
-    "dictIterator",
-    NULL, NULL, NULL, NULL
-};
-
+#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
+ * 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
+ * signed integer.
  */
 
 static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14};
@@ -472,7 +595,8 @@ static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long);
 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 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,
@@ -482,7 +606,6 @@ static const long Exp32Value[] = {
     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)
@@ -502,14 +625,15 @@ static const Tcl_WideInt MaxBase64[] = {
 static const size_t MaxBase64Size = sizeof(MaxBase64)/sizeof(Tcl_WideInt);
 
 /*
- *Table giving 3, 4, ..., 13 raised to powers greater than 16 when the
+ * Table giving 3, 4, ..., 13 raised to powers greater than 16 when the
  * results fit in a 64-bit signed integer.
  */
 
 static const unsigned short Exp64Index[] = {
     0, 23, 38, 49, 57, 63, 67, 70, 72, 74, 75, 76
 };
-static const size_t Exp64IndexSize = sizeof(Exp64Index)/sizeof(unsigned short);
+static const 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,
@@ -588,10 +712,17 @@ static const Tcl_WideInt Exp64Value[] = {
     (Tcl_WideInt)248832*248832*248832*12*12,
     (Tcl_WideInt)371293*371293*371293*13*13
 };
-static const size_t Exp64ValueSize = sizeof(Exp64Value)/sizeof(Tcl_WideInt);
+static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
+#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */
 
-#endif
+/*
+ * Markers for ExecuteExtendedBinaryMathOp.
+ */
 
+#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:
  */
@@ -602,42 +733,108 @@ static int		EvalStatsCmd(ClientData clientData,
 			    Tcl_Obj *const objv[]);
 #endif /* TCL_COMPILE_STATS */
 #ifdef TCL_COMPILE_DEBUG
-static char *		GetOpcodeName(unsigned char *pc);
+static const char *	GetOpcodeName(const unsigned char *pc);
 static void		PrintByteCodeInfo(ByteCode *codePtr);
 static const char *	StringForResultCode(int result);
 static void		ValidatePcAndStackTop(ByteCode *codePtr,
-			    unsigned char *pc, int stackTop,
-			    int stackLowerBound, int checkStack);
+			    const unsigned char *pc, int stackTop,
+			    int checkStack);
 #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(unsigned char *pc, int searchMode,
-			    ByteCode *codePtr);
-static const char *	GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr,
-			    int *lengthPtr);
+static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
+			    int searchMode, ByteCode *codePtr);
+static const char *	GetSrcInfoForPc(const unsigned char *pc,
+			    ByteCode *codePtr, int *lengthPtr,
+			    const unsigned char **pcBeg, int *cmdIdxPtr);
 static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
 			    int move);
 static void		IllegalExprOperandType(Tcl_Interp *interp,
-			    unsigned char *pc, Tcl_Obj *opndPtr);
+			    const unsigned char *pc, Tcl_Obj *opndPtr);
 static void		InitByteCodeExecution(Tcl_Interp *interp);
+static inline int	wordSkip(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	FinalizeOONext;
+static Tcl_NRPostProc	FinalizeOONextFilter;
+static Tcl_NRPostProc   TEBCresume;
 
 /*
  * The structure below defines a bytecode Tcl object type to hold the
  * compiled bytecode for Tcl expressions.
  */
 
-static Tcl_ObjType exprCodeType = {
+static const Tcl_ObjType exprCodeType = {
     "exprcode",
     FreeExprCodeInternalRep,	/* freeIntRepProc */
     DupExprCodeInternalRep,	/* dupIntRepProc */
     NULL,			/* updateStringProc */
     NULL			/* setFromAnyProc */
 };
+
+/*
+ * Custom object type only used in this file; values of its type should never
+ * be seen by user scripts.
+ */
+
+static const Tcl_ObjType dictIteratorType = {
+    "dictIterator",
+    ReleaseDictIterator,
+    NULL, NULL, NULL
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -685,7 +882,7 @@ InitByteCodeExecution(
  *	This procedure creates a new execution environment for Tcl bytecode
  *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is
  *	typically created once for each Tcl interpreter (Interp structure) and
- *	recursively passed to TclExecuteByteCode to execute ByteCode sequences
+ *	recursively passed to TclNRExecuteByteCode to execute ByteCode sequences
  *	for nested commands.
  *
  * Results:
@@ -694,37 +891,40 @@ InitByteCodeExecution(
  *
  * Side effects:
  *	The bytecode interpreter is also initialized here, as this procedure
- *	will be called before any call to TclExecuteByteCode.
+ *	will be called before any call to TclNRExecuteByteCode.
  *
  *----------------------------------------------------------------------
  */
 
-#define TCL_STACK_INITIAL_SIZE 2000
-
 ExecEnv *
 TclCreateExecEnv(
-    Tcl_Interp *interp)		/* Interpreter for which the execution
+    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 = (ExecEnv *) ckalloc(sizeof(ExecEnv));
-    ExecStack *esPtr = (ExecStack *) ckalloc(sizeof(ExecStack)
-	    + (size_t) (TCL_STACK_INITIAL_SIZE-1) * 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[TCL_STACK_INITIAL_SIZE-1];
+    esPtr->endPtr = &esPtr->stackWords[size-1];
     esPtr->tosPtr = STACK_BASE(esPtr);
 
     Tcl_MutexLock(&execMutex);
     if (!execInitialized) {
-	TclInitAuxDataTypeTable();
 	InitByteCodeExecution(interp);
 	execInitialized = 1;
     }
@@ -732,7 +932,6 @@ TclCreateExecEnv(
 
     return eePtr;
 }
-#undef TCL_STACK_INITIAL_SIZE
 
 /*
  *----------------------------------------------------------------------
@@ -755,7 +954,7 @@ static void
 DeleteExecStack(
     ExecStack *esPtr)
 {
-    if (esPtr->markerPtr) {
+    if (esPtr->markerPtr && !cachedInExit) {
 	Tcl_Panic("freeing an execStack which is still in use");
     }
 
@@ -765,7 +964,7 @@ DeleteExecStack(
     if (esPtr->nextPtr) {
 	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
     }
-    ckfree((char *) esPtr);
+    ckfree(esPtr);
 }
 
 void
@@ -774,6 +973,8 @@ TclDeleteExecEnv(
 {
     ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
 
+	cachedInExit = TclInExit();
+
     /*
      * Delete all stacks in this exec env.
      */
@@ -789,7 +990,13 @@ TclDeleteExecEnv(
 
     TclDecrRefCount(eePtr->constants[0]);
     TclDecrRefCount(eePtr->constants[1]);
-    ckfree((char *) eePtr);
+    if (eePtr->callbackPtr && !cachedInExit) {
+	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
+    }
+    if (eePtr->corPtr && !cachedInExit) {
+	Tcl_Panic("Deleting execEnv with existing coroutine");
+    }
+    ckfree(eePtr);
 }
 
 /*
@@ -816,7 +1023,6 @@ TclFinalizeExecution(void)
     Tcl_MutexLock(&execMutex);
     execInitialized = 0;
     Tcl_MutexUnlock(&execMutex);
-    TclFinalizeAuxDataTypeTable();
 }
 
 /*
@@ -850,10 +1056,9 @@ wordSkip(
  * Given a marker, compute where the following aligned memory starts.
  */
 
-#define MEMSTART(markerPtr)			\
+#define MEMSTART(markerPtr) \
     ((markerPtr) + wordSkip(markerPtr))
 
-
 /*
  *----------------------------------------------------------------------
  *
@@ -895,6 +1100,7 @@ GrowEvaluationStack(
 	    return MEMSTART(markerPtr);
 	}
     } else {
+#ifndef PURIFY
 	Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
 	int offset = wordSkip(tmpMarkerPtr);
 
@@ -911,6 +1117,7 @@ GrowEvaluationStack(
 	    *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
 	    return memStart;
 	}
+#endif
     }
 
     /*
@@ -924,6 +1131,7 @@ GrowEvaluationStack(
     }
     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!)
@@ -953,14 +1161,19 @@ GrowEvaluationStack(
      * including the elements to be copied over and the new marker.
      */
 
+#ifndef PURIFY
     newElems = 2*currElems;
     while (needed > newElems) {
 	newElems *= 2;
     }
-    newBytes = sizeof (ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
+#else
+    newElems = needed;
+#endif
+
+    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
 
     oldPtr = esPtr;
-    esPtr = (ExecStack *) ckalloc(newBytes);
+    esPtr = ckalloc(newBytes);
 
     oldPtr->nextPtr = esPtr;
     esPtr->prevPtr = oldPtr;
@@ -1056,7 +1269,7 @@ TclStackFree(
     Interp *iPtr = (Interp *) interp;
     ExecEnv *eePtr;
     ExecStack *esPtr;
-    Tcl_Obj **markerPtr;
+    Tcl_Obj **markerPtr, *marker;
 
     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
 	ckfree((char *) freePtr);
@@ -1072,30 +1285,45 @@ TclStackFree(
     eePtr = iPtr->execEnvPtr;
     esPtr = eePtr->execStackPtr;
     markerPtr = esPtr->markerPtr;
+    marker = *markerPtr;
 
-    if (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr) {
-	Tcl_Panic("TclStackFree: incorrect freePtr. Call out of sequence?");
+    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 **) *markerPtr;
-    if (*markerPtr) {
- 	return;
+    esPtr->tosPtr = markerPtr - 1;
+    esPtr->markerPtr = (Tcl_Obj **) marker;
+    if (marker) {
+	return;
     }
 
     /*
-     * Return to previous stack.
+     * Return to previous active stack. Note that repeated expansions or
+     * reallocs could have generated several unused intervening stacks: free
+     * them too.
      */
 
+    while (esPtr->nextPtr) {
+	esPtr = esPtr->nextPtr;
+    }
     esPtr->tosPtr = STACK_BASE(esPtr);
-    if (esPtr->prevPtr) {
- 	eePtr->execStackPtr = esPtr->prevPtr;
+    while (esPtr->prevPtr) {
+	ExecStack *tmpPtr = esPtr->prevPtr;
+	if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) {
+	    DeleteExecStack(tmpPtr);
+	} else {
+	    break;
+	}
     }
-    if (esPtr->nextPtr) {
- 	if (!esPtr->prevPtr) {
- 	    eePtr->execStackPtr = esPtr->nextPtr;
- 	}
- 	DeleteExecStack(esPtr);
+    if (esPtr->prevPtr) {
+	eePtr->execStackPtr = esPtr->prevPtr;
+#ifdef PURIFY
+	eePtr->execStackPtr->nextPtr = NULL;
+	DeleteExecStack(esPtr);
+#endif
+    } else {
+	eePtr->execStackPtr = esPtr;
     }
 }
 
@@ -1174,20 +1402,123 @@ Tcl_ExprObj(
     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);
+}
+
+static int
+CopyCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_Obj **resultPtrPtr = data[0];
+    Tcl_Obj *resultPtr = data[1];
+
+    if (result == TCL_OK) {
+	*resultPtrPtr = resultPtr;
+	Tcl_IncrRefCount(resultPtr);
+    } else {
+	Tcl_DecrRefCount(resultPtr);
+    }
+    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;
+    Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK);
+
+    Tcl_ResetResult(interp);
+    codePtr = CompileExprObj(interp, objPtr);
+
+    Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
+	    NULL, NULL);
+    return TclNRExecuteByteCode(interp, codePtr);
+}
+
+static int
+ExprObjCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_InterpState state = data[0];
+    Tcl_Obj *resultPtr = data[1];
+
+    if (result == TCL_OK) {
+	TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
+	(void) Tcl_RestoreInterpState(interp, state);
+    } else {
+	Tcl_DiscardInterpState(state);
+    }
+    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
+				/* Tcl Internal type of bytecode. Initialized
 				 * to avoid compiler warning. */
-    int result;
-
-    /*
-     * Execute the expression after first saving the interpreter's result.
-     */
-
-    Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(saveObjPtr);
 
     /*
      * Get the expression ByteCode from the object. If it exists, make sure it
@@ -1196,13 +1527,13 @@ Tcl_ExprObj(
     if (objPtr->typePtr == &exprCodeType) {
 	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
 
-	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
+	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != namespacePtr)
-		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
-	    objPtr->typePtr->freeIntRepProc(objPtr);
-	    objPtr->typePtr = (Tcl_ObjType *) NULL;
+		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
+		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
+	    FreeExprCodeInternalRep(objPtr);
 	}
     }
     if (objPtr->typePtr != &exprCodeType) {
@@ -1236,7 +1567,11 @@ Tcl_ExprObj(
 	TclInitByteCodeObj(objPtr, &compEnv);
 	objPtr->typePtr = &exprCodeType;
 	TclFreeCompileEnv(&compEnv);
-	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
+	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+	if (iPtr->varFramePtr->localCachePtr) {
+	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+	    codePtr->localCachePtr->refCount++;
+	}
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile == 2) {
 	    TclPrintByteCodeObj(interp, objPtr);
@@ -1244,38 +1579,7 @@ Tcl_ExprObj(
 	}
 #endif /* TCL_COMPILE_DEBUG */
     }
-
-    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);
-    }
-    TclDecrRefCount(saveObjPtr);
-    return result;
+    return codePtr;
 }
 
 /*
@@ -1284,17 +1588,17 @@ Tcl_ExprObj(
  * 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.
@@ -1319,14 +1623,15 @@ 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.
+ *
  *----------------------------------------------------------------------
  */
 
@@ -1334,36 +1639,32 @@ static void
 FreeExprCodeInternalRep(
     Tcl_Obj *objPtr)
 {
-    ByteCode *codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    codePtr->refCount--;
-    if (codePtr->refCount <= 0) {
+    objPtr->typePtr = NULL;
+    if (codePtr->refCount-- <= 1) {
 	TclCleanupByteCode(codePtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompEvalObj --
+ * TclCompileObj --
  *
- *	This procedure evaluates the script contained in a Tcl_Obj by first
- *	compiling it and then passing it to TclExecuteByteCode.
+ *	This procedure compiles the script contained in a Tcl_Obj.
  *
  * 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.
+ *	A pointer to the corresponding ByteCode, never NULL.
  *
  * Side effects:
- *	Almost certainly, depending on the ByteCode's instructions.
+ *	The object is shimmered to bytecode type.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclCompEvalObj(
+ByteCode *
+TclCompileObj(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr,
     const CmdFrame *invoker,
@@ -1371,23 +1672,7 @@ TclCompEvalObj(
 {
     register Interp *iPtr = (Interp *) interp;
     register ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
-    int result;
-    Namespace *namespacePtr;
-
-    /*
-     * Check that the interpreter is ready to execute scripts. Note that we
-     * manage the interp's runlevel here: it is a small white lie (maybe), but
-     * saves a ++/-- pair at each invocation. Amazingly enough, the impact on
-     * performance is noticeable.
-     */
-
-    iPtr->numLevels++;
-    if (TclInterpReady(interp) == TCL_ERROR) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    namespacePtr = iPtr->varFramePtr->nsPtr;
+    Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
 
     /*
      * If the object is not already of tclByteCodeType, compile it (and reset
@@ -1413,40 +1698,39 @@ TclCompEvalObj(
 	 * here.
 	 */
 
-	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
+	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != namespacePtr)
 		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
-	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-		if ((Interp *) *codePtr->interpHandle != iPtr) {
-		    Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
-		}
-		codePtr->compileEpoch = iPtr->compileEpoch;
-	    } else {
-		/*
-		 * This byteCode is invalid: free it and recompile.
-		 */
-
-		objPtr->typePtr->freeIntRepProc(objPtr);
+	    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;
+	}
+
+	/*
+	 * Check that any compiled locals do refer to the current proc
+	 * environment! If not, recompile.
+	 */
+
+	if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
+		(codePtr->procPtr == NULL) &&
+		(codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
+	    goto recompileObj;
 	}
 
 	/*
 	 * #280.
 	 * Literal sharing fix. This part of the fix is not required by 8.4
-	 * because it eval-directs any literals, so just saving the argument
-	 * locations per command in bytecode is enough, embedded 'eval'
-	 * commands, etc. get the correct information.
+	 * 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.
 	 *
-	 * It had be backported for 8.5 because we can force the separate
-	 * compiling of a literal (in a proc body) by putting it into a control
-	 * command with dynamic pieces, and then such literal may be shared
-	 * and require their line-information to be reset, as for 8.6, as
-	 * described below.
-	 *
-	 * In 8.6 all the embedded script are compiled, and the resulting
+	 * 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
@@ -1468,77 +1752,67 @@ TclCompEvalObj(
 	 *     information.
 	 */
 
-	if (invoker) {
+	if (invoker == NULL) {
+	    return codePtr;
+	} else {
 	    Tcl_HashEntry *hePtr =
-		    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
+	    ExtCmdLoc *eclPtr;
+	    CmdFrame *ctxCopyPtr;
+	    int redo;
 
-	    if (hePtr) {
-		ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
-		int redo = 0;
-		CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
-
-		*ctxPtr = *invoker;
+	    if (!hePtr) {
+		return codePtr;
+	    }
 
-		if (invoker->type == TCL_LOCATION_BC) {
-		    /*
-		     * Note: Type BC => ctx.data.eval.path    is not used.
-		     *		    ctx.data.tebc.codePtr used instead
-		     */
+	    eclPtr = Tcl_GetHashValue(hePtr);
+	    redo = 0;
+	    ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	    *ctxCopyPtr = *invoker;
 
-		    TclGetSrcInfoForPc(ctxPtr);
-		    if (ctxPtr->type == TCL_LOCATION_SOURCE) {
-			/*
-			 * The reference made by 'TclGetSrcInfoForPc' is
-			 * dead.
-			 */
-
-			Tcl_DecrRefCount(ctxPtr->data.eval.path);
-			ctxPtr->data.eval.path = NULL;
-		    }
-		}
+	    if (invoker->type == TCL_LOCATION_BC) {
+		/*
+		 * Note: Type BC => ctx.data.eval.path    is not used.
+		 *		    ctx.data.tebc.codePtr used instead
+		 */
 
-		if (word < ctxPtr->nline) {
+		TclGetSrcInfoForPc(ctxCopyPtr);
+		if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
 		    /*
-		     * 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 ...).
+		     * The reference made by 'TclGetSrcInfoForPc' is dead.
 		     */
 
-		    redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
-			    && (eclPtr->start != ctxPtr->line[word]))
-			|| ((eclPtr->type == TCL_LOCATION_BC)
-				&& (ctxPtr->type == TCL_LOCATION_SOURCE));
+		    Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
+		    ctxCopyPtr->data.eval.path = NULL;
 		}
+	    }
 
-		TclStackFree(interp, ctxPtr);
+	    if (word < ctxCopyPtr->nline) {
+		/*
+		 * Note: We do not care if the line[word] is -1. This is a
+		 * difference and requires a recompile (location changed from
+		 * absolute to relative, literal is used fixed and through
+		 * variable)
+		 *
+		 * Example:
+		 * test info-32.0 using literal of info-24.8
+		 *     (dict with ... vs           set body ...).
+		 */
 
-		if (redo) {
-		    goto recompileObj;
-		}
+		redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
+			    && (eclPtr->start != ctxCopyPtr->line[word]))
+			|| ((eclPtr->type == TCL_LOCATION_BC)
+			    && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
 	    }
-	}
 
-	/*
-	 * Increment the code's ref count while it is being executed. If
-	 * afterwards no references to it remain, free the code.
-	 */
-
-    runCompiledObj:
-	codePtr->refCount++;
-	result = TclExecuteByteCode(interp, codePtr);
-	codePtr->refCount--;
-	if (codePtr->refCount <= 0) {
-	    TclCleanupByteCode(codePtr);
+	    TclStackFree(interp, ctxCopyPtr);
+	    if (!redo) {
+		return codePtr;
+	    }
 	}
-	goto done;
     }
 
-    recompileObj:
+  recompileObj:
     iPtr->errorLine = 1;
 
     /*
@@ -1550,14 +1824,14 @@ TclCompEvalObj(
 
     iPtr->invokeCmdFramePtr = invoker;
     iPtr->invokeWord = word;
-    tclByteCodeType.setFromAnyProc(interp, objPtr);
+    TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
     iPtr->invokeCmdFramePtr = NULL;
-    codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
-    goto runCompiledObj;
-
-    done:
-    iPtr->numLevels--;
-    return result;
+    codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    if (iPtr->varFramePtr->localCachePtr) {
+	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+	codePtr->localCachePtr->refCount++;
+    }
+    return codePtr;
 }
 
 /*
@@ -1626,7 +1900,7 @@ TclIncrObj(
 	    TclSetLongObj(valuePtr, sum);
 	    return TCL_OK;
 	}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	{
 	    Tcl_WideInt w1 = (Tcl_WideInt) augend;
 	    Tcl_WideInt w2 = (Tcl_WideInt) addend;
@@ -1659,7 +1933,7 @@ TclIncrObj(
 	return TCL_ERROR;
     }
 
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
     if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
 	Tcl_WideInt w1, w2, sum;
 
@@ -1689,7 +1963,42 @@ TclIncrObj(
 /*
  *----------------------------------------------------------------------
  *
- * TclExecuteByteCode --
+ * ArgumentBCEnter --
+ *
+ *	This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates
+ *	a code sequence that is fairly common in the code but *not* commonly
+ *	called.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	May register information about the bytecode in the command frame.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ArgumentBCEnter(
+    Tcl_Interp *interp,
+    ByteCode *codePtr,
+    TEBCdata *tdPtr,
+    const unsigned char *pc,
+    int objc,
+    Tcl_Obj **objv)
+{
+    int cmd;
+
+    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+	TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
+		pc - codePtr->codeStart);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRExecuteByteCode --
  *
  *	This procedure executes the instructions of a ByteCode structure. It
  *	returns when a "done" instruction is executed or an error occurs.
@@ -1704,12 +2013,89 @@ TclIncrObj(
  *
  *----------------------------------------------------------------------
  */
+#define	bcFramePtr	(&TD->cmdFrame)
+#define	initCatchTop	((ptrdiff_t *) (&TD->stack[-1]))
+#define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
+#define esPtr		(iPtr->execEnvPtr->execStackPtr)
 
 int
-TclExecuteByteCode(
+TclNRExecuteByteCode(
     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 *);
+
+    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->catchTop    = initCatchTop;
+    TD->auxObjList  = NULL;
+
+    /*
+     * 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->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->cmdObj = NULL;
+    bcFramePtr->cmd = NULL;
+    bcFramePtr->len = 0;
+
+#ifdef TCL_COMPILE_STATS
+    iPtr->stats.numExecutions++;
+#endif
+
+    /*
+     * Test namespace-50.9 demonstrates the need for this call.
+     * Use a --enable-symbols=mem bug to see.
+     */
+
+    TclResetRewriteEnsemble(interp, 1);
+
+    /*
+     * Push the callback for bytecode execution
+     */
+
+    TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
+	    /* cleanup */ INT2PTR(0), 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;
@@ -1722,118 +2108,155 @@ TclExecuteByteCode(
 
 #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.
+     * sporadically: no special need for speed.
      */
 
-    ExecStack *esPtr;
-    Tcl_Obj **initTosPtr;	/* Stack top at start of execution. */
-    ptrdiff_t *initCatchTop;	/* Catch stack top at start of execution. */
-    Var *compiledLocals;
-    Namespace *namespacePtr;
-    CmdFrame *bcFramePtr;	/* TIP #280: Structure for tracking lines. */
+    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. */
+#endif
+
+    Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
     Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
 
+#define LOCAL(i)	(&compiledLocals[(i)])
+#define TCONST(i)	(constants[(i)])
+
+    /*
+     * These macros are just meant to save some global variables that are not
+     * used too frequently
+     */
+
+    TEBCdata *TD = data[0];
+#define auxObjList	(TD->auxObjList)
+#define catchTop	(TD->catchTop)
+#define codePtr		(TD->codePtr)
+
     /*
      * Globals: variables that store state, must remain valid at all times.
      */
 
-    ptrdiff_t *catchTop;
-    register Tcl_Obj **tosPtr;	/* Cached pointer to top of evaluation
+    Tcl_Obj **tosPtr;		/* Cached pointer to top of evaluation
 				 * stack. */
-    register unsigned char *pc = codePtr->codeStart;
-				/* The current program counter. */
-    int instructionCount = 0;	/* Counter that is used to work out when to
-				 * call Tcl_AsyncReady() */
-    Tcl_Obj *expandNestList = NULL;
-    int checkInterp = 0;	/* Indicates when a check of interp readyness
-				 * is necessary. Set by CACHE_STACK_INFO() */
+    const unsigned char *pc = data[1];
+                                /* The current program counter. */
+    unsigned char inst;         /* The currently running instruction */
 
     /*
      * Transfer variables - needed only between opcodes, but not while
      * executing an instruction.
      */
 
-    register int cleanup;
+    int cleanup = PTR2INT(data[2]);
     Tcl_Obj *objResultPtr;
-
-    /*
-     * Result variable - needed only when going to checkForcatch or other
-     * error handlers; also used as local in some opcodes.
-     */
-
-    int result = TCL_OK;	/* Return code returned after execution. */
+    int checkInterp;            /* Indicates when a check of interp readyness
+				 * is necessary. Set by CACHE_STACK_INFO() */
 
     /*
      * Locals - variables that are used within opcodes or bounded sections of
      * the file (jumps between opcodes within a family).
-     * NOTE: These are now defined locally where needed.
+     * 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
-    int traceInstructions = (tclTraceExec == 3);
     char cmdNameBuf[21];
 #endif
-    const char *curInstName = NULL;
-
-    /*
-     * The execution uses a unified stack: first the catch stack, immediately
-     * above it a CmdFrame, then the execution stack.
-     *
-     * Make sure the catch stack is large enough to hold the maximum number of
-     * catch commands that could ever be executing at the same time (this will
-     * be no more than the exception range array's depth). Make sure the
-     * execution stack is large enough to execute this ByteCode.
-     */
-
-    catchTop = initCatchTop = (ptrdiff_t *) (
-	GrowEvaluationStack(iPtr->execEnvPtr,
-		(sizeof(CmdFrame) + sizeof(Tcl_Obj *) - 1)/sizeof(Tcl_Obj *) +
-		codePtr->maxExceptDepth + codePtr->maxStackDepth, 0) - 1);
-    bcFramePtr = (CmdFrame *) (initCatchTop + codePtr->maxExceptDepth + 1);
-    tosPtr = initTosPtr = ((Tcl_Obj **) (bcFramePtr + 1)) - 1;
-    esPtr = iPtr->execEnvPtr->execStackPtr;
 
-    /*
-     * TIP #280: Initialize the frame. Do not push it yet.
-     */
-
-    bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
-	    ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
-    bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
-    bcFramePtr->framePtr = iPtr->framePtr;
-    bcFramePtr->nextPtr = iPtr->cmdFramePtr;
-    bcFramePtr->nline = 0;
-    bcFramePtr->line = NULL;
+#ifdef TCL_COMPILE_DEBUG
+    int starting = 1;
+    traceInstructions = (tclTraceExec == 3);
+#endif
 
-    bcFramePtr->data.tebc.codePtr = codePtr;
-    bcFramePtr->data.tebc.pc = NULL;
-    bcFramePtr->cmd.str.cmd = NULL;
-    bcFramePtr->cmd.str.len = 0;
+    TEBC_DATA_DIG();
 
 #ifdef TCL_COMPILE_DEBUG
-    if (tclTraceExec >= 2) {
+    if (!pc && (tclTraceExec >= 2)) {
 	PrintByteCodeInfo(codePtr);
 	fprintf(stdout, "  Starting stack top=%d\n", (int) CURR_DEPTH);
 	fflush(stdout);
     }
 #endif
 
-#ifdef TCL_COMPILE_STATS
-    iPtr->stats.numExecutions++;
-#endif
+    if (!pc) {
+	/* bytecode is starting from scratch */
+	checkInterp = 0;
+	pc = codePtr->codeStart;
+	goto cleanup0;
+    } else {
+        /* resume from invocation */
+	CACHE_STACK_INFO();
 
-    namespacePtr = iPtr->varFramePtr->nsPtr;
-    compiledLocals = iPtr->varFramePtr->compiledLocals;
+	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
+	if (bcFramePtr->cmdObj) {
+	    Tcl_DecrRefCount(bcFramePtr->cmdObj);
+	    bcFramePtr->cmdObj = NULL;
+	    bcFramePtr->cmd = NULL;
+	}
+	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    TclArgumentBCRelease(interp, bcFramePtr);
+	}
+	if (iPtr->execEnvPtr->rewind) {
+	    result = TCL_ERROR;
+	    goto abnormalReturn;
+	}
+	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
+	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
+	}
 
-    /*
-     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
-     * or some error.
-     */
+	if (result != TCL_OK) {
+	    pc--;
+	    goto processExceptionReturn;
+	}
 
-    goto cleanup0;
+	/*
+	 * 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));
+
+	/*
+	 * 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.
+	 */
+
+	objResultPtr = Tcl_GetObjResult(interp);
+	TclNewObj(objPtr);
+	Tcl_IncrRefCount(objPtr);
+	iPtr->objResultPtr = objPtr;
+#ifndef TCL_COMPILE_DEBUG
+	if (*pc == INST_POP) {
+	    TclDecrRefCount(objResultPtr);
+	    NEXT_INST_V(1, cleanup, 0);
+	}
+#endif
+	NEXT_INST_V(0, cleanup, -1);
+    }
 
     /*
      * Targets for standard instruction endings; unrolled for speed in the
@@ -1844,76 +2267,54 @@ TclExecuteByteCode(
      * cleanup.
      */
 
-    {
-	Tcl_Obj *valuePtr;
-
-    cleanupV_pushObjResultPtr:
-	switch (cleanup) {
-	case 0:
-	    *(++tosPtr) = (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 = OBJ_AT_TOS;
-	    TclDecrRefCount(valuePtr);
-	}
-	OBJ_AT_TOS = objResultPtr;
+  cleanupV_pushObjResultPtr:
+    switch (cleanup) {
+    case 0:
+	*(++tosPtr) = (objResultPtr);
 	goto cleanup0;
-
-    cleanupV:
-	switch (cleanup) {
-	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;
+    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);
     }
- cleanup0:
+    OBJ_AT_TOS = objResultPtr;
+    goto cleanup0;
 
-#ifdef TCL_COMPILE_DEBUG
-    /*
-     * Skip the stack depth check if an expansion is in progress.
-     */
+  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).
+	 */
 
-    ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0,
-	    /*checkStack*/ expandNestList == NULL);
-    if (traceInstructions) {
-	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
-	TclPrintInstruction(codePtr, pc);
-	fflush(stdout);
+	break;
     }
-#endif /* TCL_COMPILE_DEBUG */
-
-#ifdef TCL_COMPILE_STATS
-    iPtr->stats.instructionCount[*pc]++;
-#endif
+  cleanup0:
 
     /*
      * Check for asynchronous handlers [Bug 746722]; we do the check every
@@ -1921,37 +2322,31 @@ TclExecuteByteCode(
      */
 
     if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
-	/*
-	 * Check for asynchronous handlers [Bug 746722]; we do the check every
-	 * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
-	 */
-
+	DECACHE_STACK_INFO();
 	if (TclAsyncReady(iPtr)) {
-	    int localResult;
+	    result = Tcl_AsyncInvoke(interp, result);
+	    if (result == TCL_ERROR) {
+		CACHE_STACK_INFO();
+		goto gotError;
+	    }
+	}
 
-	    DECACHE_STACK_INFO();
-	    localResult = Tcl_AsyncInvoke(interp, result);
-	    CACHE_STACK_INFO();
-	    if (localResult == TCL_ERROR) {
-		result = localResult;
-		goto checkForCatch;
+	if (TclCanceled(iPtr)) {
+	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+		CACHE_STACK_INFO();
+		goto gotError;
 	    }
 	}
-	if (TclLimitReady(iPtr->limit)) {
-	    int localResult;
 
-	    DECACHE_STACK_INFO();
-	    localResult = Tcl_LimitCheck(interp);
-	    CACHE_STACK_INFO();
-	    if (localResult == TCL_ERROR) {
-		result = localResult;
-		goto checkForCatch;
+	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
@@ -1961,13 +2356,62 @@ TclExecuteByteCode(
      * reduces total obj size.
      */
 
-    if (*pc == INST_LOAD_SCALAR1) {
+    inst = *pc;
+
+    peepholeStart:
+#ifdef TCL_COMPILE_STATS
+    iPtr->stats.instructionCount[*pc]++;
+#endif
+
+#ifdef TCL_COMPILE_DEBUG
+    /*
+     * Skip the stack depth check if an expansion is in progress.
+     */
+
+    CHECK_STACK();
+    if (traceInstructions) {
+	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
+	TclPrintInstruction(codePtr, pc);
+	fflush(stdout);
+    }
+#endif /* TCL_COMPILE_DEBUG */
+
+    TCL_DTRACE_INST_NEXT();
+
+    if (inst == INST_LOAD_SCALAR1) {
 	goto instLoadScalar1;
-    } else if (*pc == INST_PUSH1) {
-	goto instPush1Peephole;
+    } else if (inst == INST_PUSH1) {
+	PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+	TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS);
+	inst = *(pc += 2);
+	goto peepholeStart;
+    } else if (inst == INST_START_CMD) {
+	/*
+	 * Peephole: do not run INST_START_CMD, just skip it
+	 */
+
+	iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
+	if (checkInterp) {
+	    checkInterp = 0;
+	    if (((codePtr->compileEpoch != iPtr->compileEpoch) ||
+		 (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) &&
+		!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+		goto instStartCmdFailed;
+	    }
+	}
+	inst = *(pc += 9);
+	goto peepholeStart;
+    } else if (inst == INST_NOP) {
+#ifndef TCL_COMPILE_DEBUG
+	while (inst == INST_NOP)
+#endif
+	{
+	    inst = *++pc;
+	}
+	goto peepholeStart;
     }
 
-    switch (*pc) {
+    switch (inst) {
     case INST_SYNTAX:
     case INST_RETURN_IMM: {
 	int code = TclGetInt4AtPtr(pc+1);
@@ -1980,34 +2424,203 @@ TclExecuteByteCode(
 	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\")",
+	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
 		    O2S(objResultPtr)));
 	    NEXT_INST_F(9, 1, 0);
-	} else {
-	    Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
-	    if (*pc == INST_SYNTAX) {
-		iPtr->flags &= ~ERR_ALREADY_LOGGED;
-	    }
-	    cleanup = 2;
-	    goto processExceptionReturn;
 	}
+	Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
+	if (*pc == INST_SYNTAX) {
+	    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+	}
+	cleanup = 2;
+	TRACE_APPEND(("\n"));
+	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\")",
+	    Tcl_DecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = objResultPtr;
+	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
 		    O2S(objResultPtr)));
 	    NEXT_INST_F(1, 0, 0);
+	} else if (result == TCL_ERROR) {
+	    /*
+	     * BEWARE! Must do this in this order, because an error in the
+	     * option dictionary overrides the result (and can be verified by
+	     * test).
+	     */
+
+	    Tcl_SetObjResult(interp, objResultPtr);
+	    Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
+	    Tcl_DecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = objResultPtr;
 	} else {
+	    Tcl_DecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = objResultPtr;
 	    Tcl_SetObjResult(interp, objResultPtr);
-	    cleanup = 1;
-	    goto processExceptionReturn;
 	}
+	cleanup = 1;
+	TRACE_APPEND(("\n"));
+	goto processExceptionReturn;
+
+    {
+	CoroutineData *corPtr;
+	int yieldParameter;
+
+    case INST_YIELD:
+	corPtr = iPtr->execEnvPtr->corPtr;
+	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
+	if (!corPtr) {
+	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "yield can only be called in a coroutine", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+		    NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceExec >= 2) {
+	    if (traceInstructions) {
+		TRACE_APPEND(("YIELD...\n"));
+	    } else {
+		fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+			Tcl_GetString(OBJ_AT_TOS));
+	    }
+	    fflush(stdout);
+	}
+#endif
+	yieldParameter = 0;
+	Tcl_SetObjResult(interp, OBJ_AT_TOS);
+	goto doYield;
+
+    case INST_YIELD_TO_INVOKE:
+	corPtr = iPtr->execEnvPtr->corPtr;
+	valuePtr = OBJ_AT_TOS;
+	if (!corPtr) {
+	    TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
+		    O2S(valuePtr)));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "yieldto can only be called in a coroutine", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+		    NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
+		    O2S(valuePtr)));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "yieldto called in deleted namespace", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+		    NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceExec >= 2) {
+	    if (traceInstructions) {
+		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
+	    } else {
+		/* FIXME: What is the right thing to trace? */
+		fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+			Tcl_GetString(valuePtr));
+	    }
+	    fflush(stdout);
+	}
+#endif
+
+	/*
+	 * Install a tailcall record in the caller and continue with the
+	 * yield. The yield is switched into multi-return mode (via the
+	 * 'yieldParameter').
+	 */
+
+	Tcl_IncrRefCount(valuePtr);
+	iPtr->execEnvPtr = corPtr->callerEEPtr;
+	TclSetTailcall(interp, valuePtr);
+	iPtr->execEnvPtr = corPtr->eePtr;
+	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/
+
+    doYield:
+	/* TIP #280: Record the last piece of info needed by
+	 * 'TclGetSrcInfoForPc', and push the frame.
+	 */
+
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
+
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
+	}
+
+	pc++;
+	cleanup = 1;
+	TEBC_YIELD();
+	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+		INT2PTR(yieldParameter), NULL, NULL);
+	return TCL_OK;
+    }
+
+    case INST_TAILCALL: {
+	Tcl_Obj *listPtr, *nsObjPtr;
+
+	opnd = TclGetUInt1AtPtr(pc+1);
+
+	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
+	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "tailcall can only be called from a proc or lambda", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
+#ifdef TCL_COMPILE_DEBUG
+	/* FIXME: What is the right thing to trace? */
+	{
+	    register int i;
+
+	    TRACE(("%d [", opnd));
+	    for (i=opnd-1 ; i>=0 ; i--) {
+		TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
+		if (i > 0) {
+		    TRACE_APPEND((" "));
+		}
+	    }
+	    TRACE_APPEND(("] => RETURN..."));
+	}
+#endif
+
+	/*
+	 * Push the evaluation of the called command into the NR callback
+	 * stack.
+	 */
+
+	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+	nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
+	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+	if (iPtr->varFramePtr->tailcallPtr) {
+	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+	}
+	iPtr->varFramePtr->tailcallPtr = listPtr;
+
+	result = TCL_RETURN;
+	cleanup = opnd;
+	goto processExceptionReturn;
+    }
 
     case INST_DONE:
 	if (tosPtr > initTosPtr) {
@@ -2027,153 +2640,91 @@ TclExecuteByteCode(
 	    }
 #endif
 	    goto checkForCatch;
-	} else {
-	    (void) POP_OBJECT();
-	    goto abnormalReturn;
 	}
-
-    case INST_PUSH1:
-    instPush1Peephole:
-	PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
-	TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
-	pc += 2;
-#if !TCL_COMPILE_DEBUG
-	/*
-	 * Runtime peephole optimisation: check if we are pushing again.
-	 */
-
-	if (*pc == INST_PUSH1) {
-	    TCL_DTRACE_INST_NEXT();
-	    goto instPush1Peephole;
-	}
-#endif
-	NEXT_INST_F(0, 0, 0);
+	(void) POP_OBJECT();
+	goto abnormalReturn;
 
     case INST_PUSH4:
 	objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
 	TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
 
-    case INST_POP: {
-	Tcl_Obj *valuePtr;
-
+    case INST_POP:
 	TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
-	valuePtr = POP_OBJECT();
-	TclDecrRefCount(valuePtr);
-
-	/*
-	 * Runtime peephole optimisation: an INST_POP is scheduled at the end
-	 * of most commands. If the next instruction is an INST_START_CMD,
-	 * fall through to it.
-	 */
-
-	pc++;
-#if !TCL_COMPILE_DEBUG
-	if (*pc == INST_START_CMD) {
-	    TCL_DTRACE_INST_NEXT();
-	    goto instStartCmdPeephole;
-	}
-#endif
-	NEXT_INST_F(0, 0, 0);
-    }
-
-    case INST_START_CMD:
-#if !TCL_COMPILE_DEBUG
-    instStartCmdPeephole:
-#endif
-	/*
-	 * Remark that if the interpreter is marked for deletion its
-	 * compileEpoch is modified, so that the epoch check also verifies
-	 * that the interp is not deleted. If no outside call has been made
-	 * since the last check, it is safe to omit the check.
-	 */
-
-	iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
-	if (!checkInterp) {
-	instStartCmdOK:
-	    NEXT_INST_F(9, 0, 0);
-	} else if (((codePtr->compileEpoch == iPtr->compileEpoch)
-		&& (codePtr->nsEpoch == namespacePtr->resolverEpoch))
-		|| (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
-	    checkInterp = 0;
-	    goto instStartCmdOK;
-	} else {
-	    const char *bytes;
-	    int length, opnd;
-	    Tcl_Obj *newObjResultPtr;
-
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
-	    DECACHE_STACK_INFO();
-	    result = Tcl_EvalEx(interp, bytes, length, 0);
-	    CACHE_STACK_INFO();
-	    if (result != TCL_OK) {
-		cleanup = 0;
-		if (result == TCL_ERROR) {
-		    /*
-		     * Tcl_EvalEx already did the task of logging
-		     * the error to the stack trace for us, so set
-		     * a flag to prevent the TEBC exception handling
-		     * machinery from trying to do it again.
-		     * Tcl Bug 2037338.  See test execute-8.4.
-		     */
-		    iPtr->flags |= ERR_ALREADY_LOGGED;
-		}
-		goto processExceptionReturn;
-	    }
-	    opnd = TclGetUInt4AtPtr(pc+1);
-	    objResultPtr = Tcl_GetObjResult(interp);
-	    TclNewObj(newObjResultPtr);
-	    Tcl_IncrRefCount(newObjResultPtr);
-	    iPtr->objResultPtr = newObjResultPtr;
-	    NEXT_INST_V(opnd, 0, -1);
-	}
+	objPtr = POP_OBJECT();
+	TclDecrRefCount(objPtr);
+	NEXT_INST_F(1, 0, 0);
 
     case INST_DUP:
 	objResultPtr = OBJ_AT_TOS;
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
 
-    case INST_OVER: {
-	int opnd;
-
+    case INST_OVER:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	objResultPtr = OBJ_AT_DEPTH(opnd);
-	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
-    }
 
     case INST_REVERSE: {
-	int opnd;
 	Tcl_Obj **a, **b;
 
 	opnd = TclGetUInt4AtPtr(pc+1);
 	a = tosPtr-(opnd-1);
 	b = tosPtr;
 	while (a<b) {
-	    Tcl_Obj *temp = *a;
+	    tmpPtr = *a;
 	    *a = *b;
-	    *b = temp;
+	    *b = tmpPtr;
 	    a++; b--;
 	}
+	TRACE(("%u => OK\n", opnd));
 	NEXT_INST_F(5, 0, 0);
     }
 
-    case INST_CONCAT1: {
-	int opnd, length, appendLen = 0;
+    case INST_STR_CONCAT1: {
+	int appendLen = 0;
 	char *bytes, *p;
 	Tcl_Obj **currPtr;
+	int onlyb = 1;
 
 	opnd = TclGetUInt1AtPtr(pc+1);
 
 	/*
+	 * 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.
 	 */
 
-	for (currPtr=&OBJ_AT_DEPTH(opnd-2);
-		appendLen >= 0 && currPtr<=&OBJ_AT_TOS; currPtr++) {
-	    bytes = TclGetStringFromObj(*currPtr, &length);
-	    if (bytes != NULL) {
-		appendLen += length;
+	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;
+		}
 	    }
 	}
 
@@ -2204,50 +2755,96 @@ TclExecuteByteCode(
 	 */
 
 	objResultPtr = OBJ_AT_DEPTH(opnd-1);
-	bytes = TclGetStringFromObj(objResultPtr, &length);
-	if (length + appendLen < 0) {
-	    /* TODO: convert panic to error ? */
-	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
-	}
-#if !TCL_COMPILE_DEBUG
-	if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
-	    TclFreeIntRep(objResultPtr);
-	    objResultPtr->typePtr = NULL;
-	    objResultPtr->bytes = ckrealloc(bytes, (length + appendLen + 1));
-	    objResultPtr->length = length + appendLen;
-	    p = TclGetString(objResultPtr) + length;
-	    currPtr = &OBJ_AT_DEPTH(opnd - 2);
-	} else {
+	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);
+	    }
+#ifndef 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 = (char *) ckalloc((unsigned) (length + appendLen + 1));
-	    TclNewObj(objResultPtr);
-	    objResultPtr->bytes = p;
-	    objResultPtr->length = length + appendLen;
-	    currPtr = &OBJ_AT_DEPTH(opnd - 1);
-#if !TCL_COMPILE_DEBUG
-	}
+	    {
+		p = ckalloc(length + appendLen + 1);
+		TclNewObj(objResultPtr);
+		objResultPtr->bytes = p;
+		objResultPtr->length = length + appendLen;
+		currPtr = &OBJ_AT_DEPTH(opnd - 1);
+	    }
+
+	    /*
+	     * Append the remaining characters.
+	     */
+
+	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
+		bytes = TclGetStringFromObj(*currPtr, &length);
+		if (bytes != NULL) {
+		    memcpy(p, bytes, (size_t) length);
+		    p += length;
+		}
+	    }
+	    *p = '\0';
+	} else {
+	    bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
+	    if (length + appendLen < 0) {
+		/* TODO: convert panic to error ? */
+		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
+			INT_MAX);
+	    }
+#ifndef 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.
-	 */
+	    /*
+	     * Append the remaining characters.
+	     */
 
-	for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
-	    bytes = TclGetStringFromObj(*currPtr, &length);
-	    if (bytes != NULL) {
-		memcpy(p, bytes, (size_t) length);
-		p += length;
+	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
+		if ((*currPtr)->bytes != tclEmptyStringRep) {
+		    bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
+		    memcpy(p, bytes, (size_t) length);
+		    p += length;
+		}
 	    }
 	}
-	*p = '\0';
 
 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_V(2, opnd, 1);
     }
 
-    case INST_EXPAND_START: {
+    case INST_CONCAT_STK:
+	/*
+	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
+	 * and then decrement their ref counts.
+	 */
+
+	opnd = TclGetUInt4AtPtr(pc+1);
+	objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+	NEXT_INST_V(5, opnd, 1);
+
+    case INST_EXPAND_START:
 	/*
-	 * Push an element to the expandNestList. This records the current
+	 * Push an element to the auxObjList. This records the current
 	 * stack depth - i.e., the point in the stack where the expanded
 	 * command starts.
 	 *
@@ -2259,18 +2856,32 @@ TclExecuteByteCode(
 	 * error, also in INST_EXPAND_STKTOP).
 	 */
 
-	Tcl_Obj *objPtr;
-
 	TclNewObj(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) CURR_DEPTH;
-	objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
-	expandNestList = objPtr;
+	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH);
+	objPtr->length = 0;
+	PUSH_TAUX_OBJ(objPtr);
+	TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
 	NEXT_INST_F(1, 0, 0);
-    }
+
+    case INST_EXPAND_DROP:
+	/*
+	 * Drops an element of the auxObjList, popping stack elements to
+	 * restore the stack to the state before the point where the aux
+	 * element was created.
+	 */
+
+	CLANG_ASSERT(auxObjList);
+	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
+	POP_TAUX_OBJ();
+#ifdef TCL_COMPILE_DEBUG
+	/* Ugly abuse! */
+	starting = 1;
+#endif
+	TRACE(("=> drop %d items\n", objc));
+	NEXT_INST_V(1, objc, 0);
 
     case INST_EXPAND_STKTOP: {
-	int objc, length, i;
-	Tcl_Obj **objv, *valuePtr;
+	int i;
 	ptrdiff_t moved;
 
 	/*
@@ -2279,12 +2890,11 @@ TclExecuteByteCode(
 	 * will be removed at checkForCatch.
 	 */
 
-	valuePtr = OBJ_AT_TOS;
-	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK){
-	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
-		    Tcl_GetObjResult(interp));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	objPtr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(objPtr)));
+	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 	(void) POP_OBJECT();
 
@@ -2295,22 +2905,26 @@ TclExecuteByteCode(
 	 * stack depth, as seen by the compiler.
 	 */
 
-	length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
-	DECACHE_STACK_INFO();
-	moved = (GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - 1)
-		- (Tcl_Obj **) initCatchTop;
+	auxObjList->length += objc - 1;
+	if ((objc > 1) && (auxObjList->length > 0)) {
+	    length = auxObjList->length /* Total expansion room we need */
+		    + codePtr->maxStackDepth /* Beyond the original max */
+		    - CURR_DEPTH;	/* Relative to where we are */
+	    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.
+		 */
 
-	if (moved) {
-	    /*
-	     * Change the global data to point to the new stack.
-	     */
+		TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
 
-	    initCatchTop += moved;
-	    catchTop += moved;
-	    bcFramePtr = (CmdFrame *) (initCatchTop + codePtr->maxExceptDepth + 1);
-	    initTosPtr += moved;
-	    tosPtr += moved;
-	    esPtr = iPtr->execEnvPtr->execStackPtr;
+		catchTop += moved;
+		tosPtr += moved;
+	    }
 	}
 
 	/*
@@ -2322,39 +2936,55 @@ TclExecuteByteCode(
 	    PUSH_OBJECT(objv[i]);
 	}
 
-	Tcl_DecrRefCount(valuePtr);
+	TRACE_APPEND(("OK\n"));
+	Tcl_DecrRefCount(objPtr);
 	NEXT_INST_F(5, 0, 0);
     }
 
-    {
+    case INST_EXPR_STK: {
+	ByteCode *newCodePtr;
+
+	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);
+    }
+
 	/*
 	 * INVOCATION BLOCK
 	 */
 
-	int objc, pcAdjustment;
-
-    case INST_INVOKE_EXPANDED:
-	{
-	    Tcl_Obj *objPtr = expandNestList;
+    instEvalStk:
+    case INST_EVAL_STK:
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
 
-	    expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
-	    objc = CURR_DEPTH
-		    - (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1;
-	    TclDecrRefCount(objPtr);
-	}
+	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 - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
+	POP_TAUX_OBJ();
 	if (objc) {
 	    pcAdjustment = 1;
 	    goto doInvocation;
-	} else {
-	    /*
-	     * Nothing was expanded, return {}.
-	     */
-
-	    TclNewObj(objResultPtr);
-	    NEXT_INST_F(1, 0, 1);
 	}
 
+	/*
+	 * Nothing was expanded, return {}.
+	 */
+
+	TclNewObj(objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+
     case INST_INVOKE_STK4:
 	objc = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
@@ -2365,103 +2995,52 @@ TclExecuteByteCode(
 	pcAdjustment = 2;
 
     doInvocation:
-	{
-	    Tcl_Obj **objv = &OBJ_AT_DEPTH(objc-1);
+	objv = &OBJ_AT_DEPTH(objc-1);
+	cleanup = objc;
 
 #ifdef TCL_COMPILE_DEBUG
-	    if (tclTraceExec >= 2) {
-		int i;
+	if (tclTraceExec >= 2) {
+	    int i;
 
-		if (traceInstructions) {
-		    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
-		    TRACE(("%u => call ", objc));
-		} else {
-		    fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
-			    (unsigned)(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*/
-
-	    /*
-	     * Reset the instructionCount variable, since we're about to check
-	     * for async stuff anyway while processing TclEvalObjvInternal.
-	     */
-
-	    instructionCount = 1;
-
-	    /*
-	     * Finally, let TclEvalObjvInternal handle the command.
-	     *
-	     * TIP #280: Record the last piece of info needed by
-	     * 'TclGetSrcInfoForPc', and push the frame.
-	     */
-
-	    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);
+	    if (traceInstructions) {
+		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+		TRACE(("%u => call ", objc));
+	    } else {
+		fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
+			(unsigned)(pc - codePtr->codeStart));
 	    }
-	    DECACHE_STACK_INFO();
-	    result = TclEvalObjvInternal(interp, objc, objv,
-		    /* call from TEBC */(char *) -1, -1, 0);
-	    CACHE_STACK_INFO();
-	    if (iPtr->flags & INTERP_DEBUG_FRAME) {
-		TclArgumentBCRelease((Tcl_Interp *) iPtr, objv, objc,
-			codePtr, pc - codePtr->codeStart);
+	    for (i = 0;  i < objc;  i++) {
+		TclPrintObject(stdout, objv[i], 15);
+		fprintf(stdout, " ");
 	    }
-	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+	    fprintf(stdout, "\n");
+	    fflush(stdout);
+	}
+#endif /*TCL_COMPILE_DEBUG*/
 
-	    if (result == TCL_OK) {
-		Tcl_Obj *objPtr;
+	/*
+	 * Finally, let TclEvalObjv handle the command.
+	 *
+	 * TIP #280: Record the last piece of info needed by
+	 * 'TclGetSrcInfoForPc', and push the frame.
+	 */
 
-		/*
-		 * Push the call's object result and continue execution with
-		 * the next instruction.
-		 */
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
 
-		TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
-			objc, cmdNameBuf), Tcl_GetObjResult(interp));
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
+	}
 
-		objResultPtr = Tcl_GetObjResult(interp);
+	DECACHE_STACK_INFO();
 
-		/*
-		 * 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;
-#ifndef TCL_COMPILE_DEBUG
-		if (*(pc+pcAdjustment) == INST_POP) {
-		    TclDecrRefCount(objResultPtr);
-		    NEXT_INST_V((pcAdjustment+1), objc, 0);
-		}
-#endif
-		NEXT_INST_V(pcAdjustment, objc, -1);
-	    } else {
-		cleanup = objc;
-		goto processExceptionReturn;
-	    }
-	}
+	pc += pcAdjustment;
+	TEBC_YIELD();
+	return TclNREvalObjv(interp, objc, objv,
+		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
 
 #if TCL_SUPPORT_84_BYTECODE
-    case INST_CALL_BUILTIN_FUNC1: {
+    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
@@ -2469,47 +3048,45 @@ TclExecuteByteCode(
 	 * function into the stack.
 	 */
 
-	int opnd, numArgs;
-	Tcl_Obj *objPtr;
-
 	opnd = TclGetUInt1AtPtr(pc+1);
 	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
 	    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
-	    Tcl_Panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
+	    Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
 	}
 
-	objPtr = Tcl_NewStringObj("::tcl::mathfunc::", 17);
+	TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
 	Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
 
 	/*
 	 * Only 0, 1 or 2 args.
 	 */
 
-	numArgs = tclBuiltinFuncTable[opnd].numArgs;
-	if (numArgs == 0) {
-	    PUSH_OBJECT(objPtr);
-	} else if (numArgs == 1) {
-	    Tcl_Obj *tmpPtr1 = POP_OBJECT();
-	    PUSH_OBJECT(objPtr);
-	    PUSH_OBJECT(tmpPtr1);
-	    Tcl_DecrRefCount(tmpPtr1);
-	} else {
+	{
+	    int numArgs = tclBuiltinFuncTable[opnd].numArgs;
 	    Tcl_Obj *tmpPtr1, *tmpPtr2;
-	    tmpPtr2 = POP_OBJECT();
-	    tmpPtr1 = POP_OBJECT();
-	    PUSH_OBJECT(objPtr);
-	    PUSH_OBJECT(tmpPtr1);
-	    PUSH_OBJECT(tmpPtr2);
-	    Tcl_DecrRefCount(tmpPtr1);
-	    Tcl_DecrRefCount(tmpPtr2);
-	}
 
-	objc = numArgs + 1;
+	    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);
+	    }
+	    objc = numArgs + 1;
+	}
 	pcAdjustment = 2;
 	goto doInvocation;
-    }
 
-    case INST_CALL_FUNC1: {
+    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
@@ -2517,16 +3094,11 @@ TclExecuteByteCode(
 	 * ::tcl::mathfunc::$objv[0].
 	 */
 
-	Tcl_Obj *tmpPtr, *objPtr;
-
-	/*
-	 * Number of arguments. The function name is the 0-th argument.
-	 */
-
-	objc = TclGetUInt1AtPtr(pc+1);
+	objc = TclGetUInt1AtPtr(pc+1);	/* Number of arguments. The function
+					 * name is the 0-th argument. */
 
 	objPtr = OBJ_AT_DEPTH(objc-1);
-	tmpPtr = Tcl_NewStringObj("::tcl::mathfunc::", 17);
+	TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
 	Tcl_AppendObjToObj(tmpPtr, objPtr);
 	Tcl_DecrRefCount(objPtr);
 
@@ -2539,7 +3111,6 @@ TclExecuteByteCode(
 
 	pcAdjustment = 2;
 	goto doInvocation;
-    }
 #else
     /*
      * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
@@ -2548,98 +3119,86 @@ TclExecuteByteCode(
      */
 
     case INST_CALL_BUILTIN_FUNC1:
-	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
+	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
     case INST_CALL_FUNC1:
-	Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
+	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
 #endif
-    }
 
-    case INST_EVAL_STK: {
-	/*
-	 * Note to maintainers: it is important that INST_EVAL_STK pop its
-	 * argument from the stack before jumping to checkForCatch! DO NOT
-	 * OPTIMISE!
-	 */
-
-	Tcl_Obj *objPtr = OBJ_AT_TOS;
-
-	DECACHE_STACK_INFO();
+    case INST_INVOKE_REPLACE:
+	objc = TclGetUInt4AtPtr(pc+1);
+	opnd = TclGetUInt1AtPtr(pc+5);
+	objPtr = POP_OBJECT();
+	objv = &OBJ_AT_DEPTH(objc-1);
+	cleanup = objc;
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceExec >= 2) {
+	    int i;
 
-	/*
-	 * TIP #280: The invoking context is left NULL for a dynamically
-	 * constructed command. We cannot match its lines to the outer
-	 * context.
-	 */
+	    if (traceInstructions) {
+		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+		TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr)));
+	    } else {
+		fprintf(stdout,
+			"%d: (%u) invoking (using implementation %s) ",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+			O2S(objPtr));
+	    }
+	    for (i = 0;  i < objc;  i++) {
+		if (i < opnd) {
+		    fprintf(stdout, "<");
+		    TclPrintObject(stdout, objv[i], 15);
+		    fprintf(stdout, ">");
+		} else {
+		    TclPrintObject(stdout, objv[i], 15);
+		}
+		fprintf(stdout, " ");
+	    }
+	    fprintf(stdout, "\n");
+	    fflush(stdout);
+	}
+#endif /*TCL_COMPILE_DEBUG*/
 
-	result = TclCompEvalObj(interp, objPtr, NULL, 0);
-	CACHE_STACK_INFO();
-	if (result == TCL_OK) {
-	    /*
-	     * Normal return; push the eval's object result.
-	     */
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
+	}
 
-	    objResultPtr = Tcl_GetObjResult(interp);
-	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
-		    Tcl_GetObjResult(interp));
+	TclInitRewriteEnsemble(interp, opnd, 1, objv);
 
-	    /*
-	     * 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 *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
 
-	    TclNewObj(objPtr);
-	    Tcl_IncrRefCount(objPtr);
-	    iPtr->objResultPtr = objPtr;
-	    NEXT_INST_F(1, 1, -1);
-	} else {
-	    cleanup = 1;
-	    goto processExceptionReturn;
+	    Tcl_ListObjAppendElement(NULL, copyPtr, objPtr);
+	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+		    objc - opnd, objv + opnd);
+	    Tcl_DecrRefCount(objPtr);
+	    objPtr = copyPtr;
 	}
-    }
-
-    case INST_EXPR_STK: {
-	Tcl_Obj *objPtr, *valuePtr;
 
-	objPtr = OBJ_AT_TOS;
 	DECACHE_STACK_INFO();
-	/*Tcl_ResetResult(interp);*/
-	result = Tcl_ExprObj(interp, objPtr, &valuePtr);
-	CACHE_STACK_INFO();
-	if (result == TCL_OK) {
-	    objResultPtr = valuePtr;
-	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
-	    NEXT_INST_F(1, 1, -1);	/* Already has right refct. */
-	} else {
-	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
-		    Tcl_GetObjResult(interp));
-	    goto checkForCatch;
-	}
-    }
+	pc += 6;
+	TEBC_YIELD();
+
+	TclMarkTailcall(interp);
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+	Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv);
+	TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
+	return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
 
     /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   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.
      */
-    {
-	int opnd, pcAdjustment;
-	Tcl_Obj *part1Ptr, *part2Ptr;
-	Var *varPtr, *arrayPtr;
-	Tcl_Obj *objPtr;
 
     case INST_LOAD_SCALAR1:
     instLoadScalar1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -2661,7 +3220,7 @@ TclExecuteByteCode(
 
     case INST_LOAD_SCALAR4:
 	opnd = TclGetUInt4AtPtr(pc+1);
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -2693,7 +3252,7 @@ TclExecuteByteCode(
     doLoadArray:
 	part1Ptr = NULL;
 	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = &(compiledLocals[opnd]);
+	arrayPtr = LOCAL(opnd);
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
@@ -2713,10 +3272,8 @@ TclExecuteByteCode(
 	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))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 	cleanup = 1;
 	goto doCallPtrGetVar;
@@ -2740,24 +3297,22 @@ TclExecuteByteCode(
 	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
 		&arrayPtr);
-	if (varPtr) {
-	    if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
-		/*
-		 * No errors, no traces: just get the value.
-		 */
+	if (!varPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
 
-		objResultPtr = varPtr->value.objPtr;
-		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-		NEXT_INST_V(1, cleanup, 1);
-	    }
-	    pcAdjustment = 1;
-	    opnd = -1;
-	    goto doCallPtrGetVar;
-	} else {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
+	    /*
+	     * No errors, no traces: just get the value.
+	     */
+
+	    objResultPtr = varPtr->value.objPtr;
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    NEXT_INST_V(1, cleanup, 1);
 	}
+	pcAdjustment = 1;
+	opnd = -1;
 
     doCallPtrGetVar:
 	/*
@@ -2769,23 +3324,16 @@ TclExecuteByteCode(
 	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
 		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
 	CACHE_STACK_INFO();
-	if (objResultPtr) {
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_V(pcAdjustment, cleanup, 1);
-	} else {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	if (!objResultPtr) {
+	    TRACE_ERROR(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
@@ -2794,10 +3342,7 @@ TclExecuteByteCode(
      */
 
     {
-	int opnd, pcAdjustment, storeFlags;
-	Tcl_Obj *part1Ptr, *part2Ptr;
-	Var *varPtr, *arrayPtr;
-	Tcl_Obj *objPtr, *valuePtr;
+	int storeFlags, len;
 
     case INST_STORE_ARRAY4:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -2811,7 +3356,7 @@ TclExecuteByteCode(
     doStoreArrayDirect:
 	valuePtr = OBJ_AT_TOS;
 	part2Ptr = OBJ_UNDER_TOS;
-	arrayPtr = &(compiledLocals[opnd]);
+	arrayPtr = LOCAL(opnd);
 	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
 		O2S(valuePtr)));
 	while (TclIsVarLink(arrayPtr)) {
@@ -2842,39 +3387,40 @@ TclExecuteByteCode(
 
     doStoreScalarDirect:
 	valuePtr = OBJ_AT_TOS;
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
-	if (TclIsVarDirectWritable(varPtr)) {
-    doStoreVarDirect:
-	    /*
-	     * No traces, no errors, plain 'set': we can safely inline. The
-	     * value *will* be set to what's requested, so that the stack top
-	     * remains pointing to the same Tcl_Obj.
-	     */
+	if (!TclIsVarDirectWritable(varPtr)) {
+	    storeFlags = TCL_LEAVE_ERR_MSG;
+	    part1Ptr = NULL;
+	    goto doStoreScalar;
+	}
 
-	    valuePtr = varPtr->value.objPtr;
-	    if (valuePtr != NULL) {
-		TclDecrRefCount(valuePtr);
-	    }
-	    objResultPtr = OBJ_AT_TOS;
-	    varPtr->value.objPtr = objResultPtr;
+	/*
+	 * 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.
+	 */
+
+    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);
-	    }
+	if (*(pc+pcAdjustment) == INST_POP) {
+	    tosPtr--;
+	    NEXT_INST_F((pcAdjustment+1), 0, 0);
+	}
 #else
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 #endif
-	    Tcl_IncrRefCount(objResultPtr);
-	    NEXT_INST_F(pcAdjustment, 0, 0);
-	}
-	storeFlags = TCL_LEAVE_ERR_MSG;
-	part1Ptr = NULL;
-	goto doStoreScalar;
+	Tcl_IncrRefCount(objResultPtr);
+	NEXT_INST_F(pcAdjustment, 0, 0);
 
     case INST_LAPPEND_STK:
 	valuePtr = OBJ_AT_TOS; /* value to append */
@@ -2927,16 +3473,14 @@ TclExecuteByteCode(
 #endif
 	varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-	if (varPtr) {
-	    cleanup = ((part2Ptr == NULL)? 2 : 3);
-	    pcAdjustment = 1;
-	    opnd = -1;
-	    goto doCallPtrSetVar;
-	} else {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	if (!varPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
+	cleanup = ((part2Ptr == NULL)? 2 : 3);
+	pcAdjustment = 1;
+	opnd = -1;
+	goto doCallPtrSetVar;
 
     case INST_LAPPEND_ARRAY4:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -2967,7 +3511,7 @@ TclExecuteByteCode(
     doStoreArray:
 	valuePtr = OBJ_AT_TOS;
 	part2Ptr = OBJ_UNDER_TOS;
-	arrayPtr = &(compiledLocals[opnd]);
+	arrayPtr = LOCAL(opnd);
 	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
 		O2S(valuePtr)));
 	while (TclIsVarLink(arrayPtr)) {
@@ -2979,13 +3523,11 @@ TclExecuteByteCode(
     doStoreArrayDirectFailed:
 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
-	if (varPtr) {
-	    goto doCallPtrSetVar;
-	} else {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	if (!varPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
+	goto doCallPtrSetVar;
 
     case INST_LAPPEND_SCALAR4:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -3015,7 +3557,7 @@ TclExecuteByteCode(
 
     doStoreScalar:
 	valuePtr = OBJ_AT_TOS;
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
@@ -3029,28 +3571,187 @@ TclExecuteByteCode(
 	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
 		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
 	CACHE_STACK_INFO();
-	if (objResultPtr) {
+	if (!objResultPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
 #ifndef TCL_COMPILE_DEBUG
-	    if (*(pc+pcAdjustment) == INST_POP) {
-		NEXT_INST_V((pcAdjustment+1), cleanup, 0);
-	    }
+	if (*(pc+pcAdjustment) == INST_POP) {
+	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+	}
 #endif
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_V(pcAdjustment, cleanup, 1);
-	} else {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    case INST_LAPPEND_LIST:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;
+	varPtr = LOCAL(opnd);
+	cleanup = 1;
+	pcAdjustment = 5;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (TclIsVarDirectReadable(varPtr)
+		&& TclIsVarDirectWritable(varPtr)) {
+	    goto lappendListDirect;
+	}
+	arrayPtr = NULL;
+	part1Ptr = part2Ptr = NULL;
+	goto lappendListPtr;
+
+    case INST_LAPPEND_LIST_ARRAY:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;
+	part1Ptr = NULL;
+	part2Ptr = OBJ_UNDER_TOS;
+	arrayPtr = LOCAL(opnd);
+	cleanup = 2;
+	pcAdjustment = 5;
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	TRACE(("%u \"%.30s\" \"%.30s\" => ",
+		opnd, O2S(part2Ptr), O2S(valuePtr)));
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)
+		&& !WriteTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr && TclIsVarDirectReadable(varPtr)
+		    && TclIsVarDirectWritable(varPtr)) {
+		goto lappendListDirect;
+	    }
+	}
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
+	if (varPtr == NULL) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	goto lappendListPtr;
+
+    case INST_LAPPEND_LIST_ARRAY_STK:
+	pcAdjustment = 1;
+	cleanup = 3;
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = OBJ_UNDER_TOS;	/* element name */
+	part1Ptr = OBJ_AT_DEPTH(2);	/* array name */
+	TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ",
+		O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
+	goto lappendList;
+
+    case INST_LAPPEND_LIST_STK:
+	pcAdjustment = 1;
+	cleanup = 2;
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = NULL;
+	part1Ptr = OBJ_UNDER_TOS;	/* variable name */
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr)));
+	goto lappendList;
+
+    lappendListDirect:
+	objResultPtr = varPtr->value.objPtr;
+	if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (Tcl_IsShared(objResultPtr)) {
+	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
+
+	    TclDecrRefCount(objResultPtr);
+	    varPtr->value.objPtr = objResultPtr = newValue;
+	    Tcl_IncrRefCount(newValue);
 	}
+	if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    lappendList:
+	opnd = -1;
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	DECACHE_STACK_INFO();
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+	CACHE_STACK_INFO();
+	if (!varPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+    lappendListPtr:
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)++;
+	}
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)++;
+	}
+	DECACHE_STACK_INFO();
+	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
+		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
+	CACHE_STACK_INFO();
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)--;
+	}
+
+	{
+	    int createdNewObj = 0;
+
+	    if (!objResultPtr) {
+		objResultPtr = valuePtr;
+	    } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    } else {
+		if (Tcl_IsShared(objResultPtr)) {
+		    objResultPtr = Tcl_DuplicateObj(objResultPtr);
+		    createdNewObj = 1;
+		}
+		if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv)
+			!= TCL_OK) {
+		    goto errorInLappendListPtr;
+		}
+	    }
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
+		    part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd);
+	    CACHE_STACK_INFO();
+	    if (!objResultPtr) {
+	    errorInLappendListPtr:
+		if (createdNewObj) {
+		    TclDecrRefCount(objResultPtr);
+		}
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	}
+	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
@@ -3061,14 +3762,11 @@ TclExecuteByteCode(
 /*TODO: Consider more untangling here; merge with LOAD and STORE ? */
 
     {
-	Tcl_Obj *objPtr, *incrPtr;
-	int opnd, pcAdjustment;
-#ifndef NO_WIDE_TYPE
+	Tcl_Obj *incrPtr;
+#ifndef TCL_WIDE_INT_IS_LONG
 	Tcl_WideInt w;
 #endif
-	long i;
-	Tcl_Obj *part1Ptr, *part2Ptr;
-	Var *varPtr, *arrayPtr;
+	long increment;
 
     case INST_INCR_SCALAR1:
     case INST_INCR_ARRAY1:
@@ -3092,8 +3790,8 @@ TclExecuteByteCode(
     case INST_INCR_ARRAY_STK_IMM:
     case INST_INCR_SCALAR_STK_IMM:
     case INST_INCR_STK_IMM:
-	i = TclGetInt1AtPtr(pc+1);
-	incrPtr = Tcl_NewIntObj(i);
+	increment = TclGetInt1AtPtr(pc+1);
+	incrPtr = Tcl_NewIntObj(increment);
 	Tcl_IncrRefCount(incrPtr);
 	pcAdjustment = 2;
 
@@ -3103,61 +3801,59 @@ TclExecuteByteCode(
 	    part2Ptr = OBJ_AT_TOS;
 	    objPtr = OBJ_UNDER_TOS;
 	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
-		    O2S(objPtr), O2S(part2Ptr), i));
+		    O2S(objPtr), O2S(part2Ptr), increment));
 	} else {
 	    part2Ptr = NULL;
 	    objPtr = OBJ_AT_TOS;
-	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
+	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
 	}
 	part1Ptr = objPtr;
 	opnd = -1;
 	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
-	if (varPtr) {
-	    cleanup = ((part2Ptr == NULL)? 1 : 2);
-	    goto doIncrVar;
-	} else {
-	    Tcl_AddObjErrorInfo(interp,
-		    "\n    (reading value of variable to increment)", -1);
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
+	if (!varPtr) {
+	    DECACHE_STACK_INFO();
+	    Tcl_AddErrorInfo(interp,
+		    "\n    (reading value of variable to increment)");
+	    CACHE_STACK_INFO();
+	    TRACE_ERROR(interp);
 	    Tcl_DecrRefCount(incrPtr);
-	    goto checkForCatch;
+	    goto gotError;
 	}
+	cleanup = ((part2Ptr == NULL)? 1 : 2);
+	goto doIncrVar;
 
     case INST_INCR_ARRAY1_IMM:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	i = TclGetInt1AtPtr(pc+2);
-	incrPtr = Tcl_NewIntObj(i);
+	increment = TclGetInt1AtPtr(pc+2);
+	incrPtr = Tcl_NewIntObj(increment);
 	Tcl_IncrRefCount(incrPtr);
 	pcAdjustment = 3;
 
     doIncrArray:
 	part1Ptr = NULL;
 	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = &(compiledLocals[opnd]);
+	arrayPtr = LOCAL(opnd);
 	cleanup = 1;
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), i));
+	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) {
-	    goto doIncrVar;
-	} else {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    result = TCL_ERROR;
+	if (!varPtr) {
+	    TRACE_ERROR(interp);
 	    Tcl_DecrRefCount(incrPtr);
-	    goto checkForCatch;
+	    goto gotError;
 	}
+	goto doIncrVar;
 
     case INST_INCR_SCALAR1_IMM:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	i = TclGetInt1AtPtr(pc+2);
+	increment = TclGetInt1AtPtr(pc+2);
 	pcAdjustment = 3;
 	cleanup = 0;
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -3170,16 +3866,16 @@ TclExecuteByteCode(
 	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
 		if (type == TCL_NUMBER_LONG) {
 		    long augend = *((const long *)ptr);
-		    long sum = augend + i;
+		    long sum = augend + increment;
 
 		    /*
 		     * Overflow when (augend and sum have different sign) and
-		     * (augend and i have the same sign). This is encapsulated
-		     * in the Overflowing macro.
+		     * (augend and increment have the same sign). This is
+		     * encapsulated in the Overflowing macro.
 		     */
 
-		    if (!Overflowing(augend, i, sum)) {
-			TRACE(("%u %ld => ", opnd, i));
+		    if (!Overflowing(augend, increment, sum)) {
+			TRACE(("%u %ld => ", opnd, increment));
 			if (Tcl_IsShared(objPtr)) {
 			    objPtr->refCount--;	/* We know it's shared. */
 			    TclNewLongObj(objResultPtr, sum);
@@ -3191,43 +3887,41 @@ TclExecuteByteCode(
 			}
 			goto doneIncr;
 		    }
-#ifndef NO_WIDE_TYPE
-		    {
-			w = (Tcl_WideInt)augend;
-
-			TRACE(("%u %ld => ", opnd, i));
-			if (Tcl_IsShared(objPtr)) {
-			    objPtr->refCount--;	/* We know it's shared. */
-			    objResultPtr = Tcl_NewWideIntObj(w+i);
-			    Tcl_IncrRefCount(objResultPtr);
-			    varPtr->value.objPtr = objResultPtr;
-			} else {
-			    objResultPtr = objPtr;
+#ifndef TCL_WIDE_INT_IS_LONG
+		    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.
-			     */
+			/*
+			 * We know the sum value is outside the long range;
+			 * use macro form that doesn't range test again.
+			 */
 
-			    TclSetWideIntObj(objPtr, w+i);
-			}
-			goto doneIncr;
+			TclSetWideIntObj(objPtr, w+increment);
 		    }
+		    goto doneIncr;
 #endif
 		}	/* end if (type == TCL_NUMBER_LONG) */
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 		if (type == TCL_NUMBER_WIDE) {
 		    Tcl_WideInt sum;
-		    w = *((const Tcl_WideInt *)ptr);
-		    sum = w + i;
+
+		    w = *((const Tcl_WideInt *) ptr);
+		    sum = w + increment;
 
 		    /*
 		     * Check for overflow.
 		     */
 
-		    if (!Overflowing(w, i, sum)) {
-			TRACE(("%u %ld => ", opnd, i));
+		    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);
@@ -3257,34 +3951,32 @@ TclExecuteByteCode(
 	    } else {
 		objResultPtr = objPtr;
 	    }
-	    TclNewLongObj(incrPtr, i);
-	    result = TclIncrObj(interp, objResultPtr, incrPtr);
-	    Tcl_DecrRefCount(incrPtr);
-	    if (result == TCL_OK) {
-		goto doneIncr;
-	    } else {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		goto checkForCatch;
+	    TclNewLongObj(incrPtr, increment);
+	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
+		Tcl_DecrRefCount(incrPtr);
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
+	    Tcl_DecrRefCount(incrPtr);
+	    goto doneIncr;
 	}
 
 	/*
 	 * All other cases, flow through to generic handling.
 	 */
 
-	TclNewLongObj(incrPtr, i);
+	TclNewLongObj(incrPtr, increment);
 	Tcl_IncrRefCount(incrPtr);
 
     doIncrScalar:
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	arrayPtr = NULL;
 	part1Ptr = part2Ptr = NULL;
 	cleanup = 0;
-	TRACE(("%u %ld => ", opnd, i));
+	TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));
 
     doIncrVar:
 	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
@@ -3297,15 +3989,12 @@ TclExecuteByteCode(
 	    } else {
 		objResultPtr = objPtr;
 	    }
-	    result = TclIncrObj(interp, objResultPtr, incrPtr);
-	    Tcl_DecrRefCount(incrPtr);
-	    if (result == TCL_OK) {
-		goto doneIncr;
-	    } else {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		goto checkForCatch;
+	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
+		Tcl_DecrRefCount(incrPtr);
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
+	    Tcl_DecrRefCount(incrPtr);
 	} else {
 	    DECACHE_STACK_INFO();
 	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
@@ -3313,10 +4002,8 @@ TclExecuteByteCode(
 	    CACHE_STACK_INFO();
 	    Tcl_DecrRefCount(incrPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		result = TCL_ERROR;
-		goto checkForCatch;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
 	}
     doneIncr:
@@ -3331,21 +4018,15 @@ TclExecuteByteCode(
 
     /*
      *	   End of INST_INCR instructions.
-     * ---------------------------------------------------------
-     */
-
-    /*
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
      *	   Start of INST_EXIST instructions.
      */
-    {
-	Tcl_Obj *part1Ptr, *part2Ptr;
-	Var *varPtr, *arrayPtr;
-
-    case INST_EXIST_SCALAR: {
-	int opnd = TclGetUInt4AtPtr(pc+1);
 
-	varPtr = &(compiledLocals[opnd]);
+    case INST_EXIST_SCALAR:
+	cleanup = 0;
+	pcAdjustment = 5;
+	opnd = TclGetUInt4AtPtr(pc+1);
+	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -3360,21 +4041,14 @@ TclExecuteByteCode(
 		varPtr = NULL;
 	    }
 	}
+	goto afterExistsPeephole;
 
-	/*
-	 * Tricky! Arrays always exist.
-	 */
-
-	objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1];
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(5, 0, 1);
-    }
-
-    case INST_EXIST_ARRAY: {
-	int opnd = TclGetUInt4AtPtr(pc+1);
-
+    case INST_EXIST_ARRAY:
+	cleanup = 1;
+	pcAdjustment = 5;
+	opnd = TclGetUInt4AtPtr(pc+1);
 	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = &(compiledLocals[opnd]);
+	arrayPtr = LOCAL(opnd);
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
@@ -3382,7 +4056,7 @@ TclExecuteByteCode(
 	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
 	    if (!varPtr || !ReadTraced(varPtr)) {
-		goto doneExistArray;
+		goto afterExistsPeephole;
 	    }
 	}
 	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
@@ -3399,14 +4073,11 @@ TclExecuteByteCode(
 		varPtr = NULL;
 	    }
 	}
-    doneExistArray:
-	objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1];
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(5, 1, 1);
-    }
+	goto afterExistsPeephole;
 
     case INST_EXIST_ARRAY_STK:
 	cleanup = 2;
+	pcAdjustment = 1;
 	part2Ptr = OBJ_AT_TOS;		/* element name */
 	part1Ptr = OBJ_UNDER_TOS;	/* array name */
 	TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
@@ -3414,6 +4085,7 @@ TclExecuteByteCode(
 
     case INST_EXIST_STK:
 	cleanup = 1;
+	pcAdjustment = 1;
 	part2Ptr = NULL;
 	part1Ptr = OBJ_AT_TOS;		/* variable name */
 	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
@@ -3433,89 +4105,343 @@ TclExecuteByteCode(
 		varPtr = NULL;
 	    }
 	}
-	objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1];
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(1, cleanup, 1);
+
+	/*
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 */
+
+    afterExistsPeephole: {
+	int found = (varPtr && !TclIsVarUndefined(varPtr));
+
+	TRACE_APPEND(("%d\n", found ? 1 : 0));
+	JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
     }
 
     /*
      *	   End of INST_EXIST instructions.
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
+     *	   Start of INST_UNSET instructions.
      */
 
-    case INST_UPVAR: {
-	int opnd;
-	Var *varPtr, *otherPtr;
+    {
+	int flags;
 
-	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
+    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 => ", (flags ? "normal" : "noerr"), opnd));
+	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
+	    /*
+	     * No errors, no traces, no searches: just make the variable cease
+	     * to exist.
+	     */
 
-	{
-	    CallFrame *framePtr, *savedFramePtr;
+	    if (!TclIsVarUndefined(varPtr)) {
+		TclDecrRefCount(varPtr->value.objPtr);
+	    } else if (flags & TCL_LEAVE_ERR_MSG) {
+		goto slowUnsetScalar;
+	    }
+	    varPtr->value.objPtr = NULL;
+	    TRACE_APPEND(("OK\n"));
+	    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);
 
-	    result = TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr);
-	    if (result != -1) {
+    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\" => ",
+		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
+	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
 		/*
-		 * Locate the other variable.
+		 * No nasty traces and element exists, so we can proceed to
+		 * unset it. Might still not exist though...
 		 */
 
-		savedFramePtr = iPtr->varFramePtr;
-		iPtr->varFramePtr = framePtr;
-		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
-			(TCL_LEAVE_ERR_MSG), "access",
-			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
-		iPtr->varFramePtr = savedFramePtr;
-		if (otherPtr) {
-		    result = TCL_OK;
-		    goto doLinkVars;
+		if (!TclIsVarUndefined(varPtr)) {
+		    TclDecrRefCount(varPtr->value.objPtr);
+		    TclSetVarUndefined(varPtr);
+		    TclClearVarNamespaceVar(varPtr);
+		    TclCleanupVar(varPtr, arrayPtr);
+		} else if (flags & TCL_LEAVE_ERR_MSG) {
+		    goto slowUnsetArray;
 		}
+		TRACE_APPEND(("OK\n"));
+		NEXT_INST_F(6, 1, 0);
+	    } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
+		/*
+		 * Don't need to do anything here.
+		 */
+
+		TRACE_APPEND(("OK\n"));
+		NEXT_INST_F(6, 1, 0);
 	    }
-	    result = TCL_ERROR;
-	    goto checkForCatch;
 	}
+    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_VARIABLE:
-	TRACE(("variable "));
-	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
-		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
-		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
-	if (otherPtr) {
-	    /*
-	     * Do the [variable] magic.
-	     */
+    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)\" => ", (flags ? "normal" : "noerr"),
+		O2S(part1Ptr), O2S(part2Ptr)));
+	goto doUnsetStk;
 
-	    TclSetVarNamespaceVar(otherPtr);
-	    result = TCL_OK;
-	    goto doLinkVars;
+    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\" => ", (flags ? "normal" : "noerr"),
+		O2S(part1Ptr)));
+
+    doUnsetStk:
+	DECACHE_STACK_INFO();
+	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
+		&& (flags & TCL_LEAVE_ERR_MSG)) {
+	    goto errorInUnset;
 	}
-	result = TCL_ERROR;
-	goto checkForCatch;
+	CACHE_STACK_INFO();
+	TRACE_APPEND(("OK\n"));
+	NEXT_INST_V(2, cleanup, 0);
 
-    case INST_NSUPVAR:
-	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+    errorInUnset:
+	CACHE_STACK_INFO();
+	TRACE_ERROR(interp);
+	goto gotError;
 
-	{
-	    Tcl_Namespace *nsPtr, *savedNsPtr;
+	/*
+	 * This is really an unset operation these days. Do not issue.
+	 */
+
+    case INST_DICT_DONE:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => OK\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 INST_ARRAY instructions.
+     */
 
-	    result = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr);
-	    if (result == TCL_OK) {
+    case INST_ARRAY_EXISTS_IMM:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	cleanup = 0;
+	part1Ptr = NULL;
+	arrayPtr = NULL;
+	TRACE(("%u => ", opnd));
+	varPtr = LOCAL(opnd);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	goto doArrayExists;
+    case INST_ARRAY_EXISTS_STK:
+	opnd = -1;
+	pcAdjustment = 1;
+	cleanup = 1;
+	part1Ptr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
+		/*createPart1*/0, /*createPart2*/0, &arrayPtr);
+    doArrayExists:
+	if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+		&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+	    DECACHE_STACK_INFO();
+	    result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
+		    NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
+		    TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
+	    CACHE_STACK_INFO();
+	    if (result == TCL_ERROR) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	}
+	if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	    objResultPtr = TCONST(1);
+	} else {
+	    objResultPtr = TCONST(0);
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    case INST_ARRAY_MAKE_IMM:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	cleanup = 0;
+	part1Ptr = NULL;
+	arrayPtr = NULL;
+	TRACE(("%u => ", opnd));
+	varPtr = LOCAL(opnd);
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	goto doArrayMake;
+    case INST_ARRAY_MAKE_STK:
+	opnd = -1;
+	pcAdjustment = 1;
+	cleanup = 1;
+	part1Ptr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
+		"set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
+	if (varPtr == NULL) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+    doArrayMake:
+	if (varPtr && !TclIsVarArray(varPtr)) {
+	    if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
 		/*
-		 * Locate the other variable.
+		 * Either an array element, or a scalar: lose!
 		 */
 
-		savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-		iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
-		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
-			(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
-			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
-		iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
-		if (otherPtr) {
-		    goto doLinkVars;
-		}
+		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
+			"variable isn't array", opnd);
+		DECACHE_STACK_INFO();
+		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+		CACHE_STACK_INFO();
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	    TclSetVarArray(varPtr);
+	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
+	    TclInitVarHashTable(varPtr->value.tablePtr,
+		    TclGetVarNsPtr(varPtr));
+#ifdef TCL_COMPILE_DEBUG
+	    TRACE_APPEND(("done\n"));
+	} else {
+	    TRACE_APPEND(("nothing to do\n"));
+#endif
+	}
+	NEXT_INST_V(pcAdjustment, cleanup, 0);
+
+    /*
+     *	   End of INST_ARRAY instructions.
+     * -----------------------------------------------------------------
+     *	   Start of variable linking instructions.
+     */
+
+    {
+	Var *otherPtr;
+	CallFrame *framePtr, *savedFramePtr;
+	Tcl_Namespace *nsPtr;
+	Namespace *savedNsPtr;
+
+    case INST_UPVAR:
+	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+
+	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
+	    TRACE_ERROR(interp);
+	    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) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	goto doLinkVars;
+
+    case INST_NSUPVAR:
+	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+	if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    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|TCL_AVOID_RESOLVERS),
+		"access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	iPtr->varFramePtr->nsPtr = savedNsPtr;
+	if (!otherPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	goto doLinkVars;
+
+    case INST_VARIABLE:
+	TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS)));
+	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
+		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	if (!otherPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+	/*
+	 * Do the [variable] magic.
+	 */
+
+	TclSetVarNamespaceVar(otherPtr);
+
     doLinkVars:
 
 	/*
@@ -3524,8 +4450,8 @@ TclExecuteByteCode(
 	 * if there are no errors; otherwise, let it handle the case.
 	 */
 
-	opnd = TclGetInt4AtPtr(pc+1);;
-	varPtr = &(compiledLocals[opnd]);
+	opnd = TclGetInt4AtPtr(pc+1);
+	varPtr = LOCAL(opnd);
 	if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
 		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
 	    if (!TclIsVarUndefined(varPtr)) {
@@ -3536,7 +4462,8 @@ TclExecuteByteCode(
 		Var *linkPtr = varPtr->value.linkPtr;
 
 		if (linkPtr == otherPtr) {
-		    goto doLinkVarsDone;
+		    TRACE_APPEND(("already linked\n"));
+		    NEXT_INST_F(5, 1, 0);
 		}
 		if (TclIsVarInHash(linkPtr)) {
 		    VarHashRefCount(linkPtr)--;
@@ -3550,11 +4477,10 @@ TclExecuteByteCode(
 	    if (TclIsVarInHash(otherPtr)) {
 		VarHashRefCount(otherPtr)++;
 	    }
-	} else {
-	    result = TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0, opnd);
-	    if (result != TCL_OK) {
-		goto checkForCatch;
-	    }
+	} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
+		opnd) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 
 	/*
@@ -3562,35 +4488,35 @@ TclExecuteByteCode(
 	 * variables - and [variable] did not push it at all.
 	 */
 
-    doLinkVarsDone:
+	TRACE_APPEND(("link made\n"));
 	NEXT_INST_F(5, 1, 0);
     }
 
-    case INST_JUMP1: {
-	int opnd = TclGetInt1AtPtr(pc+1);
+    /*
+     *	   End of variable linking instructions.
+     * -----------------------------------------------------------------
+     */
 
+    case INST_JUMP1:
+	opnd = TclGetInt1AtPtr(pc+1);
 	TRACE(("%d => new pc %u\n", opnd,
 		(unsigned)(pc + opnd - codePtr->codeStart)));
 	NEXT_INST_F(opnd, 0, 0);
-    }
-
-    case INST_JUMP4: {
-	int opnd = TclGetInt4AtPtr(pc+1);
 
+    case INST_JUMP4:
+	opnd = TclGetInt4AtPtr(pc+1);
 	TRACE(("%d => new pc %u\n", opnd,
 		(unsigned)(pc + opnd - codePtr->codeStart)));
 	NEXT_INST_F(opnd, 0, 0);
-    }
 
     {
 	int jmpOffset[2], b;
-	Tcl_Obj *valuePtr;
 
 	/* TODO: consider rewrite so we don't compute the offset we're not
 	 * going to take. */
     case INST_JUMP_FALSE4:
 	jmpOffset[0] = TclGetInt4AtPtr(pc+1);	/* FALSE offset */
-	jmpOffset[1] = 5;			/* TRUE offset*/
+	jmpOffset[1] = 5;			/* TRUE offset */
 	goto doCondJump;
 
     case INST_JUMP_TRUE4:
@@ -3609,33 +4535,30 @@ TclExecuteByteCode(
 
     doCondJump:
 	valuePtr = OBJ_AT_TOS;
+	TRACE(("%d => ", jmpOffset[
+		(*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1]));
 
 	/* TODO - check claim that taking address of b harms performance */
 	/* TODO - consider optimization search for constants */
-	result = TclGetBooleanFromObj(interp, valuePtr, &b);
-	if (result != TCL_OK) {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
-		    ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
-		    ? 0 : 1]), Tcl_GetObjResult(interp));
-	    goto checkForCatch;
+	if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
+	    TRACE_ERROR(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),
+		TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
 			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
 	    } else {
-		TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+		TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
 	    }
 	} else {
 	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
-		TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+		TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
 	    } else {
-		TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
-			O2S(valuePtr),
-			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
+		TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
+			(unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
 	    }
 	}
 #endif
@@ -3645,7 +4568,6 @@ TclExecuteByteCode(
     case INST_JUMP_TABLE: {
 	Tcl_HashEntry *hPtr;
 	JumptableInfo *jtPtr;
-	int opnd;
 
 	/*
 	 * Jump to location looked up in a hashtable; fall through to next
@@ -3654,7 +4576,7 @@ TclExecuteByteCode(
 
 	opnd = TclGetInt4AtPtr(pc+1);
 	jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
-	TRACE(("%d => %.20s ", opnd, O2S(OBJ_AT_TOS)));
+	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));
@@ -3681,27 +4603,25 @@ TclExecuteByteCode(
 	 */
 
 	int i1, i2, iResult;
-	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
-	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
 
-	result = TclGetBooleanFromObj(NULL, valuePtr, &i1);
-	if (result != TCL_OK) {
+	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 checkForCatch;
+	    goto gotError;
 	}
 
-	result = TclGetBooleanFromObj(NULL, value2Ptr, &i2);
-	if (result != TCL_OK) {
+	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 checkForCatch;
+	    goto gotError;
 	}
 
 	if (*pc == INST_LOR) {
@@ -3709,72 +4629,426 @@ TclExecuteByteCode(
 	} else {
 	    iResult = (i1 && i2);
 	}
-	objResultPtr = constants[iResult];
+	objResultPtr = TCONST(iResult);
 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
 	NEXT_INST_F(1, 2, 1);
     }
 
     /*
-     * ---------------------------------------------------------
-     *	   Start of INST_LIST and related instructions.
+     * -----------------------------------------------------------------
+     *	   Start of general introspector instructions.
      */
 
-    case INST_LIST: {
+    case INST_NS_CURRENT: {
+	Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+
+	if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
+	    TclNewLiteralStringObj(objResultPtr, "::");
+	} else {
+	    TclNewStringObj(objResultPtr, currNsPtr->fullName,
+		    strlen(currNsPtr->fullName));
+	}
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+    }
+    case INST_COROUTINE_NAME: {
+	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+	TclNewObj(objResultPtr);
+	if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
+	    Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
+		    objResultPtr);
+	}
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+    }
+    case INST_INFO_LEVEL_NUM:
+	TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+    case INST_INFO_LEVEL_ARGS: {
+	int level;
+	register CallFrame *framePtr = iPtr->varFramePtr;
+	register CallFrame *rootFramePtr = iPtr->rootFramePtr;
+
+	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+	if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (level <= 0) {
+	    level += framePtr->level;
+	}
+	for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ;
+		framePtr = framePtr->callerVarPtr) {
+	    /* Empty loop body */
+	}
+	if (framePtr == rootFramePtr) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
+	    TRACE_ERROR(interp);
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
+		    TclGetString(OBJ_AT_TOS), NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+	objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 1, 1);
+    }
+    {
+	Tcl_Command cmd, origCmd;
+
+    case INST_RESOLVE_COMMAND:
+	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+	TclNewObj(objResultPtr);
+	if (cmd != NULL) {
+	    Tcl_GetCommandFullName(interp, cmd, objResultPtr);
+	}
+	TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
+	NEXT_INST_F(1, 1, 1);
+
+    case INST_ORIGIN_COMMAND:
+	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+	if (cmd == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+		    TclGetString(OBJ_AT_TOS), NULL);
+	    CACHE_STACK_INFO();
+	    TRACE_APPEND(("ERROR: not command\n"));
+	    goto gotError;
+	}
+	origCmd = TclGetOriginalCommand(cmd);
+	if (origCmd == NULL) {
+	    origCmd = cmd;
+	}
+	TclNewObj(objResultPtr);
+	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
+	TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
+	NEXT_INST_F(1, 1, 1);
+    }
+
+    /*
+     * -----------------------------------------------------------------
+     *	   Start of TclOO support instructions.
+     */
+
+    {
+	Object *oPtr;
+	CallFrame *framePtr;
+	CallContext *contextPtr;
+	int skip, newDepth;
+
+    case INST_TCLOO_SELF:
+	framePtr = iPtr->varFramePtr;
+	if (framePtr == NULL ||
+		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    TRACE(("=> ERROR: no TclOO call context\n"));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "self may only be called from inside a method",
+		    -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+	contextPtr = framePtr->clientData;
+
 	/*
-	 * Pop the opnd (objc) top stack elements into a new list obj and then
-	 * decrement their ref counts.
+	 * Call out to get the name; it's expensive to compute but cached.
 	 */
 
-	int opnd;
+	objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
 
-	opnd = TclGetUInt4AtPtr(pc+1);
-	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
-	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
-	NEXT_INST_V(5, opnd, 1);
-    }
+    case INST_TCLOO_NEXT_CLASS:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	framePtr = iPtr->varFramePtr;
+	valuePtr = OBJ_AT_DEPTH(opnd - 2);
+	objv = &OBJ_AT_DEPTH(opnd - 1);
+	skip = 2;
+	TRACE(("%d => ", opnd));
+	if (framePtr == NULL ||
+		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "nextto may only be called from inside a method",
+		    -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+	contextPtr = framePtr->clientData;
 
-    case INST_LIST_LENGTH: {
-	Tcl_Obj *valuePtr;
-	int length;
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
+	if (oPtr == NULL) {
+	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
+	    goto gotError;
+	} else {
+	    Class *classPtr = oPtr->classPtr;
+	    struct MInvoke *miPtr;
+	    int i;
+	    const char *methodType;
+
+	    if (classPtr == NULL) {
+		TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"\"%s\" is not a class", TclGetString(valuePtr)));
+		DECACHE_STACK_INFO();
+		Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+		CACHE_STACK_INFO();
+		goto gotError;
+	    }
 
-	valuePtr = OBJ_AT_TOS;
+	    for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
+		miPtr = contextPtr->callPtr->chain + i;
+		if (!miPtr->isFilter &&
+			miPtr->mPtr->declaringClassPtr == classPtr) {
+		    newDepth = i;
+#ifdef TCL_COMPILE_DEBUG
+		    if (tclTraceExec >= 2) {
+			if (traceInstructions) {
+			    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+			} else {
+			    fprintf(stdout, "%d: (%u) invoking ",
+				    iPtr->numLevels,
+				    (unsigned)(pc - codePtr->codeStart));
+			}
+			for (i = 0;  i < opnd;  i++) {
+			    TclPrintObject(stdout, objv[i], 15);
+			    fprintf(stdout, " ");
+			}
+			fprintf(stdout, "\n");
+			fflush(stdout);
+		    }
+#endif /*TCL_COMPILE_DEBUG*/
+		    goto doInvokeNext;
+		}
+	    }
 
-	result = TclListObjLength(interp, valuePtr, &length);
-	if (result == TCL_OK) {
-	    TclNewIntObj(objResultPtr, length);
-	    TRACE(("%.20s => %d\n", O2S(valuePtr), length));
-	    NEXT_INST_F(1, 1, 1);
+	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+		methodType = "constructor";
+	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+		methodType = "destructor";
+	    } else {
+		methodType = "method";
+	    }
+
+	    TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
+		    O2S(valuePtr)));
+	    for (i=contextPtr->index ; i>=0 ; i--) {
+		miPtr = contextPtr->callPtr->chain + i;
+		if (miPtr->isFilter
+			|| miPtr->mPtr->declaringClassPtr != classPtr) {
+		    continue;
+		}
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"%s implementation by \"%s\" not reachable from here",
+			methodType, TclGetString(valuePtr)));
+		DECACHE_STACK_INFO();
+		Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+			NULL);
+		CACHE_STACK_INFO();
+		goto gotError;
+	    }
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s has no non-filter implementation by \"%s\"",
+		    methodType, TclGetString(valuePtr)));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
+    case INST_TCLOO_NEXT:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	objv = &OBJ_AT_DEPTH(opnd - 1);
+	framePtr = iPtr->varFramePtr;
+	skip = 1;
+	TRACE(("%d => ", opnd));
+	if (framePtr == NULL ||
+		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "next may only be called from inside a method",
+		    -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+	contextPtr = framePtr->clientData;
+
+	newDepth = contextPtr->index + 1;
+	if (newDepth >= 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 (contextPtr->callPtr->flags & CONSTRUCTOR) {
+		methodType = "constructor";
+	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+		methodType = "destructor";
+	    } else {
+		methodType = "method";
+	    }
+
+	    TRACE_APPEND(("ERROR: no TclOO next impl\n"));
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "no next %s implementation", methodType));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+#ifdef TCL_COMPILE_DEBUG
+	} else if (tclTraceExec >= 2) {
+	    int i;
+
+	    if (traceInstructions) {
+		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+	    } else {
+		fprintf(stdout, "%d: (%u) invoking ",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
+	    }
+	    for (i = 0;  i < opnd;  i++) {
+		TclPrintObject(stdout, objv[i], 15);
+		fprintf(stdout, " ");
+	    }
+	    fprintf(stdout, "\n");
+	    fflush(stdout);
+#endif /*TCL_COMPILE_DEBUG*/
+	}
+
+    doInvokeNext:
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
+
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv);
+	}
+
+	pcAdjustment = 2;
+	cleanup = opnd;
+	DECACHE_STACK_INFO();
+	iPtr->varFramePtr = framePtr->callerVarPtr;
+	pc += pcAdjustment;
+	TEBC_YIELD();
+
+	TclPushTailcallPoint(interp);
+	oPtr = contextPtr->oPtr;
+	if (oPtr->flags & FILTER_HANDLING) {
+	    TclNRAddCallback(interp, FinalizeOONextFilter,
+		    framePtr, contextPtr, INT2PTR(contextPtr->index),
+		    INT2PTR(contextPtr->skip));
 	} else {
-	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
-		    Tcl_GetObjResult(interp));
-	    goto checkForCatch;
+	    TclNRAddCallback(interp, FinalizeOONext,
+		    framePtr, contextPtr, INT2PTR(contextPtr->index),
+		    INT2PTR(contextPtr->skip));
+	}
+	contextPtr->skip = skip;
+	contextPtr->index = newDepth;
+	if (contextPtr->callPtr->chain[newDepth].isFilter
+		|| contextPtr->callPtr->flags & FILTER_HANDLING) {
+	    oPtr->flags |= FILTER_HANDLING;
+	} else {
+	    oPtr->flags &= ~FILTER_HANDLING;
 	}
-    }
 
-    case INST_LIST_INDEX: {
-	/*** lindex with objc == 3 ***/
+	{
+	    register Method *const mPtr =
+		    contextPtr->callPtr->chain[newDepth].mPtr;
 
-	/* Variables also for INST_LIST_INDEX_IMM */
+	    return mPtr->typePtr->callProc(mPtr->clientData, interp,
+		    (Tcl_ObjectContext) contextPtr, opnd, objv);
+	}
 
-	int listc, idx, opnd, pcAdjustment;
-	Tcl_Obj **listv;
-	Tcl_Obj *valuePtr, *value2Ptr;
+    case INST_TCLOO_IS_OBJECT:
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
+	objResultPtr = TCONST(oPtr != NULL ? 1 : 0);
+	TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
+	NEXT_INST_F(1, 1, 1);
+    case INST_TCLOO_CLASS:
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
+	if (oPtr == NULL) {
+	    TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS)));
+	    goto gotError;
+	}
+	objResultPtr = TclOOObjectName(interp, oPtr->selfCls->thisPtr);
+	TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
+	NEXT_INST_F(1, 1, 1);
+    case INST_TCLOO_NS:
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
+	if (oPtr == NULL) {
+	    TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS)));
+	    goto gotError;
+	}
 
 	/*
-	 * Pop the two operands.
+	 * TclOO objects *never* have the global namespace as their NS.
 	 */
 
+	TclNewStringObj(objResultPtr, oPtr->namespacePtr->fullName,
+		strlen(oPtr->namespacePtr->fullName));
+	TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
+	NEXT_INST_F(1, 1, 1);
+    }
+
+    /*
+     *     End of TclOO support 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.
+	 */
+
+	opnd = TclGetUInt4AtPtr(pc+1);
+	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+	NEXT_INST_V(5, opnd, 1);
+
+    case INST_LIST_LENGTH:
+	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+	if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	TclNewIntObj(objResultPtr, length);
+	TRACE_APPEND(("%d\n", length));
+	NEXT_INST_F(1, 1, 1);
+
+    case INST_LIST_INDEX:	/* lindex with objc == 3 */
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 
 	/*
 	 * Extract the desired list element.
 	 */
 
-	result = TclListObjGetElements(interp, valuePtr, &listc, &listv);
-	if ((result == TCL_OK) && (value2Ptr->typePtr != &tclListType)
-		&& (TclGetIntForIndexM(NULL , value2Ptr, listc-1,
-			&idx) == TCL_OK)) {
+	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
+		&& (value2Ptr->typePtr != &tclListType)
+		&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
+			&index) == TCL_OK)) {
 	    TclDecrRefCount(value2Ptr);
 	    tosPtr--;
 	    pcAdjustment = 1;
@@ -3782,25 +5056,20 @@ TclExecuteByteCode(
 	}
 
 	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
-	if (objResultPtr) {
-	    /*
-	     * Stash the list element on the stack.
-	     */
-
-	    TRACE(("%.20s %.20s => %s\n",
-		    O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
-	    NEXT_INST_F(1, 2, -1);	/* Already has the correct refCount */
-	} else {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
-		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	if (!objResultPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 
-    case INST_LIST_INDEX_IMM:
-	/*** lindex with objc==3 and index in bytecode stream ***/
+	/*
+	 * Stash the list element on the stack.
+	 */
+
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 2, -1);	/* Already has the correct refCount */
 
-	pcAdjustment = 5;
+    case INST_LIST_INDEX_IMM:	/* lindex with objc==3 and index in bytecode
+				 * stream */
 
 	/*
 	 * Pop the list and get the index.
@@ -3808,90 +5077,75 @@ TclExecuteByteCode(
 
 	valuePtr = OBJ_AT_TOS;
 	opnd = TclGetInt4AtPtr(pc+1);
+	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
 
 	/*
 	 * Get the contents of the list, making sure that it really is a list
 	 * in the process.
 	 */
 
-	result = TclListObjGetElements(interp, valuePtr, &listc, &listv);
-
-	if (result == TCL_OK) {
-	    /*
-	     * Select the list item based on the index. Negative operand means
-	     * end-based indexing.
-	     */
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
 
-	    if (opnd < -1) {
-		idx = opnd+1 + listc;
-	    } else {
-		idx = opnd;
-	    }
+	/*
+	 * Select the list item based on the index. Negative operand means
+	 * end-based indexing.
+	 */
 
-	lindexFastPath:
-	    if (idx >= 0 && idx < listc) {
-		objResultPtr = listv[idx];
-	    } else {
-		TclNewObj(objResultPtr);
-	    }
+	if (opnd < -1) {
+	    index = opnd+1 + objc;
+	} else {
+	    index = opnd;
+	}
+	pcAdjustment = 5;
 
-	    TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
-		    objResultPtr);
-	    NEXT_INST_F(pcAdjustment, 1, 1);
+    lindexFastPath:
+	if (index >= 0 && index < objc) {
+	    objResultPtr = objv[index];
 	} else {
-	    TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
-		    Tcl_GetObjResult(interp));
-	    goto checkForCatch;
+	    TclNewObj(objResultPtr);
 	}
-    }
 
-    case INST_LIST_INDEX_MULTI: {
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_F(pcAdjustment, 1, 1);
+
+    case INST_LIST_INDEX_MULTI:	/* 'lindex' with multiple index args */
 	/*
-	 * 'lindex' with multiple index args:
-	 *
 	 * Determine the count of index args.
 	 */
 
-	int numIdx, opnd;
-
 	opnd = TclGetUInt4AtPtr(pc+1);
-	numIdx = opnd-1;
+	numIndices = opnd-1;
 
 	/*
 	 * Do the 'lindex' operation.
 	 */
 
-	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIdx),
-		numIdx, &OBJ_AT_DEPTH(numIdx - 1));
+	TRACE(("%d => ", opnd));
+	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
+		numIndices, &OBJ_AT_DEPTH(numIndices - 1));
+	if (!objResultPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
 
 	/*
-	 * Check for errors.
+	 * Set result.
 	 */
 
-	if (objResultPtr) {
-	    /*
-	     * Set result.
-	     */
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_V(5, opnd, -1);
 
-	    TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
-	    NEXT_INST_V(5, opnd, -1);
-	} else {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
-	}
-    }
-
-    case INST_LSET_FLAT: {
+    case INST_LSET_FLAT:
 	/*
 	 * Lset with 3, 5, or more args. Get the number of index args.
 	 */
 
-	int numIdx,opnd;
-	Tcl_Obj *valuePtr, *value2Ptr;
-
 	opnd = TclGetUInt4AtPtr(pc + 1);
-	numIdx = opnd - 2;
+	numIndices = opnd - 2;
+	TRACE(("%d => ", opnd));
 
 	/*
 	 * Get the old value of variable, and remove the stack ref. This is
@@ -3900,47 +5154,28 @@ TclExecuteByteCode(
 	 * Tcl_DecrRefCount.
 	 */
 
-	value2Ptr = POP_OBJECT();
-	Tcl_DecrRefCount(value2Ptr); /* This one should be done here */
-
-	/*
-	 * Get the new element value.
-	 */
-
-	valuePtr = OBJ_AT_TOS;
+	valuePtr = POP_OBJECT();
+	Tcl_DecrRefCount(valuePtr); /* This one should be done here */
 
 	/*
 	 * Compute the new variable value.
 	 */
 
-	objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
-		&OBJ_AT_DEPTH(numIdx), valuePtr);
-
-	/*
-	 * Check for errors.
-	 */
-
-	if (objResultPtr) {
-	    /*
-	     * Set result.
-	     */
-
-	    TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
-	    NEXT_INST_V(5, (numIdx+1), -1);
-	} else {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
+		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
+	if (!objResultPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
-    }
 
-    case INST_LSET_LIST: {
 	/*
-	 * 'lset' with 4 args.
+	 * Set result.
 	 */
 
-	Tcl_Obj *objPtr, *valuePtr, *value2Ptr;
+	TRACE_APPEND(("\"%.30s\"\n", 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
@@ -3957,37 +5192,28 @@ TclExecuteByteCode(
 
 	valuePtr = OBJ_AT_TOS;
 	value2Ptr = OBJ_UNDER_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+		O2S(value2Ptr), O2S(valuePtr), O2S(objPtr)));
 
 	/*
 	 * Compute the new variable value.
 	 */
 
 	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
+	if (!objResultPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
 
 	/*
-	 * Check for errors.
+	 * Set result.
 	 */
 
-	if (objResultPtr) {
-	    /*
-	     * Set result.
-	     */
-
-	    TRACE(("=> %s\n", O2S(objResultPtr)));
-	    NEXT_INST_F(1, 2, -1);
-	} else {
-	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
-		    Tcl_GetObjResult(interp));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
-	}
-    }
-
-    case INST_LIST_RANGE_IMM: {
-	/*** lrange with objc==4 and both indices in bytecode stream ***/
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 2, -1);
 
-	int listc, fromIdx, toIdx;
-	Tcl_Obj **listv, *valuePtr;
+    case INST_LIST_RANGE_IMM:	/* lrange with objc==4 and both indices in
+				 * bytecode stream */
 
 	/*
 	 * Pop the list and get the indices.
@@ -3996,49 +5222,49 @@ TclExecuteByteCode(
 	valuePtr = OBJ_AT_TOS;
 	fromIdx = TclGetInt4AtPtr(pc+1);
 	toIdx = TclGetInt4AtPtr(pc+5);
+	TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
+		TclGetInt4AtPtr(pc+5)));
 
 	/*
 	 * Get the contents of the list, making sure that it really is a list
 	 * in the process.
 	 */
-	result = TclListObjGetElements(interp, valuePtr, &listc, &listv);
+
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
 
 	/*
 	 * Skip a lot of work if we're about to throw the result away (common
 	 * with uses of [lassign]).
 	 */
 
-	if (result == TCL_OK) {
 #ifndef TCL_COMPILE_DEBUG
-	    if (*(pc+9) == INST_POP) {
-		NEXT_INST_F(10, 1, 0);
-	    }
-#endif
-	} else {
-	    TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
-		    fromIdx, toIdx), Tcl_GetObjResult(interp));
-	    goto checkForCatch;
+	if (*(pc+9) == INST_POP) {
+	    NEXT_INST_F(10, 1, 0);
 	}
+#endif
 
 	/*
 	 * Adjust the indices for end-based handling.
 	 */
 
 	if (fromIdx < -1) {
-	    fromIdx += 1+listc;
+	    fromIdx += 1+objc;
 	    if (fromIdx < -1) {
 		fromIdx = -1;
 	    }
-	} else if (fromIdx > listc) {
-	    fromIdx = listc;
+	} else if (fromIdx > objc) {
+	    fromIdx = objc;
 	}
 	if (toIdx < -1) {
-	    toIdx += 1+listc;
+	    toIdx += 1 + objc;
 	    if (toIdx < -1) {
 		toIdx = -1;
 	    }
-	} else if (toIdx > listc) {
-	    toIdx = listc;
+	} else if (toIdx > objc) {
+	    toIdx = objc;
 	}
 
 	/*
@@ -4046,71 +5272,80 @@ TclExecuteByteCode(
 	 * so, build the list of elements in that range.
 	 */
 
-	if (fromIdx<=toIdx && fromIdx<listc && toIdx>=0) {
-	    if (fromIdx<0) {
+	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
+	    if (fromIdx < 0) {
 		fromIdx = 0;
 	    }
-	    if (toIdx >= listc) {
-		toIdx = listc-1;
+	    if (toIdx >= objc) {
+		toIdx = objc-1;
 	    }
-	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, listv+fromIdx);
+	    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) {
+		    for (index=toIdx+1; index<objc ; 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);
+	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
-    }
 
     case INST_LIST_IN:
-    case INST_LIST_NOT_IN: {
-	/*
-	 * Basic list containment operators.
-	 */
-
-	int found, s1len, s2len, llen, i;
-	Tcl_Obj *valuePtr, *value2Ptr, *o;
-	char *s1;
-	const char *s2;
-
+    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
 
-	/* TODO: Consider more efficient tests than strcmp() */
 	s1 = TclGetStringFromObj(valuePtr, &s1len);
-	result = TclListObjLength(interp, value2Ptr, &llen);
-	if (result != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
-		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
-	    goto checkForCatch;
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
-	found = 0;
-	if (llen > 0) {
+	match = 0;
+	if (length > 0) {
+	    int i = 0;
+	    Tcl_Obj *o;
+
 	    /*
 	     * An empty list doesn't match anything.
 	     */
 
-	    i = 0;
 	    do {
 		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
 		if (o != NULL) {
 		    s2 = TclGetStringFromObj(o, &s2len);
 		} else {
 		    s2 = "";
+		    s2len = 0;
 		}
 		if (s1len == s2len) {
-		    found = (strcmp(s1, s2) == 0);
+		    match = (memcmp(s1, s2, s1len) == 0);
 		}
 		i++;
-	    } while (i < llen && found == 0);
+	    } while (i < length && match == 0);
 	}
 
 	if (*pc == INST_LIST_NOT_IN) {
-	    found = !found;
+	    match = !match;
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), found));
+	TRACE_APPEND(("%d\n", match));
 
 	/*
 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
@@ -4118,154 +5353,126 @@ TclExecuteByteCode(
 	 * for branching.
 	 */
 
-	pc++;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((found ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((found ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((found ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((found ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	JUMP_PEEPHOLE_F(match, 1, 2);
+
+    case INST_LIST_CONCAT:
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    objResultPtr = Tcl_DuplicateObj(valuePtr);
+	    if (Tcl_ListObjAppendList(interp, objResultPtr,
+		    value2Ptr) != TCL_OK) {
+		TRACE_ERROR(interp);
+		TclDecrRefCount(objResultPtr);
+		goto gotError;
+	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 2, 1);
+	} else {
+	    if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 1, 0);
 	}
-#endif
-	objResultPtr = constants[found];
-	NEXT_INST_F(0, 2, 1);
-    }
 
     /*
      *	   End of INST_LIST and related instructions.
-     * ---------------------------------------------------------
+     * -----------------------------------------------------------------
+     *	   Start of string-related instructions.
      */
 
     case INST_STR_EQ:
-    case INST_STR_NEQ: {
-	/*
-	 * String (in)equality check
-	 * TODO: Consider merging into INST_STR_CMP
-	 */
-
-	int iResult;
-	Tcl_Obj *valuePtr, *value2Ptr;
-
+    case INST_STR_NEQ:		/* String (in)equality check */
+    case INST_STR_CMP:		/* String compare. */
+    stringCompare:
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
 
 	if (valuePtr == value2Ptr) {
+	    match = 0;
+	} else {
 	    /*
-	     * On the off-chance that the objects are the same, we don't
-	     * really have to think hard about equality.
+	     * 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.
 	     */
 
-	    iResult = (*pc == INST_STR_EQ);
-	} else {
-	    char *s1, *s2;
-	    int s1len, s2len;
-
-	    s1 = TclGetStringFromObj(valuePtr, &s1len);
-	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
-	    if (s1len == s2len) {
+	    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)) {
 		/*
-		 * We only need to check (in)equality when we have equal
-		 * length strings.
+		 * 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.
 		 */
 
-		if (*pc == INST_STR_NEQ) {
-		    iResult = (strcmp(s1, s2) != 0);
+		s1len = Tcl_GetCharLength(valuePtr);
+		s2len = Tcl_GetCharLength(value2Ptr);
+		if ((s1len == valuePtr->length)
+			&& (valuePtr->bytes != NULL)
+			&& (s2len == value2Ptr->length)
+			&& (value2Ptr->bytes != NULL)) {
+		    s1 = valuePtr->bytes;
+		    s2 = value2Ptr->bytes;
+		    memCmpFn = memcmp;
 		} else {
-		    /* INST_STR_EQ */
-		    iResult = (strcmp(s1, s2) == 0);
+		    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 {
-		iResult = (*pc == INST_STR_NEQ);
-	    }
-	}
-
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
-
-	/*
-	 * Peep-hole optimisation: if you're about to jump, do jump from here.
-	 */
-
-	pc++;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
-	}
-#endif
-	objResultPtr = constants[iResult];
-	NEXT_INST_F(0, 2, 1);
-    }
-
-    case INST_STR_CMP: {
-	/*
-	 * String compare.
-	 */
-
-	const char *s1, *s2;
-	int s1len, s2len, iResult;
-	Tcl_Obj *valuePtr, *value2Ptr;
-
-    stringCompare:
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
-	/*
-	 * The comparison function should compare up to the minimum byte
-	 * length only.
-	 */
-
-	if (valuePtr == value2Ptr) {
-	    /*
-	     * In the pure equality case, set lengths too for the checks below
-	     * (or we could goto beyond it).
-	     */
+		/*
+		 * strcmp can't do a simple memcmp in order to handle the
+		 * special Tcl \xC0\x80 null encoding for utf-8.
+		 */
 
-	    iResult = s1len = s2len = 0;
-	} else if (TclIsPureByteArray(valuePtr)
-		&& TclIsPureByteArray(value2Ptr)) {
-	    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.
-	     */
+		s1 = TclGetStringFromObj(valuePtr, &s1len);
+		s2 = TclGetStringFromObj(value2Ptr, &s2len);
+		if (checkEq) {
+		    memCmpFn = memcmp;
+		} else {
+		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
+		}
+	    }
 
-	    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));
+	    if (checkEq && (s1len != s2len)) {
+		match = 1;
 	    } else {
-		iResult = TclUniCharNcmp(Tcl_GetUnicode(valuePtr),
-			Tcl_GetUnicode(value2Ptr),
-			(unsigned) ((s1len < s2len) ? s1len : s2len));
+		/*
+		 * 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;
+		}
 	    }
-	} else {
-	    /*
-	     * We 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);
-	    iResult = TclpUtfNcmp2(s1, s2,
-		    (size_t) ((s1len < s2len) ? s1len : s2len));
 	}
 
 	/*
@@ -4273,133 +5480,455 @@ TclExecuteByteCode(
 	 * TODO: consider peephole opt.
 	 */
 
-	if (iResult == 0) {
-	    iResult = s1len - s2len;
-	}
-
 	if (*pc != INST_STR_CMP) {
 	    /*
 	     * Take care of the opcodes that goto'ed into here.
 	     */
 
 	    switch (*pc) {
+	    case INST_STR_EQ:
 	    case INST_EQ:
-		iResult = (iResult == 0);
+		match = (match == 0);
 		break;
+	    case INST_STR_NEQ:
 	    case INST_NEQ:
-		iResult = (iResult != 0);
+		match = (match != 0);
 		break;
 	    case INST_LT:
-		iResult = (iResult < 0);
+		match = (match < 0);
 		break;
 	    case INST_GT:
-		iResult = (iResult > 0);
+		match = (match > 0);
 		break;
 	    case INST_LE:
-		iResult = (iResult <= 0);
+		match = (match <= 0);
 		break;
 	    case INST_GE:
-		iResult = (iResult >= 0);
+		match = (match >= 0);
 		break;
 	    }
 	}
-	if (iResult < 0) {
-	    TclNewIntObj(objResultPtr, -1);
-	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), -1));
+
+	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+		(match < 0 ? -1 : match > 0 ? 1 : 0)));
+	JUMP_PEEPHOLE_F(match, 1, 2);
+
+    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);
+
+    case INST_STR_UPPER:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToUpper(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
+	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+    case INST_STR_LOWER:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToLower(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToLower(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
+	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+    case INST_STR_TITLE:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToTitle(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
 	} else {
-	    objResultPtr = constants[(iResult>0)];
-	    TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr),
-		(iResult > 0)));
+	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
+	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
 	}
 
+    case INST_STR_INDEX:
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
+	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
+
+	/*
+	 * Get char length to calulate what 'end' means.
+	 */
+
+	length = Tcl_GetCharLength(valuePtr);
+	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+	if ((index < 0) || (index >= length)) {
+	    TclNewObj(objResultPtr);
+	} else if (TclIsPureByteArray(valuePtr)) {
+	    objResultPtr = Tcl_NewByteArrayObj(
+		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+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);
+
+	    /*
+	     * 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);
+	}
+
+	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
-    }
 
-    case INST_STR_LEN: {
-	int length;
-	Tcl_Obj *valuePtr;
+    case INST_STR_RANGE:
+	TRACE(("\"%.20s\" %.20s %.20s =>",
+		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+	length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
+	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+		    &fromIdx) != TCL_OK
+	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+		    &toIdx) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+	if (fromIdx < 0) {
+	    fromIdx = 0;
+	}
+	if (toIdx >= length) {
+	    toIdx = length;
+	}
+	if (toIdx >= fromIdx) {
+	    objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
+	} else {
+	    TclNewObj(objResultPtr);
+	}
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_V(1, 3, 1);
 
+    case INST_STR_RANGE_IMM:
 	valuePtr = OBJ_AT_TOS;
+	fromIdx = TclGetInt4AtPtr(pc+1);
+	toIdx = TclGetInt4AtPtr(pc+5);
+	length = Tcl_GetCharLength(valuePtr);
+	TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));
+
+	/*
+	 * Adjust indices for end-based indexing.
+	 */
 
-	if (valuePtr->typePtr == &tclByteArrayType) {
-	    (void) Tcl_GetByteArrayFromObj(valuePtr, &length);
+	if (fromIdx < -1) {
+	    fromIdx += 1 + length;
+	    if (fromIdx < 0) {
+		fromIdx = 0;
+	    }
+	} else if (fromIdx >= length) {
+	    fromIdx = length;
+	}
+	if (toIdx < -1) {
+	    toIdx += 1 + length;
+	} else if (toIdx >= length) {
+	    toIdx = length - 1;
+	}
+
+	/*
+	 * Check if we can do a sane substring.
+	 */
+
+	if (fromIdx <= toIdx) {
+	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
 	} else {
-	    length = Tcl_GetCharLength(valuePtr);
+	    TclNewObj(objResultPtr);
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(9, 1, 1);
+
+    {
+	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
+	int length3;
+	Tcl_Obj *value3Ptr;
+
+    case INST_STR_REPLACE:
+	value3Ptr = POP_OBJECT();
+	valuePtr = OBJ_AT_DEPTH(2);
+	length = Tcl_GetCharLength(valuePtr) - 1;
+	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
+	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+		    &fromIdx) != TCL_OK
+	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+		    &toIdx) != TCL_OK) {
+	    TclDecrRefCount(value3Ptr);
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	TclDecrRefCount(OBJ_AT_TOS);
+	(void) POP_OBJECT();
+	TclDecrRefCount(OBJ_AT_TOS);
+	(void) POP_OBJECT();
+	if (fromIdx < 0) {
+	    fromIdx = 0;
+	}
+
+	if (fromIdx > toIdx || fromIdx > length) {
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+	    TclDecrRefCount(value3Ptr);
+	    NEXT_INST_F(1, 0, 0);
+	}
+
+	if (toIdx > length) {
+	    toIdx = length;
+	}
+
+	if (fromIdx == 0 && toIdx == length) {
+	    TclDecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = value3Ptr;
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+	    NEXT_INST_F(1, 0, 0);
 	}
-	TclNewIntObj(objResultPtr, length);
-	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
-	NEXT_INST_F(1, 1, 1);
-    }
 
-    case INST_STR_INDEX: {
+	length3 = Tcl_GetCharLength(value3Ptr);
+
 	/*
-	 * String compare.
+	 * See if we can splice in place. This happens when the number of
+	 * characters being replaced is the same as the number of characters
+	 * in the string to be inserted.
 	 */
 
-	int index, length;
-	char *bytes;
-	Tcl_Obj *valuePtr, *value2Ptr;
+	if (length3 - 1 == toIdx - fromIdx) {
+	    unsigned char *bytes1, *bytes2;
 
-	bytes = NULL; /* lint */
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_DuplicateObj(valuePtr);
+	    } else {
+		objResultPtr = valuePtr;
+	    }
+	    if (TclIsPureByteArray(objResultPtr)
+		    && TclIsPureByteArray(value3Ptr)) {
+		bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
+		bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+		memcpy(bytes1 + fromIdx, bytes2, length3);
+	    } else {
+		ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
+		ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
+		memcpy(ustring1 + fromIdx, ustring2,
+			length3 * sizeof(Tcl_UniChar));
+	    }
+	    Tcl_InvalidateStringRep(objResultPtr);
+	    TclDecrRefCount(value3Ptr);
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	    if (objResultPtr == valuePtr) {
+		NEXT_INST_F(1, 0, 0);
+	    } else {
+		NEXT_INST_F(1, 1, 1);
+	    }
+	}
 
 	/*
-	 * 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 unicode representation; this is where we guarantee to lose
+	 * bytearrays.
 	 */
 
-	if (TclIsPureByteArray(valuePtr)) {
-	    bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
-	} else {
+	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+	length--;
+
+	/*
+	 * Remove substring using copying.
+	 */
+
+	objResultPtr = NULL;
+	if (fromIdx > 0) {
+	    objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+	}
+	if (length3 > 0) {
+	    if (objResultPtr) {
+		Tcl_AppendObjToObj(objResultPtr, value3Ptr);
+	    } else if (Tcl_IsShared(value3Ptr)) {
+		objResultPtr = Tcl_DuplicateObj(value3Ptr);
+	    } else {
+		objResultPtr = value3Ptr;
+	    }
+	}
+	if (toIdx < length) {
+	    if (objResultPtr) {
+		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+			length - toIdx);
+	    } else {
+		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
+			length - toIdx);
+	    }
+	}
+	if (objResultPtr == NULL) {
+	    /* This has to be the case [string replace $s 0 end {}] */
+	    /* which has result {} which is same as value3Ptr. */
+	    objResultPtr = value3Ptr;
+	}
+	if (objResultPtr == value3Ptr) {
+	    /* See [Bug 82e7f67325] */
+	    TclDecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = value3Ptr;
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+	TclDecrRefCount(value3Ptr);
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 1, 1);
+
+    case INST_STR_MAP:
+	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
+	value3Ptr = OBJ_UNDER_TOS;	/* "Target" string. */
+	value2Ptr = OBJ_AT_DEPTH(2);	/* "Source" string. */
+	if (value3Ptr == value2Ptr) {
+	    objResultPtr = valuePtr;
+	    goto doneStringMap;
+	} else if (valuePtr == value2Ptr) {
+	    objResultPtr = value3Ptr;
+	    goto doneStringMap;
+	}
+	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+	if (length == 0) {
+	    objResultPtr = valuePtr;
+	    goto doneStringMap;
+	}
+	ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
+	if (length2 > length || length2 == 0) {
+	    objResultPtr = valuePtr;
+	    goto doneStringMap;
+	} else if (length2 == length) {
+	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
+		objResultPtr = valuePtr;
+	    } else {
+		objResultPtr = value3Ptr;
+	    }
+	    goto doneStringMap;
+	}
+	ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
+
+	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+	p = ustring1;
+	end = ustring1 + length;
+	for (; ustring1 < end; ustring1++) {
+	    if ((*ustring1 == *ustring2) && (length2==1 ||
+		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
+			    == 0)) {
+		if (p != ustring1) {
+		    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
+		    p = ustring1 + length2;
+		} else {
+		    p += length2;
+		}
+		ustring1 = p - 1;
+
+		Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
+	    }
+	}
+	if (p != ustring1) {
 	    /*
-	     * Get Unicode char length to calulate what 'end' means.
+	     * Put the rest of the unmapped chars onto result.
 	     */
 
-	    length = Tcl_GetCharLength(valuePtr);
+	    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
 	}
+    doneStringMap:
+	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
+		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
+	NEXT_INST_V(1, 3, 1);
 
-	result = TclGetIntForIndexM(interp, value2Ptr, length - 1, &index);
-	if (result != TCL_OK) {
-	    goto checkForCatch;
-	}
+    case INST_STR_FIND:
+	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
+	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
 
-	if ((index >= 0) && (index < length)) {
-	    if (TclIsPureByteArray(valuePtr)) {
-		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;
+	match = -1;
+	if (length2 > 0 && length2 <= length) {
+	    end = ustring1 + length - length2 + 1;
+	    for (p=ustring1 ; p<end ; p++) {
+		if ((*p == *ustring2) &&
+			memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
+		    match = p - ustring1;
+		    break;
+		}
+	    }
+	}
 
-		ch = Tcl_GetUniChar(valuePtr, index);
+	TRACE(("%.20s %.20s => %d\n",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
+	TclNewIntObj(objResultPtr, match);
+	NEXT_INST_F(1, 2, 1);
 
-		/*
-		 * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch,
-		 * 1) but creating the object as a string seems to be faster
-		 * in practical use.
-		 */
+    case INST_STR_FIND_LAST:
+	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
+	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
 
-		length = Tcl_UniCharToUtf(ch, buf);
-		objResultPtr = Tcl_NewStringObj(buf, length);
+	match = -1;
+	if (length2 > 0 && length2 <= length) {
+	    for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
+		if ((*p == *ustring2) &&
+			memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
+		    match = p - ustring1;
+		    break;
+		}
 	    }
-	} else {
-	    TclNewObj(objResultPtr);
 	}
 
-	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
-		O2S(objResultPtr)));
+	TRACE(("%.20s %.20s => %d\n",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
+
+	TclNewIntObj(objResultPtr, match);
 	NEXT_INST_F(1, 2, 1);
-    }
 
-    case INST_STR_MATCH: {
-	int nocase, match;
-	Tcl_Obj *valuePtr, *value2Ptr;
+    case INST_STR_CLASS:
+	opnd = TclGetInt1AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
+		O2S(valuePtr)));
+	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+	match = 1;
+	if (length > 0) {
+	    end = ustring1 + length;
+	    for (p=ustring1 ; p<end ; p++) {
+		if (!tclStringClassTable[opnd].comparator(*p)) {
+		    match = 0;
+		    break;
+		}
+	    }
+	}
+	TRACE_APPEND(("%d\n", match));
+	JUMP_PEEPHOLE_F(match, 2, 1);
+    }
 
+    case INST_STR_MATCH:
 	nocase = TclGetInt1AtPtr(pc+1);
 	valuePtr = OBJ_AT_TOS;		/* String */
 	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
@@ -4412,19 +5941,17 @@ TclExecuteByteCode(
 	if ((valuePtr->typePtr == &tclStringType)
 		|| (value2Ptr->typePtr == &tclStringType)) {
 	    Tcl_UniChar *ustring1, *ustring2;
-	    int length1, length2;
 
-	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length1);
+	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
-	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
+	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
 		    nocase);
 	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
-	    unsigned char *string1, *string2;
-	    int length1, length2;
+	    unsigned char *bytes1, *bytes2;
 
-	    string1 = Tcl_GetByteArrayFromObj(valuePtr, &length1);
-	    string2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
-	    match = TclByteArrayMatch(string1, length1, string2, length2, 0);
+	    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);
@@ -4433,64 +5960,169 @@ TclExecuteByteCode(
 	/*
 	 * Reuse value2Ptr object already on stack if possible. Adjustment is
 	 * 2 due to the nocase byte
-	 * TODO: consider peephole opt.
 	 */
 
 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
-	objResultPtr = constants[match];
-	NEXT_INST_F(2, 2, 1);
-    }
 
-    case INST_REGEXP: {
-	int cflags, match;
-	Tcl_Obj *valuePtr, *value2Ptr;
-	Tcl_RegExp regExpr;
+	/*
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 */
+
+	JUMP_PEEPHOLE_F(match, 2, 2);
+
+    {
+	const char *string1, *string2;
+	int trim1, trim2;
+
+    case INST_STR_TRIM_LEFT:
+	valuePtr = OBJ_UNDER_TOS;	/* String */
+	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
+	string2 = TclGetStringFromObj(value2Ptr, &length2);
+	string1 = TclGetStringFromObj(valuePtr, &length);
+	trim1 = TclTrimLeft(string1, length, string2, length2);
+	trim2 = 0;
+	goto createTrimmedString;
+    case INST_STR_TRIM_RIGHT:
+	valuePtr = OBJ_UNDER_TOS;	/* String */
+	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
+	string2 = TclGetStringFromObj(value2Ptr, &length2);
+	string1 = TclGetStringFromObj(valuePtr, &length);
+	trim2 = TclTrimRight(string1, length, string2, length2);
+	trim1 = 0;
+	goto createTrimmedString;
+    case INST_STR_TRIM:
+	valuePtr = OBJ_UNDER_TOS;	/* String */
+	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
+	string2 = TclGetStringFromObj(value2Ptr, &length2);
+	string1 = TclGetStringFromObj(valuePtr, &length);
+	trim1 = TclTrimLeft(string1, length, string2, length2);
+	if (trim1 < length) {
+	    trim2 = TclTrimRight(string1, length, string2, length2);
+	} else {
+	    trim2 = 0;
+	}
+    createTrimmedString:
+	/*
+	 * Careful here; trim set often contains non-ASCII characters so we
+	 * take care when printing. [Bug 971cb4f1db]
+	 */
 
+#ifdef TCL_COMPILE_DEBUG
+	if (traceInstructions) {
+	    TRACE(("\"%.30s\" ", O2S(valuePtr)));
+	    TclPrintObject(stdout, value2Ptr, 30);
+	    printf(" => ");
+	}
+#endif
+	if (trim1 == 0 && trim2 == 0) {
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		TclPrintObject(stdout, valuePtr, 30);
+		printf("\n");
+	    }
+#endif
+	    NEXT_INST_F(1, 1, 0);
+	} else {
+	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		TclPrintObject(stdout, objResultPtr, 30);
+		printf("\n");
+	    }
+#endif
+	    NEXT_INST_F(1, 2, 1);
+	}
+    }
+
+    case INST_REGEXP:
 	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
 	valuePtr = OBJ_AT_TOS;		/* String */
 	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 
-	regExpr = Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
-	if (regExpr == NULL) {
-	    match = -1;
-	} else {
+	/*
+	 * Compile and match the regular expression.
+	 */
+
+	{
+	    Tcl_RegExp regExpr =
+		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
+
+	    if (regExpr == NULL) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
 	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
+	    if (match < 0) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
 	}
 
+	TRACE_APPEND(("%d\n", match));
+
 	/*
-	 * Adjustment is 2 due to the nocase byte
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 * Adjustment is 2 due to the nocase byte.
 	 */
 
-	if (match < 0) {
-	    objResultPtr = Tcl_GetObjResult(interp);
-	    TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
-		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-	    result = TCL_ERROR;
-	    goto checkForCatch;
-	} else {
-	    TRACE(("%.20s %.20s => %d\n",
-		    O2S(valuePtr), O2S(value2Ptr), match));
-	    objResultPtr = constants[match];
-	    NEXT_INST_F(2, 2, 1);
-	}
+	JUMP_PEEPHOLE_F(match, 2, 2);
     }
 
+    /*
+     *	   End of string-related instructions.
+     * -----------------------------------------------------------------
+     *	   Start of numeric operator instructions.
+     */
+
+    {
+	ClientData ptr1, ptr2;
+	int type1, type2;
+	long l1, l2, lResult;
+
+    case INST_NUM_TYPE:
+	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
+	    type1 = 0;
+	} else if (type1 == TCL_NUMBER_LONG) {
+	    /* value is between LONG_MIN and LONG_MAX */
+	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
+	    int i;
+
+	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+		type1 = TCL_NUMBER_WIDE;
+	    }
+#ifndef TCL_WIDE_INT_IS_LONG
+	} else if (type1 == TCL_NUMBER_WIDE) {
+	    /* value is between WIDE_MIN and WIDE_MAX */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    int i;
+	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
+		type1 = TCL_NUMBER_LONG;
+	    }
+#endif
+	} else if (type1 == TCL_NUMBER_BIG) {
+	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    Tcl_WideInt w;
+
+	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+		type1 = TCL_NUMBER_WIDE;
+	    }
+	}
+	TclNewIntObj(objResultPtr, type1);
+	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
+	NEXT_INST_F(1, 1, 1);
+
     case INST_EQ:
     case INST_NEQ:
     case INST_LT:
     case INST_GT:
     case INST_LE:
     case INST_GE: {
-	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
-	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
-	ClientData ptr1, ptr2;
-	int iResult = 0, compare = 0, type1, type2;
-	double d1, d2, tmp;
-	long l1, l2;
-	mp_int big1, big2;
-#ifndef NO_WIDE_TYPE
-	Tcl_WideInt w1, w2;
-#endif
+	int iResult = 0, compare = 0;
+
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
 	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
 		|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
@@ -4512,222 +6144,12 @@ TclExecuteByteCode(
 	    compare = MP_EQ;
 	    goto convertComparison;
 	}
-	switch (type1) {
-	case TCL_NUMBER_LONG:
+	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
 	    l1 = *((const long *)ptr1);
-	    switch (type2) {
-	    case TCL_NUMBER_LONG:
-		l2 = *((const long *)ptr2);
-	    longCompare:
-		compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
-		break;
-#ifndef NO_WIDE_TYPE
-	    case TCL_NUMBER_WIDE:
-		w2 = *((const Tcl_WideInt *)ptr2);
-		w1 = (Tcl_WideInt)l1;
-		goto wideCompare;
-#endif
-	    case TCL_NUMBER_DOUBLE:
-		d2 = *((const double *)ptr2);
-		d1 = (double) l1;
-
-		/*
-		 * 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) {
-		    compare = MP_GT;
-		    break;
-		}
-		if (d2 > (double)LONG_MAX) {
-		    compare = MP_LT;
-		    break;
-		}
-		l2 = (long) d2;
-		goto longCompare;
-	    case TCL_NUMBER_BIG:
-		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-		if (mp_cmp_d(&big2, 0) == MP_LT) {
-		    compare = MP_GT;
-		} else {
-		    compare = MP_LT;
-		}
-		mp_clear(&big2);
-	    }
-	    break;
-
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE:
-	    w1 = *((const Tcl_WideInt *)ptr1);
-	    switch (type2) {
-	    case TCL_NUMBER_WIDE:
-		w2 = *((const Tcl_WideInt *)ptr2);
-	    wideCompare:
-		compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
-		break;
-	    case TCL_NUMBER_LONG:
-		l2 = *((const long *)ptr2);
-		w2 = (Tcl_WideInt)l2;
-		goto wideCompare;
-	    case TCL_NUMBER_DOUBLE:
-		d2 = *((const double *)ptr2);
-		d1 = (double) w1;
-		if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
-			|| w1 == (Tcl_WideInt) d1
-			|| modf(d2, &tmp) != 0.0) {
-		    goto doubleCompare;
-		}
-		if (d2 < (double)LLONG_MIN) {
-		    compare = MP_GT;
-		    break;
-		}
-		if (d2 > (double)LLONG_MAX) {
-		    compare = MP_LT;
-		    break;
-		}
-		w2 = (Tcl_WideInt) d2;
-		goto wideCompare;
-	    case TCL_NUMBER_BIG:
-		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-		if (mp_cmp_d(&big2, 0) == MP_LT) {
-		    compare = MP_GT;
-		} else {
-		    compare = MP_LT;
-		}
-		mp_clear(&big2);
-	    }
-	    break;
-#endif
-
-	case TCL_NUMBER_DOUBLE:
-	    d1 = *((const double *)ptr1);
-	    switch (type2) {
-	    case TCL_NUMBER_DOUBLE:
-		d2 = *((const double *)ptr2);
-	    doubleCompare:
-		compare = (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
-		break;
-	    case TCL_NUMBER_LONG:
-		l2 = *((const long *)ptr2);
-		d2 = (double) l2;
-		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
-			|| l2 == (long) d2
-			|| modf(d1, &tmp) != 0.0) {
-		    goto doubleCompare;
-		}
-		if (d1 < (double)LONG_MIN) {
-		    compare = MP_LT;
-		    break;
-		}
-		if (d1 > (double)LONG_MAX) {
-		    compare = MP_GT;
-		    break;
-		}
-		l1 = (long) d1;
-		goto longCompare;
-#ifndef NO_WIDE_TYPE
-	    case TCL_NUMBER_WIDE:
-		w2 = *((const Tcl_WideInt *)ptr2);
-		d2 = (double) w2;
-		if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
-			|| w2 == (Tcl_WideInt) d2
-			|| modf(d1, &tmp) != 0.0) {
-		    goto doubleCompare;
-		}
-		if (d1 < (double)LLONG_MIN) {
-		    compare = MP_LT;
-		    break;
-		}
-		if (d1 > (double)LLONG_MAX) {
-		    compare = MP_GT;
-		    break;
-		}
-		w1 = (Tcl_WideInt) d1;
-		goto wideCompare;
-#endif
-	    case TCL_NUMBER_BIG:
-		if (TclIsInfinite(d1)) {
-		    compare = (d1 > 0.0) ? MP_GT : MP_LT;
-		    break;
-		}
-		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-		if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
-		    if (mp_cmp_d(&big2, 0) == MP_LT) {
-			compare = MP_GT;
-		    } else {
-			compare = MP_LT;
-		    }
-		    mp_clear(&big2);
-		    break;
-		}
-		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
-			&& modf(d1, &tmp) != 0.0) {
-		    d2 = TclBignumToDouble(&big2);
-		    mp_clear(&big2);
-		    goto doubleCompare;
-		}
-		Tcl_InitBignumFromDouble(NULL, d1, &big1);
-		goto bigCompare;
-	    }
-	    break;
-
-	case TCL_NUMBER_BIG:
-	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-	    switch (type2) {
-#ifndef NO_WIDE_TYPE
-	    case TCL_NUMBER_WIDE:
-#endif
-	    case TCL_NUMBER_LONG:
-		compare = mp_cmp_d(&big1, 0);
-		mp_clear(&big1);
-		break;
-	    case TCL_NUMBER_DOUBLE:
-		d2 = *((const double *)ptr2);
-		if (TclIsInfinite(d2)) {
-		    compare = (d2 > 0.0) ? MP_LT : MP_GT;
-		    mp_clear(&big1);
-		    break;
-		}
-		if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
-		    compare = mp_cmp_d(&big1, 0);
-		    mp_clear(&big1);
-		    break;
-		}
-		if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
-			&& modf(d2, &tmp) != 0.0) {
-		    d1 = TclBignumToDouble(&big1);
-		    mp_clear(&big1);
-		    goto doubleCompare;
-		}
-		Tcl_InitBignumFromDouble(NULL, d2, &big2);
-		goto bigCompare;
-	    case TCL_NUMBER_BIG:
-		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	    bigCompare:
-		compare = mp_cmp(&big1, &big2);
-		mp_clear(&big1);
-		mp_clear(&big2);
-	    }
+	    l2 = *((const long *)ptr2);
+	    compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+	} else {
+	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
 	}
 
 	/*
@@ -4761,758 +6183,256 @@ TclExecuteByteCode(
 	 */
 
     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);
-	}
-#endif
-	objResultPtr = constants[iResult];
-	NEXT_INST_F(0, 2, 1);
+	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+		iResult));
+	JUMP_PEEPHOLE_F(iResult, 1, 2);
     }
 
     case INST_MOD:
     case INST_LSHIFT:
-    case INST_RSHIFT: {
-	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
-	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
-	ClientData ptr1, ptr2;
-	int invalid, shift, type1, type2;
-	long l1 = 0;
+    case INST_RSHIFT:
+    case INST_BITOR:
+    case INST_BITXOR:
+    case INST_BITAND:
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
-	result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
-	if ((result != TCL_OK) || (type1 == TCL_NUMBER_DOUBLE)
-		|| (type1 == TCL_NUMBER_NAN)) {
-	    result = TCL_ERROR;
+	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 checkForCatch;
+	    goto gotError;
 	}
 
-	result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
-	if ((result != TCL_OK) || (type2 == TCL_NUMBER_DOUBLE)
-		|| (type2 == TCL_NUMBER_NAN)) {
-	    result = TCL_ERROR;
+	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 checkForCatch;
+	    goto gotError;
 	}
 
-	if (*pc == INST_MOD) {
-	    /* TODO: Attempts to re-use unshared operands on stack */
+	/*
+	 * Check for common, simple case.
+	 */
 
-	    long l2 = 0;	/* silence gcc warning */
+	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	    l1 = *((const long *)ptr1);
+	    l2 = *((const long *)ptr2);
 
-	    if (type2 == TCL_NUMBER_LONG) {
-		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;
-		}
-		if ((l2 == 1) || (l2 == -1)) {
+		} else if ((l2 == 1) || (l2 == -1)) {
 		    /*
 		     * Div. by |1| always yields remainder of 0.
 		     */
 
-		    objResultPtr = constants[0];
+		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		    objResultPtr = TCONST(0);
 		    TRACE(("%s\n", O2S(objResultPtr)));
 		    NEXT_INST_F(1, 2, 1);
-		}
-	    }
-	    if (type1 == TCL_NUMBER_LONG) {
-		l1 = *((const long *)ptr1);
-		if (l1 == 0) {
+		} else if (l1 == 0) {
 		    /*
 		     * 0 % (non-zero) always yields remainder of 0.
 		     */
 
-		    objResultPtr = constants[0];
+		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		    objResultPtr = TCONST(0);
 		    TRACE(("%s\n", O2S(objResultPtr)));
 		    NEXT_INST_F(1, 2, 1);
-		}
-		if (type2 == TCL_NUMBER_LONG) {
-		    /*
-		     * Both operands are long; do native calculation.
-		     */
-
-		    long lRemainder, lQuotient = l1 / l2;
+		} else {
+		    lResult = l1 / l2;
 
 		    /*
 		     * Force Tcl's integer division rules.
 		     * TODO: examine for logic simplification
 		     */
 
-		    if ((lQuotient < 0 || (lQuotient == 0 &&
+		    if ((lResult < 0 || (lResult == 0 &&
 			    ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
-			    (lQuotient * l2 != l1)) {
-			lQuotient -= 1;
+			    (lResult * l2 != l1)) {
+			lResult -= 1;
 		    }
-		    lRemainder = l1 - l2*lQuotient;
-		    TclNewLongObj(objResultPtr, lRemainder);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
+		    lResult = l1 - l2*lResult;
+		    goto longResultOfArithmetic;
 		}
 
-		/*
-		 * First operand fits in long; second does not, so the second
-		 * has greater magnitude than first. No need to divide to
-		 * determine the remainder.
-		 */
-
-#ifndef NO_WIDE_TYPE
-		if (type2 == TCL_NUMBER_WIDE) {
-		    Tcl_WideInt w2 = *((const Tcl_WideInt *)ptr2);
-
-		    if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) {
-			/*
-			 * Arguments are opposite sign; remainder is sum.
-			 */
-
-			objResultPtr = Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1);
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-
+	    case INST_RSHIFT:
+		if (l2 < 0) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "negative shift argument", -1));
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
+		    DECACHE_STACK_INFO();
+		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+			    "domain error: argument not in valid range",
+			    NULL);
+		    CACHE_STACK_INFO();
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
+		    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 {
 		    /*
-		     * Arguments are same sign; remainder is first operand.
+		     * Quickly force large right shifts to 0 or -1.
 		     */
 
-		    TRACE(("%s\n", O2S(valuePtr)));
-		    NEXT_INST_F(1, 1, 0);
-		}
-#endif
-		{
-		    mp_int big2;
-
-		    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-
-		    /* TODO: internals intrusion */
-		    if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
+		    if (l2 >= (long)(CHAR_BIT*sizeof(long))) {
 			/*
-			 * Arguments are opposite sign; remainder is sum.
+			 * 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...
 			 */
 
-			mp_int big1;
-
-			TclBNInitBignumFromLong(&big1, l1);
-			mp_add(&big2, &big1, &big2);
-			mp_clear(&big1);
-			objResultPtr = Tcl_NewBignumObj(&big2);
+			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);
 		    }
 
 		    /*
-		     * Arguments are same sign; remainder is first operand.
+		     * Handle shifts within the native long range.
 		     */
 
-		    mp_clear(&big2);
-		    TRACE(("%s\n", O2S(valuePtr)));
-		    NEXT_INST_F(1, 1, 0);
+		    lResult = l1 >> ((int) l2);
+		    goto longResultOfArithmetic;
 		}
-	    }
-#ifndef NO_WIDE_TYPE
-	    if (type1 == TCL_NUMBER_WIDE) {
-		Tcl_WideInt w1 = *((const Tcl_WideInt *)ptr1);
-
-		if (type2 != TCL_NUMBER_BIG) {
-		    Tcl_WideInt w2, wQuotient, wRemainder;
 
-		    Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
-		    wQuotient = w1 / w2;
-
-		    /*
-		     * Force Tcl's integer division rules.
-		     * TODO: examine for logic simplification
-		     */
-
-		    if (((wQuotient < (Tcl_WideInt) 0)
-			    || ((wQuotient == (Tcl_WideInt) 0)
-			    && ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
-			    || (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
-			    && (wQuotient * w2 != w1)) {
-			wQuotient -= (Tcl_WideInt) 1;
-		    }
-		    wRemainder = w1 - w2*wQuotient;
-		    objResultPtr = Tcl_NewWideIntObj(wRemainder);
+	    case INST_LSHIFT:
+		if (l2 < 0) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "negative shift argument", -1));
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
+		    DECACHE_STACK_INFO();
+		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+			    "domain error: argument not in valid range",
+			    NULL);
+		    CACHE_STACK_INFO();
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
+		    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);
-		}
-		{
-		    mp_int big2;
-		    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-
-		    /* TODO: internals intrusion */
-		    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
-			/*
-			 * Arguments are opposite sign; remainder is sum.
-			 */
-
-			mp_int big1;
-
-			TclBNInitBignumFromWideInt(&big1, w1);
-			mp_add(&big2, &big1, &big2);
-			mp_clear(&big1);
-			objResultPtr = Tcl_NewBignumObj(&big2);
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-
-		    /*
-		     * Arguments are same sign; remainder is first operand.
-		     */
-
-		    mp_clear(&big2);
-		    TRACE(("%s\n", O2S(valuePtr)));
-		    NEXT_INST_F(1, 1, 0);
-		}
-	    }
-#endif
-	    {
-		mp_int big1, big2, bigResult, bigRemainder;
-
-		Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
-		Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
-		mp_init(&bigResult);
-		mp_init(&bigRemainder);
-		mp_div(&big1, &big2, &bigResult, &bigRemainder);
-		if (!mp_iszero(&bigRemainder)
-			&& (bigRemainder.sign != big2.sign)) {
+		} else if (l2 > (long) INT_MAX) {
 		    /*
-		     * Convert to Tcl's integer division rules.
+		     * 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.
 		     */
 
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    mp_add(&bigRemainder, &big2, &bigRemainder);
-		}
-		mp_copy(&bigRemainder, &bigResult);
-		mp_clear(&bigRemainder);
-		mp_clear(&big1);
-		mp_clear(&big2);
-		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		if (Tcl_IsShared(valuePtr)) {
-		    objResultPtr = Tcl_NewBignumObj(&bigResult);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
-		}
-		Tcl_SetBignumObj(valuePtr, &bigResult);
-		TRACE(("%s\n", O2S(valuePtr)));
-		NEXT_INST_F(1, 1, 0);
-	    }
-	}
-
-	/*
-	 * Reject negative shift argument.
-	 */
-
-	switch (type2) {
-	case TCL_NUMBER_LONG:
-	    invalid = (*((const long *)ptr2) < (long)0);
-	    break;
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE:
-	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
-	    break;
-#endif
-	case TCL_NUMBER_BIG: {
-	    mp_int big2;
-
-	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	    invalid = (mp_cmp_d(&big2, 0) == MP_LT);
-	    mp_clear(&big2);
-	    break;
-	}
-	default:
-	    /* Unused, here to silence compiler warning */
-	    invalid = 0;
-	}
-	if (invalid) {
-	    Tcl_SetObjResult(interp,
-		    Tcl_NewStringObj("negative shift argument", -1));
-	    result = TCL_ERROR;
-	    goto checkForCatch;
-	}
-
-	/*
-	 * Zero shifted any number of bits is still zero.
-	 */
-
-	if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    objResultPtr = constants[0];
-	    TRACE(("%s\n", O2S(objResultPtr)));
-	    NEXT_INST_F(1, 2, 1);
-	}
-
-	if (*pc == INST_LSHIFT) {
-	    /*
-	     * 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_SetObjResult(interp, Tcl_NewStringObj(
-			"integer value too large to represent", -1));
-		result = TCL_ERROR;
-		goto checkForCatch;
-	    }
-	    shift = (int)(*((const long *)ptr2));
-
-	    /*
-	     * Handle shifts within the native long range.
-	     */
-
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if ((type1 == TCL_NUMBER_LONG)
-		    && (size_t) shift < CHAR_BIT*sizeof(long)
-		    && ((l1 = *(const long *)ptr1) != 0)
-		    && !((l1>0 ? l1 : ~l1)
-			    & -(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
-		TclNewLongObj(objResultPtr, (l1<<shift));
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-
-	    /*
-	     * Handle shifts within the native wide range.
-	     */
-
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if ((type1 != TCL_NUMBER_BIG)
-		    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
-		Tcl_WideInt w;
-
-		TclGetWideIntFromObj(NULL, valuePtr, &w);
-		if (!((w>0 ? w : ~w)
-			& -(((Tcl_WideInt)1)
-			<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
-		    objResultPtr = Tcl_NewWideIntObj(w<<shift);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
-		}
-	    }
-	} else {
-	    /*
-	     * Quickly force large right shifts to 0 or -1.
-	     */
-
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if ((type2 != TCL_NUMBER_LONG)
-		    || (*(const long *)ptr2 > INT_MAX)) {
-		/*
-		 * Again, technically, the value to be shifted could be an
-		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
-		 * not take us to the result of 0 or -1, but since we're using
-		 * mp_div_2d to do the work, and it takes only an int
-		 * argument, we draw the line there.
-		 */
-
-		int zero;
-
-		switch (type1) {
-		case TCL_NUMBER_LONG:
-		    zero = (*(const long *)ptr1 > 0L);
-		    break;
-#ifndef NO_WIDE_TYPE
-		case TCL_NUMBER_WIDE:
-		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
-		    break;
-#endif
-		case TCL_NUMBER_BIG: {
-		    mp_int big1;
-		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-		    zero = (mp_cmp_d(&big1, 0) == MP_GT);
-		    mp_clear(&big1);
-		    break;
-		}
-		default:
-		    /* Unused, here to silence compiler warning. */
-		    zero = 0;
-		}
-		if (zero) {
-		    objResultPtr = constants[0];
-		} else {
-		    TclNewIntObj(objResultPtr, -1);
-		}
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-	    shift = (int)(*(const long *)ptr2);
-
-	    /*
-	     * Handle shifts within the native long range.
-	     */
-
-	    if (type1 == TCL_NUMBER_LONG) {
-		l1 = *((const long *)ptr1);
-		if ((size_t)shift >= CHAR_BIT*sizeof(long)) {
-		    if (l1 >= (long)0) {
-			objResultPtr = constants[0];
-		    } else {
-			TclNewIntObj(objResultPtr, -1);
-		    }
-		} else {
-		    TclNewLongObj(objResultPtr, (l1 >> shift));
-		}
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-
-#ifndef NO_WIDE_TYPE
-	    /*
-	     * Handle shifts within the native wide range.
-	     */
-
-	    if (type1 == TCL_NUMBER_WIDE) {
-		Tcl_WideInt w = *(const Tcl_WideInt *)ptr1;
-
-		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
-		    if (w >= (Tcl_WideInt)0) {
-			objResultPtr = constants[0];
-		    } else {
-			TclNewIntObj(objResultPtr, -1);
-		    }
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "integer value too large to represent", -1));
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
+		    DECACHE_STACK_INFO();
+		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+			    "integer value too large to represent", NULL);
+		    CACHE_STACK_INFO();
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
+		    goto gotError;
 		} else {
-		    objResultPtr = Tcl_NewWideIntObj(w >> shift);
-		}
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-#endif
-	}
-
-	{
-	    mp_int big, bigResult, bigRemainder;
+		    int shift = (int) l2;
 
-	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
-
-	    mp_init(&bigResult);
-	    if (*pc == INST_LSHIFT) {
-		mp_mul_2d(&big, shift, &bigResult);
-	    } else {
-		mp_init(&bigRemainder);
-		mp_div_2d(&big, shift, &bigResult, &bigRemainder);
-		if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
 		    /*
-		     * Convert to Tcl's integer division rules.
+		     * Handle shifts within the native long range.
 		     */
 
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		}
-		mp_clear(&bigRemainder);
-	    }
-	    mp_clear(&big);
-
-	    if (!Tcl_IsShared(valuePtr)) {
-		Tcl_SetBignumObj(valuePtr, &bigResult);
-		TRACE(("%s\n", O2S(valuePtr)));
-		NEXT_INST_F(1, 1, 0);
-	    }
-	    objResultPtr = Tcl_NewBignumObj(&bigResult);
-	}
-	TRACE(("%s\n", O2S(objResultPtr)));
-	NEXT_INST_F(1, 2, 1);
-    }
-
-    case INST_BITOR:
-    case INST_BITXOR:
-    case INST_BITAND: {
-	ClientData ptr1, ptr2;
-	int type1, type2;
-	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
-	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
-
-	result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
-	if ((result != TCL_OK)
-		|| (type1 == TCL_NUMBER_NAN)
-		|| (type1 == TCL_NUMBER_DOUBLE)) {
-	    result = TCL_ERROR;
-	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
-		    O2S(value2Ptr), (valuePtr->typePtr?
-		    valuePtr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
-	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();
-	    goto checkForCatch;
-	}
-	result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
-	if ((result != TCL_OK) || (type2 == TCL_NUMBER_NAN)
-		|| (type2 == TCL_NUMBER_DOUBLE)) {
-	    result = TCL_ERROR;
-	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
-		    O2S(value2Ptr), (value2Ptr->typePtr?
-		    value2Ptr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
-	    IllegalExprOperandType(interp, pc, value2Ptr);
-	    CACHE_STACK_INFO();
-	    goto checkForCatch;
-	}
-
-	if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
-	    mp_int big1, big2, bigResult, *First, *Second;
-	    int numPos;
-
-	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-
-	    /*
-	     * 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 (*pc) {
-	    case INST_BITAND:
-		switch (numPos) {
-		case 2:
-		    /*
-		     * Both arguments positive, base case.
-		     */
-
-		    mp_and(First, Second, &bigResult);
-		    break;
-		case 1:
-		    /*
-		     * First is positive; second negative:
-		     * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
-		     */
-
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_xor(First, Second, &bigResult);
-		    mp_and(First, &bigResult, &bigResult);
-		    break;
-		case 0:
-		    /*
-		     * Both arguments negative:
-		     * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
-		     */
-
-		    mp_neg(First, First);
-		    mp_sub_d(First, 1, First);
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_or(First, Second, &bigResult);
-		    mp_neg(&bigResult, &bigResult);
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    break;
-		}
-		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;
+		    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;
+		    }
 		}
-		break;
-	    }
-
-	    mp_clear(&big1);
-	    mp_clear(&big2);
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewBignumObj(&bigResult);
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-	    Tcl_SetBignumObj(valuePtr, &bigResult);
-	    TRACE(("%s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 1, 0);
-	}
-
-#ifndef NO_WIDE_TYPE
-	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
-	    Tcl_WideInt wResult, w1, w2;
 
-	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
-	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+		/*
+		 * Too large; need to use the broken-out function.
+		 */
 
-	    switch (*pc) {
-	    case INST_BITAND:
-		wResult = w1 & w2;
-		break;
-	    case INST_BITOR:
-		wResult = w1 | w2;
-		break;
-	    case INST_BITXOR:
-		wResult = w1 ^ w2;
+		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
 		break;
-	    default:
-		/* Unused, here to silence compiler warning. */
-		wResult = 0;
-	    }
 
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewWideIntObj(wResult);
-		TRACE(("%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);
-	}
-#endif
-	{
-	    long lResult, l1 = *((const long *)ptr1);
-	    long l2 = *((const long *)ptr2);
-
-	    switch (*pc) {
 	    case INST_BITAND:
 		lResult = l1 & l2;
-		break;
+		goto longResultOfArithmetic;
 	    case INST_BITOR:
 		lResult = l1 | l2;
-		break;
+		goto longResultOfArithmetic;
 	    case INST_BITXOR:
 		lResult = l1 ^ l2;
-		break;
-	    default:
-		/* Unused, here to silence compiler warning. */
-		lResult = 0;
+	    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);
+		}
+		TclSetLongObj(valuePtr, lResult);
+		TRACE(("%s\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 1, 0);
 	    }
+	}
 
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if (Tcl_IsShared(valuePtr)) {
-		TclNewLongObj(objResultPtr, lResult);
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-	    TclSetLongObj(valuePtr, lResult);
-	    TRACE(("%s\n", O2S(valuePtr)));
+	/*
+	 * 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.
+	 */
+
+	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_ERROR(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)));
+	    NEXT_INST_F(1, 2, 1);
 	}
-    }
 
     case INST_EXPON:
     case INST_ADD:
     case INST_SUB:
     case INST_DIV:
-    case INST_MULT: {
-	ClientData ptr1, ptr2;
-	int type1, type2;
-	Tcl_Obj *value2Ptr = OBJ_AT_TOS;
-	Tcl_Obj *valuePtr = OBJ_UNDER_TOS;
+    case INST_MULT:
+	value2Ptr = OBJ_AT_TOS;
+	valuePtr = OBJ_UNDER_TOS;
 
-	result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
-	if ((result != TCL_OK)
-#ifndef ACCEPT_NAN
-		|| (type1 == TCL_NUMBER_NAN)
-#endif
-		) {
-	    result = TCL_ERROR;
+	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 checkForCatch;
+	    goto gotError;
 	}
 
 #ifdef ACCEPT_NAN
@@ -5525,20 +6445,15 @@ TclExecuteByteCode(
 	}
 #endif
 
-	result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
-	if ((result != TCL_OK)
-#ifndef ACCEPT_NAN
-		|| (type2 == TCL_NUMBER_NAN)
-#endif
-		) {
-	    result = TCL_ERROR;
+	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 checkForCatch;
+	    goto gotError;
 	}
 
 #ifdef ACCEPT_NAN
@@ -5552,917 +6467,260 @@ TclExecuteByteCode(
 	}
 #endif
 
-	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
-	    /*
-	     * At least one of the values is floating-point, so perform
-	     * floating point calculations.
-	     */
+	/*
+	 * Handle (long,long) arithmetic as best we can without going out to
+	 * an external function.
+	 */
 
-	    double d1, d2, dResult;
+	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	    Tcl_WideInt w1, w2, wResult;
 
-	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
-	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
+	    l1 = *((const long *)ptr1);
+	    l2 = *((const long *)ptr2);
 
 	    switch (*pc) {
 	    case INST_ADD:
-		dResult = d1 + d2;
-		break;
-	    case INST_SUB:
-		dResult = d1 - d2;
-		break;
-	    case INST_MULT:
-		dResult = d1 * d2;
-		break;
-	    case INST_DIV:
-#ifndef IEEE_FLOATING_POINT
-		if (d2 == 0.0) {
-		    TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
-		    goto divideByZero;
-		}
-#endif
+		w1 = (Tcl_WideInt) l1;
+		w2 = (Tcl_WideInt) l2;
+		wResult = w1 + w2;
+#ifdef TCL_WIDE_INT_IS_LONG
 		/*
-		 * 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.
+		 * Check for overflow.
 		 */
 
-		dResult = d1 / d2;
-		break;
-	    case INST_EXPON:
-		if (d1==0.0 && d2<0.0) {
-		    TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
-		    goto exponOfZero;
-		}
-		dResult = pow(d1, d2);
-		break;
-	    default:
-		/* Unused, here to silence compiler warning. */
-		dResult = 0;
-	    }
-
-#ifndef ACCEPT_NAN
-	    /*
-	     * Check now for IEEE floating-point error.
-	     */
-
-	    if (TclIsNaN(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;
-	    }
-#endif
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if (Tcl_IsShared(valuePtr)) {
-		TclNewDoubleObj(objResultPtr, dResult);
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-	    TclSetDoubleObj(valuePtr, dResult);
-	    TRACE(("%s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 1, 0);
-	}
-
-	if ((sizeof(long) >= 2*sizeof(int)) && (*pc == INST_MULT)
-		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
-	    long l1 = *((const long *)ptr1);
-	    long l2 = *((const long *)ptr2);
-
-	    if ((l1 <= INT_MAX) && (l1 >= INT_MIN)
-		    && (l2 <= INT_MAX) && (l2 >= INT_MIN)) {
-		long lResult = l1 * l2;
-
-		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		if (Tcl_IsShared(valuePtr)) {
-		    TclNewLongObj(objResultPtr,lResult);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
-		}
-		TclSetLongObj(valuePtr, lResult);
-		TRACE(("%s\n", O2S(valuePtr)));
-		NEXT_INST_F(1, 1, 0);
-	    }
-	}
-
-	if ((sizeof(Tcl_WideInt) >= 2*sizeof(long)) && (*pc == INST_MULT)
-		&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
-	    Tcl_WideInt w1, w2, wResult;
-	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
-	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
-
-	    wResult = w1 * w2;
-
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewWideIntObj(wResult);
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-	    Tcl_SetWideIntObj(valuePtr, wResult);
-	    TRACE(("%s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 1, 0);
-	}
-
-	/* TODO: Attempts to re-use unshared operands on stack. */
-	if (*pc == INST_EXPON) {
-	    long l1 = 0, l2 = 0;
-	    int oddExponent = 0, negativeExponent = 0;
-#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
-	    Tcl_WideInt w1;
-#endif
-
-	    if (type2 == TCL_NUMBER_LONG) {
-		l2 = *((const long *) ptr2);
-		if (l2 == 0) {
-		    /*
-		     * Anything to the zero power is 1.
-		     */
-
-		    objResultPtr = constants[1];
-		    NEXT_INST_F(1, 2, 1);
-		} else if (l2 == 1) {
-		    /*
-		     * Anything to the first power is itself
-		     */
-		    NEXT_INST_F(1, 1, 0);
+		if (Overflowing(w1, w2, wResult)) {
+		    goto overflow;
 		}
-	    }
-
-	    switch (type2) {
-	    case TCL_NUMBER_LONG: {
-		negativeExponent = (l2 < 0);
-		oddExponent = (int) (l2 & 1);
-		break;
-	    }
-#ifndef NO_WIDE_TYPE
-	    case TCL_NUMBER_WIDE: {
-		Tcl_WideInt w2 = *((const Tcl_WideInt *)ptr2);
-
-		negativeExponent = (w2 < 0);
-		oddExponent = (int) (w2 & (Tcl_WideInt)1);
-		break;
-	    }
 #endif
-	    case TCL_NUMBER_BIG: {
-		mp_int big2;
-
-		Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-		negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
-		mp_mod_2d(&big2, 1, &big2);
-		oddExponent = !mp_iszero(&big2);
-		mp_clear(&big2);
-		break;
-	    }
-	    }
-
-	    if (type1 == TCL_NUMBER_LONG) {
-		l1 = *((const long *)ptr1);
-	    }
-	    if (negativeExponent) {
-		if (type1 == TCL_NUMBER_LONG) {
-		    switch (l1) {
-		    case 0:
-			/*
-			 * Zero to a negative power is div by zero error.
-			 */
-
-			TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr),
-				O2S(value2Ptr)));
-			goto exponOfZero;
-		    case -1:
-			if (oddExponent) {
-			    TclNewIntObj(objResultPtr, -1);
-			} else {
-			    objResultPtr = constants[1];
-			}
-			NEXT_INST_F(1, 2, 1);
-		    case 1:
-			/*
-			 * 1 to any power is 1.
-			 */
-
-			objResultPtr = constants[1];
-			NEXT_INST_F(1, 2, 1);
-		    }
-		}
+		goto wideResultOfArithmetic;
 
+	    case INST_SUB:
+		w1 = (Tcl_WideInt) l1;
+		w2 = (Tcl_WideInt) l2;
+		wResult = w1 - w2;
+#ifdef TCL_WIDE_INT_IS_LONG
 		/*
-		 * Integers with magnitude greater than 1 raise to a negative
-		 * power yield the answer zero (see TIP 123).
+		 * Must check for overflow. The macro tests for overflows in
+		 * sums by looking at the sign bits. As we have a subtraction
+		 * here, we are adding -w2. As -w2 could in turn overflow, we
+		 * test with ~w2 instead: it has the opposite sign bit to w2
+		 * so it does the job. Note that the only "bad" case (w2==0)
+		 * is irrelevant for this macro, as in that case w1 and
+		 * wResult have the same sign and there is no overflow anyway.
 		 */
 
-		objResultPtr = constants[0];
-		NEXT_INST_F(1, 2, 1);
-	    }
-
-	    if (type1 == TCL_NUMBER_LONG) {
-		switch (l1) {
-		case 0:
-		    /*
-		     * Zero to a positive power is zero.
-		     */
-
-		    objResultPtr = constants[0];
-		    NEXT_INST_F(1, 2, 1);
-		case 1:
-		    /*
-		     * 1 to any power is 1.
-		     */
-
-		    objResultPtr = constants[1];
-		    NEXT_INST_F(1, 2, 1);
-		case -1:
-		    if (oddExponent) {
-			TclNewIntObj(objResultPtr, -1);
-		    } else {
-			objResultPtr = constants[1];
-		    }
-		    NEXT_INST_F(1, 2, 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_SetObjResult(interp,
-			Tcl_NewStringObj("exponent too large", -1));
-		result = TCL_ERROR;
-		goto checkForCatch;
-	    }
-
-	    if (type1 == TCL_NUMBER_LONG) {
-		if (l1 == 2) {
-		    /*
-		     * Reduce small powers of 2 to shifts.
-		     */
-
-		    if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			TclNewLongObj(objResultPtr, (1L << l2));
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-#if !defined(TCL_WIDE_INT_IS_LONG)
-		    if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			objResultPtr =
-				Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2);
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-#endif
+		if (Overflowing(w1, ~w2, wResult)) {
 		    goto overflow;
 		}
-		if (l1 == -2) {
-		    int signum = oddExponent ? -1 : 1;
-
-		    /*
-		     * Reduce small powers of 2 to shifts.
-		     */
-
-		    if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			TclNewLongObj(objResultPtr, signum * (1L << l2));
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-#if !defined(TCL_WIDE_INT_IS_LONG)
-		    if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			objResultPtr = Tcl_NewWideIntObj(
-				signum * (((Tcl_WideInt) 1) << l2));
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
 #endif
-		    goto overflow;
-		}
-#if (LONG_MAX == 0x7fffffff)
-		if (l2 - 2 < (long)MaxBase32Size
-			&& l1 <=  MaxBase32[l2 - 2]
-			&& l1 >= -MaxBase32[l2 - 2]) {
-		    /*
-		     * Small powers of 32-bit integers.
-		     */
-
-		    long lResult = l1 * l1;	/* b**2 */
-		    switch (l2) {
-		    case 2:
-			break;
-		    case 3:
-			lResult *= l1;		/* b**3 */
-			break;
-		    case 4:
-			lResult *= lResult;	/* b**4 */
-			break;
-		    case 5:
-			lResult *= lResult;	/* b**4 */
-			lResult *= l1;		/* b**5 */
-			break;
-		    case 6:
-			lResult *= l1;		/* b**3 */
-			lResult *= lResult;	/* b**6 */
-			break;
-		    case 7:
-			lResult *= l1;		/* b**3 */
-			lResult *= lResult;	/* b**6 */
-			lResult *= l1;		/* b**7 */
-			break;
-		    case 8:
-			lResult *= lResult;	/* b**4 */
-			lResult *= lResult;	/* b**8 */
-			break;
-		    }
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    if (Tcl_IsShared(valuePtr)) {
-			TclNewLongObj(objResultPtr, lResult);
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-		    Tcl_SetLongObj(valuePtr, lResult);
-		    TRACE(("%s\n", O2S(valuePtr)));
-		    NEXT_INST_F(1, 1, 0);
-		}
-		if (l1 - 3 >= 0 && l1 - 2 < (long)Exp32IndexSize
-			&& l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
-
-		    unsigned short base = Exp32Index[l1 - 3]
-			    + (unsigned short) (l2 - 2 - MaxBase32Size);
-		    if (base < Exp32Index[l1 - 2]) {
-			/*
-			 * 32-bit number raised to intermediate power, done by
-			 * table lookup.
-			 */
-
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			if (Tcl_IsShared(valuePtr)) {
-			    TclNewLongObj(objResultPtr, Exp32Value[base]);
-			    TRACE(("%s\n", O2S(objResultPtr)));
-			    NEXT_INST_F(1, 2, 1);
-			}
-			Tcl_SetLongObj(valuePtr, Exp32Value[base]);
-			TRACE(("%s\n", O2S(valuePtr)));
-			NEXT_INST_F(1, 1, 0);
-		    }
-		}
-		if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
-			&& l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
-		    unsigned short base = Exp32Index[-l1 - 3]
-			    + (unsigned short) (l2 - 2 - MaxBase32Size);
-		    if (base < Exp32Index[-l1 - 2]) {
-			long lResult = (oddExponent) ?
-			    -Exp32Value[base] : Exp32Value[base];
-
-			/*
-			 * 32-bit number raised to intermediate power, done by
-			 * table lookup.
-			 */
-
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			if (Tcl_IsShared(valuePtr)) {
-			    TclNewLongObj(objResultPtr, lResult);
-			    TRACE(("%s\n", O2S(objResultPtr)));
-			    NEXT_INST_F(1, 2, 1);
-			}
-			Tcl_SetLongObj(valuePtr, lResult);
-			TRACE(("%s\n", O2S(valuePtr)));
-			NEXT_INST_F(1, 1, 0);
-		    }
-		}
-#endif
-	    }
-#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
-	    if (type1 == TCL_NUMBER_LONG) {
-		w1 = l1;
-#ifndef NO_WIDE_TYPE
-	    } else if (type1 == TCL_NUMBER_WIDE) {
-		w1 = *((const Tcl_WideInt*) ptr1);
-#endif
-	    } else {
-		goto overflow;
-	    }
-	    if (l2 - 2 < (long)MaxBase64Size
-		    && w1 <=  MaxBase64[l2 - 2]
-		    && w1 >= -MaxBase64[l2 - 2]) {
-		/*
-		 * Small powers of integers whose result is wide.
-		 */
-
-		Tcl_WideInt 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;
-
-		}
+	    wideResultOfArithmetic:
 		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		objResultPtr = Tcl_NewWideIntObj(wResult);
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-
-	    /*
-	     * Handle cases of powers > 16 that still fit in a 64-bit word by
-	     * doing table lookup.
-	     */
-	    if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
-		    && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
-		unsigned short base = Exp64Index[w1 - 3]
-			+ (unsigned short) (l2 - 2 - MaxBase64Size);
-
-		if (base < Exp64Index[w1 - 2]) {
-		    /*
-		     * 64-bit number raised to intermediate power, done by
-		     * table lookup.
-		     */
-
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    if (Tcl_IsShared(valuePtr)) {
-			objResultPtr = Tcl_NewWideIntObj(Exp64Value[base]);
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-		    Tcl_SetWideIntObj(valuePtr, Exp64Value[base]);
-		    TRACE(("%s\n", O2S(valuePtr)));
-		    NEXT_INST_F(1, 1, 0);
-		}
-	    }
-
-	    if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
-		    && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
-		unsigned short base = Exp64Index[-w1 - 3]
-			+ (unsigned short) (l2 - 2 - MaxBase64Size);
-
-		if (base < Exp64Index[-w1 - 2]) {
-		    Tcl_WideInt wResult = (oddExponent) ?
-			    -Exp64Value[base] : Exp64Value[base];
-		    /*
-		     * 64-bit number raised to intermediate power, done by
-		     * table lookup.
-		     */
-
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    if (Tcl_IsShared(valuePtr)) {
-			objResultPtr = Tcl_NewWideIntObj(wResult);
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-		    Tcl_SetWideIntObj(valuePtr, wResult);
-		    TRACE(("%s\n", O2S(valuePtr)));
-		    NEXT_INST_F(1, 1, 0);
-		}
-	    }
-#endif
-
-	    goto overflow;
-	}
-
-	if ((*pc != INST_MULT)
-		&& (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
-	    Tcl_WideInt w1, w2, wResult;
-
-	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
-	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
-
-	    switch (*pc) {
-	    case INST_ADD:
-		wResult = w1 + w2;
-#ifndef NO_WIDE_TYPE
-		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
-		{
-		    /*
-		     * Check for overflow.
-		     */
-
-		    if (Overflowing(w1, w2, wResult)) {
-			goto overflow;
-		    }
-		}
-		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 overflow;
-		    }
+		if (Tcl_IsShared(valuePtr)) {
+		    objResultPtr = Tcl_NewWideIntObj(wResult);
+		    TRACE(("%s\n", O2S(objResultPtr)));
+		    NEXT_INST_F(1, 2, 1);
 		}
-		break;
+		Tcl_SetWideIntObj(valuePtr, wResult);
+		TRACE(("%s\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 1, 0);
 
 	    case INST_DIV:
-		if (w2 == 0) {
+		if (l2 == 0) {
 		    TRACE(("%s %s => DIVIDE BY ZERO\n",
 			    O2S(valuePtr), O2S(value2Ptr)));
 		    goto divideByZero;
-		}
-
-		/*
-		 * Need a bignum to represent (LLONG_MIN / -1)
-		 */
+		} else if ((l1 == LONG_MIN) && (l2 == -1)) {
+		    /*
+		     * Can't represent (-LONG_MIN) as a long.
+		     */
 
-		if ((w1 == LLONG_MIN) && (w2 == -1)) {
 		    goto overflow;
 		}
-		wResult = w1 / w2;
+		lResult = l1 / l2;
 
 		/*
 		 * 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;
+		if (((lResult < 0) || ((lResult == 0) &&
+			((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
+			((lResult * l2) != l1)) {
+		    lResult -= 1;
 		}
-		break;
-	    default:
-		/*
-		 * Unused, here to silence compiler warning.
-		 */
+		goto longResultOfArithmetic;
 
-		wResult = 0;
+	    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;
+		}
 	    }
 
-	    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);
+	    /*
+	     * Fall through with INST_EXPON, INST_DIV and large multiplies.
+	     */
 	}
 
     overflow:
-	{
-	    mp_int big1, big2, bigResult, bigRemainder;
-
-	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	    mp_init(&bigResult);
-	    switch (*pc) {
-	    case INST_ADD:
-		mp_add(&big1, &big2, &bigResult);
-		break;
-	    case INST_SUB:
-		mp_sub(&big1, &big2, &bigResult);
-		break;
-	    case INST_MULT:
-		mp_mul(&big1, &big2, &bigResult);
-		break;
-	    case INST_DIV:
-		if (mp_iszero(&big2)) {
-		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
-			    O2S(value2Ptr)));
-		    mp_clear(&big1);
-		    mp_clear(&big2);
-		    mp_clear(&bigResult);
-		    goto divideByZero;
-		}
-		mp_init(&bigRemainder);
-		mp_div(&big1, &big2, &bigResult, &bigRemainder);
-		/* TODO: internals intrusion */
-		if (!mp_iszero(&bigRemainder)
-			&& (bigRemainder.sign != big2.sign)) {
-		    /*
-		     * Convert to Tcl's integer division rules.
-		     */
-
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    mp_add(&bigRemainder, &big2, &bigRemainder);
-		}
-		mp_clear(&bigRemainder);
-		break;
-	    case INST_EXPON:
-		if (big2.used > 1) {
-		    Tcl_SetObjResult(interp,
-			    Tcl_NewStringObj("exponent too large", -1));
-		    mp_clear(&big1);
-		    mp_clear(&big2);
-		    mp_clear(&bigResult);
-		    result = TCL_ERROR;
-		    goto checkForCatch;
-		}
-		mp_expt_d(&big1, big2.dp[0], &bigResult);
-		break;
-	    }
-	    mp_clear(&big1);
-	    mp_clear(&big2);
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewBignumObj(&bigResult);
-		TRACE(("%s\n", O2S(objResultPtr)));
-		NEXT_INST_F(1, 2, 1);
-	    }
-	    Tcl_SetBignumObj(valuePtr, &bigResult);
-	    TRACE(("%s\n", O2S(valuePtr)));
+	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_ERROR(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)));
+	    NEXT_INST_F(1, 2, 1);
 	}
-    }
 
     case INST_LNOT: {
 	int b;
-	Tcl_Obj *valuePtr = OBJ_AT_TOS;
+
+	valuePtr = OBJ_AT_TOS;
 
 	/* TODO - check claim that taking address of b harms performance */
 	/* TODO - consider optimization search for constants */
-	result = TclGetBooleanFromObj(NULL, valuePtr, &b);
-	if (result != TCL_OK) {
-	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
+	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
+	    TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
 	    CACHE_STACK_INFO();
-	    goto checkForCatch;
+	    goto gotError;
 	}
 	/* TODO: Consider peephole opt. */
-	objResultPtr = constants[!b];
+	objResultPtr = TCONST(!b);
+	TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
 	NEXT_INST_F(1, 1, 1);
     }
 
-    case INST_BITNOT: {
-	mp_int big;
-	ClientData ptr;
-	int type;
-	Tcl_Obj *valuePtr = OBJ_AT_TOS;
-
-	result = GetNumberFromObj(NULL, valuePtr, &ptr, &type);
-	if ((result != TCL_OK)
-		|| (type == TCL_NUMBER_NAN) || (type == TCL_NUMBER_DOUBLE)) {
+    case INST_BITNOT:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
 	    /*
 	     * ... ~$NonInteger => raise an error.
 	     */
 
-	    result = TCL_ERROR;
-	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+	    TRACE_APPEND(("ERROR: illegal type %s\n",
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
 	    CACHE_STACK_INFO();
-	    goto checkForCatch;
+	    goto gotError;
 	}
-	if (type == TCL_NUMBER_LONG) {
-	    long l = *((const long *)ptr);
-
-	    if (Tcl_IsShared(valuePtr)) {
-		TclNewLongObj(objResultPtr, ~l);
-		NEXT_INST_F(1, 1, 1);
-	    }
-	    TclSetLongObj(valuePtr, ~l);
-	    NEXT_INST_F(1, 0, 0);
-	}
-#ifndef NO_WIDE_TYPE
-	if (type == TCL_NUMBER_WIDE) {
-	    Tcl_WideInt w = *((const Tcl_WideInt *)ptr);
-
+	if (type1 == TCL_NUMBER_LONG) {
+	    l1 = *((const long *) ptr1);
 	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewWideIntObj(~w);
+		TclNewLongObj(objResultPtr, ~l1);
+		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 		NEXT_INST_F(1, 1, 1);
 	    }
-	    Tcl_SetWideIntObj(valuePtr, ~w);
+	    TclSetLongObj(valuePtr, ~l1);
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
-#endif
-	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
-	/* ~a = - a - 1 */
-	mp_neg(&big, &big);
-	mp_sub_d(&big, 1, &big);
-	if (Tcl_IsShared(valuePtr)) {
-	    objResultPtr = Tcl_NewBignumObj(&big);
+	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
+	if (objResultPtr != NULL) {
+	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
 	}
-	Tcl_SetBignumObj(valuePtr, &big);
-	NEXT_INST_F(1, 0, 0);
-    }
-
-    case INST_UMINUS: {
-	ClientData ptr;
-	int type;
-	Tcl_Obj *valuePtr = OBJ_AT_TOS;
 
-	result = GetNumberFromObj(NULL, valuePtr, &ptr, &type);
-	if ((result != TCL_OK)
-#ifndef ACCEPT_NAN
-		|| (type == TCL_NUMBER_NAN)
-#endif
-		) {
-	    result = TCL_ERROR;
-	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+    case INST_UMINUS:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
+	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+		|| IsErroringNaNType(type1)) {
+	    TRACE_APPEND(("ERROR: illegal type %s \n",
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
 	    CACHE_STACK_INFO();
-	    goto checkForCatch;
+	    goto gotError;
 	}
-	switch (type) {
-	case TCL_NUMBER_DOUBLE: {
-	    double d;
-
-	    if (Tcl_IsShared(valuePtr)) {
-		TclNewDoubleObj(objResultPtr, -(*((const double *)ptr)));
-		NEXT_INST_F(1, 1, 1);
-	    }
-	    d = *((const double *)ptr);
-	    TclSetDoubleObj(valuePtr, -d);
+	switch (type1) {
+	case TCL_NUMBER_NAN:
+	    /* -NaN => NaN */
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
-	}
-	case TCL_NUMBER_LONG: {
-	    long l = *((const long *)ptr);
-
-	    if (l != LONG_MIN) {
-		if (Tcl_IsShared(valuePtr)) {
-		    TclNewLongObj(objResultPtr, -l);
-		    NEXT_INST_F(1, 1, 1);
-		}
-		TclSetLongObj(valuePtr, -l);
-		NEXT_INST_F(1, 0, 0);
-	    }
-	    /* FALLTHROUGH */
-	}
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE: {
-	    Tcl_WideInt w;
-
-	    if (type == TCL_NUMBER_LONG) {
-		w = (Tcl_WideInt)(*((const long *)ptr));
-	    } else {
-		w = *((const Tcl_WideInt *)ptr);
-	    }
-	    if (w != LLONG_MIN) {
+	case TCL_NUMBER_LONG:
+	    l1 = *((const long *) ptr1);
+	    if (l1 != LONG_MIN) {
 		if (Tcl_IsShared(valuePtr)) {
-		    objResultPtr = Tcl_NewWideIntObj(-w);
+		    TclNewLongObj(objResultPtr, -l1);
+		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 		    NEXT_INST_F(1, 1, 1);
 		}
-		Tcl_SetWideIntObj(valuePtr, -w);
+		TclSetLongObj(valuePtr, -l1);
+		TRACE_APPEND(("%s\n", O2S(valuePtr)));
 		NEXT_INST_F(1, 0, 0);
 	    }
 	    /* FALLTHROUGH */
 	}
-#endif
-	case TCL_NUMBER_BIG: {
-	    mp_int big;
-
-	    switch (type) {
-#ifdef NO_WIDE_TYPE
-	    case TCL_NUMBER_LONG:
-		TclBNInitBignumFromLong(&big, *(const long *) ptr);
-		break;
-#else
-	    case TCL_NUMBER_WIDE:
-		TclBNInitBignumFromWideInt(&big, *(const Tcl_WideInt *) ptr);
-		break;
-#endif
-	    case TCL_NUMBER_BIG:
-		Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
-	    }
-	    mp_neg(&big, &big);
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewBignumObj(&big);
-		NEXT_INST_F(1, 1, 1);
-	    }
-	    Tcl_SetBignumObj(valuePtr, &big);
-	    NEXT_INST_F(1, 0, 0);
-	}
-	case TCL_NUMBER_NAN:
-	    /* -NaN => NaN */
+	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
+	if (objResultPtr != NULL) {
+	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
-    }
 
     case INST_UPLUS:
-    case INST_TRY_CVT_TO_NUMERIC: {
+    case INST_TRY_CVT_TO_NUMERIC:
 	/*
 	 * 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.
 	 */
 
-	ClientData ptr;
-	int type;
-	Tcl_Obj *valuePtr = OBJ_AT_TOS;
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
 
-	if (GetNumberFromObj(NULL, valuePtr, &ptr, &type) != TCL_OK) {
+	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
 	    if (*pc == INST_UPLUS) {
 		/*
 		 * ... +$NonNumeric => raise an error.
 		 */
 
-		result = TCL_ERROR;
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		TRACE_APPEND(("ERROR: illegal type %s\n",
 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
 		DECACHE_STACK_INFO();
 		IllegalExprOperandType(interp, pc, valuePtr);
 		CACHE_STACK_INFO();
-		goto checkForCatch;
-	    } else {
-		/* ... TryConvertToNumeric($NonNumeric) is acceptable */
-		TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
-		NEXT_INST_F(1, 0, 0);
+		goto gotError;
 	    }
+
+	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
+	    TRACE_APPEND(("not numeric\n"));
+	    NEXT_INST_F(1, 0, 0);
 	}
-#ifndef ACCEPT_NAN
-	if (type == TCL_NUMBER_NAN) {
-	    result = TCL_ERROR;
+	if (IsErroringNaNType(type1)) {
 	    if (*pc == INST_UPLUS) {
 		/*
 		 * ... +$NonNumeric => raise an error.
 		 */
 
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		TRACE_APPEND(("ERROR: illegal type %s\n",
 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
 		DECACHE_STACK_INFO();
 		IllegalExprOperandType(interp, pc, valuePtr);
@@ -6472,15 +6730,13 @@ TclExecuteByteCode(
 		 * Numeric conversion of NaN -> error.
 		 */
 
-		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
-			O2S(objResultPtr)));
+		TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
 		DECACHE_STACK_INFO();
-		TclExprFloatError(interp, *((const double *)ptr));
+		TclExprFloatError(interp, *((const double *) ptr1));
 		CACHE_STACK_INFO();
 	    }
-	    goto checkForCatch;
+	    goto gotError;
 	}
-#endif
 
 	/*
 	 * Ensure that the numeric value has a string rep the same as the
@@ -6492,7 +6748,7 @@ TclExecuteByteCode(
 	 */
 
 	if (valuePtr->bytes == NULL) {
-	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+	    TRACE_APPEND(("numeric, same Tcl_Obj\n"));
 	    NEXT_INST_F(1, 0, 0);
 	}
 	if (Tcl_IsShared(valuePtr)) {
@@ -6507,14 +6763,30 @@ TclExecuteByteCode(
 	    valuePtr->bytes = NULL;
 	    objResultPtr = Tcl_DuplicateObj(valuePtr);
 	    valuePtr->bytes = savedString;
-	    TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+	    TRACE_APPEND(("numeric, new Tcl_Obj\n"));
 	    NEXT_INST_F(1, 1, 1);
 	}
 	TclInvalidateStringRep(valuePtr);
-	TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+	TRACE_APPEND(("numeric, same Tcl_Obj\n"));
 	NEXT_INST_F(1, 0, 0);
     }
 
+    /*
+     *	   End of numeric operator instructions.
+     * -----------------------------------------------------------------
+     */
+
+    case INST_TRY_CVT_TO_BOOLEAN:
+	valuePtr = OBJ_AT_TOS;
+	if (valuePtr->typePtr == &tclBooleanType) {
+	    objResultPtr = TCONST(1);
+	} else {
+	    int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
+	    objResultPtr = TCONST(result);
+	}
+	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+
     case INST_BREAK:
 	/*
 	DECACHE_STACK_INFO();
@@ -6523,6 +6795,7 @@ TclExecuteByteCode(
 	*/
 	result = TCL_BREAK;
 	cleanup = 0;
+	TRACE(("=> BREAK!\n"));
 	goto processExceptionReturn;
 
     case INST_CONTINUE:
@@ -6533,23 +6806,28 @@ TclExecuteByteCode(
 	*/
 	result = TCL_CONTINUE;
 	cleanup = 0;
+	TRACE(("=> CONTINUE!\n"));
 	goto processExceptionReturn;
 
-    case INST_FOREACH_START4: {
+    {
+	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: /* DEPRECATED */
 	/*
 	 * Initialize the temporary local var that holds the count of the
 	 * number of iterations of the loop body to -1.
 	 */
 
-	int opnd, iterTmpIndex;
-	ForeachInfo *infoPtr;
-	Var *iterVarPtr;
-	Tcl_Obj *oldValuePtr;
-
 	opnd = TclGetUInt4AtPtr(pc+1);
-	infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
 	iterTmpIndex = infoPtr->loopCtTemp;
-	iterVarPtr = &(compiledLocals[iterTmpIndex]);
+	iterVarPtr = LOCAL(iterTmpIndex);
 	oldValuePtr = iterVarPtr->value.objPtr;
 
 	if (oldValuePtr == NULL) {
@@ -6572,33 +6850,25 @@ TclExecuteByteCode(
 #else
 	NEXT_INST_F(5, 0, 0);
 #endif
-    }
 
-    case INST_FOREACH_STEP4: {
+    case INST_FOREACH_STEP4: /* DEPRECATED */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
 	 */
 
-	ForeachInfo *infoPtr;
-	ForeachVarList *varListPtr;
-	Tcl_Obj *listPtr,*valuePtr, *value2Ptr, **elements;
-	Var *iterVarPtr, *listVarPtr, *varPtr;
-	int opnd, numLists, iterNum, listTmpIndex, listLen, numVars;
-	int varIndex, valIndex, continueLoop, j;
-	long i;
-
 	opnd = TclGetUInt4AtPtr(pc+1);
-	infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+	TRACE(("%u => ", opnd));
+	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
 	numLists = infoPtr->numLists;
 
 	/*
 	 * Increment the temp holding the loop iteration number.
 	 */
 
-	iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
+	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
 	valuePtr = iterVarPtr->value.objPtr;
-	iterNum = (valuePtr->internalRep.longValue + 1);
+	iterNum = valuePtr->internalRep.longValue + 1;
 	TclSetLongObj(valuePtr, iterNum);
 
 	/*
@@ -6612,19 +6882,17 @@ TclExecuteByteCode(
 	    varListPtr = infoPtr->varLists[i];
 	    numVars = varListPtr->numVars;
 
-	    listVarPtr = &(compiledLocals[listTmpIndex]);
+	    listVarPtr = LOCAL(listTmpIndex);
 	    listPtr = listVarPtr->value.objPtr;
-	    result = TclListObjLength(interp, listPtr, &listLen);
-	    if (result == TCL_OK) {
-		if (listLen > (iterNum * numVars)) {
-		    continueLoop = 1;
-		}
-		listTmpIndex++;
-	    } else {
-		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
-			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
-		goto checkForCatch;
+	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+		TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
+			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
+		goto gotError;
 	    }
+	    if (listLen > iterNum * numVars) {
+		continueLoop = 1;
+	    }
+	    listTmpIndex++;
 	}
 
 	/*
@@ -6642,7 +6910,7 @@ TclExecuteByteCode(
 		varListPtr = infoPtr->varLists[i];
 		numVars = varListPtr->numVars;
 
-		listVarPtr = &(compiledLocals[listTmpIndex]);
+		listVarPtr = LOCAL(listTmpIndex);
 		listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
 		TclListObjGetElements(interp, listPtr, &listLen, &elements);
 
@@ -6655,7 +6923,7 @@ TclExecuteByteCode(
 		    }
 
 		    varIndex = varListPtr->varIndexes[j];
-		    varPtr = &(compiledLocals[varIndex]);
+		    varPtr = LOCAL(varIndex);
 		    while (TclIsVarLink(varPtr)) {
 			varPtr = varPtr->value.linkPtr;
 		    }
@@ -6670,17 +6938,16 @@ TclExecuteByteCode(
 			}
 		    } else {
 			DECACHE_STACK_INFO();
-			value2Ptr = TclPtrSetVar(interp, varPtr, NULL, NULL,
-				NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex);
-			CACHE_STACK_INFO();
-			if (value2Ptr == NULL) {
-			    TRACE_WITH_OBJ((
-				    "%u => ERROR init. index temp %d: ",
-				    opnd,varIndex), Tcl_GetObjResult(interp));
-			    result = TCL_ERROR;
+			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+			    CACHE_STACK_INFO();
+			    TRACE_APPEND((
+				    "ERROR init. index temp %d: %s\n",
+				    varIndex, O2S(Tcl_GetObjResult(interp))));
 			    TclDecrRefCount(listPtr);
-			    goto checkForCatch;
+			    goto gotError;
 			}
+			CACHE_STACK_INFO();
 		    }
 		    valIndex++;
 		}
@@ -6688,8 +6955,8 @@ TclExecuteByteCode(
 		listTmpIndex++;
 	    }
 	}
-	TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
-		iterNum, (continueLoop? "continue" : "exit")));
+	TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+		numLists, iterNum, (continueLoop? "continue" : "exit")));
 
 	/*
 	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
@@ -6703,6 +6970,200 @@ TclExecuteByteCode(
 	} else {
 	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
 	}
+
+    }
+    {
+	ForeachInfo *infoPtr;
+	Tcl_Obj *listPtr, **elements, *tmpPtr;
+	ForeachVarList *varListPtr;
+	int numLists, iterMax, listLen, numVars;
+	int iterTmp, iterNum, listTmpDepth;
+	int varIndex, valIndex, j;
+	long i;
+
+    case INST_FOREACH_START:
+	/*
+	 * Initialize the data for the looping construct, pushing the
+	 * corresponding Tcl_Objs to the stack.
+	 */
+
+	opnd = TclGetUInt4AtPtr(pc+1);
+	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
+	numLists = infoPtr->numLists;
+	TRACE(("%u => ", opnd));
+
+	/*
+	 * Compute the number of iterations that will be run: iterMax
+	 */
+
+	iterMax = 0;
+	listTmpDepth = numLists-1;
+	for (i = 0;  i < numLists;  i++) {
+	    varListPtr = infoPtr->varLists[i];
+	    numVars = varListPtr->numVars;
+	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
+	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+		TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
+			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
+		goto gotError;
+	    }
+	    if (Tcl_IsShared(listPtr)) {
+		objPtr = TclListObjCopy(NULL, listPtr);
+		Tcl_IncrRefCount(objPtr);
+		Tcl_DecrRefCount(listPtr);
+		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
+	    }
+	    iterTmp = (listLen + (numVars - 1))/numVars;
+	    if (iterTmp > iterMax) {
+		iterMax = iterTmp;
+	    }
+	    listTmpDepth--;
+	}
+
+	/*
+	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
+	 * nul-string obj with the pointer stored in the ptrValue so that the
+	 * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
+	 * it will never leave this scope and is read-only.
+	 */
+
+	TclNewObj(tmpPtr);
+	tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
+	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+	PUSH_OBJECT(tmpPtr); /* iterCounts object */
+
+	/*
+	 * Store a pointer to the ForeachInfo struct; same dirty trick
+	 * as above
+	 */
+
+	TclNewObj(tmpPtr);
+	tmpPtr->internalRep.twoPtrValue.ptr1 = infoPtr;
+	PUSH_OBJECT(tmpPtr); /* infoPtr object */
+	TRACE_APPEND(("jump to loop step\n"));
+
+	/*
+	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
+	 * falls through.
+	 */
+
+	pc += 5 - infoPtr->loopCtTemp;
+
+    case INST_FOREACH_STEP:
+	/*
+	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+	 * the next value list element to each loop var.
+	 */
+
+	tmpPtr = OBJ_AT_TOS;
+	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
+	numLists = infoPtr->numLists;
+	TRACE(("=> "));
+
+	tmpPtr = OBJ_AT_DEPTH(1);
+	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
+	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+
+	/*
+	 * If some list still has a remaining list element iterate one more
+	 * time. Assign to var the next element from its value list.
+	 */
+
+	if (iterNum < iterMax) {
+	    /*
+	     * Set the variables and jump back to run the body
+	     */
+
+	    tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+
+	    listTmpDepth = numLists + 1;
+
+	    for (i = 0;  i < numLists;  i++) {
+		varListPtr = infoPtr->varLists[i];
+		numVars = varListPtr->numVars;
+
+		listPtr = OBJ_AT_DEPTH(listTmpDepth);
+		TclListObjGetElements(interp, listPtr, &listLen, &elements);
+
+		valIndex = (iterNum * numVars);
+		for (j = 0;  j < numVars;  j++) {
+		    if (valIndex >= listLen) {
+			TclNewObj(valuePtr);
+		    } else {
+			valuePtr = elements[valIndex];
+		    }
+
+		    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);
+			    }
+			    varPtr->value.objPtr = valuePtr;
+			    Tcl_IncrRefCount(valuePtr);
+			}
+		    } else {
+			DECACHE_STACK_INFO();
+			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+			    CACHE_STACK_INFO();
+			    TRACE_APPEND(("ERROR init. index temp %d: %.30s",
+				    varIndex, O2S(Tcl_GetObjResult(interp))));
+			    goto gotError;
+			}
+			CACHE_STACK_INFO();
+		    }
+		    valIndex++;
+		}
+		listTmpDepth--;
+	    }
+	    TRACE_APPEND(("jump to loop start\n"));
+	    /* loopCtTemp being 'misused' for storing the jump size */
+	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
+	}
+
+	TRACE_APPEND(("loop has no more iterations\n"));
+#ifdef TCL_COMPILE_DEBUG
+	NEXT_INST_F(1, 0, 0);
+#else
+	/*
+	 * FALL THROUGH
+	 */
+	pc++;
+#endif
+
+    case INST_FOREACH_END:
+	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
+	tmpPtr = OBJ_AT_TOS;
+	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
+	numLists = infoPtr->numLists;
+	TRACE(("=> loop terminated\n"));
+	NEXT_INST_V(1, numLists+2, 0);
+
+    case INST_LMAP_COLLECT:
+	/*
+	 * This instruction is only issued by lmap. The stack is:
+	 *   - result
+	 *   - infoPtr
+	 *   - loop counters
+	 *   - valLists
+	 *   - collecting obj (unshared)
+	 * The instruction lappends the result to the collecting obj.
+	 */
+
+	tmpPtr = OBJ_AT_DEPTH(1);
+	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
+	numLists = infoPtr->numLists;
+	TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
+
+	objPtr = OBJ_AT_DEPTH(3 + numLists);
+	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+	NEXT_INST_F(1, 1, 0);
     }
 
     case INST_BEGIN_CATCH4:
@@ -6734,14 +7195,10 @@ TclExecuteByteCode(
 	/*
 	 * 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:
@@ -6750,51 +7207,115 @@ TclExecuteByteCode(
 	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);
 
-/* TODO: normalize "valPtr" to "valuePtr" */
+    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;
+	}
+	TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
+	NEXT_INST_F(2*code-1, 1, 0);
+    }
+
+    /*
+     * -----------------------------------------------------------------
+     *	   Start of dictionary-related instructions.
+     */
+
     {
-	int opnd, opnd2, allocateDict;
-	Tcl_Obj *dictPtr, *valPtr;
-	Var *varPtr;
+	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_VERIFY:
+	dictPtr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(dictPtr)));
+	if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
+	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
+		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
+	    goto gotError;
+	}
+	TRACE_APPEND(("OK\n"));
+	NEXT_INST_F(1, 1, 0);
 
     case INST_DICT_GET:
+    case INST_DICT_EXISTS: {
+	register Tcl_Interp *interp2 = interp;
+	register int found;
+
 	opnd = TclGetUInt4AtPtr(pc+1);
 	TRACE(("%u => ", opnd));
 	dictPtr = OBJ_AT_DEPTH(opnd);
+	if (*pc == INST_DICT_EXISTS) {
+	    interp2 = NULL;
+	}
 	if (opnd > 1) {
-	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
+	    dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1,
 		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
 	    if (dictPtr == NULL) {
+		if (*pc == INST_DICT_EXISTS) {
+		    found = 0;
+		    goto afterDictExists;
+		}
 		TRACE_WITH_OBJ((
-			"%u => ERROR tracing dictionary path into \"%s\": ",
-			opnd, O2S(OBJ_AT_DEPTH(opnd))),
+			"ERROR tracing dictionary path into \"%.30s\": ",
+			O2S(OBJ_AT_DEPTH(opnd))),
 			Tcl_GetObjResult(interp));
-		result = TCL_ERROR;
-		goto checkForCatch;
+		goto gotError;
 	    }
 	}
-	result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &objResultPtr);
-	if ((result == TCL_OK) && objResultPtr) {
+	if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
+		&objResultPtr) == TCL_OK) {
+	    if (*pc == INST_DICT_EXISTS) {
+		found = (objResultPtr ? 1 : 0);
+		goto afterDictExists;
+	    }
+	    if (!objResultPtr) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"key \"%s\" not known in dictionary",
+			TclGetString(OBJ_AT_TOS)));
+		DECACHE_STACK_INFO();
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+			TclGetString(OBJ_AT_TOS), NULL);
+		CACHE_STACK_INFO();
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_V(5, opnd+1, 1);
-	}
-	if (result != TCL_OK) {
-	    TRACE_WITH_OBJ((
-		    "%u => ERROR reading leaf dictionary key \"%s\": ",
-		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+	} else if (*pc != INST_DICT_EXISTS) {
+	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
+		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
+	    goto gotError;
 	} else {
-	    DECACHE_STACK_INFO();
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
-		    "\" not known in dictionary", NULL);
-	    CACHE_STACK_INFO();
-	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
-	    result = TCL_ERROR;
+	    found = 0;
 	}
-	goto checkForCatch;
+    afterDictExists:
+	TRACE_APPEND(("%d\n", found));
+
+	/*
+	 * The INST_DICT_EXISTS instruction is usually 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).
+	 */
+
+	JUMP_PEEPHOLE_V(found, 5, opnd+1);
+    }
 
     case INST_DICT_SET:
     case INST_DICT_UNSET:
@@ -6802,7 +7323,7 @@ TclExecuteByteCode(
 	opnd = TclGetUInt4AtPtr(pc+1);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
 
-	varPtr = &(compiledLocals[opnd2]);
+	varPtr = LOCAL(opnd2);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6833,25 +7354,24 @@ TclExecuteByteCode(
 	case INST_DICT_INCR_IMM:
 	    cleanup = 1;
 	    opnd = TclGetInt4AtPtr(pc+1);
-	    result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valPtr);
+	    result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valuePtr);
 	    if (result != TCL_OK) {
 		break;
 	    }
-	    if (valPtr == NULL) {
+	    if (valuePtr == NULL) {
 		Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
 	    } else {
-		Tcl_Obj *incrPtr = Tcl_NewIntObj(opnd);
-
-		Tcl_IncrRefCount(incrPtr);
-		if (Tcl_IsShared(valPtr)) {
-		    valPtr = Tcl_DuplicateObj(valPtr);
-		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valPtr);
+		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, valPtr, incrPtr);
+		result = TclIncrObj(interp, valuePtr, value2Ptr);
 		if (result == TCL_OK) {
 		    TclInvalidateStringRep(dictPtr);
 		}
-		TclDecrRefCount(incrPtr);
+		TclDecrRefCount(value2Ptr);
 	    }
 	    break;
 	case INST_DICT_UNSET:
@@ -6868,18 +7388,17 @@ TclExecuteByteCode(
 	    if (allocateDict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
-		    opnd, opnd2), Tcl_GetObjResult(interp));
+	    TRACE_APPEND(("ERROR updating dictionary: %s\n",
+		    O2S(Tcl_GetObjResult(interp))));
 	    goto checkForCatch;
 	}
 
 	if (TclIsVarDirectWritable(varPtr)) {
 	    if (allocateDict) {
-		Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
-
+		value2Ptr = varPtr->value.objPtr;
 		Tcl_IncrRefCount(dictPtr);
-		if (oldValuePtr != NULL) {
-		    TclDecrRefCount(oldValuePtr);
+		if (value2Ptr != NULL) {
+		    TclDecrRefCount(value2Ptr);
 		}
 		varPtr->value.objPtr = dictPtr;
 	    }
@@ -6892,10 +7411,8 @@ TclExecuteByteCode(
 	    CACHE_STACK_INFO();
 	    TclDecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		result = TCL_ERROR;
-		goto checkForCatch;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
 	}
 #ifndef TCL_COMPILE_DEBUG
@@ -6903,14 +7420,13 @@ TclExecuteByteCode(
 	    NEXT_INST_V(10, cleanup, 0);
 	}
 #endif
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_V(9, cleanup, 1);
 
     case INST_DICT_APPEND:
     case INST_DICT_LAPPEND:
 	opnd = TclGetUInt4AtPtr(pc+1);
-
-	varPtr = &(compiledLocals[opnd]);
+	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
@@ -6932,29 +7448,41 @@ TclExecuteByteCode(
 	    }
 	}
 
-	result = Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS, &valPtr);
-	if (result != TCL_OK) {
+	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
+		&valuePtr) != TCL_OK) {
 	    if (allocateDict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    goto checkForCatch;
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 
 	/*
-	 * Note that a non-existent key results in a NULL valPtr, which is a
+	 * 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 (valPtr == NULL) {
-		valPtr = OBJ_AT_TOS;
+	    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 {
-		if (Tcl_IsShared(valPtr)) {
-		    valPtr = Tcl_DuplicateObj(valPtr);
-		}
-		Tcl_AppendObjToObj(valPtr, OBJ_AT_TOS);
+		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:
@@ -6962,41 +7490,53 @@ TclExecuteByteCode(
 	     * More complex because list-append can fail.
 	     */
 
-	    if (valPtr == NULL) {
-		valPtr = Tcl_NewListObj(1, &OBJ_AT_TOS);
-	    } else if (Tcl_IsShared(valPtr)) {
-		valPtr = Tcl_DuplicateObj(valPtr);
-		result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS);
-		if (result != TCL_OK) {
-		    TclDecrRefCount(valPtr);
+	    if (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 checkForCatch;
+		    TRACE_ERROR(interp);
+		    goto gotError;
 		}
+		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
 	    } else {
-		result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS);
-		if (result != TCL_OK) {
+		if (Tcl_ListObjAppendElement(interp, valuePtr,
+			OBJ_AT_TOS) != TCL_OK) {
 		    if (allocateDict) {
 			TclDecrRefCount(dictPtr);
 		    }
-		    goto checkForCatch;
+		    TRACE_ERROR(interp);
+		    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!");
 	}
 
-	Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valPtr);
-
 	if (TclIsVarDirectWritable(varPtr)) {
 	    if (allocateDict) {
-		Tcl_Obj *oldValuePtr = varPtr->value.objPtr;
-
+		value2Ptr = varPtr->value.objPtr;
 		Tcl_IncrRefCount(dictPtr);
-		if (oldValuePtr != NULL) {
-		    TclDecrRefCount(oldValuePtr);
+		if (value2Ptr != NULL) {
+		    TclDecrRefCount(value2Ptr);
 		}
 		varPtr->value.objPtr = dictPtr;
 	    }
@@ -7009,10 +7549,8 @@ TclExecuteByteCode(
 	    CACHE_STACK_INFO();
 	    TclDecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		result = TCL_ERROR;
-		goto checkForCatch;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
 	}
 #ifndef TCL_COMPILE_DEBUG
@@ -7022,36 +7560,36 @@ TclExecuteByteCode(
 #endif
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(5, 2, 1);
-    }
-
-    {
-	int opnd, done;
-	Tcl_Obj *statePtr, *dictPtr, *keyPtr, *valuePtr, *emptyPtr;
-	Var *varPtr;
-	Tcl_DictSearch *searchPtr;
 
     case INST_DICT_FIRST:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	TRACE(("%u => ", opnd));
 	dictPtr = POP_OBJECT();
-	searchPtr = (Tcl_DictSearch *) ckalloc(sizeof(Tcl_DictSearch));
-	result = Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
-		&valuePtr, &done);
-	if (result != TCL_OK) {
-	    ckfree((char *) searchPtr);
-	    goto checkForCatch;
+	searchPtr = ckalloc(sizeof(Tcl_DictSearch));
+	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
+		&valuePtr, &done) != TCL_OK) {
+
+	    /*
+	     * dictPtr is no longer on the stack, and we're not
+	     * moving it into the intrep of an iterator.  We need
+	     * to drop the refcount [Tcl Bug 9b352768e6].
+	     */
+
+	    Tcl_DecrRefCount(dictPtr);
+	    ckfree(searchPtr);
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 	TclNewObj(statePtr);
 	statePtr->typePtr = &dictIteratorType;
-	statePtr->internalRep.twoPtrValue.ptr1 = (void *) searchPtr;
-	statePtr->internalRep.twoPtrValue.ptr2 = (void *) dictPtr;
-	varPtr = (compiledLocals + opnd);
+	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
+	statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
+	varPtr = LOCAL(opnd);
 	if (varPtr->value.objPtr) {
-	    if (varPtr->value.objPtr->typePtr != &dictIteratorType) {
-		TclDecrRefCount(varPtr->value.objPtr);
-	    } else {
+	    if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
 		Tcl_Panic("mis-issued dictFirst!");
 	    }
+	    TclDecrRefCount(varPtr->value.objPtr);
 	}
 	varPtr->value.objPtr = statePtr;
 	Tcl_IncrRefCount(statePtr);
@@ -7060,11 +7598,11 @@ TclExecuteByteCode(
     case INST_DICT_NEXT:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	TRACE(("%u => ", opnd));
-	statePtr = compiledLocals[opnd].value.objPtr;
+	statePtr = (*LOCAL(opnd)).value.objPtr;
 	if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
 	    Tcl_Panic("mis-issued dictNext!");
 	}
-	searchPtr = (Tcl_DictSearch *) statePtr->internalRep.twoPtrValue.ptr1;
+	searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
 	Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
     pushDictIteratorResult:
 	if (done) {
@@ -7075,62 +7613,27 @@ TclExecuteByteCode(
 	    PUSH_OBJECT(valuePtr);
 	    PUSH_OBJECT(keyPtr);
 	}
-	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
+	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
-	objResultPtr = constants[done];
-	/* TODO: consider opt like INST_FOREACH_STEP4 */
-	NEXT_INST_F(5, 0, 1);
-
-    case INST_DICT_DONE:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	TRACE(("%u => ", opnd));
-	statePtr = compiledLocals[opnd].value.objPtr;
-	if (statePtr == NULL) {
-	    Tcl_Panic("mis-issued dictDone!");
-	}
-
-	if (statePtr->typePtr == &dictIteratorType) {
-	    /*
-	     * First kill the search, and then release the reference to the
-	     * dictionary that we were holding.
-	     */
-
-	    searchPtr = (Tcl_DictSearch *)
-		    statePtr->internalRep.twoPtrValue.ptr1;
-	    Tcl_DictObjDone(searchPtr);
-	    ckfree((char *) searchPtr);
 
-	    dictPtr = (Tcl_Obj *) statePtr->internalRep.twoPtrValue.ptr2;
-	    TclDecrRefCount(dictPtr);
-
-	    /*
-	     * Set the internal variable to an empty object to signify that we
-	     * don't hold an iterator.
-	     */
-
-	    TclDecrRefCount(statePtr);
-	    TclNewObj(emptyPtr);
-	    compiledLocals[opnd].value.objPtr = emptyPtr;
-	    Tcl_IncrRefCount(emptyPtr);
-	}
-	NEXT_INST_F(5, 0, 0);
-    }
+	/*
+	 * 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).
+	 */
 
-    {
-	int opnd, opnd2, i, length, allocdict;
-	Tcl_Obj **keyPtrPtr, *dictPtr;
-	DictUpdateInfo *duiPtr;
-	Var *varPtr;
+	JUMP_PEEPHOLE_F(done, 5, 0);
 
     case INST_DICT_UPDATE_START:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
-	varPtr = &(compiledLocals[opnd]);
+	TRACE(("%u => ", opnd));
+	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 {
@@ -7139,53 +7642,58 @@ TclExecuteByteCode(
 		    TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
 	    if (dictPtr == NULL) {
-		goto dictUpdateStartFailed;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
 	}
+	Tcl_IncrRefCount(dictPtr);
 	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
 		&keyPtrPtr) != TCL_OK) {
-	    goto dictUpdateStartFailed;
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 	if (length != duiPtr->length) {
 	    Tcl_Panic("dictUpdateStart argument length mismatch");
 	}
 	for (i=0 ; i<length ; i++) {
-	    Tcl_Obj *valPtr;
-
 	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
-		    &valPtr) != TCL_OK) {
-		goto dictUpdateStartFailed;
+		    &valuePtr) != TCL_OK) {
+		TRACE_ERROR(interp);
+		Tcl_DecrRefCount(dictPtr);
+		goto gotError;
 	    }
-	    varPtr = &(compiledLocals[duiPtr->varIndices[i]]);
+	    varPtr = LOCAL(duiPtr->varIndices[i]);
 	    while (TclIsVarLink(varPtr)) {
 		varPtr = varPtr->value.linkPtr;
 	    }
 	    DECACHE_STACK_INFO();
-	    if (valPtr == NULL) {
+	    if (valuePtr == NULL) {
 		TclObjUnsetVar2(interp,
 			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
 			NULL, 0);
 	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
-		    valPtr, TCL_LEAVE_ERR_MSG,
+		    valuePtr, TCL_LEAVE_ERR_MSG,
 		    duiPtr->varIndices[i]) == NULL) {
 		CACHE_STACK_INFO();
-	    dictUpdateStartFailed:
-		result = TCL_ERROR;
-		goto checkForCatch;
+		TRACE_ERROR(interp);
+		Tcl_DecrRefCount(dictPtr);
+		goto gotError;
 	    }
 	    CACHE_STACK_INFO();
 	}
+	TclDecrRefCount(dictPtr);
+	TRACE_APPEND(("OK\n"));
 	NEXT_INST_F(9, 0, 0);
 
     case INST_DICT_UPDATE_END:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
-	varPtr = &(compiledLocals[opnd]);
+	TRACE(("%u => ", opnd));
+	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 {
@@ -7194,41 +7702,43 @@ TclExecuteByteCode(
 	    CACHE_STACK_INFO();
 	}
 	if (dictPtr == NULL) {
+	    TRACE_APPEND(("storage was unset\n"));
 	    NEXT_INST_F(9, 1, 0);
 	}
 	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
 		|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
 			&keyPtrPtr) != TCL_OK) {
-	    result = TCL_ERROR;
-	    goto checkForCatch;
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 	allocdict = Tcl_IsShared(dictPtr);
 	if (allocdict) {
 	    dictPtr = Tcl_DuplicateObj(dictPtr);
 	}
+	if (length > 0) {
+	    TclInvalidateStringRep(dictPtr);
+	}
 	for (i=0 ; i<length ; i++) {
-	    Tcl_Obj *valPtr;
-	    Var *var2Ptr;
+	    Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
 
-	    var2Ptr = &(compiledLocals[duiPtr->varIndices[i]]);
 	    while (TclIsVarLink(var2Ptr)) {
 		var2Ptr = var2Ptr->value.linkPtr;
 	    }
 	    if (TclIsVarDirectReadable(var2Ptr)) {
-		valPtr = var2Ptr->value.objPtr;
+		valuePtr = var2Ptr->value.objPtr;
 	    } else {
 		DECACHE_STACK_INFO();
-		valPtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
+		valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
 			duiPtr->varIndices[i]);
 		CACHE_STACK_INFO();
 	    }
-	    if (valPtr == NULL) {
+	    if (valuePtr == NULL) {
 		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
-	    } else if (dictPtr == valPtr) {
+	    } else if (dictPtr == valuePtr) {
 		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i],
-			Tcl_DuplicateObj(valPtr));
+			Tcl_DuplicateObj(valuePtr));
 	    } else {
-		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valPtr);
+		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valuePtr);
 	    }
 	}
 	if (TclIsVarDirectWritable(varPtr)) {
@@ -7244,45 +7754,126 @@ TclExecuteByteCode(
 		if (allocdict) {
 		    TclDecrRefCount(dictPtr);
 		}
-		result = TCL_ERROR;
-		goto checkForCatch;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
 	}
+	TRACE_APPEND(("written back\n"));
 	NEXT_INST_F(9, 1, 0);
-    }
 
-    default:
-	Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
-    } /* end of switch on opCode */
-
-    /*
-     * Division by zero in an expression. Control only reaches this point by
-     * "goto divideByZero".
-     */
+    case INST_DICT_EXPAND:
+	dictPtr = OBJ_UNDER_TOS;
+	listPtr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
+	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
+	if (objResultPtr == NULL) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 2, 1);
 
- divideByZero:
-    DECACHE_STACK_INFO();
-    Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
-    Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
-    CACHE_STACK_INFO();
+    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_ERROR(interp);
+	    TclDecrRefCount(keysPtr);
+	    goto gotError;
+	}
+	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+	if (varPtr == NULL) {
+	    TRACE_ERROR(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_ERROR(interp);
+	    goto gotError;
+	}
+	TRACE_APPEND(("OK\n"));
+	NEXT_INST_F(1, 2, 0);
 
-    result = TCL_ERROR;
-    goto checkForCatch;
+    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_ERROR(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_ERROR(interp);
+	    goto gotError;
+	}
+	TRACE_APPEND(("OK\n"));
+	NEXT_INST_F(5, 2, 0);
+    }
 
     /*
-     * Exponentiation of zero by negative number in an expression. Control
-     * only reaches this point by "goto exponOfZero".
+     *	   End of dictionary-related instructions.
+     * -----------------------------------------------------------------
      */
 
- exponOfZero:
-    DECACHE_STACK_INFO();
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-	    "exponentiation of zero by negative power", -1));
-    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
-	    "exponentiation of zero by negative power", NULL);
-    CACHE_STACK_INFO();
-    result = TCL_ERROR;
-    goto checkForCatch;
+    case INST_CLOCK_READ:
+	{			/* Read the wall clock */
+	    Tcl_WideInt wval;
+	    Tcl_Time now;
+	    switch(TclGetUInt1AtPtr(pc+1)) {
+	    case 0:		/* clicks */
+#ifdef TCL_WIDE_CLICKS
+		wval = TclpGetWideClicks();
+#else
+		wval = (Tcl_WideInt) TclpGetClicks();
+#endif
+		break;
+	    case 1:		/* microseconds */
+		Tcl_GetTime(&now);
+		wval = (Tcl_WideInt) now.sec * 1000000 + now.usec;
+		break;
+	    case 2:		/* milliseconds */
+		Tcl_GetTime(&now);
+		wval = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
+		break;
+	    case 3:		/* seconds */
+		Tcl_GetTime(&now);
+		wval = (Tcl_WideInt) now.sec;
+		break;
+	    default:
+		Tcl_Panic("clockRead instruction with unknown clock#");
+	    }
+	    /* TclNewWideObj(objResultPtr, wval); doesn't exist */
+	    objResultPtr = Tcl_NewWideIntObj(wval);
+	    TRACE_WITH_OBJ(("=> "), objResultPtr);
+	    NEXT_INST_F(2, 0, 1);
+	}
+
+    default:
+	Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
+    } /* end of switch on opCode */
 
     /*
      * Block for variables needed to process exception returns.
@@ -7294,12 +7885,7 @@ TclExecuteByteCode(
 				 * range enclosing the pc. Used by various
 				 * instructions and processCatch to process
 				 * break, continue, and errors. */
-	Tcl_Obj *valuePtr;
 	const char *bytes;
-	int length;
-#if TCL_COMPILE_DEBUG
-	int opnd;
-#endif
 
 	/*
 	 * An external evaluation (INST_INVOKE or INST_EVAL) returned
@@ -7308,7 +7894,7 @@ TclExecuteByteCode(
 	 */
 
     processExceptionReturn:
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
 	switch (*pc) {
 	case INST_INVOKE_STK1:
 	    opnd = TclGetUInt1AtPtr(pc+1);
@@ -7352,33 +7938,65 @@ TclExecuteByteCode(
 			StringForResultCode(result),
 			rangePtr->codeOffset, rangePtr->breakOffset));
 		NEXT_INST_F(0, 0, 0);
-	    } else {
-		if (rangePtr->continueOffset == -1) {
-		    TRACE_APPEND((
-			    "%s, loop w/o continue, checking for catch\n",
-			    StringForResultCode(result)));
-		    goto checkForCatch;
-		}
-		result = TCL_OK;
-		pc = (codePtr->codeStart + rangePtr->continueOffset);
-		TRACE_APPEND(("%s, range at %d, new pc %d\n",
-			StringForResultCode(result),
-			rangePtr->codeOffset, rangePtr->continueOffset));
-		NEXT_INST_F(0, 0, 0);
 	    }
-#if TCL_COMPILE_DEBUG
-	} else if (traceInstructions) {
+	    if (rangePtr->continueOffset == -1) {
+		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
+			StringForResultCode(result)));
+		goto checkForCatch;
+	    }
+	    result = TCL_OK;
+	    pc = (codePtr->codeStart + rangePtr->continueOffset);
+	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
+		    StringForResultCode(result),
+		    rangePtr->codeOffset, rangePtr->continueOffset));
+	    NEXT_INST_F(0, 0, 0);
+	}
+#ifdef TCL_COMPILE_DEBUG
+	if (traceInstructions) {
+	    objPtr = Tcl_GetObjResult(interp);
 	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
-		Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
-		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+		TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
 			result, O2S(objPtr)));
 	    } else {
-		Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
-		TRACE_APPEND(("%s, result= \"%s\"\n",
+		TRACE_APPEND(("%s, result=\"%.30s\"\n",
 			StringForResultCode(result), O2S(objPtr)));
 	    }
-#endif
 	}
+#endif
+	goto checkForCatch;
+
+	/*
+	 * Division by zero in an expression. Control only reaches this point
+	 * by "goto divideByZero".
+	 */
+
+    divideByZero:
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+	DECACHE_STACK_INFO();
+	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:
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"exponentiation of zero by negative power", -1));
+	DECACHE_STACK_INFO();
+	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
@@ -7388,14 +8006,18 @@ TclExecuteByteCode(
 	 * and return the "exception" code.
 	 */
 
-	checkForCatch:
+    checkForCatch:
+	if (iPtr->execEnvPtr->rewind) {
+	    goto abnormalReturn;
+	}
 	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
-	    if (bytes != NULL) {
-		DECACHE_STACK_INFO();
-		Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
-		CACHE_STACK_INFO();
-	    }
+	    const unsigned char *pcBeg;
+
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
+	    DECACHE_STACK_INFO();
+	    TclLogCommandInfo(interp, codePtr->source, bytes,
+		    bytes ? length : 0, pcBeg, tosPtr);
+	    CACHE_STACK_INFO();
 	}
 	iPtr->flags &= ~ERR_ALREADY_LOGGED;
 
@@ -7404,13 +8026,32 @@ TclExecuteByteCode(
 	 * INST_BEGIN_CATCH.
 	 */
 
-	while ((expandNestList != NULL) && ((catchTop == initCatchTop) ||
-		(*catchTop <=
-		(ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) {
-	    Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
+	while (auxObjList) {
+	    if ((catchTop != initCatchTop)
+		    && (*catchTop > (ptrdiff_t)
+			auxObjList->internalRep.twoPtrValue.ptr2)) {
+		break;
+	    }
+	    POP_TAUX_OBJ();
+	}
 
-	    TclDecrRefCount(expandNestList);
-	    expandNestList = objPtr;
+	/*
+	 * 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;
 	}
 
 	/*
@@ -7442,7 +8083,7 @@ TclExecuteByteCode(
 	    /*
 	     * 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.
+	     * breaking compat with previous .tbc compiled scripts.
 	     */
 
 #ifdef TCL_COMPILE_DEBUG
@@ -7490,39 +8131,1499 @@ TclExecuteByteCode(
 
     abnormalReturn:
 	TCL_DTRACE_INST_LAST();
-	while (tosPtr > initTosPtr) {
-	    Tcl_Obj *objPtr = POP_OBJECT();
-
-	    Tcl_DecrRefCount(objPtr);
-	}
 
 	/*
-	 * Clear all expansions.
+	 * Clear all expansions and same-level NR calls.
+	 *
+	 * Note that expansion markers have a NULL type; avoid removing other
+	 * markers.
 	 */
 
-	while (expandNestList) {
-	    Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
-
-	    TclDecrRefCount(expandNestList);
-	    expandNestList = objPtr;
+	while (auxObjList) {
+	    POP_TAUX_OBJ();
 	}
+	while (tosPtr > initTosPtr) {
+	    objPtr = POP_OBJECT();
+	    Tcl_DecrRefCount(objPtr);
+	}
+
 	if (tosPtr < initTosPtr) {
 	    fprintf(stderr,
-		    "\nTclExecuteByteCode: abnormal return at pc %u: "
+		    "\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("TclExecuteByteCode execution failure: end stack top < start stack top");
+	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
 	}
+	CLANG_ASSERT(bcFramePtr);
+    }
+
+    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+    if (codePtr->refCount-- <= 1) {
+	TclCleanupByteCode(codePtr);
     }
+    TclStackFree(interp, TD);	/* free my stack */
+
+    return result;
 
     /*
-     * Restore the stack to the state it had previous to this bytecode.
+     * INST_START_CMD failure case removed where it doesn't bother that much
+     *
+     * 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.
+
+     * case INST_START_CMD:
      */
 
-    TclStackFree(interp, initCatchTop+1);
-    return result;
+	instStartCmdFailed:
+	{
+	    const char *bytes;
+
+	    checkInterp = 1;
+	    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, NULL);
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    pc += (opnd-1);
+	    assert(bytes);
+	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
+	    goto instEvalStk;
+	}
+}
+
+#undef codePtr
 #undef iPtr
+#undef bcFramePtr
+#undef initCatchTop
+#undef initTosPtr
+#undef auxObjList
+#undef catchTop
+#undef TCONST
+#undef esPtr
+
+static int
+FinalizeOONext(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    CallContext *contextPtr = data[1];
+
+    /*
+     * Reset the variable lookup frame.
+     */
+
+    iPtr->varFramePtr = 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[2]);
+    contextPtr->skip = PTR2INT(data[3]);
+    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+    return result;
+}
+
+static int
+FinalizeOONextFilter(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    CallContext *contextPtr = data[1];
+
+    /*
+     * Reset the variable lookup frame.
+     */
+
+    iPtr->varFramePtr = 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[2]);
+    contextPtr->skip = PTR2INT(data[3]);
+    contextPtr->oPtr->flags |= FILTER_HANDLING;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;				\
+    }
+
+    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 TCL_WIDE_INT_IS_LONG
+	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 TCL_WIDE_INT_IS_LONG
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "negative shift argument", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+			"integer value too large to represent", -1));
+		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 TCL_WIDE_INT_IS_LONG
+		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 TCL_WIDE_INT_IS_LONG
+	    /*
+	     * 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);
+    }
+
+    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 TCL_WIDE_INT_IS_LONG
+	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 TCL_WIDE_INT_IS_LONG
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "exponent too large", -1));
+	    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 TCL_WIDE_INT_IS_LONG
+	} 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.
+		 */
+
+		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
+		WIDE_RESULT(wResult);
+	    }
+	}
+#endif
+
+    overflowExpon:
+	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+	if (big2.used > 1) {
+	    mp_clear(&big2);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "exponent too large", -1));
+	    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);
+    }
+
+    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 TCL_WIDE_INT_IS_LONG
+		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 TCL_WIDE_INT_IS_LONG
+		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);
+    }
+
+    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 TCL_WIDE_INT_IS_LONG
+	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 TCL_WIDE_INT_IS_LONG
+	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);
+    }
+
+    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 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
+    ClientData ptr1, ptr2;
+    mp_int big1, big2;
+    double d1, d2, tmp;
+    long l1, l2;
+#ifndef TCL_WIDE_INT_IS_LONG
+    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 TCL_WIDE_INT_IS_LONG
+	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 TCL_WIDE_INT_IS_LONG
+    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 TCL_WIDE_INT_IS_LONG
+	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 TCL_WIDE_INT_IS_LONG
+	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;
+    }
 }
 
 #ifdef TCL_COMPILE_DEBUG
@@ -7532,7 +9633,7 @@ TclExecuteByteCode(
  * PrintByteCodeInfo --
  *
  *	This procedure prints a summary about a bytecode object to stdout. It
- *	is called by TclExecuteByteCode when starting to execute the bytecode
+ *	is called by TclNRExecuteByteCode when starting to execute the bytecode
  *	object if tclTraceExec has the value 2 or more.
  *
  * Results:
@@ -7593,7 +9694,7 @@ PrintByteCodeInfo(
  *
  * ValidatePcAndStackTop --
  *
- *	This procedure is called by TclExecuteByteCode when debugging to
+ *	This procedure is called by TclNRExecuteByteCode when debugging to
  *	verify that the program counter and stack top are valid during
  *	execution.
  *
@@ -7612,16 +9713,15 @@ static void
 ValidatePcAndStackTop(
     register ByteCode *codePtr,	/* The bytecode whose summary is printed to
 				 * stdout. */
-    unsigned char *pc,		/* Points to first byte of a bytecode
+    const unsigned char *pc,	/* Points to first byte of a bytecode
 				 * instruction. The program counter. */
     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 stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+    int stackUpperBound = codePtr->maxStackDepth;
 				/* Greatest legal value for stackTop. */
     unsigned relativePc = (unsigned) (pc - codePtr->codeStart);
     unsigned long codeStart = (unsigned long) codePtr->codeStart;
@@ -7630,22 +9730,22 @@ ValidatePcAndStackTop(
     unsigned char opCode = *pc;
 
     if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) {
-	fprintf(stderr, "\nBad instruction pc 0x%p in TclExecuteByteCode\n",
+	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
 		pc);
-	Tcl_Panic("TclExecuteByteCode execution failure: bad pc");
+	Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
     }
     if ((unsigned) opCode > LAST_INST_OPCODE) {
-	fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
+	fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n",
 		(unsigned) opCode, relativePc);
-	Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
+	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
     }
     if (checkStack &&
-	    ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
+	    ((stackTop < 0) || (stackTop > stackUpperBound))) {
 	int numChars;
-	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
 
-	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
-		stackTop, relativePc, stackLowerBound, stackUpperBound);
+	fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)",
+		stackTop, relativePc, stackUpperBound);
 	if (cmd != NULL) {
 	    Tcl_Obj *message;
 
@@ -7657,7 +9757,7 @@ ValidatePcAndStackTop(
 	} else {
 	    fprintf(stderr, "\n");
 	}
-	Tcl_Panic("TclExecuteByteCode execution failure: bad stack top");
+	Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
     }
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -7667,7 +9767,7 @@ ValidatePcAndStackTop(
  *
  * IllegalExprOperandType --
  *
- *	Used by TclExecuteByteCode to append an error message to the interp
+ *	Used by TclNRExecuteByteCode to append an error message to the interp
  *	result when an illegal operand type is detected by an expression
  *	instruction. The argument opndPtr holds the operand object in error.
  *
@@ -7684,14 +9784,14 @@ static void
 IllegalExprOperandType(
     Tcl_Interp *interp,		/* Interpreter to which error information
 				 * pertains. */
-    unsigned char *pc,		/* Points to the instruction being executed
+    const 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
 				 * with the illegal type. */
 {
     ClientData ptr;
     int type;
-    unsigned char opcode = *pc;
+    const unsigned char opcode = *pc;
     const char *description, *operator = "unknown";
 
     if (opcode == INST_EXPON) {
@@ -7728,7 +9828,7 @@ IllegalExprOperandType(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -7749,16 +9849,30 @@ IllegalExprOperandType(
  *----------------------------------------------------------------------
  */
 
-const char *
-TclGetSrcInfoForCmd(
-    Interp *iPtr,
-    int *lenPtr)
+Tcl_Obj *
+TclGetSourceFromFrame(
+    CmdFrame *cfPtr,
+    int objc,
+    Tcl_Obj *const objv[])
 {
-    CmdFrame *cfPtr = iPtr->cmdFramePtr;
-    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
-
-    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
-	    codePtr, lenPtr);
+    if (cfPtr == NULL) {
+        return Tcl_NewListObj(objc, objv);
+    }
+    if (cfPtr->cmdObj == NULL) {
+        if (cfPtr->cmd == NULL) {
+	    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+            cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
+		    cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
+        }
+	if (cfPtr->cmd) {
+	    cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+	} else {
+	    cfPtr->cmdObj = Tcl_NewListObj(objc, objv);
+	}
+        Tcl_IncrRefCount(cfPtr->cmdObj);
+    }
+    return cfPtr->cmdObj;
 }
 
 void
@@ -7767,13 +9881,16 @@ TclGetSrcInfoForPc(
 {
     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
 
-    if (cfPtr->cmd.str.cmd == NULL) {
-	cfPtr->cmd.str.cmd = GetSrcInfoForPc(
+    assert(cfPtr->type == TCL_LOCATION_BC);
+
+    if (cfPtr->cmd == NULL) {
+
+	cfPtr->cmd = GetSrcInfoForPc(
 		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
-		&cfPtr->cmd.str.len);
+		&cfPtr->len, NULL, NULL);
     }
 
-    if (cfPtr->cmd.str.cmd != NULL) {
+    if (cfPtr->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.
@@ -7784,14 +9901,14 @@ TclGetSrcInfoForPc(
 	int srcOffset, i;
 	Interp *iPtr = (Interp *) *codePtr->interpHandle;
 	Tcl_HashEntry *hePtr =
-		Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
 
 	if (!hePtr) {
 	    return;
 	}
 
-	srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
-	eclPtr = (ExtCmdLoc *) Tcl_GetHashValue (hePtr);
+	srcOffset = cfPtr->cmd - codePtr->source;
+	eclPtr = Tcl_GetHashValue(hePtr);
 
 	for (i=0; i < eclPtr->nuloc; i++) {
 	    if (eclPtr->loc[i].srcOffset == srcOffset) {
@@ -7821,15 +9938,21 @@ TclGetSrcInfoForPc(
 
 static const char *
 GetSrcInfoForPc(
-    unsigned char *pc,		/* The program counter value for which to
+    const unsigned char *pc,	/* The program counter value for which to
 				 * return the closest command's source info.
-				 * This points to a bytecode instruction in
-				 * codePtr's code. */
+				 * This points within 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
+    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. */
+    int *cmdIdxPtr)		/* If non-NULL, the location where the index
+				 * of the command containing the pc should
+				 * be stored. */
 {
     register int pcOffset = (pc - codePtr->codeStart);
     int numCmds = codePtr->numCommands;
@@ -7839,10 +9962,10 @@ GetSrcInfoForPc(
     int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
     int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
     int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
+    int bestCmdIdx = -1;
 
-    if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
-	return NULL;
-    }
+    /* The pc must point within the bytecode */
+    assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
 
     /*
      * Decode the code and source offset and length for each command. The
@@ -7905,10 +10028,28 @@ GetSrcInfoForPc(
 		bestDist = dist;
 		bestSrcOffset = srcOffset;
 		bestSrcLength = srcLen;
+		bestCmdIdx = i;
 	    }
 	}
     }
 
+    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;
     }
@@ -7916,6 +10057,11 @@ GetSrcInfoForPc(
     if (lengthPtr != NULL) {
 	*lengthPtr = bestSrcLength;
     }
+
+    if (cmdIdxPtr != NULL) {
+	*cmdIdxPtr = bestCmdIdx;
+    }
+
     return (codePtr->source + bestSrcOffset);
 }
 
@@ -7946,7 +10092,7 @@ GetSrcInfoForPc(
 
 static ExceptionRange *
 GetExceptRangeForPc(
-    unsigned char *pc,		/* The program counter value for which to
+    const 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. */
@@ -8001,7 +10147,7 @@ GetExceptRangeForPc(
  * GetOpcodeName --
  *
  *	This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
- *	in TclExecuteByteCode when debugging. It returns the name of the
+ *	in TclNRExecuteByteCode when debugging. It returns the name of the
  *	bytecode instruction at a specified instruction pc.
  *
  * Results:
@@ -8014,9 +10160,9 @@ GetExceptRangeForPc(
  */
 
 #ifdef TCL_COMPILE_DEBUG
-static char *
+static const char *
 GetOpcodeName(
-    unsigned char *pc)		/* Points to the instruction whose name should
+    const unsigned char *pc)	/* Points to the instruction whose name should
 				 * be returned. */
 {
     unsigned char opCode = *pc;
@@ -8186,31 +10332,31 @@ EvalStatsCmd(
     Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
     Tcl_AppendPrintfToObj(objPtr,
 	    "Compilation and execution statistics for interpreter %#lx\n",
-	    iPtr);
+	    (long int)iPtr);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n",
 	    statsPtr->numExecutions);
-    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n",
 	    statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile	%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
 	    statsPtr->numExecutions / (float)statsPtr->numCompilations);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed		%.0f\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
 	    numInstructions);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile		%.0f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile\t\t%.0f\n",
 	    numInstructions / statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution		%.0f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution\t\t%.0f\n",
 	    numInstructions / statsPtr->numExecutions);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes			%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n",
 	    statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Source bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
 	    statsPtr->totalSrcBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Code bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
 	    totalCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
 	    statsPtr->totalByteCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
 	    totalLiteralBytes);
     Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
 	    (unsigned long) sizeof(LiteralTable),
@@ -8218,20 +10364,20 @@ EvalStatsCmd(
 	    (unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)),
 	    (unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)),
 	    statsPtr->totalLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile		%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile\t\t%.1f\n",
 	    totalCodeBytes / statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source		%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
 	    totalCodeBytes / statsPtr->totalSrcBytes);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n",
 	    numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "  Source bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
 	    statsPtr->currentSrcBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Code bytes			%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
 	    currentCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
 	    statsPtr->currentByteCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
 	    currentLiteralBytes);
     Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
 	    (unsigned long) sizeof(LiteralTable),
@@ -8239,9 +10385,9 @@ EvalStatsCmd(
 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
 	    statsPtr->currentLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source		%.1f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
 	    currentCodeBytes / statsPtr->currentSrcBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes		%.6g (%0.1f mean code/src)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
 	    (currentCodeBytes + statsPtr->currentSrcBytes),
 	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
 
@@ -8254,17 +10400,17 @@ EvalStatsCmd(
 
     numSharedMultX = 0;
     Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
-    Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)\t%ld\n",
 	    tclObjsShared[1]);
     for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
-	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%d		%ld\n",
+	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%d\t\t%ld\n",
 		i, tclObjsShared[i]);
 	numSharedMultX += tclObjsShared[i];
     }
-    Tcl_AppendPrintfToObj(objPtr, "  refcount >=%d		%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "  refcount >=%d\t\t%ld\n",
 	    i, tclObjsShared[0]);
     numSharedMultX += tclObjsShared[0];
-    Tcl_AppendPrintfToObj(objPtr, "  Total shared objects			%d\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Total shared objects\t\t\t%d\n",
 	    numSharedMultX);
 
     /*
@@ -8301,31 +10447,31 @@ EvalStatsCmd(
     sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
 	    - currentLiteralBytes;
 
-    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)	%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n",
 	    tclObjsAlloced);
-    Tcl_AppendPrintfToObj(objPtr, "Current objects			%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n",
 	    (tclObjsAlloced - tclObjsFreed));
-    Tcl_AppendPrintfToObj(objPtr, "Total literal objects		%ld\n",
+    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n",
 	    statsPtr->numLiteralsCreated);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects		%d (%0.1f%% of current objects)\n",
+    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
 	    globalTablePtr->numEntries,
 	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
-    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals	 	%ld (%0.1f%% of current literals)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
 	    numByteCodeLits,
 	    Percent(numByteCodeLits, globalTablePtr->numEntries));
-    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x	 	%d\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%d\n",
 	    numSharedMultX);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean reference count	 	%.2f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean reference count\t\t%.2f\n",
 	    ((double) refCountSum) / globalTablePtr->numEntries);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x 	%.2f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x \t%.2f\n",
 	    (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
-    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x	 	%.2f\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x\t\t%.2f\n",
 	    (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
-    Tcl_AppendPrintfToObj(objPtr, "  Total sharing savings	 	%.6g (%0.1f%% of bytes if no sharing)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
 	    sharingBytesSaved,
 	    Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
-    Tcl_AppendPrintfToObj(objPtr, "    Bytes with sharing		%.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Bytes with sharing\t\t%.6g\n",
 	    currentLiteralBytes);
     Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
 	    (unsigned long) sizeof(LiteralTable),
@@ -8333,13 +10479,13 @@ EvalStatsCmd(
 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
 	    statsPtr->currentLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing		%.6g = objects %.6g + strings %.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
 	    (objBytesIfUnshared + strBytesIfUnshared),
 	    objBytesIfUnshared, strBytesIfUnshared);
-    Tcl_AppendPrintfToObj(objPtr, "  String sharing savings 	%.6g = unshared %.6g - shared %.6g\n",
+    Tcl_AppendPrintfToObj(objPtr, "  String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
 	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
 	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead	 	%ld (%0.1f%% of bytes with sharing)\n",
+    Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
 	    literalMgmtBytes,
 	    Percent(literalMgmtBytes, currentLiteralBytes));
     Tcl_AppendPrintfToObj(objPtr, "    table %lu + buckets %lu + entries %lu\n",
@@ -8387,7 +10533,7 @@ EvalStatsCmd(
      */
 
     Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
-    Tcl_AppendPrintfToObj(objPtr, "	 Up to length		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
     maxSizeDecade = 0;
     for (i = 31;  i >= 0;  i--) {
 	if (statsPtr->literalCount[i] > 0) {
@@ -8399,21 +10545,21 @@ EvalStatsCmd(
     for (i = 0;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->literalCount[i];
-	Tcl_AppendPrintfToObj(objPtr, "	%10d		%8.0f%%\n",
+	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
 		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
     }
 
     litTableStats = TclLiteralStats(globalTablePtr);
     Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
 	    litTableStats);
-    ckfree((char *) litTableStats);
+    ckfree(litTableStats);
 
     /*
      * Source and ByteCode size distributions.
      */
 
     Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
-    Tcl_AppendPrintfToObj(objPtr, "	 Up to size		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {
 	if (statsPtr->srcCount[i] > 0) {
@@ -8431,12 +10577,12 @@ EvalStatsCmd(
     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->srcCount[i];
-	Tcl_AppendPrintfToObj(objPtr, "	%10d		%8.0f%%\n",
+	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
 		decadeHigh, Percent(sum, statsPtr->numCompilations));
     }
 
     Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
-    Tcl_AppendPrintfToObj(objPtr, "	 Up to size		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {
 	if (statsPtr->byteCodeCount[i] > 0) {
@@ -8454,12 +10600,12 @@ EvalStatsCmd(
     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->byteCodeCount[i];
-	Tcl_AppendPrintfToObj(objPtr, "	%10d		%8.0f%%\n",
+	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
 		decadeHigh, Percent(sum, statsPtr->numCompilations));
     }
 
     Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
-    Tcl_AppendPrintfToObj(objPtr, "	       Up to ms		Percentage\n");
+    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {
 	if (statsPtr->lifetimeCount[i] > 0) {
@@ -8477,7 +10623,7 @@ EvalStatsCmd(
     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
 	decadeHigh = (1 << (i+1)) - 1;
 	sum += statsPtr->lifetimeCount[i];
-	Tcl_AppendPrintfToObj(objPtr, "	%12.3f		%8.0f%%\n",
+	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
 		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
     }
 
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index c52cd1e..bb814ea 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -11,6 +11,7 @@
  */
 
 #include "tclInt.h"
+#include "tclFileSystem.h"
 
 /*
  * Declarations for local functions defined in this file:
@@ -21,9 +22,9 @@ static int		CopyRenameOneFile(Tcl_Interp *interp,
 			    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);
+			    int objc, Tcl_Obj *const objv[], int copyFlag);
 static int		FileForceOption(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[], int *forcePtr);
+			    int objc, Tcl_Obj *const objv[], int *forcePtr);
 
 /*
  *---------------------------------------------------------------------------
@@ -46,10 +47,11 @@ 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. */
+    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     return FileCopyRename(interp, objc, objv, 0);
 }
@@ -74,10 +76,11 @@ 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. */
+    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     return FileCopyRename(interp, objc, objv, 1);
 }
@@ -103,7 +106,7 @@ 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. */
+    Tcl_Obj *const objv[],	/* Argument strings passed to Tcl_FileCmd. */
     int copyFlag)		/* If non-zero, copy source(s). Otherwise,
 				 * rename them. */
 {
@@ -111,22 +114,20 @@ FileCopyRename(
     Tcl_StatBuf statBuf;
     Tcl_Obj *target;
 
-    i = FileForceOption(interp, objc - 2, objv + 2, &force);
+    i = FileForceOption(interp, objc - 1, objv + 1, &force);
     if (i < 0) {
 	return TCL_ERROR;
     }
-    i += 2;
+    i++;
     if ((objc - i) < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		TclGetString(objv[0]), " ", TclGetString(objv[1]),
-		" ?options? source ?source ...? target\"", NULL);
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-option value ...? source ?source ...? target");
 	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];
@@ -146,9 +147,9 @@ FileCopyRename(
 	if ((objc - i) > 2) {
 	    errno = ENOTDIR;
 	    Tcl_PosixError(interp);
-	    Tcl_AppendResult(interp, "error ",
-		    (copyFlag ? "copying" : "renaming"), ": target \"",
-		    TclGetString(target), "\" is not a directory", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error %s: target \"%s\" is not a directory",
+		    (copyFlag?"copying":"renaming"), TclGetString(target)));
 	    result = TCL_ERROR;
 	} else {
 	    /*
@@ -171,7 +172,6 @@ FileCopyRename(
     for ( ; i<objc-1 ; i++) {
 	Tcl_Obj *jargv[2];
 	Tcl_Obj *source, *newFileName;
-	Tcl_Obj *temp;
 
 	source = FileBasename(interp, objv[i]);
 	if (source == NULL) {
@@ -180,13 +180,11 @@ FileCopyRename(
 	}
 	jargv[0] = objv[objc - 1];
 	jargv[1] = source;
-	temp = Tcl_NewListObj(2, jargv);
-	newFileName = Tcl_FSJoinPath(temp, -1);
+	newFileName = TclJoinPath(2, jargv);
 	Tcl_IncrRefCount(newFileName);
 	result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
 		force);
 	Tcl_DecrRefCount(newFileName);
-	Tcl_DecrRefCount(temp);
 	Tcl_DecrRefCount(source);
 
 	if (result == TCL_ERROR) {
@@ -216,26 +214,25 @@ 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. */
+    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
-    Tcl_Obj *errfile;
+    Tcl_Obj *errfile = NULL;
     int result, i, j, pobjc;
     Tcl_Obj *split = NULL;
     Tcl_Obj *target = NULL;
     Tcl_StatBuf statBuf;
 
-    errfile = NULL;
-
     result = TCL_OK;
-    for (i = 2; i < objc; i++) {
+    for (i = 1; i < objc; i++) {
 	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
 	    result = TCL_ERROR;
 	    break;
 	}
 
-	split = Tcl_FSSplitPath(objv[i],&pobjc);
+	split = Tcl_FSSplitPath(objv[i], &pobjc);
 	Tcl_IncrRefCount(split);
 	if (pobjc == 0) {
 	    errno = ENOENT;
@@ -272,19 +269,17 @@ TclFileMakeDirsCmd(
 		 * subdirectory.
 		 */
 
-		if (errno == EEXIST) {
-		    if ((Tcl_FSStat(target, &statBuf) == 0)
-			    && S_ISDIR(statBuf.st_mode)) {
-			/*
-			 * It is a directory that wasn't there before, so keep
-			 * going without error.
-			 */
-
-			Tcl_ResetResult(interp);
-		    } else {
-			errfile = target;
-			goto done;
-		    }
+		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);
 		} else {
 		    errfile = target;
 		    goto done;
@@ -304,8 +299,9 @@ TclFileMakeDirsCmd(
 
   done:
     if (errfile != NULL) {
-	Tcl_AppendResult(interp, "can't create directory \"",
-		TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create directory \"%s\": %s",
+		TclGetString(errfile), Tcl_PosixError(interp)));
 	result = TCL_ERROR;
     }
     if (split != NULL) {
@@ -336,30 +332,24 @@ 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. */
+    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
 {
     int i, force, result;
     Tcl_Obj *errfile;
     Tcl_Obj *errorBuffer = NULL;
 
-    i = FileForceOption(interp, objc - 2, objv + 2, &force);
+    i = FileForceOption(interp, objc - 1, objv + 1, &force);
     if (i < 0) {
 	return TCL_ERROR;
     }
-    i += 2;
-    if ((objc - i) < 1) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		TclGetString(objv[0]), " ", TclGetString(objv[1]),
-		" ?options? file ?file ...?\"", NULL);
-	return TCL_ERROR;
-    }
 
     errfile = NULL;
     result = TCL_OK;
 
-    for ( ; i < objc; i++) {
+    for (i++ ; i < objc; i++) {
 	Tcl_StatBuf statBuf;
 
 	errfile = objv[i];
@@ -390,9 +380,9 @@ TclFileDeleteCmd(
 	    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_SetObjResult(interp, Tcl_ObjPrintf(
+			    "error deleting \"%s\": directory not empty",
+			    TclGetString(objv[i])));
 		    Tcl_PosixError(interp);
 		    goto done;
 		}
@@ -432,12 +422,13 @@ TclFileDeleteCmd(
 	     * We try to accomodate poor error results from our Tcl_FS calls.
 	     */
 
-	    Tcl_AppendResult(interp, "error deleting unknown file: ",
-		    Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error deleting unknown file: %s",
+		    Tcl_PosixError(interp)));
 	} else {
-	    Tcl_AppendResult(interp, "error deleting \"",
-		    TclGetString(errfile), "\": ", Tcl_PosixError(interp),
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error deleting \"%s\": %s",
+		    TclGetString(errfile), Tcl_PosixError(interp)));
 	}
     }
 
@@ -526,7 +517,7 @@ CopyRenameOneFile(
 	 * 16 bits and we get collisions. See bug #2015723.
 	 */
 
-#if !defined(WIN32) && !defined(__CYGWIN__)
+#if !defined(_WIN32) && !defined(__CYGWIN__)
 	if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
 	    if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
 		    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
@@ -546,17 +537,17 @@ CopyRenameOneFile(
 	if (S_ISDIR(sourceStatBuf.st_mode)
 		&& !S_ISDIR(targetStatBuf.st_mode)) {
 	    errno = EISDIR;
-	    Tcl_AppendResult(interp, "can't overwrite file \"",
-		    TclGetString(target), "\" with directory \"",
-		    TclGetString(source), "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't overwrite file \"%s\" with directory \"%s\"",
+		    TclGetString(target), TclGetString(source)));
 	    goto done;
 	}
 	if (!S_ISDIR(sourceStatBuf.st_mode)
 		&& S_ISDIR(targetStatBuf.st_mode)) {
 	    errno = EISDIR;
-	    Tcl_AppendResult(interp, "can't overwrite directory \"",
-		    TclGetString(target), "\" with file \"",
-		    TclGetString(source), "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't overwrite directory \"%s\" with file \"%s\"",
+		    TclGetString(target), TclGetString(source)));
 	    goto done;
 	}
 
@@ -587,10 +578,10 @@ CopyRenameOneFile(
 	}
 
 	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error renaming \"%s\" to \"%s\": trying to rename a"
+		    " volume or move a directory into itself",
+		    TclGetString(source), TclGetString(target)));
 	    goto done;
 	} else if (errno != EXDEV) {
 	    errfile = target;
@@ -634,8 +625,9 @@ CopyRenameOneFile(
 	     * Actual file doesn't exist.
 	     */
 
-	    Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
-		    "\": the target of this link doesn't exist", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error copying \"%s\": the target of this link doesn't"
+		    " exist", TclGetString(source)));
 	    goto done;
 	} else {
 	    int counter = 0;
@@ -755,6 +747,7 @@ 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;
 		}
@@ -766,23 +759,27 @@ CopyRenameOneFile(
 	    }
 	}
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
-		    "\": ", Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
+		    TclGetString(errfile), Tcl_PosixError(interp)));
 	    errfile = NULL;
 	}
     }
 
   done:
     if (errfile != NULL) {
-	Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
-		 " \"", TclGetString(source), NULL);
+	Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
+		(copyFlag ? "copying" : "renaming"), TclGetString(source));
+
 	if (errfile != source) {
-	    Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
+	    Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
+		    TclGetString(target));
 	    if (errfile != target) {
-		Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
+		Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
+			TclGetString(errfile));
 	    }
 	}
-	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
+	Tcl_SetObjResult(interp, errorMsg);
     }
     if (errorBuffer != NULL) {
 	Tcl_DecrRefCount(errorBuffer);
@@ -816,27 +813,30 @@ static int
 FileForceOption(
     Tcl_Interp *interp,		/* Interp, for error return. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[],	/* Argument strings.  First command line
+    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 force, i;
+    int force, i, idx;
+    static const char *const options[] = {
+	"-force", "--", NULL
+    };
 
     force = 0;
     for (i = 0; i < objc; i++) {
 	if (TclGetString(objv[i])[0] != '-') {
 	    break;
 	}
-	if (strcmp(TclGetString(objv[i]), "-force") == 0) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
+		&idx) != TCL_OK) {
+	    return -1;
+	}
+	if (idx == 0 /* -force */) {
 	    force = 1;
-	} else if (strcmp(TclGetString(objv[i]), "--") == 0) {
+	} else { /* -- */
 	    i++;
 	    break;
-	} else {
-	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]),
-		    "\": should be -force or --", NULL);
-	    return -1;
 	}
     }
     *forcePtr = force;
@@ -917,13 +917,13 @@ FileBasename(
  *	    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
+ *	    const char *fileName;   This is extracted using
  *				    Tcl_TranslateFileName.
  *	    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
+ *	    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
@@ -940,32 +940,37 @@ FileBasename(
 
 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. */
+    Tcl_Obj *const objv[])	/* The command line objects. */
 {
     int result;
-    CONST char ** attributeStrings;
-    Tcl_Obj* objStrings = NULL;
-    int numObjStrings = -1, didAlloc = 0;
+    const char *const *attributeStrings;
+    const char **attributeStringsAllocated = NULL;
+    Tcl_Obj *objStrings = NULL;
+    int numObjStrings = -1;
     Tcl_Obj *filePtr;
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 2, objv,
-		"name ?option? ?value? ?option value ...?");
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
 	return TCL_ERROR;
     }
 
-    filePtr = objv[2];
+    filePtr = objv[1];
     if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
-    	return TCL_ERROR;
+	return TCL_ERROR;
     }
 
-    objc -= 3;
-    objv += 3;
+    objc -= 2;
+    objv += 2;
     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;
@@ -977,9 +982,10 @@ TclFileAttrsCmd(
 		 * 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_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not read \"%s\": %s",
+			TclGetString(filePtr), Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -997,18 +1003,24 @@ TclFileAttrsCmd(
 	if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
 	    goto end;
 	}
-	attributeStrings = (CONST char **) TclStackAlloc(interp,
-		(1+numObjStrings) * sizeof(char*));
-	didAlloc = 1;
+	attributeStringsAllocated = (const char **)
+		TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
 	for (index = 0; index < numObjStrings; index++) {
 	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
-	    attributeStrings[index] = TclGetString(objPtr);
+	    attributeStringsAllocated[index] = TclGetString(objPtr);
 	}
-	attributeStrings[index] = NULL;
+	attributeStringsAllocated[index] = NULL;
+	attributeStrings = attributeStringsAllocated;
     } else if (objStrings != NULL) {
 	Tcl_Panic("must not update objPtrRef's variable and return non-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.
@@ -1049,7 +1061,7 @@ TclFileAttrsCmd(
 	    goto end;
 	}
 
-    	Tcl_SetObjResult(interp, listPtr);
+	Tcl_SetObjResult(interp, listPtr);
     } else if (objc == 1) {
 	/*
 	 * Get one attribute.
@@ -1059,9 +1071,10 @@ 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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\", there are no file attributes in this"
+		    " filesystem", TclGetString(objv[0])));
+	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
 	    goto end;
 	}
 
@@ -1069,9 +1082,8 @@ TclFileAttrsCmd(
 		"option", 0, &index) != TCL_OK) {
 	    goto end;
 	}
-	if (didAlloc) {
+	if (attributeStringsAllocated != NULL) {
 	    TclFreeIntRep(objv[0]);
-	    objv[0]->typePtr = NULL;
 	}
 	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
 		&objPtr) != TCL_OK) {
@@ -1086,51 +1098,410 @@ 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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\", there are no file attributes in this"
+		    " filesystem", TclGetString(objv[0])));
+	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", 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 (didAlloc) {
+	    }
+	    if (attributeStringsAllocated != NULL) {
 		TclFreeIntRep(objv[i]);
-		objv[i]->typePtr = NULL;
 	    }
 	    if (i + 1 == objc) {
-		Tcl_AppendResult(interp, "value for \"",
-			TclGetString(objv[i]), "\" missing", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"value for \"%s\" missing", TclGetString(objv[i])));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
+			"NOVALUE", 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 (didAlloc) {
+    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, "option", 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_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not create new link \"%s\": that path already"
+			" exists", TclGetString(objv[index])));
+		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_SetObjResult(interp, Tcl_ObjPrintf(
+			    "could not create new link \"%s\": no such file"
+			    " or directory", TclGetString(objv[index])));
+		    Tcl_PosixError(interp);
+		} else {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "could not create new link \"%s\": target \"%s\" "
+			    "doesn't exist", TclGetString(objv[index]),
+			    TclGetString(objv[index+1])));
+		    errno = ENOENT;
+		    Tcl_PosixError(interp);
+		}
+	    } else {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not create new link \"%s\" pointing to \"%s\": %s",
+			TclGetString(objv[index]),
+			TclGetString(objv[index+1]), Tcl_PosixError(interp)));
+	    }
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not read link \"%s\": %s",
+		    TclGetString(objv[index]), Tcl_PosixError(interp)));
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetObjResult(interp, contents);
+    if (objc == 2) {
 	/*
-	 * Free up the array we allocated.
+	 * 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.
 	 */
 
-	TclStackFree(interp, (void *)attributeStrings);
+	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 (objStrings != NULL) {
+    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    contents = Tcl_FSLink(objv[1], NULL, 0);
+
+    if (contents == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"could not read link \"%s\": %s",
+		TclGetString(objv[1]), Tcl_PosixError(interp)));
+	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);
+
 	/*
-	 * We don't need this object that was passed to us any more.
+	 * Treat an empty string as if it wasn't there.
 	 */
 
-	Tcl_DecrRefCount(objStrings);
+	if (length == 0) {
+	    goto makeTemporary;
+	}
+
+	/*
+	 * 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);
+	    }
+	}
     }
-    return result;
+
+    /*
+     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create temporary file: %s", Tcl_PosixError(interp)));
+	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_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
+    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index a8360fc..2136883 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -37,6 +37,16 @@ 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);
+
+/*
+ * 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.
+ */
+
+#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE))
+#define GUESSED_BLOCK_SIZE	1024
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -62,9 +72,9 @@ SetResultLength(
 {
     Tcl_DStringSetLength(resultPtr, offset);
     if (extended == 2) {
-	Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
+	TclDStringAppendLiteral(resultPtr, "//?/UNC/");
     } else if (extended == 1) {
-	Tcl_DStringAppend(resultPtr, "//?/", 4);
+	TclDStringAppendLiteral(resultPtr, "//?/");
     }
 }
 
@@ -121,7 +131,7 @@ ExtractWinRoot(
 	if (path[1] != '/' && path[1] != '\\') {
 	    SetResultLength(resultPtr, offset, extended);
 	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
-	    Tcl_DStringAppend(resultPtr, "/", 1);
+	    TclDStringAppendLiteral(resultPtr, "/");
 	    return &path[1];
 	}
 	host = &path[2];
@@ -151,7 +161,7 @@ ExtractWinRoot(
 	     */
 
 	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
-	    Tcl_DStringAppend(resultPtr, "/", 1);
+	    TclDStringAppendLiteral(resultPtr, "/");
 	    return &path[2];
 	}
 	SetResultLength(resultPtr, offset, extended);
@@ -170,9 +180,9 @@ ExtractWinRoot(
 		break;
 	    }
 	}
-	Tcl_DStringAppend(resultPtr, "//", 2);
+	TclDStringAppendLiteral(resultPtr, "//");
 	Tcl_DStringAppend(resultPtr, host, hlen);
-	Tcl_DStringAppend(resultPtr, "/", 1);
+	TclDStringAppendLiteral(resultPtr, "/");
 	Tcl_DStringAppend(resultPtr, share, slen);
 
 	tail = &share[slen];
@@ -211,7 +221,7 @@ ExtractWinRoot(
 
 	    *typePtr = TCL_PATH_ABSOLUTE;
 	    Tcl_DStringAppend(resultPtr, path, 2);
-	    Tcl_DStringAppend(resultPtr, "/", 1);
+	    TclDStringAppendLiteral(resultPtr, "/");
 
 	    return tail;
 	}
@@ -446,8 +456,7 @@ TclpGetNativePathType(
 	    if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
 		*driveNameLengthPtr = rootEnd - path;
 		if (driveNameRef != NULL) {
-		    *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
-			    Tcl_DStringLength(&ds));
+		    *driveNameRef = TclDStringToObj(&ds);
 		    Tcl_IncrRefCount(*driveNameRef);
 		}
 	    }
@@ -578,8 +587,7 @@ Tcl_SplitPath(
      * plus the argv pointers and the terminating NULL pointer.
      */
 
-    *argvPtr = (const char **) ckalloc((unsigned)
-	    ((((*argcPtr) + 1) * sizeof(char *)) + size));
+    *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);
 
     /*
      * Position p after the last argv pointer and copy the contents of the
@@ -737,8 +745,7 @@ SplitWinPath(
      */
 
     if (p != path) {
-	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
-		Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
+	Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf));
     }
     Tcl_DStringFree(&buf);
 
@@ -800,32 +807,28 @@ Tcl_FSJoinToPath(
     int objc,			/* Number of array elements to join */
     Tcl_Obj *const objv[])	/* Path elements to join. */
 {
-    int i;
-    Tcl_Obj *lobj, *ret;
-
     if (pathPtr == NULL) {
-	lobj = Tcl_NewListObj(0, NULL);
-    } else {
-	lobj = Tcl_NewListObj(1, &pathPtr);
+	return TclJoinPath(objc, objv);
     }
-
-    for (i = 0; i<objc;i++) {
-	Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
+    if (objc == 0) {
+	return TclJoinPath(1, &pathPtr);
     }
-    ret = Tcl_FSJoinPath(lobj, -1);
-
-    /*
-     * It is possible that 'ret' is just a member of the list and is therefore
-     * going to be freed here. Therefore we must adjust the refCount manually.
-     * (It would be better if we changed the documentation of this function
-     * and Tcl_FSJoinPath so that the returned object already has a refCount
-     * for the caller, hence avoiding these subtleties (and code ugliness)).
-     */
+    if (objc == 1) {
+	Tcl_Obj *pair[2];
 
-    Tcl_IncrRefCount(ret);
-    Tcl_DecrRefCount(lobj);
-    ret->refCount--;
-    return ret;
+	pair[0] = pathPtr;
+	pair[1] = objv[0];
+	return TclJoinPath(2, pair);
+    } 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;
+    }
 }
 
 /*
@@ -1059,7 +1062,7 @@ Tcl_TranslateFileName(
     }
 
     Tcl_DStringInit(bufferPtr);
-    Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
+    TclDStringAppendObj(bufferPtr, transPtr);
     Tcl_DecrRefCount(path);
     Tcl_DecrRefCount(transPtr);
 
@@ -1176,9 +1179,10 @@ DoTildeSubst(
 	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_SetObjResult(interp, Tcl_NewStringObj(
+			"couldn't find HOME environment "
+			"variable to expand path", -1));
+		Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL);
 	    }
 	    return NULL;
 	}
@@ -1187,8 +1191,9 @@ DoTildeSubst(
     } else if (TclpGetUserHome(user, resultPtr) == NULL) {
 	if (interp) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "user \"%s\" doesn't exist", user));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
 	}
 	return NULL;
     }
@@ -1223,10 +1228,10 @@ Tcl_GlobObjCmd(
     int index, i, globFlags, length, join, dir, result;
     char *string;
     const char *separators;
-    Tcl_Obj *typePtr, *resultPtr, *look;
+    Tcl_Obj *typePtr, *look;
     Tcl_Obj *pathOrDir = NULL;
     Tcl_DString prefix;
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-directory", "-join", "-nocomplain", "-path", "-tails",
 	"-types", "--", NULL
     };
@@ -1271,11 +1276,14 @@ Tcl_GlobObjCmd(
 	    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;
@@ -1293,11 +1301,14 @@ Tcl_GlobObjCmd(
 	    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;
@@ -1308,6 +1319,7 @@ Tcl_GlobObjCmd(
 	    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];
@@ -1323,14 +1335,12 @@ Tcl_GlobObjCmd(
     }
 
   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,
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"\"-tails\" must be used with either "
-		"\"-directory\" or \"-path\"", NULL);
+		"\"-directory\" or \"-path\"", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
+		"BADOPTIONCOMBINATION", NULL);
 	return TCL_ERROR;
     }
 
@@ -1410,7 +1420,7 @@ Tcl_GlobObjCmd(
 	    search = Tcl_DStringValue(&pref);
 	    while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
 		Tcl_DStringAppend(&prefix, search, find-search);
-		Tcl_DStringAppend(&prefix, "\\", 1);
+		TclDStringAppendLiteral(&prefix, "\\");
 		Tcl_DStringAppend(&prefix, find, 1);
 		search = find+1;
 		if (*search == '\0') {
@@ -1439,8 +1449,7 @@ Tcl_GlobObjCmd(
 	if (length <= 0) {
 	    goto skipTypes;
 	}
-	globTypes = (Tcl_GlobTypeData*)
-		TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
+	globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
 	globTypes->type = 0;
 	globTypes->perm = 0;
 	globTypes->macType = NULL;
@@ -1537,10 +1546,10 @@ Tcl_GlobObjCmd(
 		 */
 
 	    badTypesArg:
-		TclNewObj(resultPtr);
-		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
-		Tcl_AppendObjToObj(resultPtr, look);
-		Tcl_SetObjResult(interp, resultPtr);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad argument to \"-types\": %s",
+			Tcl_GetString(look)));
+		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
 		result = TCL_ERROR;
 		join = 0;
 		goto endOfGlob;
@@ -1550,6 +1559,7 @@ Tcl_GlobObjCmd(
 			"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;
 	    }
@@ -1572,8 +1582,7 @@ Tcl_GlobObjCmd(
 	    Tcl_DStringInit(&prefix);
 	}
 	for (i = 0; i < objc; i++) {
-	    string = Tcl_GetStringFromObj(objv[i], &length);
-	    Tcl_DStringAppend(&prefix, string, length);
+	    TclDStringAppendObj(&prefix, objv[i]);
 	    if (i != objc -1) {
 		Tcl_DStringAppend(&prefix, separators, 1);
 	    }
@@ -1586,14 +1595,13 @@ Tcl_GlobObjCmd(
     } else if (dir == PATH_GENERAL) {
 	Tcl_DString str;
 
+	Tcl_DStringInit(&str);
 	for (i = 0; i < objc; i++) {
-	    Tcl_DStringInit(&str);
+	    Tcl_DStringSetLength(&str, 0);
 	    if (dir == PATH_GENERAL) {
-		Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
-			Tcl_DStringLength(&prefix));
+		TclDStringAppendDString(&str, &prefix);
 	    }
-	    string = Tcl_GetStringFromObj(objv[i], &length);
-	    Tcl_DStringAppend(&str, string, length);
+	    TclDStringAppendObj(&str, objv[i]);
 	    if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
 		    globTypes) != TCL_OK) {
 		result = TCL_ERROR;
@@ -1625,19 +1633,25 @@ Tcl_GlobObjCmd(
 	}
 
 	if (length == 0) {
-	    Tcl_AppendResult(interp, "no files matched glob pattern",
-		    (join || (objc == 1)) ? " \"" : "s \"", NULL);
+	    Tcl_Obj *errorMsg =
+		    Tcl_ObjPrintf("no files matched glob pattern%s \"",
+			    (join || (objc == 1)) ? "" : "s");
+
 	    if (join) {
-		Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
+		Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
 	    } else {
 		const char *sep = "";
+
 		for (i = 0; i < objc; i++) {
-		    string = Tcl_GetString(objv[i]);
-		    Tcl_AppendResult(interp, sep, string, NULL);
+		    Tcl_AppendPrintfToObj(errorMsg, "%s%s",
+			    sep, Tcl_GetString(objv[i]));
 		    sep = " ";
 		}
 	    }
-	    Tcl_AppendResult(interp, "\"", NULL);
+	    Tcl_AppendToObj(errorMsg, "\"", -1);
+	    Tcl_SetObjResult(interp, errorMsg);
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
+		    NULL);
 	    result = TCL_ERROR;
 	}
     }
@@ -1760,8 +1774,7 @@ TclGlob(
 	    if (head != Tcl_DStringValue(&buffer)) {
 		Tcl_DStringAppend(&buffer, head, -1);
 	    }
-	    pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
-		    Tcl_DStringLength(&buffer));
+	    pathPrefix = TclDStringToObj(&buffer);
 	    Tcl_IncrRefCount(pathPrefix);
 	    globFlags |= TCL_GLOBMODE_DIR;
 	    if (c != '\0') {
@@ -2205,13 +2218,17 @@ DoGlob(
 		closeBrace = p;
 		break;
 	    }
-	    Tcl_SetResult(interp, "unmatched open-brace in file name",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "unmatched open-brace in file name", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+		    "unmatched close-brace in file name", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
+		    NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -2393,9 +2410,9 @@ DoGlob(
 	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
 		if (((*name == '\\') && (name[1] == '/' ||
 			name[1] == '\\')) || (*name == '/')) {
-		    Tcl_DStringAppend(&append, "/", 1);
+		    TclDStringAppendLiteral(&append, "/");
 		} else {
-		    Tcl_DStringAppend(&append, ".", 1);
+		    TclDStringAppendLiteral(&append, ".");
 		}
 	    }
 
@@ -2404,9 +2421,9 @@ DoGlob(
 	case TCL_PLATFORM_UNIX:
 	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
 		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
-		    Tcl_DStringAppend(&append, "/", 1);
+		    TclDStringAppendLiteral(&append, "/");
 		} else {
-		    Tcl_DStringAppend(&append, ".", 1);
+		    TclDStringAppendLiteral(&append, ".");
 		}
 	    }
 	    break;
@@ -2417,8 +2434,7 @@ DoGlob(
 	 */
 
 	if (pathPtr == NULL) {
-	    joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
-		    Tcl_DStringLength(&append));
+	    joinedPtr = TclDStringToObj(&append);
 	} else if (flags) {
 	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
 		    Tcl_DStringLength(&append));
@@ -2507,7 +2523,130 @@ DoGlob(
 Tcl_StatBuf *
 Tcl_AllocStatBuf(void)
 {
-    return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
+    return ckalloc(sizeof(Tcl_StatBuf));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Access functions for Tcl_StatBuf --
+ *
+ *	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]
+ *
+ * Results:
+ *	The value from the field being retrieved.
+ *
+ * Side effects:
+ *	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
 }
 
 /*
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 02cb424..1eec7ff 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -28,18 +28,18 @@ MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
 MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
 			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
 MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
-			    Tcl_Filesystem **fsPtrPtr);
+			    const Tcl_Filesystem **fsPtrPtr);
 MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
-			    Tcl_Filesystem *fsPtr, ClientData clientData);
+			    const Tcl_Filesystem *fsPtr, ClientData clientData);
 MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
 			    Tcl_Obj *pathPtr);
-MODULE_SCOPE int	TclFSEpoch(void);
+MODULE_SCOPE size_t	TclFSEpoch(void);
 
 /*
  * Private shared variables for use by tclIOUtil.c and tclPathObj.c
  */
 
-MODULE_SCOPE Tcl_Filesystem tclNativeFilesystem;
+MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
 
 /*
  * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
@@ -47,24 +47,24 @@ MODULE_SCOPE Tcl_Filesystem tclNativeFilesystem;
  */
 
 MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
-			    Tcl_Filesystem **filesystemPtrPtr,
+			    const Tcl_Filesystem **filesystemPtrPtr,
 			    int *driveNameLengthPtr);
-MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(CONST char *pathPtr,
-			    int pathLen, Tcl_Filesystem **filesystemPtrPtr,
+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,
-			    Tcl_Filesystem **filesystemPtrPtr,
+			    const Tcl_Filesystem **filesystemPtrPtr,
 			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
-MODULE_SCOPE int	TclFSEpochOk(int filesystemEpoch);
+MODULE_SCOPE int	TclFSEpochOk(size_t filesystemEpoch);
 MODULE_SCOPE int	TclFSCwdIsNative(void);
 MODULE_SCOPE Tcl_Obj *	TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
-			    CONST char *path, Tcl_Obj **useThisCwdPtr);
+			    const char *path, Tcl_Obj **useThisCwdPtr);
 
 MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
 MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;
 
 #endif /* _TCLFILESYSTEM */
-
+
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 28734d1..97e8c7b 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -36,7 +36,7 @@
 int
 Tcl_GetInt(
     Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
-    CONST char *src,		/* String containing a (possibly signed)
+    const char *src,		/* String containing a (possibly signed)
 				 * integer in a form acceptable to
 				 * Tcl_GetIntFromObj(). */
     int *intPtr)		/* Place to store converted result. */
@@ -60,52 +60,6 @@ Tcl_GetInt(
 /*
  *----------------------------------------------------------------------
  *
- * 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" (a difference that matters on 64-bit architectures).
- *
- * Results:
- *	The return value is normally TCL_OK; in this case *longPtr will be set
- *	to the long integer value equivalent to src. If src is improperly
- *	formed then TCL_ERROR is returned and an error message will be left in
- *	the interp's result if interp is non-NULL.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGetLong(
-    Tcl_Interp *interp,		/* Interpreter used for error reporting if not
-				 * NULL. */
-    CONST char *src,		/* String containing a (possibly signed) long
-				 * integer in a form acceptable to
-				 * Tcl_GetLongFromObj(). */
-    long *longPtr)		/* Place to store converted long result. */
-{
-    Tcl_Obj obj;
-    int code;
-
-    obj.refCount = 1;
-    obj.bytes = (char *) src;
-    obj.length = strlen(src);
-    obj.typePtr = NULL;
-
-    code = Tcl_GetLongFromObj(interp, &obj, longPtr);
-    if (obj.refCount > 1) {
-	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
-    }
-    TclFreeIntRep(&obj);
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_GetDouble --
  *
  *	Given a string, produce the corresponding double-precision
@@ -126,8 +80,8 @@ TclGetLong(
 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 
+    const char *src,		/* String containing a floating-point number
+				 * in a form acceptable to
 				 * Tcl_GetDoubleFromObj(). */
     double *doublePtr)		/* Place to store converted result. */
 {
@@ -170,8 +124,8 @@ 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. */
+    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. */
 {
@@ -183,7 +137,7 @@ Tcl_GetBoolean(
     obj.length = strlen(src);
     obj.typePtr = NULL;
 
-    code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
+    code = TclSetBooleanFromAny(interp, &obj);
     if (obj.refCount > 1) {
 	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
     }
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index 551b1ed..da4c3fd 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -502,10 +502,6 @@ o_merid : /* NULL */ {
 	;
 
 %%
-MODULE_SCOPE int yychar;
-MODULE_SCOPE YYSTYPE yylval;
-MODULE_SCOPE int yynerrs;
-
 /*
  * Month and day table.
  */
@@ -535,7 +531,7 @@ static const TABLE MonthDayTable[] = {
     { "thurs",		tDAY, 4 },
     { "friday",		tDAY, 5 },
     { "saturday",	tDAY, 6 },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -553,7 +549,7 @@ static const TABLE UnitsTable[] = {
     { "min",		tSEC_UNIT,	60 },
     { "second",		tSEC_UNIT,	 1 },
     { "sec",		tSEC_UNIT,	 1 },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -585,7 +581,7 @@ static const TABLE OtherTable[] = {
     { "ago",		tAGO,		1 },
     { "epoch",		tEPOCH,		0 },
     { "stardate",	tSTARDATE,	0 },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -671,7 +667,7 @@ static const TABLE TimezoneTable[] = {
     /* ADDED BY Marco Nijdam */
     { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
     /* End ADDED */
-    {  NULL  }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -704,7 +700,7 @@ static const TABLE MilitaryTable[] = {
     { "x",	tZONE,	HOUR( 11) },
     { "y",	tZONE,	HOUR( 12) },
     { "z",	tZONE,	HOUR( 0) },
-    { NULL }
+    { NULL, 0, 0 }
 };
 
 /*
@@ -967,7 +963,7 @@ TclClockOldscanObjCmd(
     ClientData clientData,	/* Unused */
     Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Count of paraneters */
-    Tcl_Obj *CONST *objv)	/* Parameters */
+    Tcl_Obj *const *objv)	/* Parameters */
 {
     Tcl_Obj *result, *resultElement;
     int yr, mo, da;
@@ -1015,10 +1011,12 @@ TclClockOldscanObjCmd(
     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 "
@@ -1026,6 +1024,7 @@ TclClockOldscanObjCmd(
 						  "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);
@@ -1033,26 +1032,31 @@ TclClockOldscanObjCmd(
     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;
     }
 
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 256b073..1991aea 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -35,25 +35,27 @@
  */
 
 #define RANDOM_INDEX(tablePtr, i) \
-    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
+    ((((i)*1103515245L) >> (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(Tcl_HashTable *tablePtr, void *keyPtr);
+static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
 
 /*
- * Prototypes for the one word hash key methods.
+ * 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.
  */
 
 #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);
+			    void *keyPtr);
+static int		CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
 #endif
 
 /*
@@ -61,9 +63,9 @@ static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, VOID *keyPtr);
  */
 
 static Tcl_HashEntry *	AllocStringEntry(Tcl_HashTable *tablePtr,
-			    VOID *keyPtr);
-static int		CompareStringKeys(VOID *keyPtr, Tcl_HashEntry *hPtr);
-static unsigned int	HashStringKey(Tcl_HashTable *tablePtr, VOID *keyPtr);
+			    void *keyPtr);
+static int		CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static unsigned int	HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
 
 /*
  * Function prototypes for static functions in this file:
@@ -77,7 +79,7 @@ static Tcl_HashEntry *	CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
 static Tcl_HashEntry *	FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
 static void		RebuildTable(Tcl_HashTable *tablePtr);
 
-Tcl_HashKeyType tclArrayHashKeyType = {
+const Tcl_HashKeyType tclArrayHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
     TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
     HashArrayKey,			/* hashKeyProc */
@@ -86,7 +88,7 @@ Tcl_HashKeyType tclArrayHashKeyType = {
     NULL				/* freeEntryProc */
 };
 
-Tcl_HashKeyType tclOneWordHashKeyType = {
+const Tcl_HashKeyType tclOneWordHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
     0,					/* flags */
     NULL, /* HashOneWordKey, */		/* hashProc */
@@ -95,7 +97,7 @@ Tcl_HashKeyType tclOneWordHashKeyType = {
     NULL  /* FreeOneWordKey, */		/* freeEntryProc */
 };
 
-Tcl_HashKeyType tclStringHashKeyType = {
+const Tcl_HashKeyType tclStringHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
     0,					/* flags */
     HashStringKey,			/* hashKeyProc */
@@ -122,7 +124,6 @@ Tcl_HashKeyType tclStringHashKeyType = {
  *----------------------------------------------------------------------
  */
 
-#undef Tcl_InitHashTable
 void
 Tcl_InitHashTable(
     register Tcl_HashTable *tablePtr,
@@ -139,7 +140,7 @@ Tcl_InitHashTable(
      * extended version by a macro.
      */
 
-    Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
+    Tcl_InitCustomHashTable(tablePtr, keyType, (const Tcl_HashKeyType *) -1);
 }
 
 /*
@@ -170,7 +171,7 @@ Tcl_InitCustomHashTable(
 				 * 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
+    const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
 				 * behaviour of this table. */
 {
 #if (TCL_SMALL_HASH_TABLE != 4)
@@ -229,7 +230,7 @@ Tcl_InitCustomHashTable(
 Tcl_HashEntry *
 Tcl_FindHashEntry(
     Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const char *key)		/* Key to use to find matching entry. */
+    const void *key)		/* Key to use to find matching entry. */
 {
     return (*((tablePtr)->findProc))(tablePtr, key);
 }
@@ -267,7 +268,7 @@ FindHashEntry(
 Tcl_HashEntry *
 Tcl_CreateHashEntry(
     Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const char *key,		/* Key to use to find or create matching
+    const void *key,		/* Key to use to find or create matching
 				 * entry. */
     int *newPtr)		/* Store info here telling whether a new entry
 				 * was created. */
@@ -300,15 +301,15 @@ CreateHashEntry(
     }
 
     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);
+	index = RANDOM_INDEX(tablePtr, hash);
     }
 
     /*
@@ -317,6 +318,7 @@ CreateHashEntry(
 
     if (typePtr->compareKeysProc) {
 	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
+
 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
 		hPtr = hPtr->nextPtr) {
 #if TCL_HASH_KEY_STORE_HASH
@@ -324,7 +326,7 @@ CreateHashEntry(
 		continue;
 	    }
 #endif
-	    if (compareKeysProc((VOID *) key, hPtr)) {
+	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
 		if (newPtr) {
 		    *newPtr = 0;
 		}
@@ -358,9 +360,9 @@ CreateHashEntry(
 
     *newPtr = 1;
     if (typePtr->allocEntryProc) {
-	hPtr = typePtr->allocEntryProc(tablePtr, (VOID *) key);
+	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
     } else {
-	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
+	hPtr = ckalloc(sizeof(Tcl_HashEntry));
 	hPtr->key.oneWordValue = (char *) key;
 	hPtr->clientData = 0;
     }
@@ -371,7 +373,7 @@ CreateHashEntry(
     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
@@ -434,12 +436,12 @@ Tcl_DeleteHashEntry(
 #if TCL_HASH_KEY_STORE_HASH
     if (typePtr->hashKeyProc == NULL
 	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-	index = RANDOM_INDEX(tablePtr, PTR2UINT(entryPtr->hash));
+	index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
     } else {
 	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
     }
 
-    bucketPtr = &(tablePtr->buckets[index]);
+    bucketPtr = &tablePtr->buckets[index];
 #else
     bucketPtr = entryPtr->bucketPtr;
 #endif
@@ -460,9 +462,9 @@ Tcl_DeleteHashEntry(
 
     tablePtr->numEntries--;
     if (typePtr->freeEntryProc) {
-	typePtr->freeEntryProc (entryPtr);
+	typePtr->freeEntryProc(entryPtr);
     } else {
-	ckfree((char *) entryPtr);
+	ckfree(entryPtr);
     }
 }
 
@@ -511,9 +513,9 @@ Tcl_DeleteHashTable(
 	while (hPtr != NULL) {
 	    nextPtr = hPtr->nextPtr;
 	    if (typePtr->freeEntryProc) {
-		typePtr->freeEntryProc (hPtr);
+		typePtr->freeEntryProc(hPtr);
 	    } else {
-		ckfree((char *) hPtr);
+		ckfree(hPtr);
 	    }
 	    hPtr = nextPtr;
 	}
@@ -527,7 +529,7 @@ Tcl_DeleteHashTable(
 	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
 	    TclpSysFree((char *) tablePtr->buckets);
 	} else {
-	    ckfree((char *) tablePtr->buckets);
+	    ckfree(tablePtr->buckets);
 	}
     }
 
@@ -642,18 +644,6 @@ Tcl_HashStats(
     double average, tmp;
     register Tcl_HashEntry *hPtr;
     char *result, *p;
-    const Tcl_HashKeyType *typePtr;
-
-    if (tablePtr->keyType == TCL_STRING_KEYS) {
-	typePtr = &tclStringHashKeyType;
-    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
-	typePtr = &tclOneWordHashKeyType;
-    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
-	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
-	typePtr = tablePtr->typePtr;
-    } else {
-	typePtr = &tclArrayHashKeyType;
-    }
 
     /*
      * Compute a histogram of bucket usage.
@@ -684,11 +674,7 @@ Tcl_HashStats(
      * Print out the histogram and a few other pieces of information.
      */
 
-    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
-	result = (char *) TclpSysAlloc((unsigned) (NUM_COUNTERS*60) + 300, 0);
-    } else {
-	result = (char *) ckalloc((unsigned) (NUM_COUNTERS*60) + 300);
-    }
+    result = ckalloc((NUM_COUNTERS * 60) + 300);
     sprintf(result, "%d entries in table, %d buckets\n",
 	    tablePtr->numEntries, tablePtr->numBuckets);
     p = result + strlen(result);
@@ -723,7 +709,7 @@ Tcl_HashStats(
 static Tcl_HashEntry *
 AllocArrayEntry(
     Tcl_HashTable *tablePtr,	/* Hash table. */
-    VOID *keyPtr)		/* Key to store in the hash table entry. */
+    void *keyPtr)		/* Key to store in the hash table entry. */
 {
     int *array = (int *) keyPtr;
     register int *iPtr1, *iPtr2;
@@ -737,7 +723,7 @@ AllocArrayEntry(
     if (size < sizeof(Tcl_HashEntry)) {
 	size = sizeof(Tcl_HashEntry);
     }
-    hPtr = (Tcl_HashEntry *) ckalloc(size);
+    hPtr = ckalloc(size);
 
     for (iPtr1 = array, iPtr2 = hPtr->key.words;
 	    count > 0; count--, iPtr1++, iPtr2++) {
@@ -767,7 +753,7 @@ AllocArrayEntry(
 
 static int
 CompareArrayKeys(
-    VOID *keyPtr,		/* New key to compare. */
+    void *keyPtr,		/* New key to compare. */
     Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
     register const int *iPtr1 = (const int *) keyPtr;
@@ -807,7 +793,7 @@ CompareArrayKeys(
 static unsigned int
 HashArrayKey(
     Tcl_HashTable *tablePtr,	/* Hash table. */
-    VOID *keyPtr)		/* Key from which to compute hash value. */
+    void *keyPtr)		/* Key from which to compute hash value. */
 {
     register const int *array = (const int *) keyPtr;
     register unsigned int result;
@@ -839,7 +825,7 @@ HashArrayKey(
 static Tcl_HashEntry *
 AllocStringEntry(
     Tcl_HashTable *tablePtr,	/* Hash table. */
-    VOID *keyPtr)		/* Key to store in the hash table entry. */
+    void *keyPtr)		/* Key to store in the hash table entry. */
 {
     const char *string = (const char *) keyPtr;
     Tcl_HashEntry *hPtr;
@@ -849,7 +835,7 @@ AllocStringEntry(
     if (size < sizeof(hPtr->key)) {
 	allocsize = sizeof(hPtr->key);
     }
-    hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
+    hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
     memcpy(hPtr->key.string, string, size);
     hPtr->clientData = 0;
     return hPtr;
@@ -874,7 +860,7 @@ AllocStringEntry(
 
 static int
 CompareStringKeys(
-    VOID *keyPtr,		/* New key to compare. */
+    void *keyPtr,		/* New key to compare. */
     Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
     register const char *p1 = (const char *) keyPtr;
@@ -900,14 +886,14 @@ CompareStringKeys(
  *----------------------------------------------------------------------
  */
 
-static unsigned int
+static unsigned
 HashStringKey(
     Tcl_HashTable *tablePtr,	/* Hash table. */
-    VOID *keyPtr)		/* Key from which to compute hash value. */
+    void *keyPtr)		/* Key from which to compute hash value. */
 {
-    register const char *string = (const char *) keyPtr;
+    register const char *string = keyPtr;
     register unsigned int result;
-    register int c;
+    register char c;
 
     /*
      * I tried a zillion different hash functions and asked many other people
@@ -917,19 +903,34 @@ HashStringKey(
      * following reasons:
      *
      * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
-     *	  multiplying by 9 is just about as good.
+     *    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.
+     *    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.
+     *
+     * See also HashString in tclLiteral.c.
+     * See also TclObjHashKey in tclObj.c.
+     *
+     * See [tcl-Feature Request #2958832]
      */
 
-    result = 0;
-
-    for (c=*string++ ; c ; c=*string++) {
-	result += (result<<3) + c;
+    if ((result = UCHAR(*string)) != 0) {
+	while ((c = *++string) != 0) {
+	    result += (result << 3) + UCHAR(c);
+	}
     }
     return result;
 }
@@ -1043,8 +1044,8 @@ RebuildTable(
 	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
 		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
     } else {
-	tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
-		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
+	tablePtr->buckets =
+		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
     }
     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
 	    count > 0; count--, newChainPtr++) {
@@ -1064,29 +1065,29 @@ RebuildTable(
 #if TCL_HASH_KEY_STORE_HASH
 	    if (typePtr->hashKeyProc == NULL
 		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-		index = RANDOM_INDEX (tablePtr, PTR2UINT(hPtr->hash));
+		index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
 	    } else {
 		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
 	    }
 	    hPtr->nextPtr = tablePtr->buckets[index];
 	    tablePtr->buckets[index] = hPtr;
 #else
-	    VOID *key = (VOID *) Tcl_GetHashKey(tablePtr, hPtr);
+	    void *key = Tcl_GetHashKey(tablePtr, hPtr);
 
 	    if (typePtr->hashKeyProc) {
 		unsigned int hash;
 
 		hash = typePtr->hashKeyProc(tablePtr, 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
@@ -1101,7 +1102,7 @@ RebuildTable(
 	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
 	    TclpSysFree((char *) oldBuckets);
 	} else {
-	    ckfree((char *) oldBuckets);
+	    ckfree(oldBuckets);
 	}
     }
 }
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index 97cbdcd..b08e352 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -14,6 +14,24 @@
  */
 
 #include "tclInt.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;
 
 /*
  *----------------------------------------------------------------------
@@ -37,7 +55,7 @@ int
 Tcl_RecordAndEval(
     Tcl_Interp *interp,		/* Token for interpreter in which command will
 				 * be executed. */
-    CONST char *cmd,		/* Command to record. */
+    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
@@ -111,35 +129,48 @@ Tcl_RecordAndEvalObj(
 				 * current procedure. */
 {
     int result, call = 1;
-    Tcl_Obj *list[3];
-    register Tcl_Obj *objPtr;
     Tcl_CmdInfo info;
+    HistoryObjs *histObjsPtr =
+	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
 
     /*
-     * Do not call [history] if it has been replaced by an empty proc
+     * Create the references to the [::history add] command if necessary.
      */
 
-    result = Tcl_GetCommandInfo(interp, "history", &info);
+    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
+     */
 
-    if (result && (info.objProc == TclObjInterpProc)) {
-	Proc *procPtr = (Proc *)(info.objClientData);
+    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.
 	 */
 
-	TclNewLiteralStringObj(list[0], "history");
-	TclNewLiteralStringObj(list[1], "add");
+	list[0] = histObjsPtr->historyObj;
+	list[1] = histObjsPtr->addObj;
 	list[2] = cmdPtr;
 
-	objPtr = Tcl_NewListObj(3, list);
-	Tcl_IncrRefCount(objPtr);
-	(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-	Tcl_DecrRefCount(objPtr);
+	Tcl_IncrRefCount(cmdPtr);
+	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(cmdPtr);
 
 	/*
 	 * One possible failure mode above: exceeding a resource limit.
@@ -162,6 +193,35 @@ Tcl_RecordAndEvalObj(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * 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
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2e1569f..64501fd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -35,15 +35,15 @@ typedef struct ChannelHandler {
 
 /*
  * This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
+ * the current invocation of Tcl_NotifyChannel. There is a potential
  * problem if a ChannelHandler is deleted while it is the current one, since
- * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * Tcl_NotifyChannel needs to look at the nextPtr field. To handle this
  * problem, structures of the type below indicate the next handler to be
  * processed for any (recursively nested) dispatches in progress. The
  * nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nextPtr field is used to chain together all recursive invocations, so
- * that Tcl_DeleteChannelHandler can find all the recursively nested
- * invocations of ChannelHandlerEventProc and compare the handler being
+ * The nestedHandlerPtr field is used to chain together all recursive
+ * invocations, so that Tcl_DeleteChannelHandler can find all the recursively
+ * nested invocations of Tcl_NotifyChannel and compare the handler being
  * deleted against the NEXT handler to be invoked in that invocation; when it
  * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
  * field of the structure to the next handler.
@@ -54,21 +54,10 @@ typedef struct NextChannelHandler {
 					 * this invocation. */
     struct NextChannelHandler *nestedHandlerPtr;
 					/* Next nested invocation of
-					 * ChannelHandlerEventProc. */
+					 * Tcl_NotifyChannel. */
 } NextChannelHandler;
 
 /*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
- */
-
-typedef struct ChannelHandlerEvent {
-    Tcl_Event header;		/* Standard header for all events. */
-    Channel *chanPtr;		/* The channel that is ready. */
-    int readyMask;		/* Events that have occurred. */
-} ChannelHandlerEvent;
-
-/*
  * The following structure is used by Tcl_GetsObj() to encapsulates the
  * state for a "gets" operation.
  */
@@ -109,7 +98,7 @@ typedef struct CopyState {
     struct Channel *writePtr;	/* Pointer to output channel. */
     int readFlags;		/* Original read channel flags. */
     int writeFlags;		/* Original write channel flags. */
-    int toRead;			/* Number of bytes to copy, or -1. */
+    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
     Tcl_WideInt total;		/* Total bytes transferred (written). */
     Tcl_Interp *interp;		/* Interp that started the copy. */
     Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
@@ -130,7 +119,7 @@ typedef struct CopyState {
 typedef struct ThreadSpecificData {
     NextChannelHandler *nestedHandlerPtr;
 				/* This variable holds the list of nested
-				 * ChannelHandlerEventProc invocations. */
+				 * Tcl_NotifyChannel invocations. */
     ChannelState *firstCSPtr;	/* List of all channels currently open,
 				 * indexed by ChannelState, as only one
 				 * ChannelState exists per set of stacked
@@ -178,8 +167,19 @@ 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		CopyData(CopyState *csPtr, int mask);
+static int		MoveBytes(CopyState *csPtr);
+
+static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
+static void		MBError(CopyState *csPtr, int mask, int errorCode);
+static int		MBRead(CopyState *csPtr);
+static int		MBWrite(CopyState *csPtr);
+static void		MBEvent(ClientData clientData, int mask);
+
 static void		CopyEventProc(ClientData clientData, int mask);
 static void		CreateScriptRecord(Tcl_Interp *interp,
 			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
@@ -191,7 +191,8 @@ 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 *dst, int bytesToRead);
+static int		DoRead(Channel *chanPtr, char *dst, int bytesToRead,
+			    int allowShortReads);
 static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
 			    int appendFlag);
 static int		FilterInputBytes(Channel *chanPtr,
@@ -225,7 +226,7 @@ static int		Write(Channel *chanPtr, const char *src,
 static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
 static void		SpliceChannel(Tcl_Channel chan);
 static void		CutChannel(Tcl_Channel chan);
-static int WillRead(Channel *chanPtr);
+static int              WillRead(Channel *chanPtr);
 
 #define WriteChars(chanPtr, src, srcLen) \
 			Write(chanPtr, src, srcLen, chanPtr->state->encoding)
@@ -276,21 +277,21 @@ static int WillRead(Channel *chanPtr);
  * --------------------------------------------------------------------------
  */
 
-#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
+#define BytesLeft(bufPtr)	((bufPtr)->nextAdded - (bufPtr)->nextRemoved)
 
-#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)
+#define SpaceLeft(bufPtr)	((bufPtr)->bufLength - (bufPtr)->nextAdded)
 
-#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
+#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
 
-#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
+#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
 
-#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
+#define IsBufferFull(bufPtr)	((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
 
-#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)
+#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
 
-#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
+#define InsertPoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextAdded)
 
-#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
+#define RemovePoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextRemoved)
 
 /*
  * For working with channel state flag bits.
@@ -328,7 +329,7 @@ typedef struct ResolvedChanName {
 static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
 static void		FreeChannelIntRep(Tcl_Obj *objPtr);
 
-static Tcl_ObjType chanObjType = {
+static const Tcl_ObjType chanObjType = {
     "channel",			/* name for this type */
     FreeChannelIntRep,		/* freeIntRepProc */
     DupChannelIntRep,		/* dupIntRepProc */
@@ -336,7 +337,7 @@ static Tcl_ObjType chanObjType = {
     NULL			/* setFromAnyProc */
 };
 
-#define BUSY_STATE(st,fl) \
+#define BUSY_STATE(st, fl) \
      ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
       (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
 
@@ -345,6 +346,39 @@ static Tcl_ObjType chanObjType = {
 /*
  *---------------------------------------------------------------------------
  *
+ * 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);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
  * ChanRead --
  *
  *	Read up to dstSize bytes using the inputProc of chanPtr, store
@@ -452,6 +486,37 @@ ChanSeek(
 	    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);
+}
 
 /*
  *---------------------------------------------------------------------------
@@ -507,6 +572,19 @@ 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
@@ -525,26 +603,38 @@ TclFinalizeIOSubsystem(void)
 		statePtr != NULL;
 		statePtr = statePtr->nextCSPtr) {
 	    chanPtr = statePtr->topChanPtr;
-	    if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
+            if (GotFlag(statePtr, CHANNEL_DEAD)) {
+                continue;
+            }
+	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED )
+                || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+                ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
 		active = 1;
 		break;
 	    }
 	}
 
 	/*
-	 * We've found a live channel. Close it.
+	 * We've found a live (or bg-closing) channel. Close it.
 	 */
 
 	if (active) {
-	    /*
-	     * Set the channel back into blocking mode to ensure that we wait
-	     * for all data to flush out.
-	     */
 
 	    TclChannelPreserve((Tcl_Channel)chanPtr);
+	    /*
+	     * 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".
+	     */
+            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) ||
@@ -577,12 +667,7 @@ TclFinalizeIOSubsystem(void)
 		 * device for this channel.
 		 */
 
-		if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
-		    (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
-		} else {
-		    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
-			    NULL, 0);
-		}
+		(void) ChanClose(chanPtr, NULL);
 
 		/*
 		 * Finally, we clean up the fields in the channel data
@@ -745,7 +830,7 @@ Tcl_CreateCloseHandler(
     ChannelState *statePtr = ((Channel *) chan)->state;
     CloseCallback *cbPtr;
 
-    cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
+    cbPtr = ckalloc(sizeof(CloseCallback));
     cbPtr->proc = proc;
     cbPtr->clientData = clientData;
 
@@ -791,11 +876,10 @@ Tcl_DeleteCloseHandler(
 	    } else {
 		cbPrevPtr->nextPtr = cbPtr->nextPtr;
 	    }
-	    ckfree((char *) cbPtr);
+	    ckfree(cbPtr);
 	    break;
-	} else {
-	    cbPrevPtr = cbPtr;
 	}
+	cbPrevPtr = cbPtr;
     }
 }
 
@@ -827,7 +911,7 @@ GetChannelTable(
 
     hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
     if (hTblPtr == NULL) {
-	hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
 	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
 	Tcl_SetAssocData(interp, "tclIO",
 		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
@@ -916,10 +1000,10 @@ DeleteChannelTable(
 		}
 
 		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-			TclChannelEventScriptInvoker, (ClientData) sPtr);
+			TclChannelEventScriptInvoker, sPtr);
 
 		TclDecrRefCount(sPtr->scriptPtr);
-		ckfree((char *) sPtr);
+		ckfree(sPtr);
 	    } else {
 		prevPtr = sPtr;
 	    }
@@ -934,8 +1018,7 @@ DeleteChannelTable(
 
 	Tcl_DeleteHashEntry(hPtr);
 	statePtr->epoch++;
-	statePtr->refCount--;
-	if (statePtr->refCount <= 0) {
+	if (statePtr->refCount-- <= 1) {
 	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
 	    }
@@ -943,7 +1026,7 @@ DeleteChannelTable(
 
     }
     Tcl_DeleteHashTable(hTblPtr);
-    ckfree((char *) hTblPtr);
+    ckfree(hTblPtr);
 }
 
 /*
@@ -1129,8 +1212,9 @@ Tcl_UnregisterChannel(
 
     if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
 	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "Illegal recursive call to close "
-		    "through close-handler of channel", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                    "illegal recursive call to close through close-handler"
+                    " of channel", -1));
 	}
 	return TCL_ERROR;
     }
@@ -1156,7 +1240,7 @@ Tcl_UnregisterChannel(
      */
 
     if (statePtr->refCount <= 0) {
-	Tcl_Preserve((ClientData)statePtr);
+	Tcl_Preserve(statePtr);
 	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    /*
 	     * We don't want to re-enter Tcl_Close().
@@ -1165,13 +1249,13 @@ Tcl_UnregisterChannel(
 	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
 		if (Tcl_Close(interp, chan) != TCL_OK) {
 		    SetFlag(statePtr, CHANNEL_CLOSED);
-		    Tcl_Release((ClientData)statePtr);
+		    Tcl_Release(statePtr);
 		    return TCL_ERROR;
 		}
 	    }
 	}
 	SetFlag(statePtr, CHANNEL_CLOSED);
-	Tcl_Release((ClientData)statePtr);
+	Tcl_Release(statePtr);
     }
     return TCL_OK;
 }
@@ -1356,8 +1440,8 @@ Tcl_GetChannel(
     hTblPtr = GetChannelTable(interp);
     hPtr = Tcl_FindHashEntry(hTblPtr, name);
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "can not find channel named \"", chanName,
-		"\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "can not find channel named \"%s\"", chanName));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
 	return NULL;
     }
@@ -1371,7 +1455,7 @@ Tcl_GetChannel(
     chanPtr = Tcl_GetHashValue(hPtr);
     chanPtr = chanPtr->state->bottomChanPtr;
     if (modePtr != NULL) {
-	*modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE);
+	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
     }
 
     return (Tcl_Channel) chanPtr;
@@ -1461,10 +1545,10 @@ TclGetChannelFromObj(
     resPtr->epoch = statePtr->epoch;
 
   valid:
-    *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
+    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;
 
     if (modePtr != NULL) {
-	*modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE);
+	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
     }
 
     return TCL_OK;
@@ -1488,7 +1572,7 @@ TclGetChannelFromObj(
 
 Tcl_Channel
 Tcl_CreateChannel(
-    Tcl_ChannelType *typePtr, /* The channel type record. */
+    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
@@ -1498,6 +1582,7 @@ Tcl_CreateChannel(
     ChannelState *statePtr;	/* The stack-level independent state info for
 				 * the channel. */
     const char *name;
+    char *tmp;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
@@ -1510,15 +1595,31 @@ Tcl_CreateChannel(
      * as well.
      */
 
-    assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
+    assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
+    assert(typePtr->typeName != NULL);
+    if (NULL == typePtr->closeProc) {
+	Tcl_Panic("channel type %s must define closeProc", typePtr->typeName);
+    }
+    if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
+	Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
+    }
+    if ((TCL_WRITABLE & mask) &&  (NULL == typePtr->outputProc)) {
+	Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
+    }
+    if (NULL == typePtr->watchProc) {
+	Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
+    }
+    if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
+	Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
+    }
 
     /*
      * JH: We could subsequently memset these to 0 to avoid the numerous
      * assignments to 0/NULL below.
      */
 
-    chanPtr = (Channel *) ckalloc(sizeof(Channel));
-    statePtr = (ChannelState *) ckalloc(sizeof(ChannelState));
+    chanPtr = ckalloc(sizeof(Channel));
+    statePtr = ckalloc(sizeof(ChannelState));
     chanPtr->state = statePtr;
 
     chanPtr->instanceData = instanceData;
@@ -1530,14 +1631,20 @@ Tcl_CreateChannel(
      */
 
     if (chanName != NULL) {
-	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
+	unsigned len = strlen(chanName) + 1;
+
+	/*
+         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
+         * later.
+         */
 
-	statePtr->channelName = tmp;
+	tmp = ckalloc((len < 7) ? 7 : len);
 	strcpy(tmp, chanName);
     } else {
-	Tcl_Panic("Tcl_CreateChannel: NULL channel name");
+	tmp = ckalloc(7);
+	tmp[0] = '\0';
     }
-
+    statePtr->channelName = tmp;
     statePtr->flags = mask;
 
     /*
@@ -1638,14 +1745,17 @@ Tcl_CreateChannel(
      */
 
     if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
+	strcpy(tmp, "stdin");
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
 	Tcl_RegisterChannel(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);
     } else if ((tsdPtr->stderrChannel == NULL) &&
 	    (tsdPtr->stderrInitialized == 1)) {
+	strcpy(tmp, "stderr");
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
 	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
     }
@@ -1682,7 +1792,8 @@ Tcl_CreateChannel(
 Tcl_Channel
 Tcl_StackChannel(
     Tcl_Interp *interp,		/* The interpreter we are working in */
-    Tcl_ChannelType *typePtr,	/* The channel type record for the new
+    const Tcl_ChannelType *typePtr,
+				/* The channel type record for the new
 				 * channel. */
     ClientData instanceData,	/* Instance specific data for the new
 				 * channel. */
@@ -1693,7 +1804,6 @@ Tcl_StackChannel(
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     Channel *chanPtr, *prevChanPtr;
     ChannelState *statePtr;
-    Tcl_DriverThreadActionProc *threadActionProc;
 
     /*
      * Find the given channel (prevChan) in the list of all channels. If we do
@@ -1711,8 +1821,9 @@ Tcl_StackChannel(
 
     if (statePtr == NULL) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "couldn't find state for channel \"",
-		    Tcl_GetChannelName(prevChan), "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "couldn't find state for channel \"%s\"",
+		    Tcl_GetChannelName(prevChan)));
 	}
 	return NULL;
     }
@@ -1730,11 +1841,11 @@ Tcl_StackChannel(
      *	--+---+---+---+----+
      */
 
-    if ((mask & (GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE))) == 0) {
+    if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
 	if (interp) {
-	    Tcl_AppendResult(interp,
-		    "reading and writing both disallowed for channel \"",
-		    Tcl_GetChannelName(prevChan), "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "reading and writing both disallowed for channel \"%s\"",
+		    Tcl_GetChannelName(prevChan)));
 	}
 	return NULL;
     }
@@ -1761,8 +1872,9 @@ Tcl_StackChannel(
 	    statePtr->csPtrR = csPtrR;
 	    statePtr->csPtrW = csPtrW;
 	    if (interp) {
-		Tcl_AppendResult(interp, "could not flush channel \"",
-			Tcl_GetChannelName(prevChan), "\"", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "could not flush channel \"%s\"",
+			Tcl_GetChannelName(prevChan)));
 	    }
 	    return NULL;
 	}
@@ -1803,7 +1915,7 @@ Tcl_StackChannel(
 	statePtr->inQueueTail = NULL;
     }
 
-    chanPtr = (Channel *) ckalloc(sizeof(Channel));
+    chanPtr = ckalloc(sizeof(Channel));
 
     /*
      * Save some of the current state into the new structure, reinitialize the
@@ -1840,10 +1952,7 @@ Tcl_StackChannel(
      * time, mangling it.
      */
 
-    threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
-    if (threadActionProc != NULL) {
-	(*threadActionProc)(chanPtr->instanceData, TCL_CHANNEL_THREAD_INSERT);
-    }
+    ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
 
     return (Tcl_Channel) chanPtr;
 }
@@ -1868,7 +1977,7 @@ TclChannelRelease(
 	return;
     }
     if (chanPtr->typePtr == NULL) {
-	ckfree((char *)chanPtr);
+	ckfree(chanPtr);
     }
 }
 
@@ -1877,7 +1986,7 @@ ChannelFree(
     Channel *chanPtr)
 {
     if (chanPtr->refCount == 0) {
-	ckfree((char *)chanPtr);
+	ckfree(chanPtr);
 	return;
     }
     chanPtr->typePtr = NULL;
@@ -1909,7 +2018,6 @@ Tcl_UnstackChannel(
     Channel *chanPtr = (Channel *) chan;
     ChannelState *statePtr = chanPtr->state;
     int result = 0;
-    Tcl_DriverThreadActionProc *threadActionProc;
 
     /*
      * This operation should occur at the top of a channel stack.
@@ -1920,9 +2028,9 @@ Tcl_UnstackChannel(
     if (chanPtr->downChanPtr != NULL) {
 	/*
 	 * Instead of manipulating the per-thread / per-interp list/hashtable
-	 * of registered channels we wind down the state of the transformation,
-	 * and then restore the state of underlying channel into the old
-	 * structure.
+	 * of registered channels we wind down the state of the
+	 * transformation, and then restore the state of underlying channel
+	 * into the old structure.
 	 */
 
 	/*
@@ -1962,9 +2070,9 @@ Tcl_UnstackChannel(
 		 */
 
 		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
-		    Tcl_AppendResult(interp, "could not flush channel \"",
-			    Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
-			    NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                            "could not flush channel \"%s\"",
+			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));
 		}
 		return TCL_ERROR;
 	    }
@@ -2014,11 +2122,7 @@ Tcl_UnstackChannel(
 	 * the state which are still active.
 	 */
 
-	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
-	if (threadActionProc != NULL) {
-	    (*threadActionProc)(chanPtr->instanceData,
-		    TCL_CHANNEL_THREAD_REMOVE);
-	}
+	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
 
 	statePtr->topChanPtr = downChanPtr;
 	downChanPtr->upChanPtr = NULL;
@@ -2032,14 +2136,7 @@ Tcl_UnstackChannel(
 	 * Close and free the channel driver state.
 	 */
 
-	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
-	    result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
-		    interp);
-	} else {
-	    result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
-		    interp, 0);
-	}
-
+	result = ChanClose(chanPtr, interp);
 	ChannelFree(chanPtr);
 
 	UpdateInterest(statePtr->topChanPtr);
@@ -2210,7 +2307,7 @@ Tcl_GetChannelThread(
  *----------------------------------------------------------------------
  */
 
-Tcl_ChannelType *
+const Tcl_ChannelType *
 Tcl_GetChannelType(
     Tcl_Channel chan)		/* The channel to return type for. */
 {
@@ -2245,7 +2342,7 @@ Tcl_GetChannelMode(
     ChannelState *statePtr = ((Channel *) chan)->state;
 				/* State of actual channel. */
 
-    return GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE);
+    return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
 }
 
 /*
@@ -2269,9 +2366,9 @@ const char *
 Tcl_GetChannelName(
     Tcl_Channel chan)		/* The channel for which to return the name. */
 {
-    ChannelState *statePtr;	/* State of actual channel. */
+    ChannelState *statePtr = ((Channel *) chan)->state;
+				/* State of actual channel. */
 
-    statePtr = ((Channel *) chan)->state;
     return statePtr->channelName;
 }
 
@@ -2304,15 +2401,13 @@ Tcl_GetChannelHandle(
 
     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
     if (!chanPtr->typePtr->getHandleProc) {
-	Tcl_Obj* err;
-	TclNewLiteralStringObj(err, "channel \"");
-	Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
-	Tcl_AppendToObj(err, "\" does not support OS handles", -1);
-	Tcl_SetChannelError (chan,err);
+        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;
     }
@@ -2351,7 +2446,7 @@ AllocChannelBuffer(
     int n;
 
     n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
-    bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
+    bufPtr = ckalloc(n);
     bufPtr->nextAdded	= BUFFER_PADDING;
     bufPtr->nextRemoved	= BUFFER_PADDING;
     bufPtr->bufLength	= length + BUFFER_PADDING;
@@ -2364,6 +2459,9 @@ static void
 PreserveChannelBuffer(
     ChannelBuffer *bufPtr)
 {
+    if (bufPtr->refCount == 0) {
+	Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
+    }
     bufPtr->refCount++;
 }
 
@@ -2374,7 +2472,7 @@ ReleaseChannelBuffer(
     if (--bufPtr->refCount) {
 	return;
     }
-    ckfree((char *) bufPtr);
+    ckfree(bufPtr);
 }
 
 static int
@@ -2531,15 +2629,16 @@ CheckForDeadChannel(
     Tcl_Interp *interp,		/* For error reporting (can be NULL) */
     ChannelState *statePtr)	/* The channel state to check. */
 {
-    if (GotFlag(statePtr, CHANNEL_DEAD)) {
-	Tcl_SetErrno(EINVAL);
-	if (interp) {
-	    Tcl_AppendResult(interp,
-		    "unable to access channel: invalid channel", NULL);
-	}
-	return 1;
+    if (!GotFlag(statePtr, CHANNEL_DEAD)) {
+	return 0;
     }
-    return 0;
+
+    Tcl_SetErrno(EINVAL);
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                "unable to access channel: invalid channel", -1));
+    }
+    return 1;
 }
 
 /*
@@ -2547,9 +2646,9 @@ 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
@@ -2600,7 +2699,7 @@ FlushChannel(
      * the post-condition that on a successful return to caller we've
      * left space in the current output buffer for more writing (the flush
      * call was to make new room).
-     * If the channel is blocking, then yes, so we guarantee that 
+     * If the channel is blocking, then yes, so we guarantee that
      * blocking flushes actually flush all pending data.
      * Otherwise, no.  Keep the current output buffer where it is so more
      * can be written to it, possibly filling it, to promote more efficient
@@ -2645,8 +2744,8 @@ FlushChannel(
 	 */
 
 	PreserveChannelBuffer(bufPtr);
-	written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
-		RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode);
+	written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr),
+		&errorCode);
 
 	/*
 	 * If the write failed completely attempt to start the asynchronous
@@ -2678,7 +2777,7 @@ FlushChannel(
 		 * it's a tty channel (dup'ed underneath)
 		 */
 
-		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
 		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
 		    UpdateInterest(chanPtr);
 		}
@@ -2729,14 +2828,8 @@ FlushChannel(
 		Tcl_SetErrno(errorCode);
 		if (interp != NULL && !TclChanCaughtErrorBypass(interp,
 			(Tcl_Channel) chanPtr)) {
-		    /*
-		     * Casting away const here is safe because the
-		     * TCL_VOLATILE flag guarantees const treatment of the
-		     * Posix error string.
-		     */
-
-		    Tcl_SetResult(interp, (char *) Tcl_PosixError(interp),
-			    TCL_VOLATILE);
+		    Tcl_SetObjResult(interp,
+			    Tcl_NewStringObj(Tcl_PosixError(interp), -1));
 		}
 
 		/*
@@ -2787,14 +2880,26 @@ FlushChannel(
 	    goto done;
 	} else if (statePtr->outQueueHead == NULL) {
 	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
-	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
-		    statePtr->interestMask);
+	    ChanWatch(chanPtr, statePtr->interestMask);
 	} else {
-	    /* TODO: If code reaches this point, it means a writable
-	     * event is being handled on the channel, but the channel
-	     * could not in fact be written to.  This ought not happen,
-	     * but Unix pipes appear to act this way (see io-53.4).
-	     * Also can imagine broken reflected channels. */
+
+	    /*
+	     * When we are calledFromAsyncFlush, that means a writable
+	     * state on the channel triggered the call, so we should be
+	     * able to write something.  Either we did write something
+	     * and wroteSome should be set, or there was nothing left to
+	     * write in this call, and we've completed the BG flush.
+	     * These are the two cases above.  If we get here, that means
+	     * there is some kind failure in the writable event machinery.
+	     *
+	     * The tls extension indeed suffers from flaws in its channel
+	     * event mgmt.  See http://core.tcl.tk/tcl/info/c31ca233ca.
+	     * Until that patch is broadly distributed, disable the
+	     * assertion checking here, so that programs using Tcl and
+	     * tls can be debugged.
+
+	    assert(!calledFromAsyncFlush);
+	     */
 	}
     }
 
@@ -2809,7 +2914,23 @@ FlushChannel(
 	    ((statePtr->curOutPtr == NULL) ||
 	    IsBufferEmpty(statePtr->curOutPtr))) {
 	errorCode = CloseChannel(interp, chanPtr, errorCode);
+	goto done;
+    }
+
+    /*
+     * 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:
     TclChannelRelease((Tcl_Channel)chanPtr);
     return errorCode;
@@ -2886,7 +3007,7 @@ CloseChannel(
 	int dummy;
 	char c = (char) statePtr->outEofChar;
 
-	(chanPtr->typePtr->outputProc)(chanPtr->instanceData, &c, 1, &dummy);
+	(void) ChanWrite(chanPtr, &c, 1, &dummy);
     }
 
     /*
@@ -2897,7 +3018,7 @@ CloseChannel(
 
     if (statePtr->chanMsg != NULL) {
 	if (interp != NULL) {
-	    Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+	    Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
 	}
 	TclDecrRefCount(statePtr->chanMsg);
 	statePtr->chanMsg = NULL;
@@ -2914,12 +3035,7 @@ CloseChannel(
      * This may leave a TIP #219 error message in the interp.
      */
 
-    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
-	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
-    } else {
-	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
-		interp, 0);
-    }
+    result = ChanClose(chanPtr, interp);
 
     /*
      * Some resources can be cleared only if the bottom channel in a stack is
@@ -2928,7 +3044,7 @@ CloseChannel(
 
     if (chanPtr == statePtr->bottomChanPtr) {
 	if (statePtr->channelName != NULL) {
-	    ckfree((char *) statePtr->channelName);
+	    ckfree(statePtr->channelName);
 	    statePtr->channelName = NULL;
 	}
 
@@ -2954,7 +3070,7 @@ CloseChannel(
 	    statePtr->chanMsg = NULL;
 	}
 	if (interp) {
-	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
+	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
 	}
     }
     if (errorCode == 0) {
@@ -3037,7 +3153,6 @@ CutChannel(
 				 * 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
@@ -3064,11 +3179,7 @@ CutChannel(
      * TIP #218, Channel Thread Actions
      */
 
-    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
-    if (threadActionProc != NULL) {
-	(*threadActionProc)(Tcl_GetChannelInstanceData(chan),
-		TCL_CHANNEL_THREAD_REMOVE);
-    }
+    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE);
 }
 
 void
@@ -3083,7 +3194,6 @@ Tcl_CutChannel(
 				 * the list on close. */
     ChannelState *statePtr = chanPtr->state;
 				/* State of the channel stack. */
-    Tcl_DriverThreadActionProc *threadActionProc;
 
     /*
      * Remove this channel from of the list of all channels (in the current
@@ -3111,13 +3221,8 @@ Tcl_CutChannel(
      * For all transformations and the base channel.
      */
 
-    while (chanPtr) {
-	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
-	if (threadActionProc != NULL) {
-	    (*threadActionProc)(chanPtr->instanceData,
-		    TCL_CHANNEL_THREAD_REMOVE);
-	}
-	chanPtr= chanPtr->upChanPtr;
+    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
+	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
     }
 }
 
@@ -3154,7 +3259,6 @@ SpliceChannel(
 {
     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");
@@ -3175,11 +3279,7 @@ SpliceChannel(
      * TIP #218, Channel Thread Actions
      */
 
-    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
-    if (threadActionProc != NULL) {
-	(*threadActionProc) (Tcl_GetChannelInstanceData(chan),
-		TCL_CHANNEL_THREAD_INSERT);
-    }
+    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT);
 }
 
 void
@@ -3190,7 +3290,6 @@ Tcl_SpliceChannel(
     Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ChannelState *statePtr = chanPtr->state;
-    Tcl_DriverThreadActionProc *threadActionProc;
 
     if (statePtr->nextCSPtr != NULL) {
 	Tcl_Panic("SpliceChannel: trying to add channel used in different list");
@@ -3212,13 +3311,8 @@ Tcl_SpliceChannel(
      * For all transformations and the base channel.
      */
 
-    while (chanPtr) {
-	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
-	if (threadActionProc != NULL) {
-	    (*threadActionProc)(chanPtr->instanceData,
-		    TCL_CHANNEL_THREAD_INSERT);
-	}
-	chanPtr= chanPtr->upChanPtr;
+    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
+	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
     }
 }
 
@@ -3287,8 +3381,9 @@ Tcl_Close(
 
     if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "Illegal recursive call to close "
-		    "through close-handler of channel", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                    "illegal recursive call to close through close-handler"
+                    " of channel", -1));
 	}
 	return TCL_ERROR;
     }
@@ -3324,7 +3419,7 @@ Tcl_Close(
 
 	if (statePtr->chanMsg != NULL) {
 	    if (interp != NULL) {
-		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
 	    }
 	    TclDecrRefCount(statePtr->chanMsg);
 	    statePtr->chanMsg = NULL;
@@ -3340,8 +3435,8 @@ Tcl_Close(
     while (statePtr->closeCbPtr != NULL) {
 	cbPtr = statePtr->closeCbPtr;
 	statePtr->closeCbPtr = cbPtr->nextPtr;
-	(cbPtr->proc)(cbPtr->clientData);
-	ckfree((char *) cbPtr);
+	cbPtr->proc(cbPtr->clientData);
+	ckfree(cbPtr);
     }
 
     ResetFlag(statePtr, CHANNEL_INCLOSE);
@@ -3352,7 +3447,7 @@ Tcl_Close(
      */
 
     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;
@@ -3412,6 +3507,341 @@ Tcl_Close(
 /*
  *----------------------------------------------------------------------
  *
+ * 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_SetObjResult(interp, Tcl_ObjPrintf(
+                "half-close of channels not supported by %ss",
+		chanPtr->typePtr->typeName));
+	return TCL_ERROR;
+    }
+
+    /*
+     * Is the channel unstacked ? If not we fail.
+     */
+
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"half-close not applicable to stack of transformations", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+                "Half-close of %s-side not possible, side not opened or"
+                " already closed", msg));
+	return TCL_ERROR;
+    }
+
+    /*
+     * A user may try to call half-close from within a channel close
+     * handler. That won't do.
+     */
+
+    if (statePtr->flags & CHANNEL_INCLOSE) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                    "illegal recursive call to close through close-handler"
+                    " of channel", -1));
+	}
+	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) {
+	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;
+
+    /*
+     * 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;
+    }
+
+    /*
+     * Remove the closed side from the channel mode/flags.
+     */
+
+    ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ClearChannelHandlers --
  *
  *	Removes all channel handlers and event scripts from the channel,
@@ -3471,7 +3901,7 @@ Tcl_ClearChannelHandlers(
 
     for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
 	chNext = chPtr->nextPtr;
-	ckfree((char *) chPtr);
+	ckfree(chPtr);
     }
     statePtr->chPtr = NULL;
 
@@ -3498,7 +3928,7 @@ Tcl_ClearChannelHandlers(
     for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
 	eNextPtr = ePtr->nextPtr;
 	TclDecrRefCount(ePtr->scriptPtr);
-	ckfree((char *) ePtr);
+	ckfree(ePtr);
     }
     statePtr->scriptRecordPtr = NULL;
 }
@@ -3606,9 +4036,7 @@ Tcl_WriteRaw(
      * The code was stolen from 'FlushChannel'.
      */
 
-    written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
-	    src, srcLen, &errorCode);
-
+    written = ChanWrite(chanPtr, src, srcLen, &errorCode);
     if (written < 0) {
 	Tcl_SetErrno(errorCode);
     }
@@ -3719,7 +4147,7 @@ Tcl_WriteObj(
 
     Channel *chanPtr;
     ChannelState *statePtr;	/* State info for channel */
-    char *src;
+    const char *src;
     int srcLen;
 
     statePtr = ((Channel *) chan)->state;
@@ -3737,19 +4165,24 @@ Tcl_WriteObj(
     }
 }
 
-static void WillWrite(Channel *chanPtr)
+static void
+WillWrite(
+    Channel *chanPtr)
 {
     int inputBuffered;
 
-    if ((chanPtr->typePtr->seekProc != NULL)
-        && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)) {
+    if ((chanPtr->typePtr->seekProc != NULL) &&
+            ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
         int ignore;
+
         DiscardInputQueued(chanPtr->state, 0);
-        ChanSeek(chanPtr, - inputBuffered, SEEK_CUR, &ignore);
+        ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
     }
 }
 
-static int WillRead(Channel *chanPtr)
+static int
+WillRead(
+    Channel *chanPtr)
 {
     if (chanPtr->typePtr == NULL) {
 	/* Prevent read attempts on a closed channel */
@@ -3758,7 +4191,7 @@ static int WillRead(Channel *chanPtr)
 	return -1;
     }
     if ((chanPtr->typePtr->seekProc != NULL)
-        && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
+            && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
 
 	/*
 	 * CAVEAT - The assumption here is that FlushChannel() will
@@ -3833,7 +4266,7 @@ Write(
 	if (nextNewLine) {
 	    srcLimit = nextNewLine - src;
 	}
-	
+
 	/* Get space to write into */
 	bufPtr = statePtr->curOutPtr;
 	if (bufPtr == NULL) {
@@ -3861,7 +4294,7 @@ Write(
 
 	/* See chan-io-1.[89]. Tcl Bug 506297. */
 	statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
-	
+
 	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
 	    /* We're reading from invalid/incomplete UTF-8 */
 	    ReleaseChannelBuffer(bufPtr);
@@ -3901,7 +4334,7 @@ Write(
 		Tcl_Panic("unknown output translation requested");
 		break;
 	    }
-	
+
 	    result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
 		statePtr->outputEncodingFlags,
 		&statePtr->outputEncodingState, dst,
@@ -3998,14 +4431,12 @@ Tcl_Gets(
 				 * for managing the storage. */
 {
     Tcl_Obj *objPtr;
-    int charsStored, length;
-    char *string;
+    int charsStored;
 
     TclNewObj(objPtr);
     charsStored = Tcl_GetsObj(chan, objPtr);
     if (charsStored > 0) {
-	string = TclGetStringFromObj(objPtr, &length);
-	Tcl_DStringAppend(lineRead, string, length);
+	TclDStringAppendObj(lineRead, objPtr);
     }
     TclDecrRefCount(objPtr);
     return charsStored;
@@ -4227,14 +4658,14 @@ Tcl_GetsObj(
 		     * Skip the raw bytes that make up the '\n'.
 		     */
 
-		    char tmp[1 + TCL_UTF_MAX];
+		    char tmp[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);
+			    gs.rawRead, statePtr->inputEncodingFlags
+				| TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
+			    TCL_UTF_MAX, &rawRead, NULL, NULL);
 		    bufPtr->nextRemoved += rawRead;
 		    gs.rawRead -= rawRead;
 		    gs.bytesWrote--;
@@ -4335,8 +4766,9 @@ Tcl_GetsObj(
     }
     statePtr->inputEncodingState = gs.state;
     Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
-	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
-	    eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
+	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+	    &statePtr->inputEncodingState, dst,
+	    eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL,
 	    &gs.charsWrote);
     bufPtr->nextRemoved += gs.rawRead;
 
@@ -4490,7 +4922,11 @@ TclGetsObjBinary(
     skip = 0;
     eof = NULL;
     inEofChar = statePtr->inEofChar;
-    /* Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR */
+
+    /*
+     * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR.
+     */
+
     eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
 
     ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4864,9 +5300,9 @@ FilterInputBytes(
     }
     gsPtr->state = statePtr->inputEncodingState;
     result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
-	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-	    dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
-	    &gsPtr->charsWrote);
+	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
+	    &gsPtr->bytesWrote, &gsPtr->charsWrote);
 
     /*
      * Make sure that if we go through 'gets', that we reset the
@@ -5064,7 +5500,7 @@ CommonGetsCleanup(
 	    extra = SpaceLeft(bufPtr);
 	    if (extra > 0) {
 		memcpy(InsertPoint(bufPtr),
-			nextPtr->buf + BUFFER_PADDING - extra,
+			nextPtr->buf + (BUFFER_PADDING - extra),
 			(size_t) extra);
 		bufPtr->nextAdded += extra;
 		nextPtr->nextRemoved = BUFFER_PADDING;
@@ -5116,7 +5552,7 @@ Tcl_Read(
 	return -1;
     }
 
-    return DoRead(chanPtr, dst, bytesToRead);
+    return DoRead(chanPtr, dst, bytesToRead, 0);
 }
 
 /*
@@ -5328,7 +5764,7 @@ DoReadChars(
     int factor = UTF_EXPANSION_FACTOR;
 
     binaryMode = (encoding == NULL)
-	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF) 
+	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
 	    && (statePtr->inEofChar == '\0');
 
     if (appendFlag == 0) {
@@ -5385,7 +5821,7 @@ DoReadChars(
     chanPtr = statePtr->topChanPtr;
     TclChannelPreserve((Tcl_Channel)chanPtr);
 
-    /* Must clear the BLOCKED flag here since we check before reading */
+    /* Must clear the BLOCKED|EOF flags here since we check before reading */
     if (GotFlag(statePtr, CHANNEL_EOF)) {
 	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
     }
@@ -5406,9 +5842,8 @@ DoReadChars(
 
 	    bufPtr = statePtr->inQueueHead;
 	    if (IsBufferEmpty(bufPtr)) {
-		ChannelBuffer *nextPtr;
+		ChannelBuffer *nextPtr = bufPtr->nextPtr;
 
-		nextPtr = bufPtr->nextPtr;
 		RecycleBuffer(statePtr, bufPtr, 0);
 		statePtr->inQueueHead = nextPtr;
 		if (nextPtr == NULL) {
@@ -5584,7 +6019,7 @@ ReadChars(
     int savedIEFlags = statePtr->inputEncodingFlags;
     int savedFlags = statePtr->flags;
     char *dst, *src = RemovePoint(bufPtr);
-    int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
+    int numBytes, srcLen = BytesLeft(bufPtr);
 
     /*
      * One src byte can yield at most one character.  So when the
@@ -5594,23 +6029,23 @@ ReadChars(
      * for sizing receiving buffers.
      */
 
-    int toRead = ((unsigned) charsToRead > (unsigned) srcLen) ? srcLen : charsToRead;
+    int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead;
 
     /*
      * '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.
      */
-    
+
     int factor = *factorPtr;
-    int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
+    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
 
     (void) TclGetStringFromObj(objPtr, &numBytes);
-    Tcl_AppendToObj(objPtr, NULL, dstNeeded);
+    Tcl_AppendToObj(objPtr, NULL, dstLimit);
     if (toRead == srcLen) {
 	unsigned int size;
 	dst = TclGetStringStorage(objPtr, &size) + numBytes;
-	dstNeeded = size - numBytes;
+	dstLimit = size - numBytes;
     } else {
 	dst = TclGetString(objPtr) + numBytes;
     }
@@ -5631,9 +6066,14 @@ ReadChars(
      * a consistent set of results.  This takes the shape of a loop.
      */
 
-    dstLimit = dstNeeded + 1;
     while (1) {
 	int dstDecoded, dstRead, dstWrote, srcRead, numChars, code;
+	int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE;
+
+	if (charsToRead > 0) {
+	    flags |= TCL_ENCODING_CHAR_LIMIT;
+	    numChars = charsToRead;
+	}
 
 	/*
 	 * Perform the encoding transformation.  Read no more than
@@ -5654,7 +6094,7 @@ ReadChars(
 		|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);
 
 	code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
+		flags, &statePtr->inputEncodingState,
 		dst, dstLimit, &srcRead, &dstDecoded, &numChars);
 
 	/*
@@ -5718,7 +6158,7 @@ ReadChars(
 		     * time.
 		     */
 
-		    dstLimit = dstRead + TCL_UTF_MAX;
+		    dstLimit = dstRead - 1 + TCL_UTF_MAX;
 		    statePtr->flags = savedFlags;
 		    statePtr->inputEncodingFlags = savedIEFlags;
 		    statePtr->inputEncodingState = savedState;
@@ -5744,7 +6184,7 @@ ReadChars(
 		 * up back here in this call.
 		 */
 
-		dstLimit = dstRead + TCL_UTF_MAX;
+		dstLimit = dstRead - 1 + TCL_UTF_MAX;
 		statePtr->flags = savedFlags;
 		statePtr->inputEncodingFlags = savedIEFlags;
 		statePtr->inputEncodingState = savedState;
@@ -5761,10 +6201,10 @@ ReadChars(
 	     */
 
 	    if (code != TCL_OK) {
-		char buffer[TCL_UTF_MAX + 2];
+		char buffer[TCL_UTF_MAX + 1];
 		int read, decoded, count;
 
-		/* 
+		/*
 		 * Didn't get everything the buffer could offer
 		 */
 
@@ -5777,8 +6217,9 @@ ReadChars(
 			(statePtr->inputEncodingFlags & TCL_ENCODING_END));
 
 		Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
+		(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
+		&statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1,
+		&read, &decoded, &count);
 
 		if (count == 2) {
 		    if (buffer[1] == '\n') {
@@ -5790,14 +6231,13 @@ ReadChars(
 			bufPtr->nextRemoved += srcRead;
 		    }
 
-		    dst[1] = '\0';
 		    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
 
 		    Tcl_SetObjLength(objPtr, numBytes + 1);
 		    return 1;
 		}
 
-	    } else if (GotFlag(statePtr, CHANNEL_EOF)) {
+	    } else if (statePtr->flags & CHANNEL_EOF) {
 
 		/*
 		 * The bare \r is the only char and we will never read
@@ -5820,7 +6260,7 @@ ReadChars(
 	    /* FALL THROUGH - get more data (dstWrote == 0) */
 	}
 
-	/* 
+	/*
 	 * The translation transformation can only reduce the number
 	 * of chars when it converts \r\n into \n.  The reduction in
 	 * the number of chars is the difference in bytes read and written.
@@ -5830,14 +6270,16 @@ ReadChars(
 
 	if (charsToRead > 0 && numChars > charsToRead) {
 
-	    /* 
+	    /*
+	     * TODO: This cannot happen anymore.
+	     *
 	     * We read more chars than allowed.  Reset limits to
 	     * prevent that and try again.  Don't forget the extra
 	     * padding of TCL_UTF_MAX bytes demanded by the
 	     * Tcl_ExternalToUtf() call!
 	     */
 
-	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst;
+	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
 	    statePtr->flags = savedFlags;
 	    statePtr->inputEncodingFlags = savedIEFlags;
 	    statePtr->inputEncodingState = savedState;
@@ -5851,7 +6293,7 @@ ReadChars(
 
 	    assert (numChars == 0);
 
-	    /* 
+	    /*
 	     * There is one situation where this is the correct final
 	     * result.  If the src buffer contains only a single \n
 	     * byte, and we are in TCL_TRANSLATE_AUTO mode, and
@@ -5861,9 +6303,8 @@ ReadChars(
 	     * empty string.
 	     */
 
-	    if (dst[0] == '\n') {
+	    if (dstRead == 1 && dst[0] == '\n') {
 		assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
-		assert(dstRead == 1);
 
 		goto consume;
 	    }
@@ -5945,7 +6386,7 @@ ReadChars(
  *---------------------------------------------------------------------------
  */
 
-static void 
+static void
 TranslateInputEOL(
     ChannelState *statePtr,	/* Channel being read, for EOL translation and
 				 * EOF character. */
@@ -6055,7 +6496,7 @@ TranslateInputEOL(
 	char *dst = dstStart;
 	int lesser;
 
-	if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) {
+	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
 	    if (*src == '\n') { src++; srcLen--; }
 	    ResetFlag(statePtr, INPUT_SAW_CR);
 	}
@@ -6151,7 +6592,7 @@ Tcl_Ungets(
     /*
      * Clear the EOF flags, and clear the BLOCKED bit.
      */
- 
+
     if (GotFlag(statePtr, CHANNEL_EOF)) {
 	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
     }
@@ -6308,7 +6749,7 @@ GetInput(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
 
-    /* 
+    /*
      * Verify that all callers know better than to call us when
      * it's recorded that the next char waiting to be read is the
      * eofchar.
@@ -6530,8 +6971,8 @@ Tcl_Seek(
     if (GotFlag(statePtr, CHANNEL_EOF)) {
 	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
     }
-    statePtr->flags &=
-	~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR);
+    ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
+	    INPUT_SAW_CR);
     statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
 
     /*
@@ -6567,23 +7008,10 @@ Tcl_Seek(
     } else {
 	/*
 	 * Now seek to the new position in the channel as requested by the
-	 * caller. Note that we prefer the wideSeekProc if that is available
-	 * and non-NULL...
+	 * caller.
 	 */
 
-	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));
-	}
+	curPos = ChanSeek(chanPtr, offset, mode, &result);
 	if (curPos == Tcl_LongAsWide(-1)) {
 	    Tcl_SetErrno(result);
 	}
@@ -6678,25 +7106,13 @@ Tcl_Tell(
     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...
      */
 
-    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));
-    }
+    curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
     if (curPos == Tcl_LongAsWide(-1)) {
 	Tcl_SetErrno(result);
 	return Tcl_LongAsWide(-1);
@@ -6735,19 +7151,18 @@ Tcl_SeekOld(
 {
     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_WideInt wResult;
+    Tcl_WideInt wResult = Tcl_Tell(chan);
 
-    wResult = Tcl_Tell(chan);
-    return (int)Tcl_WideAsLong(wResult);
+    return (int) Tcl_WideAsLong(wResult);
 }
 
 /*
@@ -6788,7 +7203,7 @@ Tcl_TruncateChannel(
 	return TCL_ERROR;
     }
 
-    if (!(chanPtr->state->flags & TCL_WRITABLE)) {
+    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.
@@ -6885,7 +7300,7 @@ CheckChannelErrors(
      * Fail if the channel is not opened for desired operation.
      */
 
-    if (GotFlag(statePtr, direction) == 0) {
+    if ((statePtr->flags & direction) == 0) {
 	Tcl_SetErrno(EACCES);
 	return -1;
     }
@@ -7112,9 +7527,9 @@ Tcl_SetChannelBufferSize(
      */
 
     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;
@@ -7211,11 +7626,12 @@ Tcl_BadChannelOption(
 	const char **argv;
 	int argc, i;
 	Tcl_DString ds;
+        Tcl_Obj *errObj;
 
 	Tcl_DStringInit(&ds);
 	Tcl_DStringAppend(&ds, genericopt, -1);
 	if (optionList && (*optionList)) {
-	    Tcl_DStringAppend(&ds, " ", 1);
+	    TclDStringAppendLiteral(&ds, " ");
 	    Tcl_DStringAppend(&ds, optionList, -1);
 	}
 	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
@@ -7223,15 +7639,16 @@ Tcl_BadChannelOption(
 	    Tcl_Panic("malformed option list in channel driver");
 	}
 	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "bad option \"", optionName,
-		"\": should be one of ", NULL);
+	errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
+                optionName);
 	argc--;
 	for (i = 0; i < argc; i++) {
-	    Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
+	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
 	}
-	Tcl_AppendResult(interp, "or -", argv[i], NULL);
+	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
+        Tcl_SetObjResult(interp, errObj);
 	Tcl_DStringFree(&ds);
-	ckfree((char *) argv);
+	ckfree(argv);
     }
     Tcl_SetErrno(EINVAL);
     return TCL_ERROR;
@@ -7293,9 +7710,9 @@ 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;
     }
@@ -7455,8 +7872,8 @@ Tcl_GetChannelOption(
 	 * 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.
@@ -7507,8 +7924,9 @@ Tcl_SetChannelOption(
 
     if (statePtr->csPtrR || statePtr->csPtrW) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "unable to set channel options: "
-		    "background copy in progress", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                    "unable to set channel options: background copy in"
+                    " progress", -1));
 	}
 	return TCL_ERROR;
     }
@@ -7547,8 +7965,7 @@ Tcl_SetChannelOption(
     } else if (HaveOpt(7, "-buffering")) {
 	len = strlen(newValue);
 	if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
-	    statePtr->flags &=
-		    ~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED);
+	    ResetFlag(statePtr, CHANNEL_UNBUFFERED | CHANNEL_LINEBUFFERED);
 	} else if ((newValue[0] == 'l') &&
 		(strncmp(newValue, "line", len) == 0)) {
 	    ResetFlag(statePtr, CHANNEL_UNBUFFERED);
@@ -7557,12 +7974,11 @@ Tcl_SetChannelOption(
 		(strncmp(newValue, "none", len) == 0)) {
 	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
 	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
-	} else {
-	    if (interp) {
-		Tcl_AppendResult(interp, "bad value for -buffering: "
-			"must be one of full, line, or none", NULL);
-		return TCL_ERROR;
-	    }
+	} else if (interp) {
+            Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                    "bad value for -buffering: must be one of"
+                    " full, line, or none", -1));
+            return TCL_ERROR;
 	}
 	return TCL_OK;
     } else if (HaveOpt(7, "-buffersize")) {
@@ -7616,12 +8032,14 @@ Tcl_SetChannelOption(
 	    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);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+                            "bad value for -eofchar: must be non-NUL ASCII"
+                            " character", -1));
 		}
-		ckfree((char *) argv);
+		ckfree(argv);
 		return TCL_ERROR;
 	    }
 	    if (GotFlag(statePtr, TCL_READABLE)) {
@@ -7632,15 +8050,15 @@ Tcl_SetChannelOption(
 	    }
 	} else {
 	    if (interp) {
-		Tcl_AppendResult(interp,
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"bad value for -eofchar: should be a list of zero,"
-			" one, or two elements", NULL);
+			" one, or two elements", -1));
 	    }
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	    return TCL_ERROR;
 	}
 	if (argv != NULL) {
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	}
 
 	/*
@@ -7652,10 +8070,8 @@ Tcl_SetChannelOption(
 	if (GotFlag(statePtr, CHANNEL_EOF)) {
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
 	}
-	statePtr->flags &=
-		~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED);
+	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
-
 	return TCL_OK;
     } else if (HaveOpt(1, "-translation")) {
 	const char *readMode, *writeMode;
@@ -7672,16 +8088,17 @@ Tcl_SetChannelOption(
 	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
 	} else {
 	    if (interp) {
-		Tcl_AppendResult(interp,
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"bad value for -translation: must be a one or two"
-			" element list", NULL);
+			" element list", -1));
 	    }
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	    return TCL_ERROR;
 	}
 
 	if (readMode) {
 	    TclEolTranslation translation;
+
 	    if (*readMode == '\0') {
 		translation = statePtr->inputTranslation;
 	    } else if (strcmp(readMode, "auto") == 0) {
@@ -7701,12 +8118,11 @@ Tcl_SetChannelOption(
 		translation = TCL_PLATFORM_TRANSLATION;
 	    } else {
 		if (interp) {
-		    Tcl_AppendResult(interp,
-			    "bad value for -translation: "
-			    "must be one of auto, binary, cr, lf, crlf,"
-			    " or platform", NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "bad value for -translation: must be one of "
+                            "auto, binary, cr, lf, crlf, or platform", -1));
 		}
-		ckfree((char *) argv);
+		ckfree(argv);
 		return TCL_ERROR;
 	    }
 
@@ -7752,20 +8168,19 @@ Tcl_SetChannelOption(
 		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
 	    } else {
 		if (interp) {
-		    Tcl_AppendResult(interp,
-			    "bad value for -translation: "
-			    "must be one of auto, binary, cr, lf, crlf,"
-			    " or platform", NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "bad value for -translation: must be one of "
+                            "auto, binary, cr, lf, crlf, or platform", -1));
 		}
-		ckfree((char *) argv);
+		ckfree(argv);
 		return TCL_ERROR;
 	    }
 	}
-	ckfree((char *) argv);
+	ckfree(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);
     }
@@ -7820,7 +8235,7 @@ CleanupChannelHandlers(
 		    TclChannelEventScriptInvoker, sPtr);
 
 	    TclDecrRefCount(sPtr->scriptPtr);
-	    ckfree((char *) sPtr);
+	    ckfree(sPtr);
 	} else {
 	    prevPtr = sPtr;
 	}
@@ -7873,14 +8288,14 @@ Tcl_NotifyChannel(
      * their own events and pass them upward.
      */
 
-    while (mask && (chanPtr->upChanPtr != (NULL))) {
+    while (mask && (chanPtr->upChanPtr != NULL)) {
 	Tcl_DriverHandlerProc *upHandlerProc;
 
 	upChanPtr = chanPtr->upChanPtr;
 	upTypePtr = upChanPtr->typePtr;
 	upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
 	if (upHandlerProc != NULL) {
-	    mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
+	    mask = upHandlerProc(upChanPtr->instanceData, mask);
 	}
 
 	/*
@@ -7927,7 +8342,7 @@ Tcl_NotifyChannel(
 
     /*
      * Add this invocation to the list of recursive invocations of
-     * ChannelHandlerEventProc.
+     * Tcl_NotifyChannel.
      */
 
     nh.nextHandlerPtr = NULL;
@@ -7942,7 +8357,7 @@ Tcl_NotifyChannel(
 
 	if ((chPtr->mask & mask) != 0) {
 	    nh.nextHandlerPtr = chPtr->nextPtr;
-	    (*(chPtr->proc))(chPtr->clientData, chPtr->mask & mask);
+	    chPtr->proc(chPtr->clientData, chPtr->mask & mask);
 	    chPtr = nh.nextHandlerPtr;
 	} else {
 	    chPtr = chPtr->nextPtr;
@@ -8063,12 +8478,12 @@ UpdateInterest(
 	    mask &= ~TCL_EXCEPTION;
 
 	    if (!statePtr->timer) {
-		statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
-			chanPtr);
+		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+                        ChannelTimerProc, chanPtr);
 	    }
 	}
     }
-    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
+    ChanWatch(chanPtr, mask);
 }
 
 /*
@@ -8105,7 +8520,8 @@ ChannelTimerProc(
 	 * before UpdateInterest gets called by Tcl_NotifyChannel.
 	 */
 
-	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
+	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+                ChannelTimerProc,chanPtr);
 	Tcl_Preserve(statePtr);
 	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
 	Tcl_Release(statePtr);
@@ -8166,7 +8582,7 @@ Tcl_CreateChannelHandler(
 	}
     }
     if (chPtr == NULL) {
-	chPtr = (ChannelHandler *) ckalloc(sizeof(ChannelHandler));
+	chPtr = ckalloc(sizeof(ChannelHandler));
 	chPtr->mask = 0;
 	chPtr->proc = proc;
 	chPtr->clientData = clientData;
@@ -8250,7 +8666,7 @@ Tcl_DeleteChannelHandler(
     }
 
     /*
-     * If ChannelHandlerEventProc is about to process this handler, tell it to
+     * If Tcl_NotifyChannel is about to process this handler, tell it to
      * process the next one instead - we are going to delete *this* one.
      */
 
@@ -8270,7 +8686,7 @@ Tcl_DeleteChannelHandler(
     } else {
 	prevChPtr->nextPtr = chPtr->nextPtr;
     }
-    ckfree((char *) chPtr);
+    ckfree(chPtr);
 
     /*
      * Recompute the interest list for the channel, so that infinite loops
@@ -8321,6 +8737,7 @@ DeleteScriptRecord(
 	    if (esPtr == statePtr->scriptRecordPtr) {
 		statePtr->scriptRecordPtr = esPtr->nextPtr;
 	    } else {
+		CLANG_ASSERT(prevEsPtr);
 		prevEsPtr->nextPtr = esPtr->nextPtr;
 	    }
 
@@ -8328,7 +8745,7 @@ DeleteScriptRecord(
 		    TclChannelEventScriptInvoker, esPtr);
 
 	    TclDecrRefCount(esPtr->scriptPtr);
-	    ckfree((char *) esPtr);
+	    ckfree(esPtr);
 
 	    break;
 	}
@@ -8377,12 +8794,12 @@ CreateScriptRecord(
     makeCH = (esPtr == NULL);
 
     if (makeCH) {
-	esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord));
+	esPtr = ckalloc(sizeof(EventScriptRecord));
     }
 
     /*
      * Initialize the structure before calling Tcl_CreateChannelHandler,
-     * because a reflected channel caling 'chan postevent' aka
+     * because a reflected channel calling '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].
@@ -8460,7 +8877,7 @@ TclChannelEventScriptInvoker(
 	if (chanPtr->typePtr != NULL) {
 	    DeleteScriptRecord(interp, chanPtr, mask);
 	}
-	TclBackgroundException(interp, result);
+	Tcl_BackgroundException(interp, result);
     }
     TclChannelRelease((Tcl_Channel)chanPtr);
     Tcl_Release(interp);
@@ -8497,11 +8914,11 @@ Tcl_FileEventObjCmd(
     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;
+    const char *chanName;
     int modeIndex;		/* Index of mode argument. */
     int mask;
-    static const char *modeOptions[] = {"readable", "writable", NULL};
-    static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
+    static const char *const 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?");
@@ -8520,9 +8937,9 @@ Tcl_FileEventObjCmd(
     }
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
-    if (GotFlag(statePtr, mask) == 0) {
-	Tcl_AppendResult(interp, "channel is not ",
-		(mask == TCL_READABLE) ? "readable" : "writable", NULL);
+    if ((statePtr->flags & mask) == 0) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
+		(mask == TCL_READABLE) ? "readable" : "writable"));
 	return TCL_ERROR;
     }
 
@@ -8532,6 +8949,7 @@ Tcl_FileEventObjCmd(
 
     if (objc == 3) {
 	EventScriptRecord *esPtr;
+
 	for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;
 		esPtr = esPtr->nextPtr) {
 	    if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
@@ -8611,34 +9029,47 @@ ZeroTransferTimerProc(
  */
 
 int
-TclCopyChannel(
+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. */
+{
     Channel *inPtr = (Channel *) inChan;
     Channel *outPtr = (Channel *) outChan;
     ChannelState *inStatePtr, *outStatePtr;
     int readFlags, writeFlags;
     CopyState *csPtr;
     int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
+    int moveBytes;
 
     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_GetChannelName(inChan), "\" is busy", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
 	}
 	return TCL_ERROR;
     }
-    if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
+    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "channel \"",
-		    Tcl_GetChannelName(outChan), "\" is busy", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
 	}
 	return TCL_ERROR;
     }
@@ -8671,8 +9102,19 @@ TclCopyChannel(
      * Make sure the output side is unbuffered.
      */
 
-    outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
-	| CHANNEL_UNBUFFERED;
+    outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED)
+	    | CHANNEL_UNBUFFERED;
+
+    /*
+     * Test for conditions where we know we can just move bytes from input
+     * channel to output channel with no transformation or even examination
+     * of the bytes themselves.
+     */
+
+    moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
+	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
+	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
+	    && inStatePtr->encoding == outStatePtr->encoding;
 
     /*
      * Allocate a new CopyState to maintain info about the current copy in
@@ -8680,14 +9122,14 @@ TclCopyChannel(
      * completed.
      */
 
-    csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
-    csPtr->bufSize = inStatePtr->bufSize;
+    csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
+    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
     csPtr->readPtr = inPtr;
     csPtr->writePtr = outPtr;
     csPtr->readFlags = readFlags;
     csPtr->writeFlags = writeFlags;
     csPtr->toRead = toRead;
-    csPtr->total = 0;
+    csPtr->total = (Tcl_WideInt) 0;
     csPtr->interp = interp;
     if (cmdPtr) {
 	Tcl_IncrRefCount(cmdPtr);
@@ -8697,6 +9139,10 @@ TclCopyChannel(
     inStatePtr->csPtrR  = csPtr;
     outStatePtr->csPtrW = csPtr;
 
+    if (moveBytes) {
+	return MoveBytes(csPtr);
+    }
+
     /*
      * Special handling of -size 0 async transfers, so that the -command is
      * still called asynchronously.
@@ -8731,6 +9177,236 @@ TclCopyChannel(
  *----------------------------------------------------------------------
  */
 
+static void
+MBCallback(
+    CopyState *csPtr,
+    Tcl_Obj *errObj)
+{
+    Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
+    Tcl_WideInt total = csPtr->total;
+    Tcl_Interp *interp = csPtr->interp;
+    int code;
+
+    Tcl_IncrRefCount(cmdPtr);
+    StopCopy(csPtr);
+
+    /* TODO: What if cmdPtr is not a list?! */
+
+    Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total));
+    if (errObj) {
+	Tcl_ListObjAppendElement(NULL, cmdPtr, errObj);
+    }
+
+    Tcl_Preserve(interp);
+    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+    if (code != TCL_OK) {
+	Tcl_BackgroundException(interp, code);
+    }
+    Tcl_Release(interp);
+    TclDecrRefCount(cmdPtr);
+}
+
+static void
+MBError(
+    CopyState *csPtr,
+    int mask,
+    int errorCode)
+{
+    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+    Tcl_Obj *errObj;
+
+    Tcl_SetErrno(errorCode);
+
+    errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s",
+	    (mask & TCL_READABLE) ? "read" : "writ",
+	    Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
+	    Tcl_PosixError(csPtr->interp));
+
+    if (csPtr->cmdPtr) {
+	MBCallback(csPtr, errObj);
+    } else {
+	Tcl_SetObjResult(csPtr->interp, errObj);
+	StopCopy(csPtr);
+    }
+}
+
+static void
+MBEvent(
+    ClientData clientData,
+    int mask)
+{
+    CopyState *csPtr = (CopyState *) clientData;
+    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+    ChannelState *inStatePtr = csPtr->readPtr->state;
+
+    if (mask & TCL_WRITABLE) {
+	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
+	switch (MBWrite(csPtr)) {
+	case TCL_OK:
+	    MBCallback(csPtr, NULL);
+	    break;
+	case TCL_CONTINUE:
+	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+	    break;
+	}
+    } else if (mask & TCL_READABLE) {
+	if (TCL_OK == MBRead(csPtr)) {
+	    /* When at least one full buffer is present, stop reading. */
+	    if (IsBufferFull(inStatePtr->inQueueHead)
+		    || !Tcl_InputBlocked(inChan)) {
+		Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+	    }
+
+	    /* Successful read -- set up to write the bytes we read */
+	    Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
+	}
+    }
+}
+
+static int
+MBRead(
+    CopyState *csPtr)
+{
+    ChannelState *inStatePtr = csPtr->readPtr->state;
+    ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+    int code;
+
+    if (bufPtr && BytesLeft(bufPtr) > 0) {
+	return TCL_OK;
+    }
+
+    code = GetInput(inStatePtr->topChanPtr);
+    if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
+	return TCL_OK;
+    } else {
+	MBError(csPtr, TCL_READABLE, code);
+	return TCL_ERROR;
+    }
+}
+
+static int
+MBWrite(
+    CopyState *csPtr)
+{
+    ChannelState *inStatePtr = csPtr->readPtr->state;
+    ChannelState *outStatePtr = csPtr->writePtr->state;
+    ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+    ChannelBuffer *tail = NULL;
+    int code;
+    Tcl_WideInt inBytes = 0;
+
+    /* Count up number of bytes waiting in the input queue */
+    while (bufPtr) {
+	inBytes += BytesLeft(bufPtr);
+	tail = bufPtr;
+	if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
+	    /* Queue has enough bytes to complete the copy */
+	    break;
+	}
+	bufPtr = bufPtr->nextPtr;
+    }
+
+    if (bufPtr) {
+	/* Split the overflowing buffer in two */
+	int extra = (int) (inBytes - csPtr->toRead);
+        /* Note that going with int for extra assumes that inBytes is not too
+         * much over toRead to require a wide itself. If that gets violated
+         * then the calculations involving extra must be made wide too.
+         *
+         * Noted with Win32/MSVC debug build treating the warning (possible of
+         * data in __int64 to int conversion) as error.
+         */
+
+	bufPtr = AllocChannelBuffer(extra);
+
+	tail->nextAdded -= extra;
+	memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
+	bufPtr->nextAdded += extra;
+	bufPtr->nextPtr = tail->nextPtr;
+	tail->nextPtr = NULL;
+	inBytes = csPtr->toRead;
+    }
+
+    /* Update the byte counts */
+    if (csPtr->toRead != -1) {
+	csPtr->toRead -= inBytes;
+    }
+    csPtr->total += inBytes;
+
+    /* Move buffers from input to output channels */
+    if (outStatePtr->outQueueTail) {
+	outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+    } else {
+	outStatePtr->outQueueHead = inStatePtr->inQueueHead;
+    }
+    outStatePtr->outQueueTail = tail;
+    inStatePtr->inQueueHead = bufPtr;
+    if (inStatePtr->inQueueTail == tail) {
+	inStatePtr->inQueueTail = bufPtr;
+    }
+    if (bufPtr == NULL) {
+	inStatePtr->inQueueTail = NULL;
+    }
+
+    code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+    if (code) {
+	MBError(csPtr, TCL_WRITABLE, code);
+	return TCL_ERROR;
+    }
+    if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
+	return TCL_OK;
+    }
+    return TCL_CONTINUE;
+}
+
+static int
+MoveBytes(
+    CopyState *csPtr)		/* State of copy operation. */
+{
+    ChannelState *outStatePtr = csPtr->writePtr->state;
+    ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
+    int errorCode;
+
+    if (bufPtr && BytesLeft(bufPtr)) {
+	/* If we start with unflushed bytes in the destination
+	 * channel, flush them out of the way first. */
+
+	errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+	if (errorCode != 0) {
+	    MBError(csPtr, TCL_WRITABLE, errorCode);
+	    return TCL_ERROR;
+	}
+    }
+
+    if (csPtr->cmdPtr) {
+	Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+	Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+	return TCL_OK;
+    }
+
+    while (1) {
+	int code;
+
+	if (TCL_ERROR == MBRead(csPtr)) {
+	    return TCL_ERROR;
+	}
+	code = MBWrite(csPtr);
+	if (code == TCL_OK) {
+	    Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
+	    StopCopy(csPtr);
+	    return TCL_OK;
+	}
+	if (code == TCL_ERROR) {
+	    return TCL_ERROR;
+	}
+	/* code == TCL_CONTINUE --> continue the loop */
+    }
+    return TCL_OK;	/* Silence compiler warnings */
+}
+
 static int
 CopyData(
     CopyState *csPtr,		/* State of copy operation. */
@@ -8742,7 +9418,7 @@ CopyData(
     ChannelState *inStatePtr, *outStatePtr;
     int result = TCL_OK, size, sizeb;
     Tcl_WideInt total;
-    char *buffer;
+    const char *buffer;
     int inBinary, outBinary, sameEncoding;
 				/* Encoding control */
     int underflow;		/* Input underflow */
@@ -8771,7 +9447,7 @@ CopyData(
 	Tcl_IncrRefCount(bufObj);
     }
 
-    while (csPtr->toRead != 0) {
+    while (csPtr->toRead != (Tcl_WideInt) 0) {
 	/*
 	 * Check for unreported background errors.
 	 */
@@ -8795,24 +9471,26 @@ CopyData(
 	     * underflow instead to prime the readable fileevent.
 	     */
 
-	    size      = 0;
+	    size = 0;
 	    underflow = 1;
 	} else {
 	    /*
 	     * Read up to bufSize bytes.
 	     */
 
-	    if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
+	    if ((csPtr->toRead == (Tcl_WideInt) -1)
+                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
 		sizeb = csPtr->bufSize;
 	    } else {
-		sizeb = csPtr->toRead;
+		sizeb = (int) csPtr->toRead;
 	    }
 
 	    if (inBinary || sameEncoding) {
-		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
+		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
+                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
 	    } else {
 		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
-				   0 /* No append */);
+			0 /* No append */);
 	    }
 	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
 	}
@@ -8845,8 +9523,8 @@ CopyData(
 	    if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
 		break;
 	    }
-	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
-		!(mask & TCL_READABLE)) {
+	    if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) &&
+                !(mask & TCL_READABLE)) {
 		if (mask & TCL_WRITABLE) {
 		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 		}
@@ -8854,6 +9532,10 @@ CopyData(
 			csPtr);
 	    }
 	    if (size == 0) {
+		if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
+		    /* We allowed a short read.  Keep trying. */
+		    continue;
+		}
 		if (bufObj != NULL) {
 		    TclDecrRefCount(bufObj);
 		    bufObj = NULL;
@@ -8911,7 +9593,7 @@ CopyData(
 	}
 
 	/*
-	 * (UP) Update the current byte count. Do it now so the count is valid
+	 * 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.
@@ -8937,7 +9619,7 @@ CopyData(
 	 * therefore we don't need a writable handler.
 	 */
 
-	if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) {
+	if (!underflow && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) {
 	    if (!(mask & TCL_WRITABLE)) {
 		if (mask & TCL_READABLE) {
 		    Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
@@ -8988,6 +9670,7 @@ CopyData(
     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
@@ -9005,7 +9688,7 @@ CopyData(
 	}
 	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
 	if (code != TCL_OK) {
-	    TclBackgroundException(interp, code);
+	    Tcl_BackgroundException(interp, code);
 	    result = TCL_ERROR;
 	}
 	TclDecrRefCount(cmdPtr);
@@ -9031,10 +9714,9 @@ CopyData(
  * DoRead --
  *
  *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
- *	These bytes come from reading the channel "chanPtr" and 
- *	performing the configured translations.
- *
- *	No encoding conversions are applied to the bytes being read.
+ *	These bytes come from reading the channel "chanPtr" and
+ *	performing the configured translations.  No encoding conversions
+ *	are applied to the bytes being read.
  *
  * Results:
  *	The number of bytes actually stored (<= bytesToRead),
@@ -9058,8 +9740,9 @@ CopyData(
 static int
 DoRead(
     Channel *chanPtr,		/* The channel from which to read. */
-    char *dst,		/* Where to store input read. */
-    int bytesToRead)		/* Maximum number of bytes to read. */
+    char *dst,			/* Where to store input read. */
+    int bytesToRead,		/* Maximum number of bytes to read. */
+    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
 {
     ChannelState *statePtr = chanPtr->state;
     char *p = dst;
@@ -9103,7 +9786,7 @@ DoRead(
     TclChannelPreserve((Tcl_Channel)chanPtr);
     while (bytesToRead) {
 	/*
-	 * Each pass through the loop is intended to process up to 
+	 * Each pass through the loop is intended to process up to
 	 * one channel buffer.
 	 */
 
@@ -9111,13 +9794,13 @@ DoRead(
 	ChannelBuffer *bufPtr = statePtr->inQueueHead;
 
 	/*
-	 * Don't read more data if we have what we need. 
+	 * Don't read more data if we have what we need.
 	 */
 
 	while (!bufPtr ||			/* We got no buffer!   OR */
 		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
 		(BytesLeft(bufPtr) < bytesToRead) ) ) {
-						/* Not enough bytes in it 
+						/* Not enough bytes in it
 						 * yet to fill the dst */
 	    int code;
 
@@ -9185,13 +9868,13 @@ DoRead(
 	    if (bufPtr->nextPtr == NULL) {
 		/* There's no more buffered data.... */
 
-		if (GotFlag(statePtr, CHANNEL_EOF)) {
+		if (statePtr->flags & CHANNEL_EOF) {
 		    /* ...and there never will be. */
 
 		    *p++ = '\r';
 		    bytesToRead--;
 		    bufPtr->nextRemoved++;
-		} else if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		} else if (statePtr->flags & CHANNEL_BLOCKED) {
 		    /* ...and we cannot get more now. */
 		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 		    break;
@@ -9221,8 +9904,8 @@ DoRead(
 	    bufPtr = statePtr->inQueueHead;
 	}
 
-	if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
-		== (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+	if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
+		&& GotFlag(statePtr, CHANNEL_BLOCKED)) {
 	    break;
 	}
 
@@ -9273,7 +9956,7 @@ CopyEventProc(
     ClientData clientData,
     int mask)
 {
-    (void) CopyData((CopyState *) clientData, mask);
+    (void) CopyData(clientData, mask);
 }
 
 /*
@@ -9298,12 +9981,16 @@ StopCopy(
     CopyState *csPtr)		/* State for bg copy to stop . */
 {
     ChannelState *inStatePtr, *outStatePtr;
+    Tcl_Channel inChan, outChan;
+
     int nonBlocking;
 
     if (!csPtr) {
 	return;
     }
 
+    inChan = (Tcl_Channel) csPtr->readPtr;
+    outChan = (Tcl_Channel) csPtr->writePtr;
     inStatePtr = csPtr->readPtr->state;
     outStatePtr = csPtr->writePtr->state;
 
@@ -9311,34 +9998,34 @@ StopCopy(
      * 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);
 	}
     }
-    outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+    ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
     outStatePtr->flags |=
 	    csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
 
     if (csPtr->cmdPtr) {
-	Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
-		csPtr);
-	if (csPtr->readPtr != csPtr->writePtr) {
-	    Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
-		    CopyEventProc, csPtr);
+	Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
+	if (inChan != outChan) {
+	    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 	}
+	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
 	TclDecrRefCount(csPtr->cmdPtr);
     }
     inStatePtr->csPtrR = NULL;
     outStatePtr->csPtrW = NULL;
-    ckfree((char *) csPtr);
+    ckfree(csPtr);
 }
 
 /*
@@ -9379,7 +10066,7 @@ StackSetBlockMode(
     while (chanPtr != 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;
@@ -9434,8 +10121,9 @@ SetBlockMode(
 	     */
 
 	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
-		Tcl_AppendResult(interp, "error setting blocking mode: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "error setting blocking mode: %s",
+			Tcl_PosixError(interp)));
 	    }
 	} else {
 	    /*
@@ -9532,10 +10220,11 @@ Tcl_GetChannelNamesEx(
 	}
 	goto done;
     }
+
     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&hSearch)) {
-
 	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
+
 	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
 	    name = "stdin";
 	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
@@ -9681,11 +10370,8 @@ 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;
 	}
     }
@@ -9804,13 +10490,13 @@ Tcl_ChannelBlockModeProc(
 {
     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;
 }
 
 /*
@@ -10052,9 +10738,8 @@ Tcl_ChannelFlushProc(
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->flushProc;
-    } else {
-	return NULL;
     }
+    return NULL;
 }
 
 /*
@@ -10080,9 +10765,8 @@ Tcl_ChannelHandlerProc(
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->handlerProc;
-    } else {
-	return NULL;
     }
+    return NULL;
 }
 
 /*
@@ -10108,9 +10792,8 @@ Tcl_ChannelWideSeekProc(
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
 	return chanTypePtr->wideSeekProc;
-    } else {
-	return NULL;
     }
+    return NULL;
 }
 
 /*
@@ -10137,9 +10820,8 @@ Tcl_ChannelThreadActionProc(
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
 	return chanTypePtr->threadActionProc;
-    } else {
-	return NULL;
     }
+    return NULL;
 }
 
 /*
@@ -10256,7 +10938,7 @@ FixLevelCode(
 
     res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);
     if (res != TCL_OK) {
-	Tcl_Panic("Tcl_SetChannelError(Interp): Bad syntax of message");
+	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
     }
 
     explicitResult = (1 == (lc % 2));
@@ -10316,7 +10998,7 @@ FixLevelCode(
 	lcn += 2;
     }
 
-    lvn = (Tcl_Obj **) ckalloc(lcn * sizeof(Tcl_Obj *));
+    lvn = ckalloc(lcn * sizeof(Tcl_Obj *));
 
     /*
      * New level/code information is spliced into the first occurence of
@@ -10369,7 +11051,7 @@ FixLevelCode(
 
     msg = Tcl_NewListObj(j, lvn);
 
-    ckfree((char *) lvn);
+    ckfree(lvn);
     return msg;
 }
 
@@ -10453,9 +11135,8 @@ Tcl_ChannelTruncateProc(
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
 	return chanTypePtr->truncateProc;
-    } else {
-	return NULL;
     }
+    return NULL;
 }
 
 /*
@@ -10483,8 +11164,7 @@ DupChannelIntRep(
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
 				 * currently have an internal rep.*/
 {
-    ResolvedChanName *resPtr
-	    = (ResolvedChanName *) srcPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
     resPtr->refCount++;
     copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
@@ -10511,15 +11191,14 @@ static void
 FreeChannelIntRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    ResolvedChanName *resPtr
-	    = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     objPtr->typePtr = NULL;
     if (--resPtr->refCount) {
 	return;
     }
-    Tcl_Release((ClientData) resPtr->statePtr);
-    ckfree((char *)resPtr);
+    Tcl_Release(resPtr->statePtr);
+    ckfree(resPtr);
 }
 
 #if 0
@@ -10536,7 +11215,7 @@ DumpFlags(
     char buf[20];
     int i = 0;
 
-#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
+#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
 
     ChanFlag('r', TCL_READABLE);
     ChanFlag('w', TCL_WRITABLE);
diff --git a/generic/tclIO.h b/generic/tclIO.h
index d096798..ffbfa31 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -44,13 +44,13 @@ typedef struct ChannelBuffer {
     int bufLength;		/* How big is the buffer? */
     struct ChannelBuffer *nextPtr;
     				/* Next buffer in chain. */
-    char buf[4];		/* Placeholder for real buffer. The real
-				 * buffer occuppies this space + bufSize-4
+    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. */
 } ChannelBuffer;
 
-#define CHANNELBUFFER_HEADER_SIZE	(sizeof(ChannelBuffer) - 4)
+#define CHANNELBUFFER_HEADER_SIZE	TclOffset(ChannelBuffer, buf)
 
 /*
  * How much extra space to allocate in buffer to hold bytes from previous
@@ -98,7 +98,7 @@ typedef struct Channel {
     struct ChannelState *state; /* Split out state information */
     ClientData instanceData;	/* Instance-specific data provided by creator
 				 * of channel. */
-    Tcl_ChannelType *typePtr;	/* Pointer to channel type structure. */
+    const 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. */
@@ -277,6 +277,16 @@ typedef struct ChannelState {
 					 * usable, but it may not be closed
 					 * again from within the close
 					 * handler. */
+#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
+					 * No further Tcl-level write IO on
+					 * the channel is allowed. */
+
+/*
+ * The length of time to wait between synthetic timer events. Must be zero or
+ * bad things tend to happen.
+ */
+
+#define SYNTHETIC_EVENT_TIME	0
 
 /*
  * Local Variables:
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index db1150d..834f225 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,8 +16,8 @@
  */
 
 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;
 
 /*
@@ -117,12 +117,12 @@ Tcl_PutsObjCmd(
     ThreadSpecificData *tsdPtr;
 
     switch (objc) {
-    case 2: /* [puts $x] */
+    case 2:			/* [puts $x] */
 	string = objv[1];
 	newline = 1;
 	break;
 
-    case 3: /* [puts -nonewline $x] or [puts $chan $x] */
+    case 3:			/* [puts -nonewline $x] or [puts $chan $x] */
 	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
 	    newline = 0;
 	} else {
@@ -132,12 +132,14 @@ Tcl_PutsObjCmd(
 	string = objv[2];
 	break;
 
-    case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
+    case 4:			/* [puts -nonewline $chan $x] or
+				 * [puts $chan $x nonewline] */
 	newline = 0;
 	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
 	    chanObjPtr = objv[2];
 	    string = objv[3];
 	    break;
+#if TCL_MAJOR_VERSION < 9
 	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
 	    /*
 	     * The code below provides backwards compatibility with an old
@@ -149,10 +151,11 @@ Tcl_PutsObjCmd(
 	    chanObjPtr = objv[1];
 	    string = objv[2];
 	    break;
+#endif
 	}
 	/* Fall through */
-    default:
-	/* [puts] or [puts some bad number of arguments...] */
+    default:			/* [puts] or
+				 * [puts some bad number of arguments...] */
 	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
 	return TCL_ERROR;
     }
@@ -171,9 +174,10 @@ Tcl_PutsObjCmd(
     if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for writing", NULL);
+    if (!(mode & TCL_WRITABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for writing",
+		TclGetString(chanObjPtr)));
 	return TCL_ERROR;
     }
 
@@ -200,9 +204,8 @@ Tcl_PutsObjCmd(
 
   error:
     if (!TclChanCaughtErrorBypass(interp, chan)) {
-	Tcl_AppendResult(interp, "error writing \"",
-		TclGetString(chanObjPtr), "\": ",
-		Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
+		TclGetString(chanObjPtr), Tcl_PosixError(interp)));
     }
     TclChannelRelease(chan);
     return TCL_ERROR;
@@ -245,9 +248,10 @@ Tcl_FlushObjCmd(
     if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for writing", NULL);
+    if (!(mode & TCL_WRITABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for writing",
+		TclGetString(chanObjPtr)));
 	return TCL_ERROR;
     }
 
@@ -261,9 +265,9 @@ Tcl_FlushObjCmd(
 	 */
 
 	if (!TclChanCaughtErrorBypass(interp, chan)) {
-	    Tcl_AppendResult(interp, "error flushing \"",
-		    TclGetString(chanObjPtr), "\": ",
-		    Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error flushing \"%s\": %s",
+		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
 	TclChannelRelease(chan);
 	return TCL_ERROR;
@@ -311,9 +315,10 @@ Tcl_GetsObjCmd(
     if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for reading", NULL);
+    if (!(mode & TCL_READABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for reading",
+		TclGetString(chanObjPtr)));
 	return TCL_ERROR;
     }
 
@@ -325,17 +330,16 @@ Tcl_GetsObjCmd(
 	    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.
+	     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+			"error reading \"%s\": %s",
+			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	    }
 	    code = TCL_ERROR;
 	    goto done;
@@ -403,7 +407,6 @@ Tcl_ReadObjCmd(
 
 	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
 	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId");
-	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
 	return TCL_ERROR;
     }
 
@@ -422,12 +425,13 @@ Tcl_ReadObjCmd(
     if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for reading", NULL);
+    if (!(mode & TCL_READABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for reading",
+		TclGetString(chanObjPtr)));
 	return TCL_ERROR;
     }
-    i++;	/* Consumed channel name. */
+    i++;			/* Consumed channel name. */
 
     /*
      * Compute how many bytes to read.
@@ -435,7 +439,9 @@ Tcl_ReadObjCmd(
 
     toRead = -1;
     if (i < objc) {
-	if (TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
+	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
@@ -444,15 +450,16 @@ Tcl_ReadObjCmd(
 	     */
 
 	    if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
-	    return TCL_ERROR;
+#endif
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"expected non-negative integer but got \"%s\"",
+			TclGetString(objv[i])));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
+		return TCL_ERROR;
+#if TCL_MAJOR_VERSION < 9
 	    }
 	    newline = 1;
-	} else if (toRead < 0) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "expected non-negative integer but got \"",
-		    TclGetString(objv[i]), "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
-	    return TCL_ERROR;
+#endif
 	}
     }
 
@@ -469,10 +476,9 @@ Tcl_ReadObjCmd(
 	 */
 
 	if (!TclChanCaughtErrorBypass(interp, chan)) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "error reading \"",
-		    TclGetString(chanObjPtr), "\": ",
-		    Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error reading \"%s\": %s",
+		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
 	TclChannelRelease(chan);
 	Tcl_DecrRefCount(resultPtr);
@@ -484,7 +490,7 @@ Tcl_ReadObjCmd(
      */
 
     if ((charactersRead > 0) && (newline != 0)) {
-	char *result;
+	const char *result;
 	int length;
 
 	result = TclGetStringFromObj(resultPtr, &length);
@@ -529,10 +535,10 @@ Tcl_SeekObjCmd(
     int mode;			/* How to seek? */
     Tcl_WideInt result;		/* Of calling Tcl_Seek. */
     int optionIndex;
-    static const char *originOptions[] = {
+    static const char *const originOptions[] = {
 	"start", "current", "end", 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?");
@@ -562,10 +568,11 @@ Tcl_SeekObjCmd(
 	 * 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);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error during seek on \"%s\": %s",
+		    TclGetString(objv[1]), Tcl_PosixError(interp)));
 	}
 	TclChannelRelease(chan);
 	return TCL_ERROR;
@@ -663,9 +670,13 @@ Tcl_CloseObjCmd(
     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};
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
 	return TCL_ERROR;
     }
 
@@ -673,6 +684,45 @@ Tcl_CloseObjCmd(
 	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "Half-close of %s-side not possible, side not opened"
+		    " or already closed", dirOptions[index]));
+	    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
@@ -686,7 +736,7 @@ Tcl_CloseObjCmd(
 	 */
 
 	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-	char *string;
+	const char *string;
 	int len;
 
 	if (Tcl_IsShared(resultPtr)) {
@@ -728,13 +778,12 @@ Tcl_FconfigureObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *optionName, *valueName;
+    const char *optionName, *valueName;
     Tcl_Channel chan;		/* The channel to set a mode on. */
     int i;			/* Iterate over arg-value pairs. */
 
     if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"channelId ?optionName? ?value? ?optionName value?...");
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
 	return TCL_ERROR;
     }
 
@@ -845,19 +894,14 @@ Tcl_ExecObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    /*
-     * This function generates an argv array for the string arguments. It
-     * starts out with stack-allocated space but uses dynamically-allocated
-     * storage if needed.
-     */
-
     Tcl_Obj *resultPtr;
-    const char **argv;
-    char *string;
+    const char **argv;		/* An array for the string arguments. Stored
+				 * on the _Tcl_ stack. */
+    const char *string;
     Tcl_Channel chan;
     int argc, background, i, index, keepNewline, result, skip, length;
     int ignoreStderr;
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-ignorestderr", "-keepnewline", "--", NULL
     };
     enum options {
@@ -875,7 +919,7 @@ Tcl_ExecObjCmd(
 	if (string[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+	if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option",
 		TCL_EXACT, &index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -889,7 +933,7 @@ Tcl_ExecObjCmd(
 	}
     }
     if (objc <= skip) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?");
 	return TCL_ERROR;
     }
 
@@ -910,8 +954,7 @@ Tcl_ExecObjCmd(
      */
 
     argc = objc - skip;
-    argv = (const char **)
-	    TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
+    argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
 
     /*
      * Copy the string conversions of each (post option) object into the
@@ -923,13 +966,13 @@ Tcl_ExecObjCmd(
     }
     argv[argc] = NULL;
     chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
-	    (ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));
+	    ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
 
     /*
      * Free the argv array.
      */
 
-    TclStackFree(interp, (void *)argv);
+    TclStackFree(interp, (void *) argv);
 
     if (chan == NULL) {
 	return TCL_ERROR;
@@ -959,9 +1002,9 @@ Tcl_ExecObjCmd(
 	     */
 
 	    if (!TclChanCaughtErrorBypass(interp, chan)) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "error reading output from command: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"error reading output from command: %s",
+			Tcl_PosixError(interp)));
 		Tcl_DecrRefCount(resultPtr);
 	    }
 	    return TCL_ERROR;
@@ -1030,9 +1073,10 @@ Tcl_FblockedObjCmd(
     if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
-		"\" wasn't opened for reading", NULL);
+    if (!(mode & TCL_READABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for reading",
+		TclGetString(objv[1])));
 	return TCL_ERROR;
     }
 
@@ -1079,15 +1123,17 @@ Tcl_OpenObjCmd(
     } else {
 	modeString = TclGetString(objv[2]);
 	if (objc == 4) {
-	    char *permString = TclGetString(objv[3]);
+	    const char *permString = TclGetString(objv[3]);
 	    int code = TCL_ERROR;
 	    int scanned = TclParseAllWhiteSpace(permString, -1);
 
-	    /* Support legacy octal numbers */
+	    /*
+	     * Support legacy octal numbers.
+	     */
+
 	    if ((permString[scanned] == '0')
 		    && (permString[scanned+1] >= '0')
 		    && (permString[scanned+1] <= '7')) {
-
 		Tcl_Obj *permObj;
 
 		TclNewLiteralStringObj(permObj, "0o");
@@ -1148,13 +1194,13 @@ Tcl_OpenObjCmd(
 		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
 	    }
 	}
-	ckfree((char *) cmdArgv);
+	ckfree(cmdArgv);
     }
     if (chan == NULL) {
 	return TCL_ERROR;
     }
     Tcl_RegisterChannel(interp, chan);
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
     return TCL_OK;
 }
 
@@ -1197,7 +1243,7 @@ TcpAcceptCallbacksDeleteProc(
 	acceptCallbackPtr->interp = NULL;
     }
     Tcl_DeleteHashTable(hTblPtr);
-    ckfree((char *) hTblPtr);
+    ckfree(hTblPtr);
 }
 
 /*
@@ -1234,17 +1280,16 @@ RegisterTcpServerInterpCleanup(
     Tcl_HashEntry *hPtr;	/* Entry for this record. */
     int isNew;			/* Is the entry new? */
 
-    hTblPtr = (Tcl_HashTable *)
-	    Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
 
     if (hTblPtr == NULL) {
-	hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
+	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
 	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
-	(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
 		TcpAcceptCallbacksDeleteProc, hTblPtr);
     }
 
-    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &isNew);
+    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
     if (!isNew) {
 	Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
     }
@@ -1281,8 +1326,7 @@ UnregisterTcpServerInterpCleanupProc(
     Tcl_HashTable *hTblPtr;
     Tcl_HashEntry *hPtr;
 
-    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
-	    "tclTCPAcceptCallbacks", NULL);
+    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
     if (hTblPtr == NULL) {
 	return;
     }
@@ -1320,7 +1364,7 @@ AcceptCallbackProc(
     char *address,		/* Address of client that was accepted. */
     int port)			/* Port of client that was accepted. */
 {
-    AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+    AcceptCallback *acceptCallbackPtr = callbackData;
 
     /*
      * Check if the callback is still valid; the interpreter may have gone
@@ -1350,7 +1394,7 @@ AcceptCallbackProc(
 	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
 		" ", address, " ", portBuf, NULL);
 	if (result != TCL_OK) {
-	    TclBackgroundException(interp, result);
+	    Tcl_BackgroundException(interp, result);
 	    Tcl_UnregisterChannel(interp, chan);
 	}
 
@@ -1365,8 +1409,8 @@ AcceptCallbackProc(
 	Tcl_Release(script);
     } else {
 	/*
-	 * The interpreter has been deleted, so there is no useful way to
-	 * utilize the client socket - just close it.
+	 * The interpreter has been deleted, so there is no useful way to use
+	 * the client socket - just close it.
 	 */
 
 	Tcl_Close(NULL, chan);
@@ -1399,7 +1443,7 @@ TcpServerCloseProc(
     ClientData callbackData)	/* The data passed in the call to
 				 * Tcl_CreateCloseHandler. */
 {
-    AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+    AcceptCallback *acceptCallbackPtr = callbackData;
 				/* The actual data. */
 
     if (acceptCallbackPtr->interp != NULL) {
@@ -1407,7 +1451,7 @@ TcpServerCloseProc(
 		acceptCallbackPtr);
     }
     Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
-    ckfree((char *) acceptCallbackPtr);
+    ckfree(acceptCallbackPtr);
 }
 
 /*
@@ -1434,14 +1478,14 @@ Tcl_SocketObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static const char *socketOptions[] = {
-	"-async", "-myaddr", "-myport","-server", NULL
+    static const char *const socketOptions[] = {
+	"-async", "-myaddr", "-myport", "-server", NULL
     };
     enum socketOptions {
 	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
     };
     int optionIndex, a, server = 0, port, myport = 0, async = 0;
-    char *host, *script = NULL, *myaddr = NULL;
+    const char *host, *script = NULL, *myaddr = NULL;
     Tcl_Channel chan;
 
     if (TclpHasSockets(interp) != TCL_OK) {
@@ -1461,8 +1505,8 @@ Tcl_SocketObjCmd(
 	switch ((enum socketOptions) optionIndex) {
 	case SKT_ASYNC:
 	    if (server == 1) {
-		Tcl_AppendResult(interp,
-			"cannot set -async option for server sockets", NULL);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot set -async option for server sockets", -1));
 		return TCL_ERROR;
 	    }
 	    async = 1;
@@ -1470,19 +1514,19 @@ Tcl_SocketObjCmd(
 	case SKT_MYADDR:
 	    a++;
 	    if (a >= objc) {
-		Tcl_AppendResult(interp,
-			"no argument given for -myaddr option", NULL);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"no argument given for -myaddr option", -1));
 		return TCL_ERROR;
 	    }
 	    myaddr = TclGetString(objv[a]);
 	    break;
 	case SKT_MYPORT: {
-	    char *myPortName;
+	    const char *myPortName;
 
 	    a++;
 	    if (a >= objc) {
-		Tcl_AppendResult(interp,
-			"no argument given for -myport option", NULL);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"no argument given for -myport option", -1));
 		return TCL_ERROR;
 	    }
 	    myPortName = TclGetString(objv[a]);
@@ -1493,15 +1537,15 @@ Tcl_SocketObjCmd(
 	}
 	case SKT_SERVER:
 	    if (async == 1) {
-		Tcl_AppendResult(interp,
-			"cannot set -async option for server sockets", NULL);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot set -async option for server sockets", -1));
 		return TCL_ERROR;
 	    }
 	    server = 1;
 	    a++;
 	    if (a >= objc) {
-		Tcl_AppendResult(interp,
-			"no argument given for -server option", NULL);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"no argument given for -server option", -1));
 		return TCL_ERROR;
 	    }
 	    script = TclGetString(objv[a]);
@@ -1513,8 +1557,8 @@ Tcl_SocketObjCmd(
     if (server) {
 	host = myaddr;		/* NULL implies INADDR_ANY */
 	if (myport != 0) {
-	    Tcl_AppendResult(interp, "option -myport is not valid for servers",
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "option -myport is not valid for servers", -1));
 	    return TCL_ERROR;
 	}
     } else if (a < objc) {
@@ -1530,7 +1574,6 @@ Tcl_SocketObjCmd(
 	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"-server command ?-myaddr addr? port");
-	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
 	return TCL_ERROR;
     }
 
@@ -1544,8 +1587,8 @@ Tcl_SocketObjCmd(
     }
 
     if (server) {
-	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
-		ckalloc((unsigned) sizeof(AcceptCallback));
+	AcceptCallback *acceptCallbackPtr =
+		ckalloc(sizeof(AcceptCallback));
 	unsigned len = strlen(script) + 1;
 	char *copyScript = ckalloc(len);
 
@@ -1556,7 +1599,7 @@ Tcl_SocketObjCmd(
 		acceptCallbackPtr);
 	if (chan == NULL) {
 	    ckfree(copyScript);
-	    ckfree((char *) acceptCallbackPtr);
+	    ckfree(acceptCallbackPtr);
 	    return TCL_ERROR;
 	}
 
@@ -1582,9 +1625,9 @@ Tcl_SocketObjCmd(
 	    return TCL_ERROR;
 	}
     }
-    Tcl_RegisterChannel(interp, chan);
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
 
+    Tcl_RegisterChannel(interp, chan);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
     return TCL_OK;
 }
 
@@ -1614,9 +1657,10 @@ Tcl_FcopyObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Channel inChan, outChan;
-    int mode, i, toRead, index;
+    int mode, i, index;
+    Tcl_WideInt toRead;
     Tcl_Obj *cmdPtr;
-    static const char* switches[] = { "-size", "-command", NULL };
+    static const char *const switches[] = { "-size", "-command", NULL };
     enum { FcopySize, FcopyCommand };
 
     if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
@@ -1633,39 +1677,42 @@ Tcl_FcopyObjCmd(
     if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
-		"\" wasn't opened for reading", NULL);
+    if (!(mode & TCL_READABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for reading",
+		TclGetString(objv[1])));
 	return TCL_ERROR;
     }
     if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
-		"\" wasn't opened for writing", NULL);
+    if (!(mode & TCL_WRITABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"channel \"%s\" wasn't opened for writing",
+		TclGetString(objv[2])));
 	return TCL_ERROR;
     }
 
     toRead = -1;
     cmdPtr = NULL;
     for (i = 3; i < objc; i += 2) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
 		&index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	switch (index) {
 	case FcopySize:
-	    if (TclGetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
+	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (toRead<0) {
+	    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;
@@ -1707,7 +1754,7 @@ ChanPendingObjCmd(
 {
     Tcl_Channel chan;
     int index, mode;
-    static const char *options[] = {"input", "output", NULL};
+    static const char *const options[] = {"input", "output", NULL};
     enum options {PENDING_INPUT, PENDING_OUTPUT};
 
     if (objc != 3) {
@@ -1726,14 +1773,14 @@ ChanPendingObjCmd(
 
     switch ((enum options) index) {
     case PENDING_INPUT:
-	if ((mode & TCL_READABLE) == 0) {
+	if (!(mode & TCL_READABLE)) {
 	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
 	} else {
 	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
 	}
 	break;
     case PENDING_OUTPUT:
-	if ((mode & TCL_WRITABLE) == 0) {
+	if (!(mode & TCL_WRITABLE)) {
 	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
 	} else {
 	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
@@ -1787,8 +1834,8 @@ ChanTruncateObjCmd(
 	    return TCL_ERROR;
 	}
 	if (length < 0) {
-	    Tcl_AppendResult(interp,
-		    "cannot truncate to negative length of file", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "cannot truncate to negative length of file", -1));
 	    return TCL_ERROR;
 	}
     } else {
@@ -1798,18 +1845,17 @@ ChanTruncateObjCmd(
 
 	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);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not determine current location in \"%s\": %s",
+		    TclGetString(objv[1]), Tcl_PosixError(interp)));
 	    return TCL_ERROR;
 	}
     }
 
     if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
-	Tcl_AppendResult(interp, "error during truncate on \"",
-		TclGetString(objv[1]), "\": ",
-		Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"error during truncate on \"%s\": %s",
+		TclGetString(objv[1]), Tcl_PosixError(interp)));
 	return TCL_ERROR;
     }
 
@@ -1819,6 +1865,90 @@ ChanTruncateObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * 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
@@ -1845,26 +1975,29 @@ TclInitChanCmd(
      * function at the moment.
      */
     static const EnsembleImplMap initMap[] = {
-	{"blocked",	Tcl_FblockedObjCmd, NULL},
-	{"close",	Tcl_CloseObjCmd, NULL},
-	{"copy",	Tcl_FcopyObjCmd, NULL},
-	{"create",	TclChanCreateObjCmd, NULL},		/* TIP #219 */
-	{"eof",		Tcl_EofObjCmd, NULL},
-	{"event",	Tcl_FileEventObjCmd, NULL},
-	{"flush",	Tcl_FlushObjCmd, NULL},
-	{"gets",	Tcl_GetsObjCmd, NULL},
-	{"pending",	ChanPendingObjCmd, NULL},		/* TIP #287 */
-	{"postevent",	TclChanPostEventObjCmd, NULL},	/* TIP #219 */
-	{"puts",	Tcl_PutsObjCmd, NULL},
-	{"read",	Tcl_ReadObjCmd, NULL},
-	{"seek",	Tcl_SeekObjCmd, NULL},
-	{"tell",	Tcl_TellObjCmd, NULL},
-	{"truncate",	ChanTruncateObjCmd, NULL},		/* TIP #208 */
-	{NULL,NULL, NULL}
+	{"blocked",	Tcl_FblockedObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"close",	Tcl_CloseObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"copy",	Tcl_FcopyObjCmd,	NULL, NULL, NULL, 0},
+	{"create",	TclChanCreateObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #219 */
+	{"eof",		Tcl_EofObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"event",	Tcl_FileEventObjCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
+	{"flush",	Tcl_FlushObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"gets",	Tcl_GetsObjCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"names",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"pending",	ChanPendingObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #287 */
+	{"pipe",	ChanPipeObjCmd,		TclCompileBasic0ArgCmd, NULL, NULL, 0},		/* TIP #304 */
+	{"pop",		TclChanPopObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},		/* TIP #230 */
+	{"postevent",	TclChanPostEventObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	/* TIP #219 */
+	{"push",	TclChanPushObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #230 */
+	{"puts",	Tcl_PutsObjCmd,		NULL, NULL, NULL, 0},
+	{"read",	Tcl_ReadObjCmd,		NULL, NULL, NULL, 0},
+	{"seek",	Tcl_SeekObjCmd,		TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
+	{"tell",	Tcl_TellObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"truncate",	ChanTruncateObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},		/* TIP #208 */
+	{NULL, NULL, NULL, NULL, NULL, 0}
     };
     static const char *const extras[] = {
 	"configure",	"::fconfigure",
-	"names",	"::file channels",
 	NULL
     };
     Tcl_Command ensemble;
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 7ba2f2a..7f61def 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -116,7 +116,7 @@ static inline void	ResultAdd(ResultBuffer *r, unsigned char *buf,
  * transformations.
  */
 
-static Tcl_ChannelType transformChannelType = {
+static const Tcl_ChannelType transformChannelType = {
     "transform",		/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
     TransformCloseProc,		/* Close proc. */
@@ -230,7 +230,7 @@ ReleaseData(
     }
     ResultClear(&dataPtr->result);
     Tcl_DecrRefCount(dataPtr->command);
-    ckfree((char *) dataPtr);
+    ckfree(dataPtr);
 }
 
 /*
@@ -287,7 +287,7 @@ TclChannelTransform(
      * regime of the underlying channel and to use the same for us too.
      */
 
-    dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
+    dataPtr = ckalloc(sizeof(TransformChannelData));
 
     dataPtr->refCount = 1;
     Tcl_DStringInit(&ds);
@@ -313,8 +313,8 @@ TclChannelTransform(
     dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
 	    mode, chan);
     if (dataPtr->self == NULL) {
-	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
-		Tcl_GetChannelName(chan), "\"", NULL);
+	Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
+		"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
 	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
@@ -683,7 +683,7 @@ TransformInputProc(
 	     * Already saw EOF from downChan; don't ask again.
 	     * NOTE: Could move this up to avoid the last maxRead
 	     * execution.  Believe this would still be correct behavior,
-	     * but the test suite tests the whole command callback 
+	     * but the test suite tests the whole command callback
 	     * sequence, so leave it unchanged for now.
 	     */
 
@@ -696,7 +696,6 @@ TransformInputProc(
 
 	read = Tcl_ReadRaw(downChan, buf, toRead);
 	if (read < 0) {
-
 	    if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
 		/*
 		 * Zero bytes available from downChan because blocked.
@@ -838,7 +837,7 @@ TransformSeekProc(
 {
     TransformChannelData *dataPtr = instanceData;
     Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
-    Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
+    const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
     Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
 
     if ((offset == 0) && (mode == SEEK_CUR)) {
@@ -905,7 +904,7 @@ TransformWideSeekProc(
 {
     TransformChannelData *dataPtr = instanceData;
     Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
-    Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
+    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
     Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
     Tcl_DriverWideSeekProc *parentWideSeekProc =
 	    Tcl_ChannelWideSeekProc(parentType);
@@ -1274,7 +1273,7 @@ ResultClear(
     r->used = 0;
 
     if (r->allocated) {
-	ckfree((char *) r->buf);
+	ckfree(r->buf);
 	r->buf = NULL;
 	r->allocated = 0;
     }
@@ -1418,10 +1417,10 @@ ResultAdd(
 
 	if (r->allocated == 0) {
 	    r->allocated = toWrite + INCREMENT;
-	    r->buf = UCHARP(ckalloc(r->allocated));
+	    r->buf = ckalloc(r->allocated);
 	} else {
 	    r->allocated += toWrite + INCREMENT;
-	    r->buf = UCHARP(ckrealloc((char *) r->buf, r->allocated));
+	    r->buf = ckrealloc(r->buf, r->allocated);
 	}
     }
 
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 85cbec4..f476a1a 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -16,8 +16,8 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#include <tclInt.h>
-#include <tclIO.h>
+#include "tclInt.h"
+#include "tclIO.h"
 #include <assert.h>
 
 #ifndef EINVAL
@@ -39,6 +39,9 @@ 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);
+#ifdef TCL_THREADS
+static void		ReflectThread(ClientData clientData, int action);
+#endif
 static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
 			    Tcl_WideInt offset, int mode, int *errorCodePtr);
 static int		ReflectSeek(ClientData clientData, long offset,
@@ -55,24 +58,28 @@ static int		ReflectSetOption(ClientData clientData,
  * a version 3 structure.
  */
 
-static Tcl_ChannelType tclRChannelType = {
-    "tclrchannel",         /* Type name.                                  */
+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 */
+    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 */
+#ifdef TCL_THREADS
+    ReflectThread,         /* thread action, tracking owner */
+#else
+    NULL,		   /* thread action */
+#endif
+    NULL		   /* truncate */
 };
 
 /*
@@ -89,7 +96,8 @@ typedef struct {
 				 * command is gone.
 				 */
 #ifdef TCL_THREADS
-    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
+    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
+    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
 #endif
     Tcl_Obj *cmd;		/* Callback command prefix */
     Tcl_Obj *methods;		/* Methods to append to command prefix */
@@ -99,6 +107,9 @@ typedef struct {
     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.
      *
@@ -137,7 +148,7 @@ typedef struct {
  * Event literals. ==================================================
  */
 
-static const char *eventOptions[] = {
+static const char *const eventOptions[] = {
     "read", "write", NULL
 };
 typedef enum {
@@ -148,7 +159,7 @@ typedef enum {
  * Method literals. ==================================================
  */
 
-static const char *methodNames[] = {
+static const char *const methodNames[] = {
     "blocking",		/* OPT */
     "cget",		/* OPT \/ Together or none */
     "cgetall",		/* OPT /\ of these two     */
@@ -318,7 +329,8 @@ typedef struct ForwardingEvent {
 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_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
@@ -340,7 +352,7 @@ typedef struct ThreadSpecificData {
      * per-thread version of the per-interpreter map.
      */
 
-    ReflectedChannelMap* rcmPtr;
+    ReflectedChannelMap *rcmPtr;
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
@@ -364,31 +376,31 @@ TCL_DECLARE_MUTEX(rcForwardMutex)
  * leak resources when threads go away.
  */
 
-static void		ForwardOpToOwnerThread(ReflectedChannel *rcPtr,
-			    ForwardedOperation op, const VOID *param);
+static void		ForwardOpToHandlerThread(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); \
+	if ((p)->base.mustFree) {                               \
+	    ckfree((p)->base.msgStr);                           \
 	}
 #define PassReceivedErrorInterp(i,p) \
-	if ((i) != NULL) { \
-	    Tcl_SetChannelErrorInterp((i), \
-		    Tcl_NewStringObj((p)->base.msgStr, -1)); \
-	} \
+	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.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.code = TCL_ERROR;                             \
+	(p)->base.mustFree = 1;                                 \
 	(p)->base.msgStr = (char *) (emsg)
 
 static void		ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
@@ -423,7 +435,8 @@ static int		InvokeTclMethod(ReflectedChannel *rcPtr,
 static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
 static void		DeleteReflectedChannelMap(ClientData clientData,
 			    Tcl_Interp *interp);
-static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
+static int		ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
+static void		MarkDead(ReflectedChannel *rcPtr);
 
 /*
  * Global constant strings (messages). ==================
@@ -487,9 +500,11 @@ TclChanCreateObjCmd(
     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. */
+    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
@@ -516,6 +531,7 @@ TclChanCreateObjCmd(
      * Expect at least one list element. Abbreviations are ok.
      */
 
+    modeObj = objv[MODE];
     if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -558,6 +574,7 @@ TclChanCreateObjCmd(
     /* assert modeObj.refCount == 1 */
     result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
     Tcl_DecrRefCount(modeObj);
+
     if (result != TCL_OK) {
 	UnmarshallErrorResult(interp, resObj);
 	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
@@ -572,11 +589,9 @@ TclChanCreateObjCmd(
      */
 
     if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
-	TclNewLiteralStringObj(err, "chan handler \"");
-	Tcl_AppendObjToObj(err, cmdObj);
-	Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
-	Tcl_AppendObjToObj(err, resObj);
-	Tcl_SetObjResult(interp, err);
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s initialize\" returned non-list: %s",
+                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
 	Tcl_DecrRefCount(resObj);
 	goto error;
     }
@@ -600,42 +615,37 @@ TclChanCreateObjCmd(
     Tcl_DecrRefCount(resObj);
 
     if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
-	TclNewLiteralStringObj(err, "chan handler \"");
-	Tcl_AppendObjToObj(err, cmdObj);
-	Tcl_AppendToObj(err, "\" does not support all required methods", -1);
-	Tcl_SetObjResult(interp, err);
+        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)) {
-	TclNewLiteralStringObj(err, "chan handler \"");
-	Tcl_AppendObjToObj(err, cmdObj);
-	Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
-	Tcl_SetObjResult(interp, err);
+        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)) {
-	TclNewLiteralStringObj(err, "chan handler \"");
-	Tcl_AppendObjToObj(err, cmdObj);
-	Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
-	Tcl_SetObjResult(interp, err);
+        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))) {
-	TclNewLiteralStringObj(err, "chan handler \"");
-	Tcl_AppendObjToObj(err, cmdObj);
-	Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
-	Tcl_SetObjResult(interp, err);
+        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))) {
-	TclNewLiteralStringObj(err, "chan handler \"");
-	Tcl_AppendObjToObj(err, cmdObj);
-	Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
-	Tcl_SetObjResult(interp, err);
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
+                Tcl_GetString(cmdObj)));
 	goto error;
     }
 
@@ -658,8 +668,7 @@ TclChanCreateObjCmd(
 	 * as the actual channel type.
 	 */
 
-	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
-		ckalloc(sizeof(Tcl_ChannelType));
+	Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType));
 
 	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
 
@@ -688,19 +697,17 @@ TclChanCreateObjCmd(
 
     Tcl_RegisterChannel(interp, chan);
 
-    rcmPtr = GetReflectedChannelMap (interp);
-    hPtr   = Tcl_CreateHashEntry(&rcmPtr->map,
-				 chanPtr->state->channelName, &isNew);
-    if (!isNew) {
-	if (chanPtr != Tcl_GetHashValue(hPtr)) {
-	    Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
-	}
+    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);
+    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
+	    &isNew);
     Tcl_SetHashValue(hPtr, chan);
 #endif
 
@@ -708,10 +715,11 @@ TclChanCreateObjCmd(
      * Return handle as result of command.
      */
 
-    Tcl_SetObjResult(interp, rcId);
+    Tcl_SetObjResult(interp,
+            Tcl_NewStringObj(chanPtr->state->channelName, -1));
     return TCL_OK;
 
- error:
+  error:
     Tcl_DecrRefCount(rcPtr->name);
     Tcl_DecrRefCount(rcPtr->methods);
     Tcl_DecrRefCount(rcPtr->cmd);
@@ -740,6 +748,50 @@ TclChanCreateObjCmd(
  *----------------------------------------------------------------------
  */
 
+typedef struct ReflectEvent {
+    Tcl_Event header;
+    ReflectedChannel *rcPtr;
+    int events;
+} ReflectEvent;
+
+static int
+ReflectEventRun(
+    Tcl_Event *ev,
+    int flags)
+{
+    /* OWNER thread
+     *
+     * Note: When the channel is closed any pending events of this type are
+     * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls
+     * accomplishing that.
+     */
+
+    ReflectEvent *e = (ReflectEvent *) ev;
+
+    Tcl_NotifyChannel(e->rcPtr->chan, e->events);
+    return 1;
+}
+
+static int
+ReflectEventDelete(
+    Tcl_Event *ev,
+    ClientData cd)
+{
+    /* OWNER thread
+     *
+     * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The
+     * latter ensures that no pending events of this type are run on an
+     * invalid channel.
+     */
+
+    ReflectEvent *e = (ReflectEvent *) ev;
+
+    if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) {
+        return 0;
+    }
+    return 1;
+}
+
 int
 TclChanPostEventObjCmd(
     ClientData clientData,
@@ -748,6 +800,8 @@ TclChanPostEventObjCmd(
     Tcl_Obj *const *objv)
 {
     /*
+     * Ensure -> HANDLER thread
+     *
      * Syntax:   chan postevent CHANNEL EVENTSPEC
      *           [0]  [1]       [2]     [3]
      *
@@ -766,8 +820,9 @@ TclChanPostEventObjCmd(
 				/* 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 */
+    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
+				 * this interp. */
+    Tcl_HashEntry *hPtr;	/* Entry in the above map */
 
     /*
      * Number of arguments...
@@ -785,12 +840,12 @@ TclChanPostEventObjCmd(
 
     chanId = TclGetString(objv[CHAN]);
 
-    rcmPtr = GetReflectedChannelMap (interp);
-    hPtr = Tcl_FindHashEntry (&rcmPtr->map, chanId);
+    rcmPtr = GetReflectedChannelMap(interp);
+    hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId);
 
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "can not find reflected channel named \"", chanId,
-		"\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "can not find reflected channel named \"%s\"", chanId));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL);
 	return TCL_ERROR;
     }
@@ -811,7 +866,7 @@ TclChanPostEventObjCmd(
      * have gone seriously haywire.
      */
 
-    chan        = Tcl_GetHashValue(hPtr);
+    chan = Tcl_GetHashValue(hPtr);
     chanTypePtr = Tcl_GetChannelType(chan);
 
     /*
@@ -824,13 +879,13 @@ TclChanPostEventObjCmd(
      */
 
     if (chanTypePtr->watchProc != &ReflectWatch) {
-	Tcl_Panic ("TclChanPostEventObjCmd: channel is not a reflected channel");
+	Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel");
     }
 
-    rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
+    rcPtr = Tcl_GetChannelInstanceData(chan);
 
     if (rcPtr->interp != interp) {
-	Tcl_Panic ("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
+	Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
     }
 
     /*
@@ -847,8 +902,9 @@ TclChanPostEventObjCmd(
      */
 
     if (events & ~rcPtr->interest) {
-	Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
-		"\" is not interested in", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "tried to post events channel \"%s\" is not interested in",
+                chanId));
 	return TCL_ERROR;
     }
 
@@ -856,7 +912,44 @@ TclChanPostEventObjCmd(
      * We have the channel and the events to post.
      */
 
-    Tcl_NotifyChannel(chan, events);
+#ifdef TCL_THREADS
+    if (rcPtr->owner == rcPtr->thread) {
+#endif
+        Tcl_NotifyChannel(chan, events);
+#ifdef TCL_THREADS
+    } else {
+        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
+
+        ev->header.proc = ReflectEventRun;
+        ev->events = events;
+        ev->rcPtr = rcPtr;
+
+        /*
+         * We are not preserving the structure here. When the channel is
+         * closed any pending events are deleted, see ReflectClose(), and
+         * ReflectEventDelete(). Trying to preserve and later release when the
+         * event is run may generate a situation where the channel structure
+         * is deleted but not our structure, crashing in
+         * FreeReflectedChannel().
+         *
+         * Force creation of the RCM, for proper cleanup on thread teardown.
+         * The teardown of unprocessed events is currently coupled to the
+         * thread reflected channel map
+         */
+
+        (void) GetThreadReflectedChannelMap();
+
+        /* XXX Race condition !!
+         * XXX The destination thread may not exist anymore already.
+         * XXX (Delayed postevent executed after channel got removed).
+         * XXX Can we detect this ? (check the validity of the owner threadid ?)
+         * XXX Actually, in that case the channel should be dead also !
+         */
+
+        Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
+        Tcl_ThreadAlert(rcPtr->owner);
+    }
+#endif
 
     /*
      * Squash interp results left by the event script.
@@ -873,7 +966,7 @@ TclChanPostEventObjCmd(
  * Channel error message marshalling utilities.
  */
 
-static Tcl_Obj*
+static Tcl_Obj *
 MarshallError(
     Tcl_Interp *interp)
 {
@@ -928,7 +1021,7 @@ UnmarshallErrorResult(
     }
 
     (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
-    ((Interp *)interp)->flags &= ~ERR_ALREADY_LOGGED;
+    ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
 }
 
 int
@@ -1013,12 +1106,13 @@ ReflectClose(
     ClientData clientData,
     Tcl_Interp *interp)
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    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 */
-    Tcl_ChannelType *tctPtr;
+    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
+				 * this interp */
+    Tcl_HashEntry *hPtr;	/* Entry in the above map */
+    const Tcl_ChannelType *tctPtr;
 
     if (TclInThreadExit()) {
 	/*
@@ -1032,26 +1126,27 @@ ReflectClose(
 	/*
 	 * 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?
+	 * 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);
+	    ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
 	    result = p.base.code;
 
-	    /*
-	     * FreeReflectedChannel is done in the forwarded operation!, in
-	     * the other thread. rcPtr here is gone!
-	     */
+            /*
+             * Now squash the pending reflection events for this channel.
+             */
+
+            Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
 
 	    if (result != TCL_OK) {
 		FreeReceivedError(&p);
 	    }
-	    return EOK;
 	}
 #endif
 
@@ -1060,7 +1155,7 @@ ReflectClose(
 	    ckfree((char *)tctPtr);
 	    ((Channel *)rcPtr->chan)->typePtr = NULL;
 	}
-        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	return EOK;
     }
 
@@ -1072,13 +1167,14 @@ ReflectClose(
     if (rcPtr->thread != Tcl_GetCurrentThread()) {
 	ForwardParam p;
 
-	ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
 	result = p.base.code;
 
-	/*
-	 * FreeReflectedChannel is done in the forwarded operation!, in the
-	 * other thread. rcPtr here is gone!
-	 */
+        /*
+         * Now squash the pending reflection events for this channel.
+         */
+
+        Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
 
 	if (result != TCL_OK) {
 	    PassReceivedErrorInterp(interp, &p);
@@ -1106,32 +1202,29 @@ ReflectClose(
 	 * the per-interp DeleteReflectedChannelMap exit-handler.
 	 */
 
-	if (rcPtr->interp) {
-	    rcmPtr = GetReflectedChannelMap (rcPtr->interp);
-	    hPtr = Tcl_FindHashEntry (&rcmPtr->map,
-				      Tcl_GetChannelName (rcPtr->chan));
+	if (!rcPtr->dead) {
+	    rcmPtr = GetReflectedChannelMap(rcPtr->interp);
+	    hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+		    Tcl_GetChannelName(rcPtr->chan));
 	    if (hPtr) {
-		Tcl_DeleteHashEntry (hPtr);
+		Tcl_DeleteHashEntry(hPtr);
 	    }
 	}
 #ifdef TCL_THREADS
-        rcmPtr = GetThreadReflectedChannelMap();
-	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
-				  Tcl_GetChannelName (rcPtr->chan));
+	rcmPtr = GetThreadReflectedChannelMap();
+	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+		Tcl_GetChannelName(rcPtr->chan));
 	if (hPtr) {
-	    Tcl_DeleteHashEntry (hPtr);
+	    Tcl_DeleteHashEntry(hPtr);
 	}
+    }
 #endif
-
-	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
-	if (tctPtr && tctPtr != &tclRChannelType) {
+    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+    if (tctPtr && tctPtr != &tclRChannelType) {
 	    ckfree((char *)tctPtr);
 	    ((Channel *)rcPtr->chan)->typePtr = NULL;
-	}
-        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-#ifdef TCL_THREADS
     }
-#endif
+    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
     return (result == TCL_OK) ? EOK : EINVAL;
 }
 
@@ -1158,7 +1251,7 @@ ReflectInput(
     int toRead,
     int *errorCodePtr)
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *toReadObj;
     int bytec;			/* Number of returned bytes */
     unsigned char *bytev;	/* Array of returned bytes */
@@ -1175,7 +1268,7 @@ ReflectInput(
 	p.input.buf = buf;
 	p.input.toRead = toRead;
 
-	ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
 
 	if (p.base.code != TCL_OK) {
 	    if (p.base.code < 0) {
@@ -1203,7 +1296,7 @@ ReflectInput(
     Tcl_IncrRefCount(toReadObj);
 
     if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
-	int code = ErrnoReturn (rcPtr, resObj);
+	int code = ErrnoReturn(rcPtr, resObj);
 
 	if (code < 0) {
 	    *errorCodePtr = -code;
@@ -1224,7 +1317,7 @@ ReflectInput(
     *errorCodePtr = EOK;
 
     if (bytec > 0) {
-	memcpy(buf, bytev, (size_t)bytec);
+	memcpy(buf, bytev, (size_t) bytec);
     }
 
  stop:
@@ -1262,7 +1355,7 @@ ReflectOutput(
     int toWrite,
     int *errorCodePtr)
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *bufObj;
     Tcl_Obj *resObj;		/* Result data for 'write' */
     int written;
@@ -1278,7 +1371,7 @@ ReflectOutput(
 	p.output.buf = buf;
 	p.output.toWrite = toWrite;
 
-	ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
 
 	if (p.base.code != TCL_OK) {
 	    if (p.base.code < 0) {
@@ -1388,7 +1481,7 @@ ReflectSeekWide(
     int seekMode,
     int *errorCodePtr)
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *offObj, *baseObj;
     Tcl_Obj *resObj;		/* Result for 'seek' */
     Tcl_WideInt newLoc;
@@ -1404,7 +1497,7 @@ ReflectSeekWide(
 	p.seek.seekMode = seekMode;
 	p.seek.offset = offset;
 
-	ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
 
 	if (p.base.code != TCL_OK) {
 	    PassReceivedError(rcPtr->chan, &p);
@@ -1422,9 +1515,10 @@ ReflectSeekWide(
 
     Tcl_Preserve(rcPtr);
 
-    offObj = Tcl_NewWideIntObj(offset);
-    baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
-	    ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
+    offObj  = Tcl_NewWideIntObj(offset);
+    baseObj = Tcl_NewStringObj(
+            (seekMode == SEEK_SET) ? "start" :
+            (seekMode == SEEK_CUR) ? "current" : "end", -1);
     Tcl_IncrRefCount(offObj);
     Tcl_IncrRefCount(baseObj);
 
@@ -1496,7 +1590,7 @@ ReflectWatch(
     ClientData clientData,
     int mask)
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *maskObj;
 
     /*
@@ -1524,7 +1618,7 @@ ReflectWatch(
 	ForwardParam p;
 
 	p.watch.mask = mask;
-	ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);
 
 	/*
 	 * Any failure from the forward is ignored. We have no place to put
@@ -1568,7 +1662,7 @@ ReflectBlock(
     ClientData clientData,
     int nonblocking)
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *blockObj;
     int errorNum;		/* EINVAL or EOK (success). */
     Tcl_Obj *resObj;		/* Result data for 'blocking' */
@@ -1583,7 +1677,7 @@ ReflectBlock(
 
 	p.block.nonblocking = nonblocking;
 
-	ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);
 
 	if (p.base.code != TCL_OK) {
 	    PassReceivedError(rcPtr->chan, &p);
@@ -1599,7 +1693,7 @@ ReflectBlock(
 
     Tcl_Preserve(rcPtr);
 
-    if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
+    if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
 	errorNum = EINVAL;
     } else {
@@ -1613,6 +1707,44 @@ ReflectBlock(
     return errorNum;
 }
 
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectThread --
+ *
+ *	This function is invoked to tell the channel about thread movements.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReflectThread(
+    ClientData clientData,
+    int action)
+{
+    ReflectedChannel *rcPtr = clientData;
+
+    switch (action) {
+    case TCL_CHANNEL_THREAD_INSERT:
+        rcPtr->owner = Tcl_GetCurrentThread();
+        break;
+    case TCL_CHANNEL_THREAD_REMOVE:
+        rcPtr->owner = NULL;
+        break;
+    default:
+        Tcl_Panic("Unknown thread action code.");
+        break;
+    }
+}
+
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -1636,7 +1768,7 @@ ReflectSetOption(
     const char *optionName,	/* Name of requested option */
     const char *newValue)	/* The new value */
 {
-    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *optionObj, *valueObj;
     int result;			/* Result code for 'configure' */
     Tcl_Obj *resObj;		/* Result data for 'configure' */
@@ -1652,7 +1784,7 @@ ReflectSetOption(
 	p.setOpt.name = optionName;
 	p.setOpt.value = newValue;
 
-	ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p);
+	ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
 
 	if (p.base.code != TCL_OK) {
 	    Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
@@ -1713,7 +1845,7 @@ ReflectGetOption(
      * The bypass functions are not required.
      */
 
-    ReflectedChannel *rcPtr = (ReflectedChannel*) clientData;
+    ReflectedChannel *rcPtr = clientData;
     Tcl_Obj *optionObj;
     Tcl_Obj *resObj;		/* Result data for 'configure' */
     int listc, result = TCL_OK;
@@ -1738,7 +1870,7 @@ ReflectGetOption(
 	    opcode = ForwardedGetOpt;
 	}
 
-	ForwardOpToOwnerThread(rcPtr, opcode, &p);
+	ForwardOpToHandlerThread(rcPtr, opcode, &p);
 
 	if (p.base.code != TCL_OK) {
 	    Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
@@ -1782,7 +1914,7 @@ ReflectGetOption(
      */
 
     if (optionObj != NULL) {
-	Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
+	TclDStringAppendObj(dsPtr, resObj);
         goto ok;
     }
 
@@ -1814,10 +1946,10 @@ ReflectGetOption(
         goto error;
     } else {
 	int len;
-	char *str = Tcl_GetStringFromObj(resObj, &len);
+	const char *str = Tcl_GetStringFromObj(resObj, &len);
 
 	if (len) {
-	    Tcl_DStringAppend(dsPtr, " ", 1);
+	    TclDStringAppendLiteral(dsPtr, " ");
 	    Tcl_DStringAppend(dsPtr, str, len);
 	}
         goto ok;
@@ -1881,7 +2013,8 @@ EncodeEventMask(
     }
 
     if (listc < 1) {
-	Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "bad %s list: is empty", objName));
 	return TCL_ERROR;
     }
 
@@ -1914,7 +2047,7 @@ EncodeEventMask(
  *	This function takes an internal bitmask of events and constructs the
  *	equivalent list of event items.
  *
- * Results:
+ * Results, Contract:
  *	A Tcl_Obj reference. The object will have a refCount of one. The user
  *	has to decrement it to release the object.
  *
@@ -1948,6 +2081,7 @@ DecodeEventMask(
 
     evObj = Tcl_NewStringObj(eventStr, -1);
     Tcl_IncrRefCount(evObj);
+    /* assert evObj.refCount == 1 */
     return evObj;
 }
 
@@ -1978,12 +2112,13 @@ NewReflectedChannel(
     ReflectedChannel *rcPtr;
     MethodName mn = METH_BLOCKING;
 
-    rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
+    rcPtr = ckalloc(sizeof(ReflectedChannel));
 
     /* rcPtr->chan: Assigned by caller. Dummy data here. */
 
     rcPtr->chan = NULL;
     rcPtr->interp = interp;
+    rcPtr->dead = 0;
 #ifdef TCL_THREADS
     rcPtr->thread = Tcl_GetCurrentThread();
 #endif
@@ -2053,10 +2188,16 @@ FreeReflectedChannel(
     Channel *chanPtr = (Channel *) rcPtr->chan;
 
     TclChannelRelease((Tcl_Channel)chanPtr);
-    Tcl_DecrRefCount(rcPtr->name);
-    Tcl_DecrRefCount(rcPtr->methods);
-    Tcl_DecrRefCount(rcPtr->cmd);
-    ckfree((char*) rcPtr);
+    if (rcPtr->name) {
+	Tcl_DecrRefCount(rcPtr->name);
+    }
+    if (rcPtr->methods) {
+	Tcl_DecrRefCount(rcPtr->methods);
+    }
+    if (rcPtr->cmd) {
+	Tcl_DecrRefCount(rcPtr->cmd);
+    }
+    ckfree(rcPtr);
 }
 
 /*
@@ -2097,7 +2238,7 @@ InvokeTclMethod(
     Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
     Tcl_Obj *cmd;
 
-    if (!rcPtr->interp) {
+    if (rcPtr->dead) {
 	/*
 	 * The channel is marked as dead. Bail out immediately, with an
 	 * appropriate error.
@@ -2131,6 +2272,9 @@ InvokeTclMethod(
     /*
      * 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.
      */
 
     if (argOneObj) {
@@ -2148,7 +2292,7 @@ InvokeTclMethod(
     Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-    result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
+    result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
 
     /*
      * We do not try to extract the result information if the caller has no
@@ -2236,12 +2380,14 @@ InvokeTclMethod(
  */
 
 static int
-ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj)
+ErrnoReturn(
+    ReflectedChannel *rcPtr,
+    Tcl_Obj *resObj)
 {
     int code;
     Tcl_InterpState sr;		/* State of handler interp */
 
-    if (!rcPtr->interp) {
+    if (rcPtr->dead) {
 	return 0;
     }
 
@@ -2250,9 +2396,10 @@ ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* 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;
+    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
+	    || (code >= 0))) {
+	if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
+	    code = -EAGAIN;
 	} else {
 	    code = 0;
 	}
@@ -2283,10 +2430,10 @@ static ReflectedChannelMap *
 GetReflectedChannelMap(
     Tcl_Interp *interp)
 {
-    ReflectedChannelMap* rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);
+    ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);
 
     if (rcmPtr == NULL) {
-	rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
+	rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
 	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
 	Tcl_SetAssocData(interp, RCMKEY,
 		(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
@@ -2315,16 +2462,38 @@ GetReflectedChannelMap(
  */
 
 static void
+MarkDead(
+    ReflectedChannel *rcPtr)
+{
+    if (rcPtr->dead) {
+	return;
+    }
+    if (rcPtr->name) {
+	Tcl_DecrRefCount(rcPtr->name);
+	rcPtr->name = NULL;
+    }
+    if (rcPtr->methods) {
+	Tcl_DecrRefCount(rcPtr->methods);
+	rcPtr->methods = NULL;
+    }
+    if (rcPtr->cmd) {
+	Tcl_DecrRefCount(rcPtr->cmd);
+	rcPtr->cmd = NULL;
+    }
+    rcPtr->dead = 1;
+}
+
+static void
 DeleteReflectedChannelMap(
     ClientData clientData,	/* The per-interpreter data structure. */
     Tcl_Interp *interp)		/* The interpreter being deleted. */
 {
-    ReflectedChannelMap* rcmPtr; /* The map */
+    ReflectedChannelMap *rcmPtr = clientData;
+				/* The map */
     Tcl_HashSearch hSearch;	 /* Search variable. */
     Tcl_HashEntry *hPtr;	 /* Search variable. */
-    ReflectedChannel* rcPtr;
+    ReflectedChannel *rcPtr;
     Tcl_Channel chan;
-
 #ifdef TCL_THREADS
     ForwardingResult *resultPtr;
     ForwardingEvent *evPtr;
@@ -2334,7 +2503,7 @@ DeleteReflectedChannelMap(
     /*
      * 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
+     * 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
@@ -2343,20 +2512,17 @@ DeleteReflectedChannelMap(
      * this interp.
      */
 
-    rcmPtr = clientData;
     for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
-	 hPtr != NULL;
-	 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
-
-	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
-	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
-
-	rcPtr->interp = NULL;
+	    hPtr != NULL;
+	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
+	chan = Tcl_GetHashValue(hPtr);
+	rcPtr = Tcl_GetChannelInstanceData(chan);
 
+	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
     Tcl_DeleteHashTable(&rcmPtr->map);
-    ckfree((char *) &rcmPtr->map);
+    ckfree(&rcmPtr->map);
 
 #ifdef TCL_THREADS
     /*
@@ -2372,10 +2538,13 @@ DeleteReflectedChannelMap(
     Tcl_MutexLock(&rcForwardMutex);
 
     for (resultPtr = forwardList;
-	 resultPtr != NULL;
-	 resultPtr = resultPtr->nextPtr) {
+	    resultPtr != NULL;
+	    resultPtr = resultPtr->nextPtr) {
 	if (resultPtr->dsti != interp) {
-	    /* Ignore results/events for other interpreters. */
+	    /*
+	     * Ignore results/events for other interpreters.
+	     */
+
 	    continue;
 	}
 
@@ -2390,6 +2559,11 @@ DeleteReflectedChannelMap(
 	 */
 
 	evPtr = resultPtr->evPtr;
+
+	/* Basic crash safety until this routine can get revised [3411310] */
+	if (evPtr == NULL) {
+	    continue;
+	}
 	paramPtr = evPtr->param;
 	if (!evPtr) {
 	    continue;
@@ -2403,6 +2577,7 @@ DeleteReflectedChannelMap(
 
 	Tcl_ConditionNotify(&resultPtr->done);
     }
+    Tcl_MutexUnlock(&rcForwardMutex);
 
     /*
      * Get the map of all channels handled by the current thread. This is a
@@ -2413,21 +2588,22 @@ DeleteReflectedChannelMap(
 
     rcmPtr = GetThreadReflectedChannelMap();
     for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
-	 hPtr != NULL;
-	 hPtr = Tcl_NextHashEntry(&hSearch)) {
-
-	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
-	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
+	    hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&hSearch)) {
+	chan = Tcl_GetHashValue(hPtr);
+	rcPtr = Tcl_GetChannelInstanceData(chan);
 
 	if (rcPtr->interp != interp) {
-	    /* Ignore entries for other interpreters */
+	    /*
+	     * Ignore entries for other interpreters.
+	     */
+
 	    continue;
 	}
 
+	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
-
-    Tcl_MutexUnlock(&rcForwardMutex);
 #endif
 }
 
@@ -2450,12 +2626,12 @@ DeleteReflectedChannelMap(
  */
 
 static ReflectedChannelMap *
-GetThreadReflectedChannelMap()
+GetThreadReflectedChannelMap(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (!tsdPtr->rcmPtr) {
-	tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
+	tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
 	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
 	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
     }
@@ -2470,7 +2646,7 @@ GetThreadReflectedChannelMap()
  *
  *	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().
+ *	DeleteReflectedChannelMap().
  *
  * Results:
  *	None.
@@ -2488,13 +2664,8 @@ DeleteThreadReflectedChannelMap(
     Tcl_HashSearch hSearch;	 /* Search variable. */
     Tcl_HashEntry *hPtr;	 /* Search variable. */
     Tcl_ThreadId self = Tcl_GetCurrentThread();
-
-    ReflectedChannelMap* rcmPtr; /* The map */
-    Tcl_Channel chan;
-    ReflectedChannel* rcPtr;
+    ReflectedChannelMap *rcmPtr; /* The map */
     ForwardingResult *resultPtr;
-    ForwardingEvent *evPtr;
-    ForwardParam *paramPtr;
 
     /*
      * The origin thread for one or more reflected channels is gone.
@@ -2511,10 +2682,16 @@ DeleteThreadReflectedChannelMap(
     Tcl_MutexLock(&rcForwardMutex);
 
     for (resultPtr = forwardList;
-	 resultPtr != NULL;
-	 resultPtr = resultPtr->nextPtr) {
+	    resultPtr != NULL;
+	    resultPtr = resultPtr->nextPtr) {
+	ForwardingEvent *evPtr;
+	ForwardParam *paramPtr;
+
 	if (resultPtr->dst != self) {
-	    /* Ignore results/events for other threads. */
+	    /*
+	     * Ignore results/events for other threads.
+	     */
+
 	    continue;
 	}
 
@@ -2529,6 +2706,11 @@ DeleteThreadReflectedChannelMap(
 	 */
 
 	evPtr = resultPtr->evPtr;
+
+	/* Basic crash safety until this routine can get revised [3411310] */
+	if (evPtr == NULL ) {
+	    continue;
+	}
 	paramPtr = evPtr->param;
 	if (!evPtr) {
 	    continue;
@@ -2542,6 +2724,16 @@ DeleteThreadReflectedChannelMap(
 
 	Tcl_ConditionNotify(&resultPtr->done);
     }
+    Tcl_MutexUnlock(&rcForwardMutex);
+
+    /*
+     * Run over the event queue of this thread and remove all ReflectEvent's
+     * still pending. These are inbound events for reflected channels this
+     * thread owns but doesn't handle. The inverse of the channel map
+     * actually.
+     */
+
+    Tcl_DeleteEvents(ReflectEventDelete, NULL);
 
     /*
      * Get the map of all channels handled by the current thread. This is a
@@ -2551,26 +2743,28 @@ DeleteThreadReflectedChannelMap(
 
     rcmPtr = GetThreadReflectedChannelMap();
     for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
-	 hPtr != NULL;
-	 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
-
-	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
-	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
-
-	rcPtr->interp = NULL;
+	    hPtr != NULL;
+	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
+	Tcl_Channel chan = Tcl_GetHashValue(hPtr);
+	ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
 
+	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
-
-    Tcl_MutexUnlock(&rcForwardMutex);
+    ckfree(rcmPtr);
 }
 
 static void
-ForwardOpToOwnerThread(
+ForwardOpToHandlerThread(
     ReflectedChannel *rcPtr,	/* Channel instance */
     ForwardedOperation op,	/* Forwarded driver operation */
-    const VOID *param)		/* Arguments */
+    const void *param)		/* Arguments */
 {
+    /*
+     * Core of the communication from OWNER to HANDLER thread.
+     * The receiver is ForwardProc() below.
+     */
+
     Tcl_ThreadId dst = rcPtr->thread;
     ForwardingEvent *evPtr;
     ForwardingResult *resultPtr;
@@ -2582,13 +2776,13 @@ ForwardOpToOwnerThread(
 
     Tcl_MutexLock(&rcForwardMutex);
 
-    if (rcPtr->interp == NULL) {
+    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);
+	ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
 	Tcl_MutexUnlock(&rcForwardMutex);
 	return;
     }
@@ -2597,8 +2791,8 @@ ForwardOpToOwnerThread(
      * Create and initialize the event and data structures.
      */
 
-    evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
-    resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
+    evPtr = ckalloc(sizeof(ForwardingEvent));
+    resultPtr = ckalloc(sizeof(ForwardingResult));
 
     evPtr->event.proc = ForwardProc;
     evPtr->resultPtr = resultPtr;
@@ -2606,8 +2800,8 @@ ForwardOpToOwnerThread(
     evPtr->rcPtr = rcPtr;
     evPtr->param = (ForwardParam *) param;
 
-    resultPtr->src  = Tcl_GetCurrentThread();
-    resultPtr->dst  = dst;
+    resultPtr->src = Tcl_GetCurrentThread();
+    resultPtr->dst = dst;
     resultPtr->dsti = rcPtr->interp;
     resultPtr->done = NULL;
     resultPtr->result = -1;
@@ -2622,23 +2816,23 @@ ForwardOpToOwnerThread(
 
     /*
      * Ensure cleanup of the event if the origin thread exits while this event
-     * is pending or in progress. Exitus of the destination thread is handled
-     * by DeleteThreadReflectionChannelMap(), this is set up by
-     * GetThreadReflectedChannelMap().  This is what we use the 'forwardList'
+     * is pending or in progress. Exit of the destination thread is handled by
+     * DeleteThreadReflectedChannelMap(), this is set up by
+     * GetThreadReflectedChannelMap(). This is what we use the 'forwardList'
      * (see above) for.
      */
 
-    Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+    Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);
 
     /*
      * Queue the event and poke the other thread's notifier.
      */
 
-    Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
+    Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
     Tcl_ThreadAlert(dst);
 
     /*
-     * (*) Block until the other thread has either processed the transfer or
+     * (*) Block until the handler thread has either processed the transfer or
      * rejected it.
      */
 
@@ -2656,8 +2850,8 @@ ForwardOpToOwnerThread(
     }
 
     /*
-     * Unlink result from the forwarder list.
-     * No need to lock. Either still locked, or locked by the ConditionWait
+     * Unlink result from the forwarder list. No need to lock. Either still
+     * locked, or locked by the ConditionWait
      */
 
     TclSpliceOut(resultPtr, forwardList);
@@ -2675,9 +2869,9 @@ ForwardOpToOwnerThread(
      * Note: The event structure has already been deleted.
      */
 
-    Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
 
-    ckfree((char*) resultPtr);
+    ckfree(resultPtr);
 }
 
 static int
@@ -2686,6 +2880,11 @@ ForwardProc(
     int mask)
 {
     /*
+     * HANDLER thread.
+
+     * The receiver part for the operations coming from the OWNER thread.
+     * See ForwardOpToHandlerThread() for the transmitter.
+     *
      * Notes regarding access to the referenced data.
      *
      * In principle the data belongs to the originating thread (see
@@ -2704,8 +2903,9 @@ ForwardProc(
     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 */
+    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.
@@ -2731,8 +2931,6 @@ ForwardProc(
 	 * No parameters/results.
 	 */
 
-	Tcl_ChannelType *tctPtr;
-
 	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2747,22 +2945,16 @@ ForwardProc(
 	 * '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);
+	rcmPtr = GetReflectedChannelMap(interp);
+	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+                Tcl_GetChannelName(rcPtr->chan));
+	Tcl_DeleteHashEntry(hPtr);
 
-	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
-	if (tctPtr && tctPtr != &tclRChannelType) {
-	    ckfree((char *)tctPtr);
-	    ((Channel *)rcPtr->chan)->typePtr = NULL;
-	}
-        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+	rcmPtr = GetThreadReflectedChannelMap();
+	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
+                Tcl_GetChannelName(rcPtr->chan));
+	Tcl_DeleteHashEntry(hPtr);
+	MarkDead(rcPtr);
 	break;
     }
 
@@ -2772,7 +2964,7 @@ ForwardProc(
 
         Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
-	    int code = ErrnoReturn (rcPtr, resObj);
+	    int code = ErrnoReturn(rcPtr, resObj);
 
 	    if (code < 0) {
 		paramPtr->base.code = code;
@@ -2795,7 +2987,7 @@ ForwardProc(
 		paramPtr->input.toRead = -1;
 	    } else {
 		if (bytec > 0) {
-		    memcpy(paramPtr->input.buf, bytev, (size_t)bytec);
+		    memcpy(paramPtr->input.buf, bytev, (size_t) bytec);
 		}
 		paramPtr->input.toRead = bytec;
 	    }
@@ -2807,7 +2999,7 @@ ForwardProc(
 
     case ForwardedOutput: {
 	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
-		paramPtr->output.buf, paramPtr->output.toWrite);
+                paramPtr->output.buf, paramPtr->output.toWrite);
         Tcl_IncrRefCount(bufObj);
 
         Tcl_Preserve(rcPtr);
@@ -2828,7 +3020,9 @@ ForwardProc(
 	    int written;
 
 	    if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
-		ForwardSetObjError(paramPtr, MarshallError(interp));
+		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);
@@ -2845,8 +3039,8 @@ ForwardProc(
     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);
+                (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+                (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
 
         Tcl_IncrRefCount(offObj);
         Tcl_IncrRefCount(baseObj);
@@ -2871,7 +3065,9 @@ ForwardProc(
 		    paramPtr->seek.offset = newLoc;
 		}
 	    } else {
-		ForwardSetObjError(paramPtr, MarshallError(interp));
+		Tcl_DecrRefCount(resObj);
+		resObj = MarshallError(interp);
+		ForwardSetObjError(paramPtr, resObj);
 		paramPtr->seek.offset = -1;
 	    }
 	}
@@ -2895,11 +3091,11 @@ ForwardProc(
 
     case ForwardedBlock: {
 	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
-        Tcl_IncrRefCount(blockObj);
 
+        Tcl_IncrRefCount(blockObj);
         Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
-		&resObj) != TCL_OK) {
+                &resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
         Tcl_Release(rcPtr);
@@ -2909,13 +3105,13 @@ ForwardProc(
 
     case ForwardedSetOpt: {
 	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
-	Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
+	Tcl_Obj *valueObj  = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
 
         Tcl_IncrRefCount(optionObj);
         Tcl_IncrRefCount(valueObj);
         Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
-		&resObj) != TCL_OK) {
+                &resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
         Tcl_Release(rcPtr);
@@ -2930,14 +3126,13 @@ ForwardProc(
 	 */
 
 	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
-        Tcl_IncrRefCount(optionObj);
 
+        Tcl_IncrRefCount(optionObj);
         Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
-	    Tcl_DStringAppend(paramPtr->getOpt.value,
-		    TclGetString(resObj), -1);
+	    TclDStringAppendObj(paramPtr->getOpt.value, resObj);
 	}
         Tcl_Release(rcPtr);
         Tcl_DecrRefCount(optionObj);
@@ -2962,8 +3157,10 @@ ForwardProc(
 	    Tcl_Obj **listv;
 
 	    if (Tcl_ListObjGetElements(interp, resObj, &listc,
-		    &listv) != TCL_OK) {
-		ForwardSetObjError(paramPtr, MarshallError(interp));
+                    &listv) != TCL_OK) {
+		Tcl_DecrRefCount(resObj);
+		resObj = MarshallError(interp);
+		ForwardSetObjError(paramPtr, resObj);
 	    } else if ((listc % 2) == 1) {
 		/*
 		 * Odd number of elements is wrong. [x].
@@ -2980,7 +3177,7 @@ ForwardProc(
 		const char *str = Tcl_GetStringFromObj(resObj, &len);
 
 		if (len) {
-		    Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
+		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
 		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
 		}
 	    }
@@ -3026,7 +3223,7 @@ static void
 SrcExitProc(
     ClientData clientData)
 {
-    ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
+    ForwardingEvent *evPtr = clientData;
     ForwardingResult *resultPtr;
     ForwardParam *paramPtr;
 
@@ -3079,7 +3276,7 @@ ForwardSetObjError(
     const char *msgStr = Tcl_GetStringFromObj(obj, &len);
 
     len++;
-    ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+    ForwardSetDynamicError(paramPtr, ckalloc(len));
     memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
 }
 #endif
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
new file mode 100644
index 0000000..af86ba5
--- /dev/null
+++ b/generic/tclIORTrans.c
@@ -0,0 +1,3427 @@
+/*
+ * 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 eofPending;		/* Flag: EOF seen down, but not raised up */
+    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) \
+	do {								\
+	    if ((p)->base.mustFree) {					\
+		ckfree((p)->base.msgStr);				\
+	    }								\
+	} while (0)
+#define PassReceivedErrorInterp(i,p) \
+	do {								\
+	    if ((i) != NULL) {						\
+		Tcl_SetChannelErrorInterp((i),				\
+			Tcl_NewStringObj((p)->base.msgStr, -1));	\
+	    }								\
+	    FreeReceivedError(p);					\
+	} while (0)
+#define PassReceivedError(c,p) \
+	do {								\
+	    Tcl_SetChannelError((c),					\
+		    Tcl_NewStringObj((p)->base.msgStr, -1));		\
+	    FreeReceivedError(p);					\
+	} while (0)
+#define ForwardSetStaticError(p,emsg) \
+	do {								\
+	    (p)->base.code = TCL_ERROR;					\
+	    (p)->base.mustFree = 0;					\
+	    (p)->base.msgStr = (char *) (emsg);				\
+	} while (0)
+#define ForwardSetDynamicError(p,emsg) \
+	do {								\
+	    (p)->base.code = TCL_ERROR;					\
+	    (p)->base.mustFree = 1;					\
+	    (p)->base.msgStr = (char *) (emsg);				\
+	} while (0)
+
+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).
+ */
+
+/*
+ * 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, Tcl_Obj *bufObj);
+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. */
+    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) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "chan handler \"%s initialize\" returned %s",
+		    Tcl_GetString(cmdObj),
+		    Tcl_GetString(Tcl_GetObjResult(interp))));
+	    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 /* TCL_THREADS */
+
+    /*
+     * Return the channel as the result of the command.
+     */
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    Tcl_GetChannelName(rtPtr->chan), -1));
+    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_THREADS */
+
+	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 /* TCL_THREADS */
+	    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 /* TCL_THREADS */
+	    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 /* TCL_THREADS */
+
+    /*
+     * 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_THREADS */
+    }
+
+    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;
+    Tcl_Obj *bufObj;
+
+    /*
+     * 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);
+
+    /* TODO: Consider a more appropriate buffer size. */
+    bufObj = Tcl_NewByteArrayObj(NULL, toRead);
+    Tcl_IncrRefCount(bufObj);
+    gotBytes = 0;
+    if (rtPtr->eofPending) {
+	goto stop;
+    }
+    rtPtr->readIsDrained = 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;
+	}
+
+	if (rtPtr->eofPending) {
+	    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,
+		(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
+	if (readBytes < 0) {
+	    if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {
+
+		/*
+		 * Down channel is blocked and offers zero additional bytes.
+		 * The nonzero gotBytes already returned makes the total
+		 * operation a valid short read.  Return to caller.
+		 */
+
+		goto stop;
+	    }
+
+	    /*
+	     * Either the down channel is not blocked (a real error)
+	     * or it is and there are gotBytes==0 byte copied so far.
+	     * In either case, pass up the error, so we either report
+	     * any real error, or do not mistakenly signal EOF by
+	     * returning 0 to the caller.
+	     */
+
+	    *errorCodePtr = Tcl_GetErrno();
+	    goto error;
+	}
+
+	if (readBytes == 0) {
+
+	    /*
+	     * Zero returned from Tcl_ReadRaw() always indicates EOF
+	     * on the down channel.
+	     */
+
+	    rtPtr->eofPending = 1;
+
+		/*
+		 * 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;
+		}
+
+		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.
+	 */
+
+	Tcl_SetByteArrayLength(bufObj, readBytes);
+	if (!TransformRead(rtPtr, errorCodePtr, bufObj)) {
+	    goto error;
+	}
+	if (Tcl_IsShared(bufObj)) {
+	    Tcl_DecrRefCount(bufObj);
+	    bufObj = Tcl_NewObj();
+	    Tcl_IncrRefCount(bufObj);
+	}
+	Tcl_SetByteArrayLength(bufObj, 0);
+    } /* while toRead > 0 */
+
+ stop:
+    if (gotBytes == 0) {
+	rtPtr->eofPending = 0;
+    }
+    Tcl_DecrRefCount(bufObj);
+    Tcl_Release(rtPtr);
+    return gotBytes;
+
+ error:
+    gotBytes = -1;
+    goto stop;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectOutput --
+ *
+ *	This function is invoked when data is written 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->eofPending = 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);
+    Tcl_Preserve(rtPtr->interp);
+    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->interp);
+    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 /* TCL_THREADS */
+
+    /*
+     * 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;
+	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(&rtForwardMutex);
+#endif /* TCL_THREADS */
+}
+
+#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;
+	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(&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 /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(SYNTHETIC_EVENT_TIME,
+	    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;
+    }
+
+    ckfree((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(ckalloc(rPtr->allocated));
+	} else {
+	    rPtr->allocated += toWrite + RB_INCREMENT;
+	    rPtr->buf = UCHARP(ckrealloc((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,
+    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 *) Tcl_GetByteArrayFromObj(bufObj,
+		&(p.transform.size));
+
+	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 /* TCL_THREADS */
+
+    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
+    /* ASSERT: rtPtr->mode & TCL_READABLE */
+
+    if (InvokeTclMethod(rtPtr, "read", bufObj, 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 */
+    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 /* TCL_THREADS */
+    {
+	/* 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 = Tcl_GetErrno();
+	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 /* TCL_THREADS */
+    {
+	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 /* TCL_THREADS */
+    {
+	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 = Tcl_GetErrno();
+	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 /* TCL_THREADS */
+
+    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
+    /* ASSERT: rtPtr->mode & TCL_READABLE */
+
+    (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
+
+    rtPtr->readIsDrained = 0;
+    rtPtr->eofPending = 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 97dec06..c5b7d28 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -10,6 +10,29 @@
  */
 
 #include "tclInt.h"
+
+#if defined(_WIN32) && defined(UNICODE)
+/* On Windows, we need to do proper Unicode->UTF-8 conversion. */
+
+typedef struct ThreadSpecificData {
+    int initialized;
+    Tcl_DString errorMsg; /* UTF-8 encoded error-message */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+#undef gai_strerror
+static const char *gai_strerror(int code) {
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (tsdPtr->initialized) {
+	Tcl_DStringFree(&tsdPtr->errorMsg);
+    } else {
+	tsdPtr->initialized = 1;
+    }
+    Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg);
+    return Tcl_DStringValue(&tsdPtr->errorMsg);
+}
+#endif
 
 /*
  *---------------------------------------------------------------------------
@@ -58,8 +81,8 @@ TclSockGetPort(
 	return TCL_ERROR;
     }
     if (*portPtr > 0xFFFF) {
-	Tcl_AppendResult(interp, "couldn't open socket: port number too high",
-		NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"couldn't open socket: port number too high", -1));
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -81,7 +104,6 @@ TclSockGetPort(
  *----------------------------------------------------------------------
  */
 
-#undef TclSockMinimumBuffers
 #if !defined(_WIN32) && !defined(__CYGWIN__)
 #   define SOCKET int
 #endif
@@ -95,21 +117,172 @@ TclSockMinimumBuffers(
     socklen_t len;
 
     len = sizeof(int);
-    getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
+    getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
+	    (char *) &current, &len);
     if (current < size) {
 	len = sizeof(int);
-	setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
+	setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
+		(char *) &size, len);
     }
     len = sizeof(int);
-    getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
+    getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
+		(char *) &current, &len);
     if (current < size) {
 	len = sizeof(int);
-	setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
+	setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
+		(char *) &size, len);
     }
     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, portbuf[TCL_INTEGER_SPACE], *portstring;
+    const char *family = NULL;
+    Tcl_DString ds;
+    int result;
+
+    if (host != NULL) {
+	native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
+    }
+
+    /*
+     * Workaround for OSX's apparent inability to resolve "localhost", "0"
+     * when the loopback device is the only available network interface.
+     */
+    if (host != NULL && port == 0) {
+        portstring = NULL;
+    } else {
+        TclFormatInt(portbuf, port);
+        portstring = portbuf;
+    }
+
+    (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) {
+	*errorMsgPtr =
+#ifdef EAI_SYSTEM	/* Doesn't exist on Windows */
+		(result == EAI_SYSTEM) ? Tcl_PosixError(interp) :
+#endif /* EAI_SYSTEM */
+		gai_strerror(result);
+        return 0;
+    }
+
+    /*
+     * 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;
+	}
+    }
+    return 1;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index e1c5709..e00b9ac 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -19,7 +19,7 @@
  */
 
 #include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
 #   include "tclWinInt.h"
 #endif
 #include "tclFileSystem.h"
@@ -40,7 +40,7 @@
 typedef struct FilesystemRecord {
     ClientData clientData;	/* Client specific data for the new filesystem
 				 * (can be NULL) */
-    Tcl_Filesystem *fsPtr;	/* Pointer to filesystem dispatch table. */
+    const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */
     struct FilesystemRecord *nextPtr;
 				/* The next filesystem registered to Tcl, or
 				 * NULL if no more. */
@@ -59,18 +59,19 @@ typedef struct FilesystemRecord {
 
 typedef struct ThreadSpecificData {
     int initialized;
-    int cwdPathEpoch;
-    int filesystemEpoch;
+    size_t cwdPathEpoch;
+    size_t filesystemEpoch;
     Tcl_Obj *cwdPathPtr;
     ClientData cwdClientData;
     FilesystemRecord *filesystemList;
-    int claims;
+    size_t claims;
 } ThreadSpecificData;
 
 /*
  * Prototypes for functions defined later in this file.
  */
 
+static Tcl_NRPostProc	EvalFileCallback;
 static FilesystemRecord*FsGetFirstFilesystem(void);
 static void		FsThrExitProc(ClientData cd);
 static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
@@ -78,11 +79,13 @@ static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
 			    Tcl_Obj *pathPtr, const char *pattern,
 			    Tcl_GlobTypeData *types);
 static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
-
 static void		FsRecacheFilesystemList(void);
 static void		Claim(void);
 static void		Disclaim(void);
 
+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
@@ -91,15 +94,170 @@ static void		Disclaim(void);
  * they are not (and should not be) used anywhere else.
  */
 
-MODULE_SCOPE const char *		tclpFileAttrStrings[];
+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.
+ */
+
+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).
+ */
+
+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,
+    /* Needs casts since we're using version_2. */
+    (Tcl_FSLoadFileProc *) TclpDlopen,
+    (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,
+    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.
+ */
+
+static size_t theFilesystemEpoch = 1;
+
+/*
+ * Stores the linked list of filesystems. A 1:1 copy of this list is also
+ * maintained in the TSD for each thread. This is to avoid synchronization
+ * issues.
+ */
+
+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 size_t cwdPathEpoch = 0;
+static ClientData cwdClientData = NULL;
+TCL_DECLARE_MUTEX(cwdMutex)
+
+static Tcl_ThreadDataKey fsDataKey;
+
+/*
+ * One of these structures is used each time we successfully load a file from
+ * a file system by way of making a temporary copy of the file on the native
+ * filesystem. We need to store both the actual unloadProc/clientData
+ * combination which was used, and the original and modified filenames, so
+ * that we can correctly undo the entire operation when we want to unload the
+ * code.
+ */
+
+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(
@@ -108,7 +266,7 @@ Tcl_Stat(
 {
     int ret;
     Tcl_StatBuf buf;
-    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
 
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSStat(pathPtr, &buf);
@@ -116,6 +274,7 @@ Tcl_Stat(
     if (ret != -1) {
 #ifndef TCL_WIDE_INT_IS_LONG
 	Tcl_WideInt tmp1, tmp2, tmp3 = 0;
+
 # define OUT_OF_RANGE(x) \
 	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
 	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
@@ -132,10 +291,10 @@ Tcl_Stat(
 	 * Tcl_WideInt.
 	 */
 
-        tmp1 = (Tcl_WideInt) buf.st_ino;
-        tmp2 = (Tcl_WideInt) buf.st_size;
+	tmp1 = (Tcl_WideInt) buf.st_ino;
+	tmp2 = (Tcl_WideInt) buf.st_size;
 #ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-        tmp3 = (Tcl_WideInt) buf.st_blocks;
+	tmp3 = (Tcl_WideInt) buf.st_blocks;
 #endif
 
 	if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
@@ -242,16 +401,15 @@ Tcl_GetCwd(
     Tcl_Interp *interp,
     Tcl_DString *cwdPtr)
 {
-    Tcl_Obj *cwd;
-    cwd = Tcl_FSGetCwd(interp);
+    Tcl_Obj *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);
+    TclDStringAppendObj(cwdPtr, cwd);
+    Tcl_DecrRefCount(cwd);
+    return Tcl_DStringValue(cwdPtr);
 }
 
 /* Obsolete */
@@ -263,6 +421,7 @@ Tcl_EvalFile(
 {
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSEvalFile(interp, pathPtr);
     Tcl_DecrRefCount(pathPtr);
@@ -270,234 +429,14 @@ Tcl_EvalFile(
 }
 
 /*
- * 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.
- */
-
-#undef USE_OBSOLETE_FS_HOOKS
-
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- * The following typedef declarations allow for hooking into the chain of
- * functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
- * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
- * list is defined.
- */
-
-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_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).
- */
-
-Tcl_FSFilesystemPathTypeProc	TclpFilesystemPathType;
-Tcl_FSInternalToNormalizedProc	TclpNativeToNormalized;
-Tcl_FSStatProc			TclpObjStat;
-Tcl_FSAccessProc		TclpObjAccess;
-Tcl_FSMatchInDirectoryProc	TclpMatchInDirectory;
-Tcl_FSChdirProc			TclpObjChdir;
-Tcl_FSLstatProc			TclpObjLstat;
-Tcl_FSCopyFileProc		TclpObjCopyFile;
-Tcl_FSDeleteFileProc		TclpObjDeleteFile;
-Tcl_FSRenameFileProc		TclpObjRenameFile;
-Tcl_FSCreateDirectoryProc	TclpObjCreateDirectory;
-Tcl_FSCopyDirectoryProc		TclpObjCopyDirectory;
-Tcl_FSRemoveDirectoryProc	TclpObjRemoveDirectory;
-Tcl_FSUnloadFileProc		TclpUnloadFile;
-Tcl_FSLinkProc			TclpObjLink;
-Tcl_FSListVolumesProc		TclpObjListVolumes;
-
-/*
- * Define the native filesystem dispatch table. If necessary, it is ok to make
- * this non-static, but it should only be accessed by the functions actually
- * listed within it (or perhaps other helper functions of them). Anything
- * which is not part of this 'native filesystem implementation' should not be
- * delving inside here!
- */
-
-Tcl_Filesystem tclNativeFilesystem = {
-    "native",
-    sizeof(Tcl_Filesystem),
-    TCL_FILESYSTEM_VERSION_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,
-    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.
- */
-
-static int theFilesystemEpoch = 1;
-
-/*
- * Stores the linked list of filesystems. A 1:1 copy of this list is also
- * maintained in the TSD for each thread. This is to avoid synchronization
- * issues.
- */
-
-static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
-TCL_DECLARE_MUTEX(filesystemMutex)
-
-/*
- * Used to implement Tcl_FSGetCwd in a file-system independent way.
- */
-
-static Tcl_Obj* cwdPathPtr = NULL;
-static int cwdPathEpoch = 0;
-static ClientData cwdClientData = NULL;
-TCL_DECLARE_MUTEX(cwdMutex)
-
-static Tcl_ThreadDataKey fsDataKey;
-
-/*
- * One of these structures is used each time we successfully load a file from
- * a file system by way of making a temporary copy of the file on the native
- * filesystem. We need to store both the actual unloadProc/clientData
- * combination which was used, and the original and modified filenames, so
- * that we can correctly undo the entire operation when we want to unload the
- * code.
- */
-
-typedef struct FsDivertLoad {
-    Tcl_LoadHandle loadHandle;
-    Tcl_FSUnloadFileProc *unloadProcPtr;
-    Tcl_Obj *divertedFile;
-    const Tcl_Filesystem *divertedFilesystem;
-    ClientData divertedFileNativeRep;
-} FsDivertLoad;
-
-/*
- * Now move on to the basic filesystem implementation
+ * Now move on to the basic filesystem implementation.
  */
 
 static void
 FsThrExitProc(
     ClientData cd)
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
+    ThreadSpecificData *tsdPtr = cd;
     FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
 
     /*
@@ -520,7 +459,7 @@ FsThrExitProc(
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr->nextPtr;
 	fsRecPtr->fsPtr = NULL;
-	ckfree((char *)fsRecPtr);
+	ckfree(fsRecPtr);
 	fsRecPtr = tmpFsRecPtr;
     }
     tsdPtr->filesystemList = NULL;
@@ -562,7 +501,7 @@ TclFSCwdIsNative(void)
 
 int
 TclFSCwdPointerEquals(
-    Tcl_Obj** pathPtrPtr)
+    Tcl_Obj **pathPtrPtr)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
 
@@ -591,7 +530,7 @@ TclFSCwdPointerEquals(
     Tcl_MutexUnlock(&cwdMutex);
 
     if (tsdPtr->initialized == 0) {
-	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
+	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
 	tsdPtr->initialized = 1;
     }
 
@@ -607,7 +546,7 @@ TclFSCwdPointerEquals(
 
 	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
 	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
-	if (len1 == len2 && !strcmp(str1,str2)) {
+	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
 	    /*
 	     * They are equal, but different objects. Update so they will be
 	     * the same object in the future.
@@ -659,7 +598,7 @@ FsRecacheFilesystemList(void)
     list = NULL;
     fsRecPtr = tmpFsRecPtr;
     while (fsRecPtr != NULL) {
-	tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
+	tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
 	*tmpFsRecPtr = *fsRecPtr;
 	tmpFsRecPtr->nextPtr = list;
 	tmpFsRecPtr->prevPtr = NULL;
@@ -673,7 +612,7 @@ FsRecacheFilesystemList(void)
     while (toFree) {
 	FilesystemRecord *next = toFree->nextPtr;
 	toFree->fsPtr = NULL;
-	ckfree((char *)toFree);
+	ckfree(toFree);
 	toFree = next;
     }
 
@@ -682,7 +621,7 @@ FsRecacheFilesystemList(void)
      */
 
     if (tsdPtr->initialized == 0) {
-	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
+	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
 	tsdPtr->initialized = 1;
     }
 }
@@ -705,29 +644,32 @@ FsGetFirstFilesystem(void)
 
 int
 TclFSEpochOk(
-    int filesystemEpoch)
+    size_t filesystemEpoch)
 {
     return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
 }
 
 static void
-Claim()
+Claim(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
     tsdPtr->claims++;
 }
 
 static void
-Disclaim()
+Disclaim(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
     tsdPtr->claims--;
 }
 
-int
-TclFSEpoch()
+size_t
+TclFSEpoch(void)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+
     return tsdPtr->filesystemEpoch;
 }
 
@@ -742,7 +684,7 @@ FsUpdateCwd(
     ClientData clientData)
 {
     int len;
-    char *str = NULL;
+    const char *str = NULL;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
 
     if (cwdObj != NULL) {
@@ -766,11 +708,13 @@ FsUpdateCwd(
 	 */
 
 	cwdPathPtr = Tcl_NewStringObj(str, len);
-    	Tcl_IncrRefCount(cwdPathPtr);
+	Tcl_IncrRefCount(cwdPathPtr);
 	cwdClientData = TclNativeDupInternalRep(clientData);
     }
 
-    cwdPathEpoch++;
+    if (++cwdPathEpoch == 0) {
+	++cwdPathEpoch;
+    }
     tsdPtr->cwdPathEpoch = cwdPathEpoch;
     Tcl_MutexUnlock(&cwdMutex);
 
@@ -833,7 +777,7 @@ TclFinalizeFilesystem(void)
 
     /*
      * Remove all filesystems, freeing any allocated memory that is no longer
-     * needed
+     * needed.
      */
 
     fsRecPtr = filesystemList;
@@ -843,11 +787,13 @@ TclFinalizeFilesystem(void)
 	/* The native filesystem is static, so we don't free it. */
 
 	if (fsRecPtr != &nativeFilesystemRecord) {
-	    ckfree((char *)fsRecPtr);
+	    ckfree(fsRecPtr);
 	}
 	fsRecPtr = tmpFsRecPtr;
     }
-    theFilesystemEpoch++;
+    if (++theFilesystemEpoch == 0) {
+	++theFilesystemEpoch;
+    }
     filesystemList = NULL;
 
     /*
@@ -855,12 +801,7 @@ TclFinalizeFilesystem(void)
      * filesystem is likely to fail.
      */
 
-#ifdef USE_OBSOLETE_FS_HOOKS
-    statProcList = NULL;
-    accessProcList = NULL;
-    openFileChannelProcList = NULL;
-#endif
-#ifdef __WIN32__
+#ifdef _WIN32
     TclWinEncodingsCleanup();
 #endif
 }
@@ -885,9 +826,11 @@ void
 TclResetFilesystem(void)
 {
     filesystemList = &nativeFilesystemRecord;
-    theFilesystemEpoch++;
+    if (++theFilesystemEpoch == 0) {
+	++theFilesystemEpoch;
+    }
 
-#ifdef __WIN32__
+#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.
@@ -929,8 +872,8 @@ TclResetFilesystem(void)
 
 int
 Tcl_FSRegister(
-    ClientData clientData,	/* Client specific data for this fs */
-    Tcl_Filesystem *fsPtr)	/* The filesystem record for the new fs. */
+    ClientData clientData,	/* Client specific data for this fs. */
+    const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */
 {
     FilesystemRecord *newFilesystemPtr;
 
@@ -938,7 +881,7 @@ Tcl_FSRegister(
 	return TCL_ERROR;
     }
 
-    newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
+    newFilesystemPtr = ckalloc(sizeof(FilesystemRecord));
 
     newFilesystemPtr->clientData = clientData;
     newFilesystemPtr->fsPtr = fsPtr;
@@ -970,7 +913,9 @@ Tcl_FSRegister(
      * conceivably now belong to different filesystems.
      */
 
-    theFilesystemEpoch++;
+    if (++theFilesystemEpoch == 0) {
+	++theFilesystemEpoch;
+    }
     Tcl_MutexUnlock(&filesystemMutex);
 
     return TCL_OK;
@@ -1002,7 +947,7 @@ Tcl_FSRegister(
 
 int
 Tcl_FSUnregister(
-    Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
+    const Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
 {
     int retVal = TCL_ERROR;
     FilesystemRecord *fsRecPtr;
@@ -1035,9 +980,11 @@ Tcl_FSUnregister(
 	     * (which would of course lead to memory exceptions).
 	     */
 
-	    theFilesystemEpoch++;
+	    if (++theFilesystemEpoch == 0) {
+		++theFilesystemEpoch;
+	    }
 
-	    ckfree((char *)fsRecPtr);
+	    ckfree(fsRecPtr);
 
 	    retVal = TCL_OK;
 	} else {
@@ -1093,7 +1040,7 @@ Tcl_FSUnregister(
 int
 Tcl_FSMatchInDirectory(
     Tcl_Interp *interp,		/* Interpreter to receive error messages, but
-                       		 * may be NULL. */
+				 * 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. */
@@ -1105,7 +1052,7 @@ Tcl_FSMatchInDirectory(
     Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
     int resLength, i, ret = -1;
 
-    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
+    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
@@ -1132,8 +1079,8 @@ Tcl_FSMatchInDirectory(
 	    Tcl_SetErrno(ENOENT);
 	    return -1;
 	}
-	ret = (*fsPtr->matchInDirectoryProc)(interp, resultPtr, pathPtr,
-		pattern, types);
+	ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern,
+		types);
 	if (ret == TCL_OK && pattern != NULL) {
 	    FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
 	}
@@ -1142,7 +1089,7 @@ Tcl_FSMatchInDirectory(
 
     /*
      * If the path isn't empty, we have no idea how to match files in a
-     * directory which belongs to no known filesystem
+     * directory which belongs to no known filesystem.
      */
 
     if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
@@ -1163,8 +1110,9 @@ Tcl_FSMatchInDirectory(
     cwd = Tcl_FSGetCwd(NULL);
     if (cwd == NULL) {
 	if (interp != NULL) {
-	    Tcl_SetResult(interp, "glob couldn't determine "
-		    "the current working directory", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "glob couldn't determine the current working directory",
+		    -1));
 	}
 	return TCL_ERROR;
     }
@@ -1173,8 +1121,8 @@ Tcl_FSMatchInDirectory(
     if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) {
 	TclNewObj(tmpResultPtr);
 	Tcl_IncrRefCount(tmpResultPtr);
-	ret = (*fsPtr->matchInDirectoryProc)(interp, tmpResultPtr, cwd,
-		pattern, types);
+	ret = fsPtr->matchInDirectoryProc(interp, tmpResultPtr, cwd, pattern,
+		types);
 	if (ret == TCL_OK) {
 	    FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
 
@@ -1218,7 +1166,7 @@ static void
 FsAddMountsToGlobResult(
     Tcl_Obj *resultPtr,		/* The current list of matching paths; must
 				 * not be shared! */
-    Tcl_Obj *pathPtr,		/* The directory in question */
+    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
@@ -1259,7 +1207,7 @@ FsAddMountsToGlobResult(
 		    Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
 		    gLength--;
 		}
-		break;		/* Break out of for loop */
+		break;		/* Break out of for loop. */
 	    }
 	}
 	if (!found && dir) {
@@ -1349,7 +1297,7 @@ FsAddMountsToGlobResult(
 
 void
 Tcl_FSMountsChanged(
-    Tcl_Filesystem *fsPtr)
+    const Tcl_Filesystem *fsPtr)
 {
     /*
      * We currently don't do anything with this parameter. We could in the
@@ -1365,7 +1313,9 @@ Tcl_FSMountsChanged(
      */
 
     Tcl_MutexLock(&filesystemMutex);
-    theFilesystemEpoch++;
+    if (++theFilesystemEpoch == 0) {
+	++theFilesystemEpoch;
+    }
     Tcl_MutexUnlock(&filesystemMutex);
 }
 
@@ -1390,7 +1340,7 @@ Tcl_FSMountsChanged(
 
 ClientData
 Tcl_FSData(
-    Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
+    const Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
 {
     ClientData retVal = NULL;
     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
@@ -1444,8 +1394,8 @@ Tcl_FSData(
 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 */
+    Tcl_Obj *pathPtr,		/* The path to normalize in place. */
+    int startAt)		/* Start at this char-offset. */
 {
     FilesystemRecord *fsRecPtr, *firstFsRecPtr;
 
@@ -1459,37 +1409,42 @@ TclFSNormalizeToUniquePath(
     firstFsRecPtr = FsGetFirstFilesystem();
 
     Claim();
-    fsRecPtr = firstFsRecPtr;
-    while (fsRecPtr != NULL) {
-	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
-	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
-	    if (proc != NULL) {
-		startAt = (*proc)(interp, pathPtr, startAt);
-	    }
-	    break;
+    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
+	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
+	    continue;
 	}
-	fsRecPtr = fsRecPtr->nextPtr;
+
+	/*
+	 * 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);
+	}
+	break;
     }
 
-    fsRecPtr = firstFsRecPtr;
-    while (fsRecPtr != NULL) {
+    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
 	/*
 	 * 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);
-	    }
+	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
+	    continue;
+	}
 
-	    /*
-	     * We could add an efficiency check like this:
-	     *		if (retVal == length-of(pathPtr)) {break;}
-	     * but there's not much benefit.
-	     */
+	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+		    startAt);
 	}
-	fsRecPtr = fsRecPtr->nextPtr;
+
+	/*
+	 * We could add an efficiency check like this:
+	 *		if (retVal == length-of(pathPtr)) {break;}
+	 * but there's not much benefit.
+	 */
     }
     Disclaim();
 
@@ -1563,7 +1518,7 @@ TclGetOpenModeEx(
 				 * EOF during the opening of the file. */
     int *binaryPtr)		/* Set this to 1 if the caller should
 				 * configure the opened channel for binary
-				 * operations */
+				 * operations. */
 {
     int mode, modeArgc, c, i, gotRW;
     const char **modeArgv, *flag;
@@ -1605,7 +1560,7 @@ TclGetOpenModeEx(
 	default:
 	    goto error;
 	}
-	i=1;
+	i = 1;
 	while (i<3 && modeString[i]) {
 	    if (modeString[i] == modeString[i-1]) {
 		goto error;
@@ -1636,8 +1591,8 @@ TclGetOpenModeEx(
 	*seekFlagPtr = 0;
 	*binaryPtr = 0;
 	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "illegal access mode \"", modeString,
-		    "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "illegal access mode \"%s\"", modeString));
 	}
 	return -1;
     }
@@ -1686,10 +1641,11 @@ TclGetOpenModeEx(
 	    mode |= O_NOCTTY;
 #else
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "access mode \"", flag,
-			"\" not supported by this system", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"access mode \"%s\" not supported by this system",
+			flag));
 	    }
-	    ckfree((char *) modeArgv);
+	    ckfree(modeArgv);
 	    return -1;
 #endif
 
@@ -1698,10 +1654,11 @@ TclGetOpenModeEx(
 	    mode |= O_NONBLOCK;
 #else
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "access mode \"", flag,
-			"\" not supported by this system", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"access mode \"%s\" not supported by this system",
+			flag));
 	    }
-	    ckfree((char *) modeArgv);
+	    ckfree(modeArgv);
 	    return -1;
 #endif
 
@@ -1712,21 +1669,23 @@ TclGetOpenModeEx(
 	} 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);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"invalid access mode \"%s\": must be RDONLY, WRONLY, "
+			"RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK,"
+			" or TRUNC", flag));
 	    }
-	    ckfree((char *) modeArgv);
+	    ckfree(modeArgv);
 	    return -1;
 	}
     }
 
-    ckfree((char *) modeArgv);
+    ckfree(modeArgv);
 
     if (!gotRW) {
 	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "access mode must include either"
-		    " RDONLY, WRONLY, or RDWR", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "access mode must include either RDONLY, WRONLY, or RDWR",
+		    -1));
 	}
 	return -1;
     }
@@ -1734,25 +1693,13 @@ TclGetOpenModeEx(
 }
 
 /*
- * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
- */
-
-int
-Tcl_FSEvalFile(
-    Tcl_Interp *interp,		/* Interpreter in which to process file. */
-    Tcl_Obj *pathPtr)		/* Path of file to process. Tilde-substitution
-				 * will be performed on this name. */
-{
-    return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
-}
-
-/*
  *----------------------------------------------------------------------
  *
- * Tcl_FSEvalFileEx --
+ * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile --
  *
  *	Read in a file and process the entire file as one gigantic Tcl
- *	command.
+ *	command. Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
+ *	TclNREvalFile is an NRE-enabled version of Tcl_FSEvalFileEx.
  *
  * Results:
  *	A standard Tcl result, which is either the result of executing the
@@ -1767,6 +1714,15 @@ Tcl_FSEvalFile(
  */
 
 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
@@ -1778,7 +1734,7 @@ Tcl_FSEvalFileEx(
     Tcl_StatBuf statBuf;
     Tcl_Obj *oldScriptFile;
     Interp *iPtr;
-    char *string;
+    const char *string;
     Tcl_Channel chan;
     Tcl_Obj *objPtr;
 
@@ -1788,15 +1744,16 @@ Tcl_FSEvalFileEx(
 
     if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
 	Tcl_SetErrno(errno);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
 	return result;
     }
     chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
-    if (chan == (Tcl_Channel) NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+    if (chan == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
 	return result;
     }
 
@@ -1822,25 +1779,32 @@ Tcl_FSEvalFileEx(
 
     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_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
 	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);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
 	goto end;
     }
 
@@ -1853,10 +1817,13 @@ Tcl_FSEvalFileEx(
     iPtr->scriptFile = pathPtr;
     Tcl_IncrRefCount(iPtr->scriptFile);
     string = Tcl_GetStringFromObj(objPtr, &length);
-    /* TIP #280 Force the evaluator to open a frame for a sourced
-     * file. */
+
+    /*
+     * TIP #280 Force the evaluator to open a frame for a sourced file.
+     */
+
     iPtr->evalFlags |= TCL_EVAL_FILE;
-    result = Tcl_EvalEx(interp, string, length, 0);
+    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
 
     /*
      * Now we have to be careful; the script may have changed the
@@ -1883,13 +1850,163 @@ Tcl_FSEvalFileEx(
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (file \"%.*s%s\" line %d)",
 		(overflow ? limit : length), pathString,
-		(overflow ? "..." : ""), interp->errorLine));
+		(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_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+	return TCL_ERROR;
+    }
+    chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
+    if (chan == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't read file \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+	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;
+
+    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)));
+    }
+
+    Tcl_DecrRefCount(objPtr);
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -1913,6 +2030,11 @@ Tcl_FSEvalFileEx(
 int
 Tcl_GetErrno(void)
 {
+    /*
+     * On some platforms, errno is really a thread local (implemented by the C
+     * library).
+     */
+
     return errno;
 }
 
@@ -1921,7 +2043,9 @@ Tcl_GetErrno(void)
  *
  * Tcl_SetErrno --
  *
- *	Sets the Tcl error code variable to the supplied value.
+ *	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!
  *
  * Results:
  *	None.
@@ -1936,6 +2060,11 @@ void
 Tcl_SetErrno(
     int err)			/* The new value. */
 {
+    /*
+     * On some platforms, errno is really a thread local (implemented by the C
+     * library).
+     */
+
     errno = err;
 }
 
@@ -1997,72 +2126,10 @@ Tcl_FSStat(
     Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
     Tcl_StatBuf *buf)		/* Filled with results of stat call. */
 {
-    const Tcl_Filesystem *fsPtr;
-#ifdef USE_OBSOLETE_FS_HOOKS
-    struct stat oldStyleStatBuffer;
-    int retVal = -1;
-
-    /*
-     * Call each of the "stat" function in succession. A non-return value of
-     * -1 indicates the particular function has succeeded.
-     */
-
-    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_STRUCT_STAT_ST_BLKSIZE
-	buf->st_blksize = oldStyleStatBuffer.st_blksize;
-#endif
-#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
-#endif
-	return retVal;
-    }
-#endif /* USE_OBSOLETE_FS_HOOKS */
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
 
-    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
-	Tcl_FSStatProc *proc = fsPtr->statProc;
-	if (proc != NULL) {
-	    return (*proc)(pathPtr, buf);
-	}
+    if (fsPtr != NULL && fsPtr->statProc != NULL) {
+	return fsPtr->statProc(pathPtr, buf);
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -2093,15 +2160,13 @@ Tcl_FSLstat(
     Tcl_StatBuf *buf)		/* Filled with results of stat call. */
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
     if (fsPtr != NULL) {
-	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);
-	    }
+	if (fsPtr->lstatProc != NULL) {
+	    return fsPtr->lstatProc(pathPtr, buf);
+	}
+	if (fsPtr->statProc != NULL) {
+	    return fsPtr->statProc(pathPtr, buf);
 	}
     }
     Tcl_SetErrno(ENOENT);
@@ -2130,51 +2195,11 @@ Tcl_FSAccess(
     Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
     int mode)			/* Permission setting. */
 {
-    const Tcl_Filesystem *fsPtr;
-#ifdef USE_OBSOLETE_FS_HOOKS
-    int retVal = -1;
-
-    /*
-     * Call each of the "access" function in succession. A non-return value of
-     * -1 indicates the particular function has succeeded.
-     */
-
-    Tcl_MutexLock(&obsoleteFsHookMutex);
-
-    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 */
+    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
 
-    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
-	Tcl_FSAccessProc *proc = fsPtr->accessProc;
-	if (proc != NULL) {
-	    return (*proc)(pathPtr, mode);
-	}
+    if (fsPtr != NULL && fsPtr->accessProc != NULL) {
+	return fsPtr->accessProc(pathPtr, mode);
     }
-
     Tcl_SetErrno(ENOENT);
     return -1;
 }
@@ -2210,41 +2235,6 @@ Tcl_FSOpenFileChannel(
     const Tcl_Filesystem *fsPtr;
     Tcl_Channel retVal = NULL;
 
-#ifdef USE_OBSOLETE_FS_HOOKS
-    /*
-     * Call each of the "Tcl_OpenFileChannel" functions in succession. A
-     * non-NULL return value indicates the particular function has succeeded.
-     */
-
-    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);
-	}
-
-	openFileChannelProcPtr = openFileChannelProcList;
-
-	while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
-	    retVal = (*openFileChannelProcPtr->proc)(interp, path,
-		    modeString, permissions);
-	    openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
-	}
-	if (transPtr != NULL) {
-	    Tcl_DecrRefCount(transPtr);
-	}
-    }
-    Tcl_MutexUnlock(&obsoleteFsHookMutex);
-    if (retVal != NULL) {
-	return retVal;
-    }
-#endif /* USE_OBSOLETE_FS_HOOKS */
-
     /*
      * We need this just to ensure we return the correct error messages under
      * some circumstances.
@@ -2255,49 +2245,47 @@ Tcl_FSOpenFileChannel(
     }
 
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
-	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
-	if (proc != NULL) {
-	    int mode, seekFlag, binary;
+    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.
-	     */
+	/*
+	 * 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;
-	    }
+	mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
+	if (mode == -1) {
+	    return NULL;
+	}
 
-	    /*
-	     * Do the actual open() call.
-	     */
+	/*
+	 * Do the actual open() call.
+	 */
 
-	    retVal = (*proc)(interp, pathPtr, mode, permissions);
-	    if (retVal == NULL) {
-		return NULL;
-	    }
+	retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode,
+		permissions);
+	if (retVal == NULL) {
+	    return NULL;
+	}
 
-	    /*
-	     * Apply appropriate flags parsed out above.
-	     */
+	/*
+	 * Apply appropriate flags parsed out above.
+	 */
 
-	    if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
-		    SEEK_END) < (Tcl_WideInt)0) {
-		if (interp != NULL) {
-		    Tcl_AppendResult(interp, "could not seek to end "
-			    "of file while opening \"", Tcl_GetString(pathPtr),
-			    "\": ", Tcl_PosixError(interp), NULL);
-		}
-		Tcl_Close(NULL, retVal);
-		return NULL;
-	    }
-	    if (binary) {
-		Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
+	if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
+		< (Tcl_WideInt) 0) {
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not seek to end of file while opening \"%s\": %s",
+			Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
 	    }
-	    return retVal;
+	    Tcl_Close(NULL, retVal);
+	    return NULL;
 	}
+	if (binary) {
+	    Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
+	}
+	return retVal;
     }
 
     /*
@@ -2306,8 +2294,9 @@ Tcl_FSOpenFileChannel(
 
     Tcl_SetErrno(ENOENT);
     if (interp != NULL) {
-	Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
-		"\": ", Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't open \"%s\": %s",
+		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
     }
     return NULL;
 }
@@ -2331,17 +2320,17 @@ Tcl_FSOpenFileChannel(
 
 int
 Tcl_FSUtime(
-    Tcl_Obj *pathPtr,		/* File to change access/modification times */
+    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) {
-	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
-	if (proc != NULL) {
-	    return (*proc)(pathPtr, tval);
-	}
+
+    if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
+	return fsPtr->utimeProc(pathPtr, tval);
     }
+    /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
     return -1;
 }
 
@@ -2365,7 +2354,7 @@ Tcl_FSUtime(
  *----------------------------------------------------------------------
  */
 
-static const char **
+static const char *const *
 NativeFileAttrStrings(
     Tcl_Obj *pathPtr,
     Tcl_Obj **objPtrRef)
@@ -2402,8 +2391,7 @@ NativeFileAttrsGet(
     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);
 }
 
 /*
@@ -2432,7 +2420,7 @@ NativeFileAttrsSet(
     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);
 }
 
 /*
@@ -2459,18 +2447,15 @@ NativeFileAttrsSet(
  *----------------------------------------------------------------------
  */
 
-const char **
+const char *const *
 Tcl_FSFileAttrStrings(
     Tcl_Obj *pathPtr,
     Tcl_Obj **objPtrRef)
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
 
-    if (fsPtr != NULL) {
-	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
-	if (proc != NULL) {
-	    return (*proc)(pathPtr, objPtrRef);
-	}
+    if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
+	return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
     }
     Tcl_SetErrno(ENOENT);
     return NULL;
@@ -2501,7 +2486,7 @@ TclFSFileAttrIndex(
     int *indexPtr)		/* Where to write the found index. */
 {
     Tcl_Obj *listObj = NULL;
-    const char **attrTable;
+    const char *const *attrTable;
 
     /*
      * Get the attribute table for the file.
@@ -2583,11 +2568,8 @@ Tcl_FSFileAttrsGet(
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
 
-    if (fsPtr != NULL) {
-	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
-	if (proc != NULL) {
-	    return (*proc)(interp, index, pathPtr, objPtrRef);
-	}
+    if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
+	return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -2620,11 +2602,8 @@ Tcl_FSFileAttrsSet(
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
 
-    if (fsPtr != NULL) {
-	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
-	if (proc != NULL) {
-	    return (*proc)(interp, index, pathPtr, objPtr);
-	}
+    if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
+	return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -2687,55 +2666,58 @@ Tcl_FSGetCwd(
 
 	fsRecPtr = FsGetFirstFilesystem();
 	Claim();
-	while ((retVal == NULL) && (fsRecPtr != NULL)) {
-	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
-	    if (proc != NULL) {
-		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
-		    ClientData retCd;
-		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
-		    retCd = (*proc2)(NULL);
-		    if (retCd != NULL) {
-			Tcl_Obj *norm;
-			/* Looks like a new current directory */
-			retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
-				retCd);
-			Tcl_IncrRefCount(retVal);
-			norm = TclFSNormalizeAbsolutePath(interp,retVal);
-			if (norm != NULL) {
-			    /*
-			     * We found a cwd, which is now in our global
-			     * storage. We must make a copy. Norm already has
-			     * a refCount of 1.
-			     *
-			     * Threading issue: note that multiple threads at
-			     * system startup could in principle call this
-			     * function simultaneously. They will therefore
-			     * each set the cwdPathPtr independently. That
-			     * behaviour is a bit peculiar, but should be
-			     * fine. Once we have a cwd, we'll always be in
-			     * the 'else' branch below which is simpler.
-			     */
-
-			    FsUpdateCwd(norm, retCd);
-			    Tcl_DecrRefCount(norm);
-			} else {
-			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
-			}
-			Tcl_DecrRefCount(retVal);
-			retVal = NULL;
-			Disclaim();
-			goto cdDidNotChange;
-		    } else if (interp != NULL) {
-			Tcl_AppendResult(interp,
-				"error getting working directory name: ",
-				Tcl_PosixError(interp), NULL);
-		    }
+	for (; (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);
+		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 {
-		    retVal = (*proc)(interp);
+		    fsRecPtr->fsPtr->freeInternalRepProc(retCd);
 		}
+		Tcl_DecrRefCount(retVal);
+		retVal = NULL;
+		Disclaim();
+		goto cdDidNotChange;
+	    } else if (interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"error getting working directory name: %s",
+			Tcl_PosixError(interp)));
 	    }
-	    fsRecPtr = fsRecPtr->nextPtr;
 	}
 	Disclaim();
 
@@ -2750,6 +2732,7 @@ Tcl_FSGetCwd(
 
 	if (retVal != NULL) {
 	    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
+
 	    if (norm != NULL) {
 		/*
 		 * We found a cwd, which is now in our global storage. We must
@@ -2764,6 +2747,7 @@ Tcl_FSGetCwd(
 		 */
 
 		ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
+
 		FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
 		Tcl_DecrRefCount(norm);
 	    }
@@ -2777,7 +2761,10 @@ Tcl_FSGetCwd(
 	 * the permissions on that directory have changed.
 	 */
 
-	const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+	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
@@ -2788,93 +2775,98 @@ Tcl_FSGetCwd(
 	 * (This is tested for in the test suite on unix).
 	 */
 
-	if (fsPtr != NULL) {
-	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
-	    ClientData retCd = NULL;
-	    if (proc != NULL) {
-		Tcl_Obj *retVal;
-		if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
-		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
-		    retCd = (*proc2)(tsdPtr->cwdClientData);
-		    if (retCd == NULL && interp != NULL) {
-			Tcl_AppendResult(interp,
-				"error getting working directory name: ",
-				Tcl_PosixError(interp), NULL);
-		    }
+	if (fsPtr == NULL || fsPtr->getCwdProc == NULL) {
+	    goto cdDidNotChange;
+	}
 
-		    if (retCd == tsdPtr->cwdClientData) {
-			goto cdDidNotChange;
-		    }
+	if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
+	    retVal = fsPtr->getCwdProc(interp);
+	} else {
+	    /*
+	     * New API.
+	     */
 
-		    /*
-		     * Looks like a new current directory.
-		     */
+	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
 
-		    retVal = (*fsPtr->internalToNormalizedProc)(retCd);
-		    Tcl_IncrRefCount(retVal);
-		} else {
-		    retVal = (*proc)(interp);
-		}
-		if (retVal != NULL) {
-		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
+	    retCd = proc2(tsdPtr->cwdClientData);
+	    if (retCd == NULL && interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"error getting working directory name: %s",
+			Tcl_PosixError(interp)));
+	    }
 
-		    /*
-		     * Check whether cwd has changed from the value previously
-		     * stored in cwdPathPtr. Really 'norm' shouldn't be NULL,
-		     * but we are careful.
-		     */
+	    if (retCd == tsdPtr->cwdClientData) {
+		goto cdDidNotChange;
+	    }
 
-		    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;
-			char *str1, *str2;
-
-			str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
-			str2 = Tcl_GetStringFromObj(norm, &len2);
-			if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
-			    /*
-			     * If the paths were equal, we can be more
-			     * efficient and retain the old path object which
-			     * will probably already be shared. In this case
-			     * we can simply free the normalized path we just
-			     * calculated.
-			     */
-
-			cdEqual:
-			    Tcl_DecrRefCount(norm);
-			    if (retCd != NULL) {
-				(*fsPtr->freeInternalRepProc)(retCd);
-			    }
-			} else {
-			    FsUpdateCwd(norm, retCd);
-			    Tcl_DecrRefCount(norm);
-			}
-		    }
-		    Tcl_DecrRefCount(retVal);
-		} else {
-		    /*
-		     * The 'cwd' function returned an error; reset the cwd.
-		     */
+	    /*
+	     * Looks like a new current directory.
+	     */
 
-		    FsUpdateCwd(NULL, NULL);
+	    retVal = fsPtr->internalToNormalizedProc(retCd);
+	    Tcl_IncrRefCount(retVal);
+	}
+
+	/*
+	 * Check if the 'cwd' function returned an error; if so, reset the
+	 * cwd.
+	 */
+
+	if (retVal == NULL) {
+	    FsUpdateCwd(NULL, NULL);
+	    goto cdDidNotChange;
+	}
+
+	/*
+	 * Normalize the path.
+	 */
+
+	norm = TclFSNormalizeAbsolutePath(interp, retVal);
+
+	/*
+	 * Check whether cwd has changed from the value previously stored in
+	 * cwdPathPtr. Really 'norm' shouldn't be NULL, but we are careful.
+	 */
+
+	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);
 		}
+	    } else {
+		FsUpdateCwd(norm, retCd);
+		Tcl_DecrRefCount(norm);
 	    }
 	}
+	Tcl_DecrRefCount(retVal);
     }
 
   cdDidNotChange:
@@ -2909,9 +2901,13 @@ int
 Tcl_FSChdir(
     Tcl_Obj *pathPtr)
 {
-    const Tcl_Filesystem *fsPtr;
+    const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
     int retVal = -1;
 
+    if (tsdPtr->cwdPathPtr != NULL) {
+	oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+    }
     if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
 	Tcl_SetErrno(ENOENT);
 	return retVal;
@@ -2919,14 +2915,13 @@ Tcl_FSChdir(
 
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
-	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
-	if (proc != NULL) {
+	if (fsPtr->chdirProc != NULL) {
 	    /*
 	     * If this fails, an appropriate errno will have been stored using
 	     * 'Tcl_SetErrno()'.
 	     */
 
-	    retVal = (*proc)(pathPtr);
+	    retVal = fsPtr->chdirProc(pathPtr);
 	} else {
 	    /*
 	     * Fallback on stat-based implementation.
@@ -2938,7 +2933,7 @@ Tcl_FSChdir(
 	     * 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
+	     * an appropriate error code.
 	     */
 
 	    if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode))
@@ -2960,9 +2955,7 @@ Tcl_FSChdir(
      * 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
@@ -3014,7 +3007,6 @@ Tcl_FSChdir(
 	     * instead. This should be examined by someone on Unix.
 	     */
 
-	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
 	    ClientData cd;
 	    ClientData oldcd = tsdPtr->cwdClientData;
 
@@ -3022,14 +3014,23 @@ Tcl_FSChdir(
 	     * Assumption we are using a filesystem version 2.
 	     */
 
-	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
-	    cd = (*proc2)(oldcd);
+	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
+
+	    cd = proc2(oldcd);
 	    if (cd != oldcd) {
 		FsUpdateCwd(normDirName, cd);
 	    }
 	} else {
 	    FsUpdateCwd(normDirName, NULL);
 	}
+
+	/*
+	 * If the filesystem changed between old and new cwd
+	 * force filesystem refresh on path objects.
+	 */
+	if (oldFsPtr != NULL && fsPtr != oldFsPtr) {
+	    Tcl_FSMountsChanged(NULL);
+	}
     }
 
     return retVal;
@@ -3082,9 +3083,8 @@ Tcl_FSLoadFile(
 				 * function which should be used for this
 				 * file. */
 {
-    const char *symbols[2];
-    Tcl_PackageInitProc **procPtrs[2];
-    ClientData clientData;
+    const char *symbols[3];
+    void *procPtrs[2];
     int res;
 
     /*
@@ -3093,35 +3093,27 @@ Tcl_FSLoadFile(
 
     symbols[0] = sym1;
     symbols[1] = sym2;
-    procPtrs[0] = proc1Ptr;
-    procPtrs[1] = proc2Ptr;
+    symbols[2] = NULL;
 
     /*
      * Perform the load.
      */
 
-    res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs, handlePtr,
-	    &clientData, unloadProcPtr);
-
-    /*
-     * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
-     * library, we don't keep the loadHandle (for TclpFindSymbol) and the
-     * clientData (for the unloadProc) separately. In fact we effectively
-     * throw away the loadHandle and only use the clientData. It just so
-     * happens, for the native filesystem only, that these two are identical.
-     *
-     * This also means that the signatures Tcl_FSUnloadFileProc and
-     * Tcl_FSLoadFileProc are both misleading.
-     */
+    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;
+    }
 
-    *handlePtr = (Tcl_LoadHandle) clientData;
     return res;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclLoadFile --
+ * 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
@@ -3135,26 +3127,17 @@ Tcl_FSLoadFile(
  *	filesystems (and has other problems documented in the load man-page),
  *	so it is advised that full paths are always used.
  *
- *	This function is currently private to Tcl. It may be exported in the
- *	future and its interface fixed (but we should clean up the
- *	loadHandle/clientData confusion at that time -- see the above comments
- *	in Tcl_FSLoadFile for details). For a public function, see
- *	Tcl_FSLoadFile.
- *
  * Results:
  *	A standard Tcl completion code. If an error occurs, an error message
  *	is left in the interp's result.
  *
  * Side effects:
  *	New code suddenly appears in memory. This may later be unloaded by
- *	passing the clientData to the unloadProc.
+ *	calling TclFS_UnloadFile.
  *
  *----------------------------------------------------------------------
  */
 
-typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
-	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
-
 /*
  * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
  * error) yet somehow trash some internal data structures which prevents the
@@ -3189,7 +3172,7 @@ TclSkipUnlink (Tcl_Obj* shlibFile)
      *
      * Ad 2: This variable can disable/override the AUFS detection, i.e. for
      * testing if a newer AUFS does not have the bug any more.
-     * 
+     *
      * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
      *       This part needs proper tests in the configure(.in).
      */
@@ -3232,58 +3215,47 @@ TclSkipUnlink (Tcl_Obj* shlibFile)
 }
 
 int
-TclLoadFile(
+Tcl_LoadFile(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Obj *pathPtr,		/* Name of the file containing the desired
 				 * code. */
-    int symc,			/* Number of symbols/procPtrs in the next two
-				 * arrays. */
-    const char *symbols[],	/* Names of functions to look up in the file's
+    const char *const symbols[],/* Names of functions to look up in the file's
 				 * symbol table. */
-    Tcl_PackageInitProc **procPtrs[],
-				/* Where to return the addresses corresponding
+    int flags,			/* Flags */
+    void *procVPtrs,		/* Where to return the addresses corresponding
 				 * to symbols[]. */
-    Tcl_LoadHandle *handlePtr,	/* Filled with token for shared library
+    Tcl_LoadHandle *handlePtr)	/* Filled with token for shared library
 				 * information which can be used in
 				 * TclpFindSymbol. */
-    ClientData *clientDataPtr,	/* Filled with token for dynamically loaded
-				 * file which will be passed back to
-				 * (*unloadProcPtr)() to unload the file. */
-    Tcl_FSUnloadFileProc **unloadProcPtr)
-				/* Filled with address of Tcl_FSUnloadFileProc
-				 * function which should be used for this
-				 * file. */
 {
+    void **procPtrs = (void **) procVPtrs;
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    Tcl_FSLoadFileProc *proc;
-    Tcl_Filesystem *copyFsPtr;
+    const Tcl_Filesystem *copyFsPtr;
+    Tcl_FSUnloadFileProc *unloadProcPtr;
     Tcl_Obj *copyToPtr;
     Tcl_LoadHandle newLoadHandle = NULL;
-    ClientData newClientData = NULL;
+    Tcl_LoadHandle divertedLoadHandle = NULL;
     Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
     FsDivertLoad *tvdlPtr;
     int retVal;
+    int i;
 
     if (fsPtr == NULL) {
 	Tcl_SetErrno(ENOENT);
 	return TCL_ERROR;
     }
 
-    proc = fsPtr->loadFileProc;
-    if (proc != NULL) {
-	int retVal = ((Tcl_FSLoadFileProc2 *)proc)
-		(interp, pathPtr, handlePtr, unloadProcPtr, 0);
+    if (fsPtr->loadFileProc != NULL) {
+	int retVal = ((Tcl_FSLoadFileProc2 *)(fsPtr->loadFileProc))
+		(interp, pathPtr, handlePtr, &unloadProcPtr, flags);
+
 	if (retVal == TCL_OK) {
 	    if (*handlePtr == NULL) {
 		return TCL_ERROR;
 	    }
-
-	    /*
-	     * Copy this across, since both are equal for the native fs.
-	     */
-
-	    *clientDataPtr = (ClientData)*handlePtr;
-	    Tcl_ResetResult(interp);
+	    if (interp) {
+		Tcl_ResetResult(interp);
+	    }
 	    goto resolveSymbols;
 	}
 	if (Tcl_GetErrno() != EXDEV) {
@@ -3299,8 +3271,11 @@ TclLoadFile(
      */
 
     if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
-	Tcl_AppendResult(interp, "couldn't load library \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't load library \"%s\": %s",
+		    Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+	}
 	return TCL_ERROR;
     }
 
@@ -3342,26 +3317,25 @@ TclLoadFile(
 	ret = Tcl_Read(data, buffer, size);
 	Tcl_Close(interp, data);
 	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
-		unloadProcPtr);
+		&unloadProcPtr, flags);
 	if (ret == TCL_OK && *handlePtr != NULL) {
-	    *clientDataPtr = (ClientData) *handlePtr;
 	    goto resolveSymbols;
 	}
     }
 
   mustCopyToTempAnyway:
-    Tcl_ResetResult(interp);
-#endif
+    if (interp) {
+	Tcl_ResetResult(interp);
+    }
+#endif /* TCL_LOAD_FROM_MEMORY */
 
     /*
      * Get a temporary filename to use, first to copy the file into, and then
      * to load.
      */
 
-    copyToPtr = TclpTempFileName();
+    copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);
     if (copyToPtr == NULL) {
-	Tcl_AppendResult(interp, "couldn't create temporary file: ",
-		Tcl_PosixError(interp), NULL);
 	return TCL_ERROR;
     }
     Tcl_IncrRefCount(copyToPtr);
@@ -3376,7 +3350,10 @@ TclLoadFile(
 
 	Tcl_FSDeleteFile(copyToPtr);
 	Tcl_DecrRefCount(copyToPtr);
-	Tcl_AppendResult(interp, "couldn't load from current filesystem",NULL);
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "couldn't load from current filesystem", -1));
+	}
 	return TCL_ERROR;
     }
 
@@ -3390,7 +3367,7 @@ TclLoadFile(
 	return TCL_ERROR;
     }
 
-#if !defined(__WIN32__)
+#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
@@ -3416,10 +3393,12 @@ TclLoadFile(
      * have stored the number of bytes in the result.
      */
 
-    Tcl_ResetResult(interp);
+    if (interp) {
+	Tcl_ResetResult(interp);
+    }
 
-    retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
-	    &newLoadHandle, &newClientData, &newUnloadProcPtr);
+    retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
+	    &newLoadHandle);
     if (retVal != TCL_OK) {
 	/*
 	 * The file didn't load successfully.
@@ -3447,10 +3426,10 @@ TclLoadFile(
 	 * handle and unload proc ptr.
 	 */
 
-	(*handlePtr) = newLoadHandle;
-	(*clientDataPtr) = newClientData;
-	(*unloadProcPtr) = newUnloadProcPtr;
-	Tcl_ResetResult(interp);
+	*handlePtr = newLoadHandle;
+	if (interp) {
+	    Tcl_ResetResult(interp);
+	}
 	return TCL_OK;
     }
 
@@ -3459,7 +3438,7 @@ TclLoadFile(
      * unload and cleanup the temporary file correctly.
      */
 
-    tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
+    tvdlPtr = ckalloc(sizeof(FsDivertLoad));
 
     /*
      * Remember three pieces of information. This allows us to cleanup the
@@ -3504,20 +3483,38 @@ TclLoadFile(
     }
 
     copyToPtr = NULL;
-    (*handlePtr) = newLoadHandle;
-    (*clientDataPtr) = (ClientData) tvdlPtr;
-    (*unloadProcPtr) = TclFSUnloadTempFile;
 
-    Tcl_ResetResult(interp);
+    divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_));
+    divertedLoadHandle->clientData = tvdlPtr;
+    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
+    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
+    *handlePtr = divertedLoadHandle;
+
+    if (interp) {
+	Tcl_ResetResult(interp);
+    }
     return retVal;
 
   resolveSymbols:
-    {
-	int i;
+    /*
+     * At this point, *handlePtr is already set up to the handle for the
+     * loaded library. We now try to resolve the symbols.
+     */
 
-	for (i=0 ; i<symc ; i++) {
-	    if (symbols[i] != NULL) {
-		*procPtrs[i] = TclpFindSymbol(interp, *handlePtr, symbols[i]);
+    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.)
+		 */
+
+		(*handlePtr)->unloadFileProcPtr(*handlePtr);
+		*handlePtr = NULL;
+		return TCL_ERROR;
 	    }
 	}
     }
@@ -3525,7 +3522,196 @@ TclLoadFile(
 }
 
 /*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
+ *
+ * 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_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);
+    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 --
  *
@@ -3540,7 +3726,7 @@ TclLoadFile(
  *	The effects of the 'unload' function called, and of course the
  *	temporary file will be deleted.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 void
@@ -3568,7 +3754,7 @@ TclFSUnloadTempFile(
      */
 
     if (tvdlPtr->unloadProcPtr != NULL) {
-	(*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
+	tvdlPtr->unloadProcPtr(tvdlPtr->loadHandle);
     }
 
     if (tvdlPtr->divertedFilesystem == NULL) {
@@ -3580,7 +3766,6 @@ TclFSUnloadTempFile(
 
 	TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
 	NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
-
     } else {
 	/*
 	 * Remove the temporary file we created. Note, we may crash here
@@ -3615,7 +3800,7 @@ TclFSUnloadTempFile(
 	Tcl_DecrRefCount(tvdlPtr->divertedFile);
     }
 
-    ckfree((char*)tvdlPtr);
+    ckfree(tvdlPtr);
 }
 
 /*
@@ -3653,18 +3838,14 @@ TclFSUnloadTempFile(
 
 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_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) {
-	Tcl_FSLinkProc *proc = fsPtr->linkProc;
-
-	if (proc != NULL) {
-	    return (*proc)(pathPtr, toPtr, linkAction);
-	}
+    if (fsPtr != NULL && fsPtr->linkProc != NULL) {
+	return fsPtr->linkProc(pathPtr, toPtr, linkAction);
     }
 
     /*
@@ -3676,7 +3857,7 @@ Tcl_FSLink(
      */
 
 #ifndef S_IFLNK
-    errno = EINVAL;
+    errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */
 #else
     Tcl_SetErrno(ENOENT);
 #endif /* S_IFLNK */
@@ -3708,7 +3889,7 @@ Tcl_FSLink(
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj*
+Tcl_Obj *
 Tcl_FSListVolumes(void)
 {
     FilesystemRecord *fsRecPtr;
@@ -3724,9 +3905,9 @@ Tcl_FSListVolumes(void)
     fsRecPtr = FsGetFirstFilesystem();
     Claim();
     while (fsRecPtr != NULL) {
-	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
-	if (proc != NULL) {
-	    Tcl_Obj *thisFsVolumes = (*proc)();
+	if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
+	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
+
 	    if (thisFsVolumes != NULL) {
 		Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
 		Tcl_DecrRefCount(thisFsVolumes);
@@ -3776,15 +3957,13 @@ FsListMounts(
     fsRecPtr = FsGetFirstFilesystem();
     Claim();
     while (fsRecPtr != NULL) {
-	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);
+	if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
+		fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
+	    if (resultPtr == NULL) {
+		resultPtr = Tcl_NewObj();
 	    }
+	    fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr,
+		    pattern, &mountsOnly);
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
@@ -3819,10 +3998,10 @@ Tcl_FSSplitPath(
     int *lenPtr)		/* int to store number of path elements. */
 {
     Tcl_Obj *result = NULL;	/* Needed only to prevent gcc warnings. */
-    Tcl_Filesystem *fsPtr;
+    const Tcl_Filesystem *fsPtr;
     char separator = '/';
     int driveNameLength;
-    char *p;
+    const char *p;
 
     /*
      * Perform platform specific splitting.
@@ -3842,7 +4021,8 @@ Tcl_FSSplitPath(
      */
 
     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];
@@ -3867,14 +4047,16 @@ Tcl_FSSplitPath(
      */
 
     for (;;) {
-	char *elementStart = p;
+	const 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, "./");
 		Tcl_AppendToObj(nextElt, elementStart, length);
@@ -3897,7 +4079,6 @@ Tcl_FSSplitPath(
     }
     return result;
 }
-
 /*
  *----------------------------------------------------------------------
  *
@@ -3919,8 +4100,8 @@ Tcl_FSSplitPath(
 
 Tcl_PathType
 TclGetPathType(
-    Tcl_Obj *pathPtr,		/* Path to determine type for */
-    Tcl_Filesystem **filesystemPtrPtr,
+    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. */
@@ -3934,11 +4115,9 @@ TclGetPathType(
 				 * caller. */
 {
     int pathLen;
-    char *path;
+    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
     Tcl_PathType type;
 
-    path = Tcl_GetStringFromObj(pathPtr, &pathLen);
-
     type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
 	    driveNameLengthPtr, driveNameRef);
 
@@ -3976,9 +4155,9 @@ TclGetPathType(
 
 Tcl_PathType
 TclFSNonnativePathType(
-    const char *path,		/* Path to determine type for */
-    int pathLen,		/* Length of the path */
-    Tcl_Filesystem **filesystemPtrPtr,
+    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. */
@@ -4003,39 +4182,37 @@ TclFSNonnativePathType(
     fsRecPtr = FsGetFirstFilesystem();
     Claim();
     while (fsRecPtr != NULL) {
-	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
-
 	/*
 	 * We want to skip the native filesystem in this loop because
-	 * otherwise we won't necessarily pass all the Tcl testsuite -- this
-	 * is because some of the tests artificially change the current
-	 * platform (between 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.
+	 * 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.
+	 * the native filesystem - since the tclFilename.c code has nice fast
+	 * 'absolute path' checkers, we don't want to waste time repeating
+	 * that effort here, and this function is actually called quite often,
+	 * so if we can save the overhead of the native filesystem returning
+	 * us a list of volumes all the time, it is better.
 	 */
 
-	if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
+	if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
+		&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
 	    int numVolumes;
-	    Tcl_Obj *thisFsVolumes = (*proc)();
+	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
 
 	    if (thisFsVolumes != NULL) {
 		if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
 			!= TCL_OK) {
 		    /*
-		     * This is VERY bad; the Tcl_FSListVolumesProc didn't
-		     * return a valid list. Set numVolumes to -1 so that we
-		     * skip the while loop below and just return with the
-		     * current value of 'type'.
+		     * 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).
@@ -4046,7 +4223,7 @@ TclFSNonnativePathType(
 		while (numVolumes > 0) {
 		    Tcl_Obj *vol;
 		    int len;
-		    char *strVol;
+		    const char *strVol;
 
 		    numVolumes--;
 		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
@@ -4074,6 +4251,7 @@ TclFSNonnativePathType(
 		    /*
 		     * We don't need to examine any more filesystems.
 		     */
+
 		    break;
 		}
 	    }
@@ -4104,21 +4282,20 @@ TclFSNonnativePathType(
 
 int
 Tcl_FSRenameFile(
-    Tcl_Obj* srcPathPtr,	/* Pathname of file or dir to be renamed
+    Tcl_Obj *srcPathPtr,	/* Pathname of file or dir to be renamed
 				 * (UTF-8). */
     Tcl_Obj *destPathPtr)	/* New pathname of file or directory
 				 * (UTF-8). */
 {
     int retVal = -1;
     const Tcl_Filesystem *fsPtr, *fsPtr2;
+
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if ((fsPtr == fsPtr2) && (fsPtr != NULL)) {
-	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
-	if (proc != NULL) {
-	    retVal = (*proc)(srcPathPtr, destPathPtr);
-	}
+    if ((fsPtr == fsPtr2) && (fsPtr != NULL)
+	    && (fsPtr->renameFileProc != NULL)) {
+	retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
     }
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
@@ -4155,14 +4332,12 @@ Tcl_FSCopyFile(
 {
     int retVal = -1;
     const Tcl_Filesystem *fsPtr, *fsPtr2;
+
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if (fsPtr == fsPtr2 && fsPtr != NULL) {
-	Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
-	if (proc != NULL) {
-	    retVal = (*proc)(srcPathPtr, destPathPtr);
-	}
+    if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyFileProc != NULL) {
+	retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
     }
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
@@ -4187,9 +4362,10 @@ Tcl_FSCopyFile(
  *
  *---------------------------------------------------------------------------
  */
+
 int
 TclCrossFilesystemCopy(
-    Tcl_Interp *interp,		/* For error messages */
+    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). */
 {
@@ -4269,11 +4445,9 @@ Tcl_FSDeleteFile(
     Tcl_Obj *pathPtr)		/* Pathname of file to be removed (UTF-8). */
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
-	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
-	if (proc != NULL) {
-	    return (*proc)(pathPtr);
-	}
+
+    if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
+	return fsPtr->deleteFileProc(pathPtr);
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -4301,11 +4475,9 @@ Tcl_FSCreateDirectory(
     Tcl_Obj *pathPtr)		/* Pathname of directory to create (UTF-8). */
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL) {
-	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
-	if (proc != NULL) {
-	    return (*proc)(pathPtr);
-	}
+
+    if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
+	return fsPtr->createDirectoryProc(pathPtr);
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -4331,7 +4503,7 @@ Tcl_FSCreateDirectory(
 
 int
 Tcl_FSCopyDirectory(
-    Tcl_Obj* srcPathPtr,	/* Pathname of directory to be copied
+    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
@@ -4340,14 +4512,12 @@ Tcl_FSCopyDirectory(
 {
     int retVal = -1;
     const Tcl_Filesystem *fsPtr, *fsPtr2;
+
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if (fsPtr == fsPtr2 && fsPtr != NULL) {
-	Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
-	if (proc != NULL) {
-	    retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
-	}
+    if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyDirectoryProc != NULL){
+	retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
     }
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
@@ -4384,45 +4554,46 @@ Tcl_FSRemoveDirectory(
 				 * error, with refCount 1. */
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
-	Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
-	if (recursive) {
-	    /*
-	     * We check whether the cwd lies inside this directory and move it
-	     * if it does.
-	     */
 
-	    Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
+    if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) {
+	Tcl_SetErrno(ENOENT);
+	return -1;
+    }
 
-	    if (cwdPtr != NULL) {
-		char *cwdStr, *normPathStr;
-		int cwdLen, normLen;
-		Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+    /*
+     * When working recursively, we check whether the cwd lies inside this
+     * directory and move it if it does.
+     */
 
-		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]'.
-			 */
+    if (recursive) {
+	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
 
-			Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
-				TCL_PATH_DIRNAME);
+	if (cwdPtr != NULL) {
+	    const char *cwdStr, *normPathStr;
+	    int cwdLen, normLen;
+	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
 
-			Tcl_FSChdir(dirPtr);
-			Tcl_DecrRefCount(dirPtr);
-		    }
+	    if (normPath != NULL) {
+		normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
+		cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
+			(size_t) normLen) == 0)) {
+		    /*
+		     * The cwd is inside the directory, so we perform a 'cd
+		     * [file dirname $path]'.
+		     */
+
+		    Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
+			    TCL_PATH_DIRNAME);
+
+		    Tcl_FSChdir(dirPtr);
+		    Tcl_DecrRefCount(dirPtr);
 		}
-		Tcl_DecrRefCount(cwdPtr);
 	    }
+	    Tcl_DecrRefCount(cwdPtr);
 	}
-	return (*proc)(pathPtr, recursive, errorPtr);
     }
-    Tcl_SetErrno(ENOENT);
-    return -1;
+    return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
 }
 
 /*
@@ -4444,12 +4615,12 @@ Tcl_FSRemoveDirectory(
  *---------------------------------------------------------------------------
  */
 
-Tcl_Filesystem *
+const Tcl_Filesystem *
 Tcl_FSGetFileSystemForPath(
-    Tcl_Obj* pathPtr)
+    Tcl_Obj *pathPtr)
 {
     FilesystemRecord *fsRecPtr;
-    Tcl_Filesystem* retVal = NULL;
+    const Tcl_Filesystem *retVal = NULL;
 
     if (pathPtr == NULL) {
 	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
@@ -4480,6 +4651,10 @@ Tcl_FSGetFileSystemForPath(
     if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
 	Disclaim();
 	return NULL;
+    } else if (retVal != NULL) {
+	/* TODO: Can this happen? */
+	Disclaim();
+	return retVal;
     }
 
     /*
@@ -4487,27 +4662,27 @@ Tcl_FSGetFileSystemForPath(
      * non-return value of -1 indicates the particular function has succeeded.
      */
 
-    while ((retVal == NULL) && (fsRecPtr != NULL)) {
-	Tcl_FSPathInFilesystemProc *proc =
-		fsRecPtr->fsPtr->pathInFilesystemProc;
+    for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) {
+	ClientData clientData = NULL;
 
-	if (proc != NULL) {
-	    ClientData clientData = NULL;
-	    if ((*proc)(pathPtr, &clientData) != -1) {
-		/*
-		 * We assume the type of pathPtr hasn't been changed by the
-		 * above call to the pathInFilesystemProc.
-		 */
+	if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) {
+	    continue;
+	}
 
-		TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
-		retVal = fsRecPtr->fsPtr;
-	    }
+	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->fsPtr, clientData);
+	    Disclaim();
+	    return fsRecPtr->fsPtr;
 	}
-	fsRecPtr = fsRecPtr->nextPtr;
     }
     Disclaim();
 
-    return retVal;
+    return NULL;
 }
 
 /*
@@ -4525,7 +4700,7 @@ Tcl_FSGetFileSystemForPath(
  *	functions not in this file), then one cannot necessarily guarantee
  *	that the path object pointer is from the correct filesystem.
  *
- *	Note: in the future it might be desireable to have separate versions
+ *	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.
@@ -4539,11 +4714,11 @@ Tcl_FSGetFileSystemForPath(
  *---------------------------------------------------------------------------
  */
 
-const char *
+const void *
 Tcl_FSGetNativePath(
     Tcl_Obj *pathPtr)
 {
-    return (const char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
+    return Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
 }
 
 /*
@@ -4566,7 +4741,7 @@ static void
 NativeFreeInternalRep(
     ClientData clientData)
 {
-    ckfree((char *) clientData);
+    ckfree(clientData);
 }
 
 /*
@@ -4592,7 +4767,6 @@ Tcl_FSFileSystemInfo(
     Tcl_Obj *pathPtr)
 {
     Tcl_Obj *resPtr;
-    Tcl_FSFilesystemPathTypeProc *proc;
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
 
     if (fsPtr == NULL) {
@@ -4600,11 +4774,12 @@ Tcl_FSFileSystemInfo(
     }
 
     resPtr = Tcl_NewListObj(0, NULL);
-    Tcl_ListObjAppendElement(NULL,resPtr,Tcl_NewStringObj(fsPtr->typeName,-1));
+    Tcl_ListObjAppendElement(NULL, resPtr,
+	    Tcl_NewStringObj(fsPtr->typeName, -1));
+
+    if (fsPtr->filesystemPathTypeProc != NULL) {
+	Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr);
 
-    proc = fsPtr->filesystemPathTypeProc;
-    if (proc != NULL) {
-	Tcl_Obj *typePtr = (*proc)(pathPtr);
 	if (typePtr != NULL) {
 	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
 	}
@@ -4637,23 +4812,23 @@ Tcl_FSPathSeparator(
     Tcl_Obj *pathPtr)
 {
     const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    Tcl_Obj *resultObj;
 
     if (fsPtr == NULL) {
 	return NULL;
     }
+
     if (fsPtr->filesystemSeparatorProc != NULL) {
-	return (*fsPtr->filesystemSeparatorProc)(pathPtr);
-    } else {
-	Tcl_Obj *resultObj;
+	return fsPtr->filesystemSeparatorProc(pathPtr);
+    }
 
-	/*
-	 * Allow filesystems not to provide a filesystemSeparatorProc if they
-	 * wish to use the standard forward slash.
-	 */
+    /*
+     * Allow filesystems not to provide a filesystemSeparatorProc if they wish
+     * to use the standard forward slash.
+     */
 
-	TclNewLiteralStringObj(resultObj, "/");
-	return resultObj;
-    }
+    TclNewLiteralStringObj(resultObj, "/");
+    return resultObj;
 }
 
 /*
@@ -4678,6 +4853,7 @@ NativeFilesystemSeparator(
     Tcl_Obj *pathPtr)
 {
     const char *separator = NULL; /* lint */
+
     switch (tclPlatform) {
     case TCL_PLATFORM_UNIX:
 	separator = "/";
@@ -4688,318 +4864,6 @@ NativeFilesystemSeparator(
     }
     return Tcl_NewStringObj(separator,1);
 }
-
-/* Everything from here on is contained in this obsolete ifdef */
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- *----------------------------------------------------------------------
- *
- * TclStatInsertProc --
- *
- *	Insert the passed function pointer at the head of the list of
- *	functions which are used during a call to 'TclStat(...)'. The passed
- *	function should behave exactly like 'TclStat' when called during that
- *	time (see 'TclStat(...)' for more information). The function will be
- *	added even if it already in the list.
- *
- * Results:
- *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
- *	not be allocated.
- *
- * Side effects:
- *	Memory allocated and modifies the link list for 'TclStat' functions.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclStatInsertProc(
-    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 removable.
- *
- * Results:
- *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
- *	otherwise.
- *
- * Side effects:
- *	Memory is deallocated and the respective list updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclStatDeleteProc(
-    TclStatProc_ *proc)
-{
-    int retVal = TCL_ERROR;
-    StatProc *tmpStatProcPtr;
-    StatProc *prevStatProcPtr = NULL;
-
-    Tcl_MutexLock(&obsoleteFsHookMutex);
-    tmpStatProcPtr = statProcList;
-
-    /*
-     * Traverse the 'statProcList' looking for the particular node whose
-     * 'proc' member matches 'proc' and remove that one from the list. Ensure
-     * that the "default" node cannot be removed.
-     */
-
-    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 function pointer at the head of the list of
- *	functions which are used during a call to 'TclAccess(...)'. The passed
- *	function should behave exactly like 'TclAccess' when called during
- *	that time (see 'TclAccess(...)' for more information). The function
- *	will be added even if it already in the list.
- *
- * Results:
- *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
- *	not be allocated.
- *
- * Side effects:
- *	Memory allocated and modifies the link list for 'TclAccess' functions.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclAccessInsertProc(
-    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 removable.
- *
- * Results:
- *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
- *	otherwise.
- *
- * Side effects:
- *	Memory is deallocated and the respective list updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclAccessDeleteProc(
-    TclAccessProc_ *proc)
-{
-    int retVal = TCL_ERROR;
-    AccessProc *tmpAccessProcPtr;
-    AccessProc *prevAccessProcPtr = NULL;
-
-    /*
-     * Traverse the 'accessProcList' looking for the particular node whose
-     * 'proc' member matches 'proc' and remove that one from the list. Ensure
-     * that the "default" node cannot be removed.
-     */
-
-    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 function pointer at the head of the list of
- *	functions which are used during a call to 'Tcl_OpenFileChannel(...)'.
- *	The passed function should behave exactly like 'Tcl_OpenFileChannel'
- *	when called during that time (see 'Tcl_OpenFileChannel(...)' for more
- *	information). The function will be added even if it already in the
- *	list.
- *
- * Results:
- *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
- *	not be allocated.
- *
- * Side effects:
- *	Memory allocated and modifies the link list for 'Tcl_OpenFileChannel'
- *	functions.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclOpenFileChannelInsertProc(
-    TclOpenFileChannelProc_ *proc)
-{
-    int retVal = TCL_ERROR;
-
-    if (proc != NULL) {
-	OpenFileChannelProc *newOpenFileChannelProcPtr;
-
-	newOpenFileChannelProcPtr = (OpenFileChannelProc *)
-		ckalloc(sizeof(OpenFileChannelProc));
-
-	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 function pointer was successfully removed, TCL_ERROR
- *	otherwise.
- *
- * Side effects:
- *	Memory is deallocated and the respective list updated.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclOpenFileChannelDeleteProc(
-    TclOpenFileChannelProc_ *proc)
-{
-    int retVal = TCL_ERROR;
-    OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
-    OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
-
-    /*
-     * Traverse the 'openFileChannelProcList' looking for the particular node
-     * whose 'proc' member matches 'proc' and remove that one from the list.
-     */
-
-    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;
-	    }
-
-	    ckfree((char *) tmpOpenFileChannelProcPtr);
-
-	    retVal = TCL_OK;
-	} else {
-	    prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
-	    tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
-	}
-    }
-    Tcl_MutexUnlock(&obsoleteFsHookMutex);
-
-    return retVal;
-}
-#endif /* USE_OBSOLETE_FS_HOOKS */
 
 /*
  * Local Variables:
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 73ba515..0e0ddc9 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -3,9 +3,11 @@
  *
  *	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.
+ *	the matching entry. Also provides table-based argv/argc processing.
  *
+ * 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.
@@ -17,22 +19,36 @@
  * Prototypes for functions 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);
 
 /*
  * The structure below defines the index Tcl object type by means of functions
  * that can be invoked by generic object code.
  */
 
-static Tcl_ObjType indexType = {
-    "index",				/* name */
-    FreeIndex,				/* freeIntRepProc */
-    DupIndex,				/* dupIntRepProc */
-    UpdateStringOfIndex,		/* updateStringProc */
-    SetIndexFromAny			/* setFromAnyProc */
+static const Tcl_ObjType indexType = {
+    "index",			/* name */
+    FreeIndex,			/* freeIntRepProc */
+    DupIndex,			/* dupIntRepProc */
+    UpdateStringOfIndex,	/* updateStringProc */
+    SetIndexFromAny		/* setFromAnyProc */
 };
 
 /*
@@ -44,9 +60,9 @@ static Tcl_ObjType indexType = {
  */
 
 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;
 
 /*
@@ -70,7 +86,7 @@ typedef struct {
  *
  * Results:
  *	If the value of objPtr is identical to or a unique abbreviation for
- *	one of the entries in objPtr, then the return value is TCL_OK and the
+ *	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
@@ -88,9 +104,9 @@ typedef struct {
 #undef Tcl_GetIndexFromObj
 int
 Tcl_GetIndexFromObj(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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
+    const char *const*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
@@ -126,6 +142,90 @@ 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
@@ -134,13 +234,13 @@ Tcl_GetIndexFromObj(
  *
  * Results:
  *	If the value of objPtr is identical to or a unique abbreviation for
- *	one of the entries in objPtr, then the return value is TCL_OK and the
- *	index of the matching entry is stored at *indexPtr. If there isn't a
- *	proper match, then TCL_ERROR is returned and an error message is left
- *	in interp's result (unless interp is NULL). The msg argument is used
- *	in the error message; for example, if msg has the value "option" then
- *	the error message will say something like 'bad option "foo": must be
- *	...'
+ *	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 like 'bad option "foo": must
+ *	be ...'
  *
  * Side effects:
  *	The result of the lookup is cached as the internal rep of objPtr, so
@@ -151,7 +251,7 @@ Tcl_GetIndexFromObj(
 
 int
 Tcl_GetIndexFromObjStruct(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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
@@ -165,7 +265,7 @@ Tcl_GetIndexFromObjStruct(
     int *indexPtr)		/* Place to store resulting integer index. */
 {
     int index, idx, numAbbrev;
-    char *key, *p1;
+    const char *key, *p1;
     const char *p2;
     const char *const *entryPtr;
     Tcl_Obj *resultPtr;
@@ -241,12 +341,12 @@ Tcl_GetIndexFromObjStruct(
      */
 
     if (objPtr->typePtr == &indexType) {
- 	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
     } else {
 	TclFreeIntRep(objPtr);
- 	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
- 	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
- 	objPtr->typePtr = &indexType;
+	indexRep = ckalloc(sizeof(IndexRep));
+	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
+	objPtr->typePtr = &indexType;
     }
     indexRep->tablePtr = (void *) tablePtr;
     indexRep->offset = offset;
@@ -264,25 +364,31 @@ Tcl_GetIndexFromObjStruct(
 	int count = 0;
 
 	TclNewObj(resultPtr);
-	Tcl_SetObjResult(interp, resultPtr);
 	entryPtr = tablePtr;
 	while ((*entryPtr != NULL) && !**entryPtr) {
 	    entryPtr = NEXT_ENTRY(entryPtr, offset);
 	}
-	Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) &&
-		!(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", key,
-		"\": must be ", *entryPtr, NULL);
-	entryPtr = NEXT_ENTRY(entryPtr, offset);
-	while (*entryPtr != NULL) {
-	    if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
-		Tcl_AppendStringsToObj(resultPtr, ((count > 0) ? "," : ""),
-			" or ", *entryPtr, NULL);
-	    } else if (**entryPtr) {
-		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
-		count++;
-	    }
+	Tcl_AppendStringsToObj(resultPtr,
+		(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
+		msg, " \"", key, NULL);
+	if (*entryPtr == NULL) {
+	    Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
+	} else {
+	    Tcl_AppendStringsToObj(resultPtr, "\": must be ",
+		    *entryPtr, NULL);
 	    entryPtr = NEXT_ENTRY(entryPtr, offset);
+	    while (*entryPtr != NULL) {
+		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
+		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
+			    " or ", *entryPtr, NULL);
+		} else if (**entryPtr) {
+		    Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
+		    count++;
+		}
+		entryPtr = NEXT_ENTRY(entryPtr, offset);
+	    }
 	}
+	Tcl_SetObjResult(interp, resultPtr);
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
     }
     return TCL_ERROR;
@@ -314,7 +420,7 @@ SetIndexFromAny(
     register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     if (interp) {
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 	    "can't convert value to index except via Tcl_GetIndexFromObj API",
 	    -1));
     }
@@ -348,7 +454,7 @@ UpdateStringOfIndex(
     register const char *indexStr = EXPAND_OF(indexRep);
 
     len = strlen(indexStr);
-    buf = (char *) ckalloc(len + 1);
+    buf = ckalloc(len + 1);
     memcpy(buf, indexStr, len+1);
     objPtr->bytes = buf;
     objPtr->length = len;
@@ -378,7 +484,7 @@ DupIndex(
     Tcl_Obj *dupPtr)
 {
     IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
-    IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+    IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
 
     memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
     dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
@@ -406,13 +512,325 @@ static void
 FreeIndex(
     Tcl_Obj *objPtr)
 {
-    ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1);
+    ckfree(objPtr->internalRep.twoPtrValue.ptr1);
     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,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"match",   PrefixMatchObjCmd,	TclCompileBasicMin2ArgCmd, 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_SetObjResult(interp, Tcl_NewStringObj(
+			"missing value for -message", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+			"missing value for -error", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+			"error options must have an even number of elements",
+			-1));
+		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. */
+{
+    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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_WrongNumArgs --
  *
  *	This function generates a "wrong # args" error message in an
@@ -489,6 +907,7 @@ Tcl_WrongNumArgs(
 
     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 {
@@ -506,6 +925,14 @@ Tcl_WrongNumArgs(
 	Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
 
 	/*
+	 * Check for spelling fixes, and substitute the fixed values.
+	 */
+
+	if (origObjv[0] == NULL) {
+	    origObjv = (Tcl_Obj *const *)origObjv[2];
+	}
+
+	/*
 	 * 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
@@ -538,12 +965,6 @@ Tcl_WrongNumArgs(
 
 		elementStr = EXPAND_OF(indexRep);
 		elemLen = strlen(elementStr);
-	    } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
-		register EnsembleCmdRep *ecrPtr =
-			origObjv[i]->internalRep.twoPtrValue.ptr1;
-
-		elementStr = ecrPtr->fullSubcmdName;
-		elemLen = strlen(elementStr);
 	    } else {
 		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
 	    }
@@ -592,11 +1013,6 @@ Tcl_WrongNumArgs(
 	    register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
 
 	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
-	} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
-	    register EnsembleCmdRep *ecrPtr =
-		    objv[i]->internalRep.twoPtrValue.ptr1;
-
-	    Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
 	} else {
 	    /*
 	     * Quote the argument if it contains spaces (Bug 942757).
@@ -641,12 +1057,430 @@ Tcl_WrongNumArgs(
 	Tcl_AppendStringsToObj(objPtr, message, NULL);
     }
     Tcl_AppendStringsToObj(objPtr, "\"", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
     Tcl_SetObjResult(interp, objPtr);
 #undef MAY_QUOTE_WORD
 #undef AFTER_FIRST_WORD
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * 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_SetObjResult(interp, Tcl_ObjPrintf(
+			"ambiguous option \"%s\"", str));
+		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_SetObjResult(interp, Tcl_ObjPrintf(
+			"unrecognized argument \"%s\"", str));
+		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_SetObjResult(interp, Tcl_ObjPrintf(
+			"expected integer argument for \"%s\" but got \"%s\"",
+			infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
+		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_SetObjResult(interp, Tcl_ObjPrintf(
+			"expected floating-point argument for \"%s\" but got \"%s\"",
+			infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
+		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_SetObjResult(interp, Tcl_ObjPrintf(
+	    "\"%s\" option requires an additional argument", str));
+  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];
+    Tcl_Obj *msg;
+
+    /*
+     * 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.
+     */
+
+    msg = Tcl_NewStringObj("Command-specific options:", -1);
+    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
+	if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
+	    Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr);
+	    continue;
+	}
+	Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr);
+	numSpaces = width + 1 - strlen(infoPtr->keyStr);
+	while (numSpaces > 0) {
+	    if (numSpaces >= NUM_SPACES) {
+		Tcl_AppendToObj(msg, spaces, NUM_SPACES);
+	    } else {
+		Tcl_AppendToObj(msg, spaces, numSpaces);
+	    }
+	    numSpaces -= NUM_SPACES;
+	}
+	Tcl_AppendToObj(msg, infoPtr->helpStr, -1);
+	switch (infoPtr->type) {
+	case TCL_ARGV_INT:
+	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d",
+		    *((int *) infoPtr->dstPtr));
+	    break;
+	case TCL_ARGV_FLOAT:
+	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
+		    *((double *) infoPtr->dstPtr));
+	    sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
+	    break;
+	case TCL_ARGV_STRING: {
+	    char *string = *((char **) infoPtr->dstPtr);
+
+	    if (string != NULL) {
+		Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"",
+			string);
+	    }
+	    break;
+	}
+	default:
+	    break;
+	}
+    }
+    Tcl_SetObjResult(interp, msg);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 *codePtr)		/* Argument objects. */
+{
+    static const char *const returnCodes[] = {
+	"ok", "error", "return", "break", "continue", NULL
+    };
+
+    if ((value->typePtr != &indexType)
+	    && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
+	return TCL_OK;
+    }
+    if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
+	    codePtr) == TCL_OK) {
+	return TCL_OK;
+    }
+
+    /*
+     * Value is not a legal completion code.
+     */
+
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad completion code \"%s\": must be"
+		" ok, error, return, break, continue, or an integer",
+		TclGetString(value)));
+	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
+    }
+    return TCL_ERROR;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 920116c..4e7e422 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -51,7 +51,7 @@ declare 7 {
     int TclCopyAndCollapse(int count, const char *src, char *dst)
 }
 declare 8 {
-    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
+    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
 	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
 }
 
@@ -160,11 +160,12 @@ declare 34 {
 #    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
 #	    int flags)
 #}
-declare 36 {
-    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
-}
+# Removed in 8.6a2
+#declare 36 {
+#    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
+#}
 declare 37 {
-    int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
+    int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
 }
 declare 38 {
     int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
@@ -182,7 +183,7 @@ declare 41 {
     Tcl_Command TclGetOriginalCommand(Tcl_Command command)
 }
 declare 42 {
-    char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
+    CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
 }
 # Removed in Tcl 8.5a2
 #declare 43 {
@@ -317,9 +318,10 @@ declare 76 {
 declare 77 {
     void TclpGetTime(Tcl_Time *time)
 }
-declare 78 {
-    int TclpGetTimeZone(unsigned long time)
-}
+# Removed in 8.6:
+#declare 78 {
+#    int TclpGetTimeZone(unsigned long time)
+#}
 # Replaced by Tcl_FSListVolumes in 8.4:
 #declare 79 {
 #    int TclpListVolumes(Tcl_Interp *interp)
@@ -408,7 +410,7 @@ declare 98 {
 #	    Tcl_Obj *objPtr, int flags)
 #}
 declare 101 {
-    char *TclSetPreInitScript(char *string)
+    CONST86 char *TclSetPreInitScript(const char *string)
 }
 declare 102 {
     void TclSetupEnv(Tcl_Interp *interp)
@@ -575,7 +577,7 @@ declare 144 {
 	    int index)
 }
 declare 145 {
-    struct AuxDataType *TclGetAuxDataType(char *typeName)
+    const struct AuxDataType *TclGetAuxDataType(const char *typeName)
 }
 declare 146 {
     TclHandle TclHandleCreate(void *ptr)
@@ -623,11 +625,13 @@ declare 156 {
 declare 157 {
     Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
 }
+# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
 declare 158 {
     void TclSetStartupScriptFileName(const char *filename)
 }
+# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
 declare 159 {
-    CONST84_RETURN char *TclGetStartupScriptFileName(void)
+    const char *TclGetStartupScriptFileName(void)
 }
 #declare 160 {
 #    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
@@ -650,7 +654,7 @@ declare 162 {
 # correct type when calling this procedure.
 
 declare 163 {
-    void *TclGetInstructionTable(void)
+    const void *TclGetInstructionTable(void)
 }
 
 # ALERT: The argument of 'TclExpandCodeArray' is actually a
@@ -673,9 +677,11 @@ declare 166 {
 }
 
 # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
+# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
 declare 167 {
     void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
 }
+# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
 declare 168 {
     Tcl_Obj *TclGetStartupScriptPath(void)
 }
@@ -724,6 +730,7 @@ 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 too
 declare 178 {
     void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
 }
@@ -893,10 +900,12 @@ declare 227 {
     void TclSetNsPath(Namespace *nsPtr, int pathLength,
             Tcl_Namespace *pathAry[])
 }
-declare 228 {
-    int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
-             int skip, ProcErrorProc errorProc)
-}
+#  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)
@@ -935,15 +944,73 @@ 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 239 {
+    int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
+			    int skip, ProcErrorProc *errorProc)
+}
+declare 240 {
+    int TclNRRunCallbacks(Tcl_Interp *interp, int result,
+	      struct NRE_callback *rootPtr)
+}
+declare 241 {
+    int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
+	    const CmdFrame *invoker, int word)
+}
+declare 242 {
+    int TclNREvalObjv(Tcl_Interp *interp, int objc,
+	      Tcl_Obj *const objv[], int flags, Command *cmdPtr)
+}
+
 # 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 245 {
+    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
+}
+declare 246 {
+    int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
+	    int numInserted, Tcl_Obj *const *objv)
+}
+declare 247 {
+    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
+}
+
+declare 248 {
+    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
+	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
+}
+
 declare 249 {
     char *TclDoubleDigits(double dv, int ndigits, int flags,
 			  int *decpt, int *signum, char **endPtr)
 }
+# TIP #285: Script cancellation support.
+declare 250 {
+    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
+}
+
+# Allow extensions for optimization
+declare 251 {
+    int TclRegisterLiteral(void *envPtr,
+	    char *bytes, int length, int flags)
+}
 
 ##############################################################################
 
@@ -1060,9 +1127,10 @@ declare 21 win {
 declare 22 win {
     TclFile TclpCreateTempFile(const char *contents)
 }
-declare 23 win {
-    char *TclpGetTZName(int isdst)
-}
+# Removed in 8.6:
+#declare 23 win {
+#    char *TclpGetTZName(int isdst)
+#}
 declare 24 win {
     char *TclWinNoBackslash(char *path)
 }
@@ -1085,9 +1153,6 @@ declare 27 win {
 declare 28 win {
     void TclWinResetInterfaces(void)
 }
-declare 29 win {
-    int TclWinCPUID(unsigned int index, unsigned int *regs)
-}
 
 ################################
 # Unix specific functions
@@ -1179,9 +1244,17 @@ declare 18 macosx {
 declare 19 macosx {
     void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
 }
-declare 29 unix {
+
+declare 29 {win unix} {
     int TclWinCPUID(unsigned int index, unsigned int *regs)
 }
+# Added in 8.6; core of TclpOpenTemporaryFile
+declare 30 {win unix} {
+    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
+	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
+}
+
+
 
 # Local Variables:
 # mode: tcl
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6113f23..fe4fefd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -9,6 +9,8 @@
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * 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.
@@ -21,7 +23,6 @@
  * Some numerics configuration options.
  */
 
-#undef NO_WIDE_TYPE
 #undef ACCEPT_NAN
 
 /*
@@ -29,8 +30,7 @@
  * 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.
+ * important. For example, stdio.h is needed by tcl.h.
  */
 
 #include "tclPort.h"
@@ -95,14 +95,6 @@ typedef int ptrdiff_t;
 #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".
@@ -127,6 +119,10 @@ typedef int ptrdiff_t;
 #   endif
 #endif
 
+#if defined(_WIN32) && defined(_MSC_VER)
+#   define vsnprintf _vsnprintf
+#endif
+
 /*
  * The following procedures allow namespaces to be customized to support
  * special name resolution rules for commands/variables.
@@ -174,6 +170,21 @@ typedef struct Tcl_ResolverInfo {
 } Tcl_ResolverInfo;
 
 /*
+ * This flag bit should not interfere with TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
+ * lookup is performed for upvar (or similar) purposes, with slightly
+ * different rules:
+ *    - Bug #696893 - variable is either proc-local or in the current
+ *	namespace; never follow the second (global) resolution path
+ *    - Bug #631741 - do not use special namespace or interp resolvers
+ *
+ * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
+ * (Bug #835020)
+ */
+
+#define TCL_AVOID_RESOLVERS 0x40000
+
+/*
  *----------------------------------------------------------------
  * Data structures related to namespaces.
  *----------------------------------------------------------------
@@ -201,6 +212,14 @@ typedef struct TclVarHashTable {
 #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.
@@ -224,8 +243,15 @@ typedef struct Namespace {
     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. */
@@ -310,6 +336,12 @@ typedef struct Namespace {
     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. */
 } Namespace;
 
 /*
@@ -348,13 +380,17 @@ struct NamespacePathEntry {
  *		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_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.
  */
 
 #define NS_DYING	0x01
 #define NS_DEAD		0x02
 #define NS_KILLED	0x04
+#define NS_SUPPRESS_COMPILATION	0x08
 
 /*
  * Flags passed to TclGetNamespaceForQualName:
@@ -369,31 +405,91 @@ struct NamespacePathEntry {
 #define TCL_FIND_ONLY_NS		0x1000
 
 /*
- * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
- * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
- * referring to the same subcommand, even where one is a duplicate of another.
- */
-
-typedef struct {
-    Namespace *nsPtr;		/* The namespace backing the ensemble which
-				 * this is a subcommand of. */
-    int epoch;			/* Used to confirm when the data in this
-				 * really structure matches up with the
-				 * ensemble. */
-    Tcl_Command token;		/* Reference to the comamnd for which this
-				 * structure is a cache of the resolution. */
-    char *fullSubcmdName;	/* The full (local) name of the subcommand,
-				 * allocated with ckalloc(). */
-    Tcl_Obj *realPrefixObj;	/* Object containing the prefix words of the
-				 * command that implements this ensemble
-				 * subcommand. */
-} EnsembleCmdRep;
+ * 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.
+ */
+
+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;
 
 /*
- * Flag to enable bytecode compilation of an ensemble.
+ * Various bits for the EnsembleConfig.flags field.
  */
 
-#define ENSEMBLE_COMPILE 0x4
+#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. */
 
 /*
  *----------------------------------------------------------------
@@ -755,6 +851,9 @@ typedef struct VarInHash {
 #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)
@@ -822,7 +921,7 @@ typedef struct CompiledLocal {
 				 * 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
+    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
@@ -869,7 +968,7 @@ typedef struct Proc {
  * of a procedure (or lambda term or ...).
  */
 
-typedef void (*ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
+typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
 
 /*
  * The structure below defines a command trace. This is used to allow Tcl
@@ -1020,10 +1119,20 @@ typedef struct CallFrame {
 				 * meaning of the value is, which we do not
 				 * specify. */
     LocalCache *localCachePtr;
+    Tcl_Obj    *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. */
 
 /*
  * TIP #280
@@ -1061,29 +1170,27 @@ typedef struct CmdFrame {
      *
      * 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
-     * =======	  ====		  ======	  =========
+     * Field	  TEBC		  EvalEx
+     * =======	  ====		  ======
+     * level	  yes		  yes
+     * type	  BC/PREBC	  SRC/EVAL
+     * line0	  yes		  yes
+     * framePtr	  yes		  yes
+     * =======	  ====		  ======
      *
-     * =======	  ====		  ======	  ========= union data
-     * line1	  -		  yes		  -
-     * line3	  -		  yes		  -
-     * path	  -		  yes		  -
-     * -------	  ----		  ------	  ---------
-     * codePtr	  yes		  -		  -
-     * pc	  yes		  -		  -
-     * =======	  ====		  ======	  =========
+     * =======	  ====		  ========= union data
+     * line1	  -		  yes
+     * line3	  -		  yes
+     * path	  -		  yes
+     * -------	  ----		  ------
+     * codePtr	  yes		  -
+     * pc	  yes		  -
+     * =======	  ====		  ======
      *
-     * =======	  ====		  ======	  ========= | union cmd
-     * listPtr	  -		  -		  yes	    |
-     * -------	  ----		  ------	  --------- |
-     * cmd	  yes		  yes		  -	    |
-     * cmdlen	  yes		  yes		  -	    |
-     * -------	  ----		  ------	  --------- |
+     * =======	  ====		  ========= union cmd
+     * str.cmd	  yes		  yes
+     * str.len	  yes		  yes
+     * -------	  ----		  ------
      */
 
     union {
@@ -1096,13 +1203,14 @@ typedef struct CmdFrame {
 	    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;
+    Tcl_Obj *cmdObj;
+    const char *cmd;		/* The executed command, if possible... */
+    int len;			/* ... and its length. */
+    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;
 
 typedef struct CFWord {
@@ -1119,6 +1227,9 @@ typedef struct CFWordBC {
     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 */
 } CFWordBC;
 
 /*
@@ -1158,8 +1269,6 @@ typedef struct ContLineLoc {
  * 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
@@ -1171,8 +1280,6 @@ typedef struct ContLineLoc {
  */
 
 #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. */
@@ -1186,10 +1293,10 @@ typedef struct ContLineLoc {
  * by [info frame]. Contains a sub-structure for each extra field.
  */
 
-typedef Tcl_Obj *(*GetFrameInfoValueProc)(ClientData clientData);
+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
+    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
@@ -1308,12 +1415,48 @@ typedef struct ExecStack {
  * currently active execution stack.
  */
 
+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;
 } 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
@@ -1411,6 +1554,10 @@ 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;
 
 /*
@@ -1503,6 +1650,7 @@ typedef struct Command {
 				 * command. */
     CommandTrace *tracePtr;	/* First in list of all traces set for this
 				 * command. */
+    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
 } Command;
 
 /*
@@ -1519,6 +1667,9 @@ typedef struct Command {
  * 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.
+ * CMD_COMPILES_EXPANDED -	1 means that this command has a compiler that
+ *				can handle expansion (provided it is not the
+ *				first word).
  * 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
@@ -1526,10 +1677,13 @@ typedef struct Command {
  * (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		    0x01
+#define CMD_TRACE_ACTIVE	    0x02
+#define CMD_HAS_EXEC_TRACES	    0x04
+#define CMD_COMPILES_EXPANDED	    0x08
 #define CMD_REDEF_IN_PROGRESS	    0x10
+#define CMD_VIA_RESOLVER	    0x20
+
 
 /*
  *----------------------------------------------------------------
@@ -1579,6 +1733,24 @@ enum PkgPreferOptions {
 
 /*
  *----------------------------------------------------------------
+ * 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 allocCache 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
@@ -1616,7 +1788,7 @@ typedef struct Interp {
     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;
+    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
@@ -1635,7 +1807,14 @@ typedef struct Interp {
     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) */
+    union {
+	void (*optimizer)(void *envPtr);
+	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
+				 * unused space in interp was repurposed for
+				 * pluggable bytecode optimizers. The core
+				 * contains one optimizer, which can be
+				 * selectively overriden by extensions. */
+    } extra;
 
     /*
      * Information related to procedures and variables. See tclProc.c and
@@ -1910,23 +2089,55 @@ typedef struct Interp {
      * They are used by the macros defined below.
      */
 
-    void *allocCache;
+    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 */
-    int *stackBound;		/* Pointer to the limit stack address
-				 * allowable for invoking a new command
-				 * without "risking" a C-stack overflow; see
-				 * TclpCheckStackSpace in the platform's
-				 * directory. */
+    /*
+     * 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.
+     */
 
+    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
     /*
      * Statistical information about the bytecode compiler and interpreter's
-     * operation.
+     * operation. This should be the last field of Interp.
      */
 
     ByteCodeStats stats;	/* Holds compilation and execution statistics
@@ -1942,6 +2153,22 @@ typedef struct Interp {
     *((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))
+
+/*
  * Macros for splicing into and out of doubly linked lists. They assume
  * existence of struct items 'prevPtr' and 'nextPtr'.
  *
@@ -1976,9 +2203,10 @@ typedef struct Interp {
  *			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_ALLOW_EXCEPTIONS		0x04
+#define TCL_EVAL_FILE			0x02
+#define TCL_EVAL_SOURCE_IN_FRAME	0x10
+#define TCL_EVAL_NORESOLVE		0x20
 
 /*
  * Flag bits for Interp structures:
@@ -2011,6 +2239,16 @@ typedef struct Interp {
  *			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)
@@ -2026,6 +2264,7 @@ typedef struct Interp {
 #define INTERP_TRACE_IN_PROGRESS	 0x200
 #define INTERP_ALTERNATE_WRONG_ARGS	 0x400
 #define ERR_LEGACY_COPY			 0x800
+#define CANCELED			0x1000
 
 /*
  * Maximum number of levels of nesting permitted in Tcl commands (used to
@@ -2135,6 +2374,8 @@ typedef struct 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.
@@ -2173,6 +2414,14 @@ typedef struct List {
     (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)
 
 /*
+ * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
+ * TclNRLmapCmd and their compilations.
+ */
+
+#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
+#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */
+
+/*
  * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
  * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
  *
@@ -2201,6 +2450,30 @@ typedef struct List {
 #endif
 
 /*
+ * Macro used 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 TCL_WIDE_INT_IS_LONG
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
+    (((objPtr)->typePtr == &tclIntType)					\
+	? (*(wideIntPtr) = (Tcl_WideInt)				\
+		((objPtr)->internalRep.longValue), TCL_OK) :		\
+	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#else /* !TCL_WIDE_INT_IS_LONG */
+#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 /* TCL_WIDE_INT_IS_LONG */
+
+/*
  * Flag values for TclTraceDictPath().
  *
  * DICT_PATH_READ indicates that all entries on the path must exist but no
@@ -2242,6 +2515,8 @@ typedef struct List {
 
 #define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
 typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
+typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
+	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 
 /*
  * The following types are used for getting and storing platform-specific file
@@ -2291,10 +2566,10 @@ typedef enum Tcl_PathPart {
  *----------------------------------------------------------------
  */
 
-typedef int (TclStatProc_)(CONST char *path, struct stat *buf);
-typedef int (TclAccessProc_)(CONST char *path, int mode);
+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);
+	const char *fileName, const char *modeString, int permissions);
 
 /*
  *----------------------------------------------------------------
@@ -2359,6 +2634,8 @@ typedef struct ProcessGlobalValue {
 				 * prefixes. */
 #define TCL_PARSE_NO_WHITESPACE		32
 				/* Reject leading/trailing whitespace. */
+#define TCL_PARSE_BINARY_ONLY	64
+				/* Parse binary even without prefix. */
 
 /*
  *----------------------------------------------------------------------
@@ -2382,7 +2659,7 @@ MODULE_SCOPE char *tclNativeExecutableName;
 MODULE_SCOPE int tclFindExecutableSearchDone;
 MODULE_SCOPE char *tclMemDumpFileName;
 MODULE_SCOPE TclPlatformType tclPlatform;
-MODULE_SCOPE Tcl_NotifierProcs tclOriginalNotifier;
+MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
 
 MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
 
@@ -2399,32 +2676,33 @@ MODULE_SCOPE ClientData tclTimeClientData;
  * Variables denoting the Tcl object types defined in the core.
  */
 
-MODULE_SCOPE Tcl_ObjType tclBignumType;
-MODULE_SCOPE Tcl_ObjType tclBooleanType;
-MODULE_SCOPE Tcl_ObjType tclByteArrayType;
-MODULE_SCOPE Tcl_ObjType tclByteCodeType;
-MODULE_SCOPE Tcl_ObjType tclDoubleType;
-MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
-MODULE_SCOPE Tcl_ObjType tclIntType;
-MODULE_SCOPE Tcl_ObjType tclListType;
-MODULE_SCOPE Tcl_ObjType tclDictType;
-MODULE_SCOPE Tcl_ObjType tclProcBodyType;
-MODULE_SCOPE Tcl_ObjType tclStringType;
-MODULE_SCOPE Tcl_ObjType tclArraySearchType;
-MODULE_SCOPE Tcl_ObjType tclEnsembleCmdType;
-#ifndef NO_WIDE_TYPE
-MODULE_SCOPE Tcl_ObjType tclWideIntType;
+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 TCL_WIDE_INT_IS_LONG
+MODULE_SCOPE const Tcl_ObjType tclWideIntType;
 #endif
-MODULE_SCOPE Tcl_ObjType tclRegexpType;
+MODULE_SCOPE const Tcl_ObjType tclRegexpType;
+MODULE_SCOPE Tcl_ObjType tclCmdNameType;
 
 /*
  * Variables denoting the hash key types defined in the core.
  */
 
-MODULE_SCOPE Tcl_HashKeyType tclArrayHashKeyType;
-MODULE_SCOPE Tcl_HashKeyType tclOneWordHashKeyType;
-MODULE_SCOPE Tcl_HashKeyType tclStringHashKeyType;
-MODULE_SCOPE Tcl_HashKeyType tclObjHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
+MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;
 
 /*
  * The head of the list of free Tcl objects, and the total number of Tcl
@@ -2449,6 +2727,83 @@ MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
 MODULE_SCOPE char *	tclEmptyStringRep;
 MODULE_SCOPE char	tclEmptyString;
 
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl modules but not used by the outside world,
+ * introduced by/for NRE.
+ *----------------------------------------------------------------
+ */
+
+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 TclNRLmapCmd;
+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_NRPostProc TclNRCoroutineActivateCallback;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
+MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
+MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
+
+MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
+MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);
+
+/* These two can be considered for the public api */
+MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
+MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);
+
+/*
+ * 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 */
+};
+
 /* Flags for conversion of doubles to digit strings */
 
 #define TCL_DD_SHORTEST 		0x4
@@ -2483,66 +2838,81 @@ MODULE_SCOPE char	tclEmptyString;
 
 MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
 			    const unsigned char *bytes, int len);
-MODULE_SCOPE void       TclAdvanceContinuations(int* line, int** next, int loc);
-MODULE_SCOPE void       TclAdvanceLines(int *line, const char *start,
+MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    int flags);
+MODULE_SCOPE void	TclAdvanceContinuations(int *line, int **next,
+			    int loc);
+MODULE_SCOPE void	TclAdvanceLines(int *line, const char *start,
 			    const char *end);
-MODULE_SCOPE void       TclArgumentEnter(Tcl_Interp* interp,
-			    Tcl_Obj* objv[], int objc, CmdFrame* cf);
-MODULE_SCOPE void       TclArgumentRelease(Tcl_Interp* interp,
-			    Tcl_Obj* objv[], int objc);
-MODULE_SCOPE void       TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
-			    CmdFrame **cfPtrPtr, int *wordPtr);
-MODULE_SCOPE void       TclArgumentBCEnter(Tcl_Interp *interp,
-			    Tcl_Obj* objv[], int objc,
-			    void *codePtr, CmdFrame *cfPtr, int pc);
-MODULE_SCOPE void       TclArgumentBCRelease(Tcl_Interp *interp,
+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, int pc);
+			    void *codePtr, CmdFrame *cfPtr, int cmd, 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(mp_int *bignum);
+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(mp_int *a);
+MODULE_SCOPE double	TclCeil(const mp_int *a);
 MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
 MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
-MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp, const char *value);
+MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,
+			    const char *value);
 MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
 			    Tcl_Channel chan);
-MODULE_SCOPE ContLineLoc* TclContinuationsEnter(Tcl_Obj *objPtr, int num,
+MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
+MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
+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 ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 			    Tcl_Obj *originObjPtr);
-MODULE_SCOPE int	TclConvertElement(CONST char *src, int length,
+MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
+			    const char *dict, int dictLength,
+			    const char **elementPtr, const char **nextPtr,
+			    int *sizePtr, int *literalPtr);
 /* TIP #280 - Modified token based evulation, with line information. */
 MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
 			    int numBytes, int flags, int line,
-			    int *clNextOuter, CONST char *outerScript);
-MODULE_SCOPE int	TclFileAttrsCmd(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclFileCopyCmd(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclFileDeleteCmd(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclFileMakeDirsCmd(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclFileRenameCmd(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
+			    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 char *	TclDStringAppendObj(Tcl_DString *dsPtr,
+			    Tcl_Obj *objPtr);
+MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
+			    Tcl_DString *toAppendPtr);
+MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
+MODULE_SCOPE Tcl_Obj *const *	TclFetchEnsembleRoot(Tcl_Interp *interp,
+			    Tcl_Obj *const *objv, int objc, int *objcPtr);
 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);
@@ -2556,18 +2926,23 @@ MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
 MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
 MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
-MODULE_SCOPE void	TclFinalizeThreadData(void);
+MODULE_SCOPE void	TclFinalizeThreadData(int quick);
 MODULE_SCOPE void	TclFinalizeThreadObjects(void);
-MODULE_SCOPE double	TclFloor(mp_int *a);
+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 CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
+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);
@@ -2575,7 +2950,8 @@ 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 Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
 			    unsigned int *sizePtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
@@ -2587,6 +2963,8 @@ 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[]);
@@ -2609,6 +2987,7 @@ MODULE_SCOPE void	TclInitSubsystems(void);
 MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
 MODULE_SCOPE int	TclIsSpaceProc(char byte);
 MODULE_SCOPE int	TclIsBareword(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,
@@ -2619,12 +2998,6 @@ MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
 			    int *lines, Tcl_Obj *const *elems);
 MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
-MODULE_SCOPE int	TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-			    int symc, const char *symbols[],
-			    Tcl_PackageInitProc **procPtrs[],
-			    Tcl_LoadHandle *handlePtr,
-			    ClientData *clientDataPtr,
-			    Tcl_FSUnloadFileProc **unloadProcPtr);
 MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
 MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
@@ -2632,12 +3005,14 @@ MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    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	TclMaxListLength(const char *bytes, int numBytes,
+			    const char **endPtr);
 MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
 			    int *codePtr, int *levelPtr);
-MODULE_SCOPE int	TclNokia770Doubles();
+MODULE_SCOPE 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);
@@ -2649,7 +3024,7 @@ MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
 MODULE_SCOPE int	TclParseBackslash(const char *src,
 			    int numBytes, int *readPtr, char *dst);
 MODULE_SCOPE int	TclParseHex(const char *src, int numBytes,
-			    Tcl_UniChar *resultPtr);
+			    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);
@@ -2658,20 +3033,22 @@ MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
 MODULE_SCOPE int	TclParseAllWhiteSpace(const char *src, int numBytes);
 MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
 			    int code, int level, Tcl_Obj *returnOpts);
-#ifndef TCL_NO_STACK_CHECK
-MODULE_SCOPE int        TclpGetCStackParams(int **stackBoundPtr);
-#endif
 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 char *path);
+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,
+			    Tcl_ThreadCreateProc *proc, ClientData clientData,
 			    int stackSize, int flags);
 MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
 MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
@@ -2700,41 +3077,42 @@ 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);
-#ifndef TclpPanic
-MODULE_SCOPE void	TclpPanic(const char *format, ...);
-#endif
 MODULE_SCOPE char *	TclpReadlink(const char *fileName,
 			    Tcl_DString *linkPtr);
-#ifndef TclpReleaseFile
-MODULE_SCOPE void	TclpReleaseFile(TclFile file);
-#endif
 MODULE_SCOPE void	TclpSetInterfaces(void);
 MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
-MODULE_SCOPE void	TclpUnloadFile(Tcl_LoadHandle loadHandle);
-MODULE_SCOPE void *	TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
-MODULE_SCOPE void	TclpThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
+MODULE_SCOPE void *	TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
+MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
 			    void *data);
 MODULE_SCOPE void	TclpThreadExit(int status);
-MODULE_SCOPE size_t	TclpThreadGetStackSize(void);
 MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
 MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
 MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
 MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
-			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
-MODULE_SCOPE int	TclScanElement(CONST char *string, int length,
+			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
+			    int *quantifiersFoundPtr);
+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 int	TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 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	TclSpellFix(Tcl_Interp *interp,
+			    Tcl_Obj *const *objv, int objc, int subIdx,
+			    Tcl_Obj *bad, Tcl_Obj *fix);
 MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
 			    int numBytes);
 MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
@@ -2742,38 +3120,48 @@ MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
 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 void	TclTransferResult(Tcl_Interp *sourceInterp, int result,
-			    Tcl_Interp *targetInterp);
+			    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 int	TclUtfCasecmp(const char *cs, const char *ct);
 MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
 MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
-MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp,
-			    Tcl_LoadHandle loadHandle, const char *symbol);
 MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    Tcl_LoadHandle *loadHandle,
-			    Tcl_FSUnloadFileProc **unloadProcPtr);
+			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 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);
+			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 #endif
 MODULE_SCOPE void	TclInitThreadStorage(void);
-MODULE_SCOPE void	TclpFinalizeThreadDataThread(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);
 #endif
-MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
-MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);
+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);
+
+MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
 
 /*
  *----------------------------------------------------------------
@@ -2790,12 +3178,8 @@ MODULE_SCOPE int	Tcl_AppendObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_ApplyObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tcl_ArrayObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tcl_BinaryObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
+MODULE_SCOPE 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[]);
@@ -2815,6 +3199,10 @@ MODULE_SCOPE int	TclChanCreateObjCmd(ClientData clientData,
 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,
@@ -2835,12 +3223,25 @@ 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[]);
-MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
+
+/* 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 Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
+MODULE_SCOPE int	TclMakeEncodingCommandSafe(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -2868,9 +3269,8 @@ MODULE_SCOPE int	Tcl_FconfigureObjCmd(
 MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tcl_FileObjCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
+MODULE_SCOPE 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[]);
@@ -2926,6 +3326,9 @@ MODULE_SCOPE int	Tcl_LlengthObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_ListObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LmapObjCmd(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[]);
@@ -2950,7 +3353,8 @@ MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tcl_NamespaceObjCmd(ClientData clientData,
+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,
@@ -2962,6 +3366,7 @@ MODULE_SCOPE int	Tcl_PackageObjCmd(ClientData clientData,
 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[]);
@@ -2980,6 +3385,9 @@ MODULE_SCOPE int	Tcl_RegsubObjCmd(ClientData clientData,
 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[]);
@@ -3011,12 +3419,17 @@ MODULE_SCOPE int	Tcl_SwitchObjCmd(ClientData clientData,
 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[]);
@@ -3051,18 +3464,42 @@ 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	TclCompileArrayExistsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileArraySetCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileArrayUnsetCmd(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	TclCompileClockClicksCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileClockReadingCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileConcatCmd(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	TclCompileDictCreateCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictExistsCmd(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);
@@ -3075,15 +3512,30 @@ MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictMapCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileDictMergeCmd(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	TclCompileDictUnsetCmd(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);
@@ -3093,15 +3545,36 @@ MODULE_SCOPE int	TclCompileForCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileForeachCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileFormatCmd(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	TclCompileInfoCommandsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileInfoCoroutineCmd(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	TclCompileInfoLevelCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileInfoObjectClassCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileInfoObjectIsACmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileInfoObjectNamespaceCmd(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);
@@ -3114,48 +3587,144 @@ MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLinsertCmd(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	TclCompileLmapCmd(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	TclCompileNamespaceCmd(Tcl_Interp *interp,
+MODULE_SCOPE int	TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceOriginCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceTailCmd(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	TclCompileNamespaceWhichCmd(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	TclCompileObjectNextCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileObjectNextToCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileObjectSelfCmd(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	TclCompileRegsubCmd(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	TclCompileStringCatCmd(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	TclCompileStringFirstCmd(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	TclCompileStringIsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringLastCmd(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	TclCompileStringMapCmd(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	TclCompileStringRangeCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringReplaceCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToLowerCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToTitleCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToUpperCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringTrimCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringTrimLCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringTrimRCmd(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	TclCompileTailcallCmd(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);
@@ -3165,6 +3734,48 @@ MODULE_SCOPE int	TclCompileVariableCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileWhileCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileYieldCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileYieldToCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic0ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic1ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic2ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic3ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic0Or1ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic1Or2ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic2Or3ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic0To2ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasic1To3ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasicMin0ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 
 MODULE_SCOPE int	TclInvertOpCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
@@ -3305,8 +3916,12 @@ 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
+ * Functions defined in generic/tclVar.c and currently exported only for use
  * by the bytecode compiler and engine. Some of these could later be placed in
  * the public interface.
  */
@@ -3333,7 +3948,13 @@ MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVar(Tcl_Interp *interp,
 			    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);
+MODULE_SCOPE void	TclFindArrayPtrElements(Var *arrayPtr,
+			    Tcl_HashTable *tablePtr);
 
 /*
  * The new extended interface to the variable traces.
@@ -3351,6 +3972,8 @@ 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);
+
 /*
  *----------------------------------------------------------------
  * Macros used by the Tcl core to create and release Tcl objects.
@@ -3377,7 +4000,10 @@ MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
  */
 
 #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 */
@@ -3395,6 +4021,12 @@ MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
 #  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(); \
@@ -3413,7 +4045,7 @@ MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
  */
 
 # define TclDecrRefCount(objPtr) \
-    if (--(objPtr)->refCount > 0) ; else { \
+    if ((objPtr)->refCount-- > 1) ; else { \
 	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
 	    TCL_DTRACE_OBJ_FREE(objPtr); \
 	    if ((objPtr)->bytes \
@@ -3437,13 +4069,14 @@ MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
  * track memory leaks.
  */
 
-#  define TclAllocObjStorage(objPtr) \
-	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
+#  define TclAllocObjStorageEx(interp, objPtr) \
+	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
 
-#  define TclFreeObjStorage(objPtr) \
+#  define TclFreeObjStorageEx(interp, objPtr) \
 	ckfree((char *) (objPtr))
 
 #undef USE_THREAD_ALLOC
+#undef USE_TCLALLOC
 #elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
 
 /*
@@ -3460,11 +4093,44 @@ MODULE_SCOPE void	TclpSetAllocCache(void *);
 MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclpFreeAllocCache(void *);
 
-#  define TclAllocObjStorage(objPtr) \
-	(objPtr) = TclThreadAllocObj()
-
-#  define TclFreeObjStorage(objPtr) \
-	TclThreadFreeObj((objPtr))
+/*
+ * 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.twoPtrValue.ptr1; \
+	    --cachePtr->numObjects;					\
+	}								\
+    } while (0)
+
+#  define TclFreeObjStorageEx(interp, objPtr)				\
+    do {								\
+	AllocCache *cachePtr;						\
+	if (((interp) == NULL) ||					\
+		((cachePtr = ((Interp *)(interp))->allocCache),		\
+			((cachePtr->numObjects == 0) ||			\
+			(cachePtr->numObjects >= ALLOC_NOBJHIGH)))) {	\
+	    TclThreadFreeObj(objPtr);					\
+	} else {							\
+	    (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
+	    cachePtr->firstObjPtr = objPtr;				\
+	    ++cachePtr->numObjects;					\
+	}								\
+    } while (0)
 
 #else /* not PURIFY or USE_THREAD_ALLOC */
 
@@ -3480,32 +4146,39 @@ MODULE_SCOPE void	TclpFreeAllocCache(void *);
 MODULE_SCOPE Tcl_Mutex	tclObjMutex;
 #endif
 
-#  define TclAllocObjStorage(objPtr) \
-	Tcl_MutexLock(&tclObjMutex); \
-	if (tclFreeObjList == NULL) { \
-	    TclAllocateFreeObjects(); \
-	} \
-	(objPtr) = tclFreeObjList; \
-	tclFreeObjList = (Tcl_Obj *) \
-		tclFreeObjList->internalRep.twoPtrValue.ptr1; \
-	Tcl_MutexUnlock(&tclObjMutex)
-
-#  define TclFreeObjStorage(objPtr) \
-	Tcl_MutexLock(&tclObjMutex); \
+#  define TclAllocObjStorageEx(interp, objPtr) \
+    do {								\
+	Tcl_MutexLock(&tclObjMutex);					\
+	if (tclFreeObjList == NULL) {					\
+	    TclAllocateFreeObjects();					\
+	}								\
+	(objPtr) = tclFreeObjList;					\
+	tclFreeObjList = (Tcl_Obj *)					\
+		tclFreeObjList->internalRep.twoPtrValue.ptr1;		\
+	Tcl_MutexUnlock(&tclObjMutex);					\
+    } while (0)
+
+#  define TclFreeObjStorageEx(interp, objPtr) \
+    do {							       \
+	Tcl_MutexLock(&tclObjMutex);				       \
 	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \
-	tclFreeObjList = (objPtr); \
-	Tcl_MutexUnlock(&tclObjMutex)
+	tclFreeObjList = (objPtr);				       \
+	Tcl_MutexUnlock(&tclObjMutex);				       \
+    } while (0)
 #endif
 
 #else /* TCL_MEM_DEBUG */
-MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
+MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 			    int line);
 
 # define TclDbNewObj(objPtr, file, line) \
-    TclIncrObjsAllocated(); \
-    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
-    TclDbInitNewObj((objPtr), (file), (line)); \
-    TCL_DTRACE_OBJ_CREATE(objPtr)
+    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__);
@@ -3540,8 +4213,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
 	(objPtr)->length = 0; \
     } else { \
 	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
-	memcpy((void *) (objPtr)->bytes, (void *) (bytePtr), \
-		(unsigned) (len)); \
+	memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
 	(objPtr)->bytes[len] = '\0'; \
 	(objPtr)->length = (len); \
     }
@@ -3577,9 +4249,11 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
  */
 
 #define TclFreeIntRep(objPtr) \
-    if ((objPtr)->typePtr != NULL && \
-	    (objPtr)->typePtr->freeIntRepProc != NULL) { \
-	(objPtr)->typePtr->freeIntRepProc(objPtr); \
+    if ((objPtr)->typePtr != NULL) { \
+	if ((objPtr)->typePtr->freeIntRepProc != NULL) { \
+	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
+	} \
+	(objPtr)->typePtr = NULL; \
     }
 
 /*
@@ -3613,43 +4287,57 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
  *----------------------------------------------------------------
  */
 
+/* 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)
+#endif
+
 #define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
-#define TCL_MIN_TOKEN_GROWTH 50
 #define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr)	\
-{									\
-    int needed = (used) + (append);					\
-    if (needed > TCL_MAX_TOKENS) {					\
-	Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded",	\
-		TCL_MAX_TOKENS);					\
-    }									\
-    if (needed > (available)) {						\
-	int allocated = 2 * needed;					\
-	Tcl_Token *oldPtr = (tokenPtr);					\
-	Tcl_Token *newPtr;						\
-	if (oldPtr == (staticPtr)) {					\
-	    oldPtr = NULL;						\
-	}								\
-	if (allocated > TCL_MAX_TOKENS) {				\
-	    allocated = TCL_MAX_TOKENS;					\
+    do {								\
+	int needed = (used) + (append);					\
+	if (needed > TCL_MAX_TOKENS) {					\
+	    Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded",	\
+		    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 (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 *) ckrealloc((char *) oldPtr,		\
+	    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;					\
 	}								\
-	(available) = allocated;					\
-	if (oldPtr == NULL) {						\
-	    memcpy((VOID *) newPtr, (VOID *) staticPtr,			\
-		    (size_t) ((used) * sizeof(Tcl_Token)));		\
-	}								\
-	(tokenPtr) = newPtr;						\
-    }									\
-}
+    } while (0)
 
 #define TclGrowParseTokenArray(parsePtr, append)			\
     TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\
@@ -3675,6 +4363,30 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
 
 /*
  *----------------------------------------------------------------
+ * 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
@@ -3729,17 +4441,28 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
 /*
  *----------------------------------------------------------------------
  *
- * Core procedures added to libtommath for bignum manipulation.
+ * Core procedure added to libtommath for bignum manipulation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * External (platform specific) initialization routine, these declarations
+ * explicitly don't use EXTERN since this code does not get compiled into the
+ * library:
  *
  *----------------------------------------------------------------------
  */
 
-MODULE_SCOPE int	TclTommath_Init(Tcl_Interp *interp);
-MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
-MODULE_SCOPE void	TclBNInitBignumFromWideInt(mp_int *bignum,
-			    Tcl_WideInt initVal);
-MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
-			    Tcl_WideUInt initVal);
+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;
 
 /*
  *----------------------------------------------------------------
@@ -3750,7 +4473,8 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
  *----------------------------------------------------------------
  */
 
-#define TclMatchIsTrivial(pattern)	strpbrk((pattern), "*[?\\") == NULL
+#define TclMatchIsTrivial(pattern) \
+    (strpbrk((pattern), "*[?\\") == NULL)
 
 /*
  *----------------------------------------------------------------
@@ -3767,14 +4491,16 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
  *----------------------------------------------------------------
  */
 
-#define TclSetIntObj(objPtr, i) \
-    TclInvalidateStringRep(objPtr);\
-    TclFreeIntRep(objPtr); \
-    (objPtr)->internalRep.longValue = (long)(i); \
-    (objPtr)->typePtr = &tclIntType
+#define TclSetLongObj(objPtr, i) \
+    do {						\
+	TclInvalidateStringRep(objPtr);			\
+	TclFreeIntRep(objPtr);				\
+	(objPtr)->internalRep.longValue = (long)(i);	\
+	(objPtr)->typePtr = &tclIntType;		\
+    } while (0)
 
-#define TclSetLongObj(objPtr, l) \
-    TclSetIntObj((objPtr), (l))
+#define TclSetIntObj(objPtr, l) \
+    TclSetLongObj(objPtr, l)
 
 /*
  * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
@@ -3784,21 +4510,25 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
  */
 
 #define TclSetBooleanObj(objPtr, b) \
-    TclSetIntObj((objPtr), ((b)? 1 : 0));
+    TclSetLongObj(objPtr, (b)!=0);
 
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 #define TclSetWideIntObj(objPtr, w) \
-    TclInvalidateStringRep(objPtr);\
-    TclFreeIntRep(objPtr); \
-    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
-    (objPtr)->typePtr = &tclWideIntType
+    do {							\
+	TclInvalidateStringRep(objPtr);				\
+	TclFreeIntRep(objPtr);					\
+	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
+	(objPtr)->typePtr = &tclWideIntType;			\
+    } while (0)
 #endif
 
 #define TclSetDoubleObj(objPtr, d) \
-    TclInvalidateStringRep(objPtr);\
-    TclFreeIntRep(objPtr); \
-    (objPtr)->internalRep.doubleValue = (double)(d); \
-    (objPtr)->typePtr = &tclDoubleType
+    do {							\
+	TclInvalidateStringRep(objPtr);				\
+	TclFreeIntRep(objPtr);					\
+	(objPtr)->internalRep.doubleValue = (double)(d);	\
+	(objPtr)->typePtr = &tclDoubleType;			\
+    } while (0)
 
 /*
  *----------------------------------------------------------------
@@ -3818,41 +4548,47 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
  */
 
 #ifndef TCL_MEM_DEBUG
-#define TclNewIntObj(objPtr, i) \
-    TclIncrObjsAllocated(); \
-    TclAllocObjStorage(objPtr); \
-    (objPtr)->refCount = 0; \
-    (objPtr)->bytes = NULL; \
-    (objPtr)->internalRep.longValue = (long)(i); \
-    (objPtr)->typePtr = &tclIntType; \
-    TCL_DTRACE_OBJ_CREATE(objPtr)
+#define TclNewLongObj(objPtr, 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))
+#define TclNewIntObj(objPtr, l) \
+    TclNewLongObj(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))
+    TclNewLongObj((objPtr), (b)!=0)
 
 #define TclNewDoubleObj(objPtr, d) \
-    TclIncrObjsAllocated(); \
-    TclAllocObjStorage(objPtr); \
-    (objPtr)->refCount = 0; \
-    (objPtr)->bytes = NULL; \
-    (objPtr)->internalRep.doubleValue = (double)(d); \
-    (objPtr)->typePtr = &tclDoubleType; \
-    TCL_DTRACE_OBJ_CREATE(objPtr)
+    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) \
-    TclIncrObjsAllocated(); \
-    TclAllocObjStorage(objPtr); \
-    (objPtr)->refCount = 0; \
-    TclInitStringRep((objPtr), (s), (len));\
-    (objPtr)->typePtr = NULL; \
-    TCL_DTRACE_OBJ_CREATE(objPtr)
+    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) \
@@ -3880,6 +4616,21 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
 
 /*
  *----------------------------------------------------------------
+ * Convenience macros for DStrings.
+ * The ANSI C "prototypes" for these macros are:
+ *
+ * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
+ *			const char *sLiteral);
+ * MODULE_SCOPE void   TclDStringClear(Tcl_DString *dsPtr);
+ */
+
+#define TclDStringAppendLiteral(dsPtr, sLiteral) \
+    Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+#define TclDStringClear(dsPtr) \
+    Tcl_DStringSetLength((dsPtr), 0)
+
+/*
+ *----------------------------------------------------------------
  * Macros used by the Tcl core to test for some special double values.
  * The ANSI C "prototypes" for these macros are:
  *
@@ -3929,7 +4680,7 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
  */
 
 #define TclCleanupCommandMacro(cmdPtr) \
-    if (--(cmdPtr)->refCount <= 0) { \
+    if ((cmdPtr)->refCount-- <= 1) { \
 	ckfree((char *) (cmdPtr));\
     }
 
@@ -3956,11 +4707,157 @@ MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
 	    ((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. */
+#ifndef NRE_ENABLE_ASSERTS
+#define NRE_ENABLE_ASSERTS	0
+#endif
+
+/*
+ * 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)
+
+#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
+
 #endif /* _TCLINT */
 
 /*
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index e4e85ad..f95f999 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -41,6 +41,8 @@
 #undef Tcl_FindCommand
 #undef Tcl_GetCommandFromObj
 #undef Tcl_GetCommandFullName
+#undef Tcl_SetStartupScript
+#undef Tcl_GetStartupScript
 
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
@@ -61,782 +63,410 @@ extern "C" {
 /* Slot 0 is reserved */
 /* Slot 1 is reserved */
 /* Slot 2 is reserved */
-#ifndef TclAllocateFreeObjects_TCL_DECLARED
-#define TclAllocateFreeObjects_TCL_DECLARED
 /* 3 */
 EXTERN void		TclAllocateFreeObjects(void);
-#endif
 /* Slot 4 is reserved */
-#ifndef TclCleanupChildren_TCL_DECLARED
-#define TclCleanupChildren_TCL_DECLARED
 /* 5 */
 EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
 				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
-#endif
-#ifndef TclCleanupCommand_TCL_DECLARED
-#define TclCleanupCommand_TCL_DECLARED
 /* 6 */
 EXTERN void		TclCleanupCommand(Command *cmdPtr);
-#endif
-#ifndef TclCopyAndCollapse_TCL_DECLARED
-#define TclCopyAndCollapse_TCL_DECLARED
 /* 7 */
-EXTERN int		TclCopyAndCollapse(int count, CONST char *src,
+EXTERN int		TclCopyAndCollapse(int count, const char *src,
 				char *dst);
-#endif
-#ifndef TclCopyChannel_TCL_DECLARED
-#define TclCopyChannel_TCL_DECLARED
 /* 8 */
-EXTERN int		TclCopyChannel(Tcl_Interp *interp,
+EXTERN int		TclCopyChannelOld(Tcl_Interp *interp,
 				Tcl_Channel inChan, Tcl_Channel outChan,
 				int toRead, Tcl_Obj *cmdPtr);
-#endif
-#ifndef TclCreatePipeline_TCL_DECLARED
-#define TclCreatePipeline_TCL_DECLARED
 /* 9 */
 EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
-				CONST char **argv, Tcl_Pid **pidArrayPtr,
+				const char **argv, Tcl_Pid **pidArrayPtr,
 				TclFile *inPipePtr, TclFile *outPipePtr,
 				TclFile *errFilePtr);
-#endif
-#ifndef TclCreateProc_TCL_DECLARED
-#define TclCreateProc_TCL_DECLARED
 /* 10 */
 EXTERN int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
-				CONST char *procName, Tcl_Obj *argsPtr,
+				const char *procName, Tcl_Obj *argsPtr,
 				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
-#endif
-#ifndef TclDeleteCompiledLocalVars_TCL_DECLARED
-#define TclDeleteCompiledLocalVars_TCL_DECLARED
 /* 11 */
 EXTERN void		TclDeleteCompiledLocalVars(Interp *iPtr,
 				CallFrame *framePtr);
-#endif
-#ifndef TclDeleteVars_TCL_DECLARED
-#define TclDeleteVars_TCL_DECLARED
 /* 12 */
 EXTERN void		TclDeleteVars(Interp *iPtr,
 				TclVarHashTable *tablePtr);
-#endif
 /* Slot 13 is reserved */
-#ifndef TclDumpMemoryInfo_TCL_DECLARED
-#define TclDumpMemoryInfo_TCL_DECLARED
 /* 14 */
 EXTERN int		TclDumpMemoryInfo(ClientData clientData, int flags);
-#endif
 /* Slot 15 is reserved */
-#ifndef TclExprFloatError_TCL_DECLARED
-#define TclExprFloatError_TCL_DECLARED
 /* 16 */
 EXTERN void		TclExprFloatError(Tcl_Interp *interp, double value);
-#endif
 /* Slot 17 is reserved */
 /* Slot 18 is reserved */
 /* Slot 19 is reserved */
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
-#ifndef TclFindElement_TCL_DECLARED
-#define TclFindElement_TCL_DECLARED
 /* 22 */
 EXTERN int		TclFindElement(Tcl_Interp *interp,
-				CONST char *listStr, int listLength,
-				CONST char **elementPtr,
-				CONST char **nextPtr, int *sizePtr,
+				const char *listStr, int listLength,
+				const char **elementPtr,
+				const char **nextPtr, int *sizePtr,
 				int *bracePtr);
-#endif
-#ifndef TclFindProc_TCL_DECLARED
-#define TclFindProc_TCL_DECLARED
 /* 23 */
-EXTERN Proc *		TclFindProc(Interp *iPtr, CONST char *procName);
-#endif
-#ifndef TclFormatInt_TCL_DECLARED
-#define TclFormatInt_TCL_DECLARED
+EXTERN Proc *		TclFindProc(Interp *iPtr, const char *procName);
 /* 24 */
 EXTERN int		TclFormatInt(char *buffer, long n);
-#endif
-#ifndef TclFreePackageInfo_TCL_DECLARED
-#define TclFreePackageInfo_TCL_DECLARED
 /* 25 */
 EXTERN void		TclFreePackageInfo(Interp *iPtr);
-#endif
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
-#ifndef TclpGetDefaultStdChannel_TCL_DECLARED
-#define TclpGetDefaultStdChannel_TCL_DECLARED
 /* 28 */
 EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
-#endif
 /* Slot 29 is reserved */
 /* Slot 30 is reserved */
-#ifndef TclGetExtension_TCL_DECLARED
-#define TclGetExtension_TCL_DECLARED
 /* 31 */
-EXTERN CONST char *	TclGetExtension(CONST char *name);
-#endif
-#ifndef TclGetFrame_TCL_DECLARED
-#define TclGetFrame_TCL_DECLARED
+EXTERN const char *	TclGetExtension(const char *name);
 /* 32 */
-EXTERN int		TclGetFrame(Tcl_Interp *interp, CONST char *str,
+EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
 				CallFrame **framePtrPtr);
-#endif
 /* Slot 33 is reserved */
-#ifndef TclGetIntForIndex_TCL_DECLARED
-#define TclGetIntForIndex_TCL_DECLARED
 /* 34 */
 EXTERN int		TclGetIntForIndex(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, int endValue, int *indexPtr);
-#endif
 /* Slot 35 is reserved */
-#ifndef TclGetLong_TCL_DECLARED
-#define TclGetLong_TCL_DECLARED
-/* 36 */
-EXTERN int		TclGetLong(Tcl_Interp *interp, CONST char *str,
-				long *longPtr);
-#endif
-#ifndef TclGetLoadedPackages_TCL_DECLARED
-#define TclGetLoadedPackages_TCL_DECLARED
+/* Slot 36 is reserved */
 /* 37 */
 EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
-				char *targetName);
-#endif
-#ifndef TclGetNamespaceForQualName_TCL_DECLARED
-#define TclGetNamespaceForQualName_TCL_DECLARED
+				const char *targetName);
 /* 38 */
 EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
-				CONST char *qualName, Namespace *cxtNsPtr,
+				const char *qualName, Namespace *cxtNsPtr,
 				int flags, Namespace **nsPtrPtr,
 				Namespace **altNsPtrPtr,
 				Namespace **actualCxtPtrPtr,
-				CONST char **simpleNamePtr);
-#endif
-#ifndef TclGetObjInterpProc_TCL_DECLARED
-#define TclGetObjInterpProc_TCL_DECLARED
+				const char **simpleNamePtr);
 /* 39 */
 EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
-#endif
-#ifndef TclGetOpenMode_TCL_DECLARED
-#define TclGetOpenMode_TCL_DECLARED
 /* 40 */
-EXTERN int		TclGetOpenMode(Tcl_Interp *interp, CONST char *str,
+EXTERN int		TclGetOpenMode(Tcl_Interp *interp, const char *str,
 				int *seekFlagPtr);
-#endif
-#ifndef TclGetOriginalCommand_TCL_DECLARED
-#define TclGetOriginalCommand_TCL_DECLARED
 /* 41 */
 EXTERN Tcl_Command	TclGetOriginalCommand(Tcl_Command command);
-#endif
-#ifndef TclpGetUserHome_TCL_DECLARED
-#define TclpGetUserHome_TCL_DECLARED
 /* 42 */
-EXTERN char *		TclpGetUserHome(CONST char *name,
+EXTERN CONST86 char *	TclpGetUserHome(const char *name,
 				Tcl_DString *bufferPtr);
-#endif
 /* Slot 43 is reserved */
-#ifndef TclGuessPackageName_TCL_DECLARED
-#define TclGuessPackageName_TCL_DECLARED
 /* 44 */
-EXTERN int		TclGuessPackageName(CONST char *fileName,
+EXTERN int		TclGuessPackageName(const char *fileName,
 				Tcl_DString *bufPtr);
-#endif
-#ifndef TclHideUnsafeCommands_TCL_DECLARED
-#define TclHideUnsafeCommands_TCL_DECLARED
 /* 45 */
 EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
-#endif
-#ifndef TclInExit_TCL_DECLARED
-#define TclInExit_TCL_DECLARED
 /* 46 */
 EXTERN int		TclInExit(void);
-#endif
 /* Slot 47 is reserved */
 /* Slot 48 is reserved */
 /* Slot 49 is reserved */
-#ifndef TclInitCompiledLocals_TCL_DECLARED
-#define TclInitCompiledLocals_TCL_DECLARED
 /* 50 */
 EXTERN void		TclInitCompiledLocals(Tcl_Interp *interp,
 				CallFrame *framePtr, Namespace *nsPtr);
-#endif
-#ifndef TclInterpInit_TCL_DECLARED
-#define TclInterpInit_TCL_DECLARED
 /* 51 */
 EXTERN int		TclInterpInit(Tcl_Interp *interp);
-#endif
 /* Slot 52 is reserved */
-#ifndef TclInvokeObjectCommand_TCL_DECLARED
-#define TclInvokeObjectCommand_TCL_DECLARED
 /* 53 */
 EXTERN int		TclInvokeObjectCommand(ClientData clientData,
 				Tcl_Interp *interp, int argc,
 				CONST84 char **argv);
-#endif
-#ifndef TclInvokeStringCommand_TCL_DECLARED
-#define TclInvokeStringCommand_TCL_DECLARED
 /* 54 */
 EXTERN int		TclInvokeStringCommand(ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[]);
-#endif
-#ifndef TclIsProc_TCL_DECLARED
-#define TclIsProc_TCL_DECLARED
+				Tcl_Obj *const objv[]);
 /* 55 */
 EXTERN Proc *		TclIsProc(Command *cmdPtr);
-#endif
 /* Slot 56 is reserved */
 /* Slot 57 is reserved */
-#ifndef TclLookupVar_TCL_DECLARED
-#define TclLookupVar_TCL_DECLARED
 /* 58 */
-EXTERN Var *		TclLookupVar(Tcl_Interp *interp, CONST char *part1,
-				CONST char *part2, int flags,
-				CONST char *msg, int createPart1,
+EXTERN Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
+				const char *part2, int flags,
+				const char *msg, int createPart1,
 				int createPart2, Var **arrayPtrPtr);
-#endif
 /* Slot 59 is reserved */
-#ifndef TclNeedSpace_TCL_DECLARED
-#define TclNeedSpace_TCL_DECLARED
 /* 60 */
-EXTERN int		TclNeedSpace(CONST char *start, CONST char *end);
-#endif
-#ifndef TclNewProcBodyObj_TCL_DECLARED
-#define TclNewProcBodyObj_TCL_DECLARED
+EXTERN int		TclNeedSpace(const char *start, const char *end);
 /* 61 */
 EXTERN Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
-#endif
-#ifndef TclObjCommandComplete_TCL_DECLARED
-#define TclObjCommandComplete_TCL_DECLARED
 /* 62 */
 EXTERN int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
-#endif
-#ifndef TclObjInterpProc_TCL_DECLARED
-#define TclObjInterpProc_TCL_DECLARED
 /* 63 */
 EXTERN int		TclObjInterpProc(ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[]);
-#endif
-#ifndef TclObjInvoke_TCL_DECLARED
-#define TclObjInvoke_TCL_DECLARED
+				Tcl_Obj *const objv[]);
 /* 64 */
 EXTERN int		TclObjInvoke(Tcl_Interp *interp, int objc,
-				Tcl_Obj *CONST objv[], int flags);
-#endif
+				Tcl_Obj *const objv[], int flags);
 /* Slot 65 is reserved */
 /* Slot 66 is reserved */
 /* Slot 67 is reserved */
 /* Slot 68 is reserved */
-#ifndef TclpAlloc_TCL_DECLARED
-#define TclpAlloc_TCL_DECLARED
 /* 69 */
 EXTERN char *		TclpAlloc(unsigned int size);
-#endif
 /* Slot 70 is reserved */
 /* Slot 71 is reserved */
 /* Slot 72 is reserved */
 /* Slot 73 is reserved */
-#ifndef TclpFree_TCL_DECLARED
-#define TclpFree_TCL_DECLARED
 /* 74 */
 EXTERN void		TclpFree(char *ptr);
-#endif
-#ifndef TclpGetClicks_TCL_DECLARED
-#define TclpGetClicks_TCL_DECLARED
 /* 75 */
 EXTERN unsigned long	TclpGetClicks(void);
-#endif
-#ifndef TclpGetSeconds_TCL_DECLARED
-#define TclpGetSeconds_TCL_DECLARED
 /* 76 */
 EXTERN unsigned long	TclpGetSeconds(void);
-#endif
-#ifndef TclpGetTime_TCL_DECLARED
-#define TclpGetTime_TCL_DECLARED
 /* 77 */
 EXTERN void		TclpGetTime(Tcl_Time *time);
-#endif
-#ifndef TclpGetTimeZone_TCL_DECLARED
-#define TclpGetTimeZone_TCL_DECLARED
-/* 78 */
-EXTERN int		TclpGetTimeZone(unsigned long time);
-#endif
+/* Slot 78 is reserved */
 /* Slot 79 is reserved */
 /* Slot 80 is reserved */
-#ifndef TclpRealloc_TCL_DECLARED
-#define TclpRealloc_TCL_DECLARED
 /* 81 */
 EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
-#endif
 /* Slot 82 is reserved */
 /* Slot 83 is reserved */
 /* Slot 84 is reserved */
 /* Slot 85 is reserved */
 /* Slot 86 is reserved */
 /* Slot 87 is reserved */
-#ifndef TclPrecTraceProc_TCL_DECLARED
-#define TclPrecTraceProc_TCL_DECLARED
 /* 88 */
 EXTERN char *		TclPrecTraceProc(ClientData clientData,
-				Tcl_Interp *interp, CONST char *name1,
-				CONST char *name2, int flags);
-#endif
-#ifndef TclPreventAliasLoop_TCL_DECLARED
-#define TclPreventAliasLoop_TCL_DECLARED
+				Tcl_Interp *interp, const char *name1,
+				const char *name2, int flags);
 /* 89 */
 EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
 				Tcl_Interp *cmdInterp, Tcl_Command cmd);
-#endif
 /* Slot 90 is reserved */
-#ifndef TclProcCleanupProc_TCL_DECLARED
-#define TclProcCleanupProc_TCL_DECLARED
 /* 91 */
 EXTERN void		TclProcCleanupProc(Proc *procPtr);
-#endif
-#ifndef TclProcCompileProc_TCL_DECLARED
-#define TclProcCompileProc_TCL_DECLARED
 /* 92 */
 EXTERN int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
 				Tcl_Obj *bodyPtr, Namespace *nsPtr,
-				CONST char *description,
-				CONST char *procName);
-#endif
-#ifndef TclProcDeleteProc_TCL_DECLARED
-#define TclProcDeleteProc_TCL_DECLARED
+				const char *description,
+				const char *procName);
 /* 93 */
 EXTERN void		TclProcDeleteProc(ClientData clientData);
-#endif
 /* Slot 94 is reserved */
 /* Slot 95 is reserved */
-#ifndef TclRenameCommand_TCL_DECLARED
-#define TclRenameCommand_TCL_DECLARED
 /* 96 */
 EXTERN int		TclRenameCommand(Tcl_Interp *interp,
-				CONST char *oldName, CONST char *newName);
-#endif
-#ifndef TclResetShadowedCmdRefs_TCL_DECLARED
-#define TclResetShadowedCmdRefs_TCL_DECLARED
+				const char *oldName, const char *newName);
 /* 97 */
 EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
 				Command *newCmdPtr);
-#endif
-#ifndef TclServiceIdle_TCL_DECLARED
-#define TclServiceIdle_TCL_DECLARED
 /* 98 */
 EXTERN int		TclServiceIdle(void);
-#endif
 /* Slot 99 is reserved */
 /* Slot 100 is reserved */
-#ifndef TclSetPreInitScript_TCL_DECLARED
-#define TclSetPreInitScript_TCL_DECLARED
 /* 101 */
-EXTERN char *		TclSetPreInitScript(char *string);
-#endif
-#ifndef TclSetupEnv_TCL_DECLARED
-#define TclSetupEnv_TCL_DECLARED
+EXTERN CONST86 char *	TclSetPreInitScript(const char *string);
 /* 102 */
 EXTERN void		TclSetupEnv(Tcl_Interp *interp);
-#endif
-#ifndef TclSockGetPort_TCL_DECLARED
-#define TclSockGetPort_TCL_DECLARED
 /* 103 */
-EXTERN int		TclSockGetPort(Tcl_Interp *interp, CONST char *str,
-				CONST char *proto, int *portPtr);
-#endif
-#ifndef TclSockMinimumBuffersOld_TCL_DECLARED
-#define TclSockMinimumBuffersOld_TCL_DECLARED
+EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
+				const char *proto, int *portPtr);
 /* 104 */
 EXTERN int		TclSockMinimumBuffersOld(int sock, int size);
-#endif
 /* Slot 105 is reserved */
 /* Slot 106 is reserved */
 /* Slot 107 is reserved */
-#ifndef TclTeardownNamespace_TCL_DECLARED
-#define TclTeardownNamespace_TCL_DECLARED
 /* 108 */
 EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
-#endif
-#ifndef TclUpdateReturnInfo_TCL_DECLARED
-#define TclUpdateReturnInfo_TCL_DECLARED
 /* 109 */
 EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
-#endif
-#ifndef TclSockMinimumBuffers_TCL_DECLARED
-#define TclSockMinimumBuffers_TCL_DECLARED
 /* 110 */
-EXTERN int		TclSockMinimumBuffers(VOID *sock, int size);
-#endif
-#ifndef Tcl_AddInterpResolvers_TCL_DECLARED
-#define Tcl_AddInterpResolvers_TCL_DECLARED
+EXTERN int		TclSockMinimumBuffers(void *sock, int size);
 /* 111 */
 EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
-				CONST char *name,
+				const char *name,
 				Tcl_ResolveCmdProc *cmdProc,
 				Tcl_ResolveVarProc *varProc,
 				Tcl_ResolveCompiledVarProc *compiledVarProc);
-#endif
-#ifndef Tcl_AppendExportList_TCL_DECLARED
-#define Tcl_AppendExportList_TCL_DECLARED
 /* 112 */
 EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
 				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_CreateNamespace_TCL_DECLARED
-#define Tcl_CreateNamespace_TCL_DECLARED
 /* 113 */
 EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
-				CONST char *name, ClientData clientData,
+				const char *name, ClientData clientData,
 				Tcl_NamespaceDeleteProc *deleteProc);
-#endif
-#ifndef Tcl_DeleteNamespace_TCL_DECLARED
-#define Tcl_DeleteNamespace_TCL_DECLARED
 /* 114 */
 EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
-#endif
-#ifndef Tcl_Export_TCL_DECLARED
-#define Tcl_Export_TCL_DECLARED
 /* 115 */
 EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				CONST char *pattern, int resetListFirst);
-#endif
-#ifndef Tcl_FindCommand_TCL_DECLARED
-#define Tcl_FindCommand_TCL_DECLARED
+				const char *pattern, int resetListFirst);
 /* 116 */
-EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
+EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
-#endif
-#ifndef Tcl_FindNamespace_TCL_DECLARED
-#define Tcl_FindNamespace_TCL_DECLARED
 /* 117 */
 EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
-				CONST char *name,
+				const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
-#endif
-#ifndef Tcl_GetInterpResolvers_TCL_DECLARED
-#define Tcl_GetInterpResolvers_TCL_DECLARED
 /* 118 */
 EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
-				CONST char *name, Tcl_ResolverInfo *resInfo);
-#endif
-#ifndef Tcl_GetNamespaceResolvers_TCL_DECLARED
-#define Tcl_GetNamespaceResolvers_TCL_DECLARED
+				const char *name, Tcl_ResolverInfo *resInfo);
 /* 119 */
 EXTERN int		Tcl_GetNamespaceResolvers(
 				Tcl_Namespace *namespacePtr,
 				Tcl_ResolverInfo *resInfo);
-#endif
-#ifndef Tcl_FindNamespaceVar_TCL_DECLARED
-#define Tcl_FindNamespaceVar_TCL_DECLARED
 /* 120 */
 EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
-				CONST char *name,
+				const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
-#endif
-#ifndef Tcl_ForgetImport_TCL_DECLARED
-#define Tcl_ForgetImport_TCL_DECLARED
 /* 121 */
 EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, CONST char *pattern);
-#endif
-#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
-#define Tcl_GetCommandFromObj_TCL_DECLARED
+				Tcl_Namespace *nsPtr, const char *pattern);
 /* 122 */
 EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetCommandFullName_TCL_DECLARED
-#define Tcl_GetCommandFullName_TCL_DECLARED
 /* 123 */
 EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
 				Tcl_Command command, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
-#define Tcl_GetCurrentNamespace_TCL_DECLARED
 /* 124 */
 EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
-#define Tcl_GetGlobalNamespace_TCL_DECLARED
 /* 125 */
 EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_GetVariableFullName_TCL_DECLARED
-#define Tcl_GetVariableFullName_TCL_DECLARED
 /* 126 */
 EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
 				Tcl_Var variable, Tcl_Obj *objPtr);
-#endif
-#ifndef Tcl_Import_TCL_DECLARED
-#define Tcl_Import_TCL_DECLARED
 /* 127 */
 EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				CONST char *pattern, int allowOverwrite);
-#endif
-#ifndef Tcl_PopCallFrame_TCL_DECLARED
-#define Tcl_PopCallFrame_TCL_DECLARED
+				const char *pattern, int allowOverwrite);
 /* 128 */
 EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
-#endif
-#ifndef Tcl_PushCallFrame_TCL_DECLARED
-#define Tcl_PushCallFrame_TCL_DECLARED
 /* 129 */
 EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
 				Tcl_CallFrame *framePtr,
 				Tcl_Namespace *nsPtr, int isProcCallFrame);
-#endif
-#ifndef Tcl_RemoveInterpResolvers_TCL_DECLARED
-#define Tcl_RemoveInterpResolvers_TCL_DECLARED
 /* 130 */
 EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
-				CONST char *name);
-#endif
-#ifndef Tcl_SetNamespaceResolvers_TCL_DECLARED
-#define Tcl_SetNamespaceResolvers_TCL_DECLARED
+				const char *name);
 /* 131 */
 EXTERN void		Tcl_SetNamespaceResolvers(
 				Tcl_Namespace *namespacePtr,
 				Tcl_ResolveCmdProc *cmdProc,
 				Tcl_ResolveVarProc *varProc,
 				Tcl_ResolveCompiledVarProc *compiledVarProc);
-#endif
-#ifndef TclpHasSockets_TCL_DECLARED
-#define TclpHasSockets_TCL_DECLARED
 /* 132 */
 EXTERN int		TclpHasSockets(Tcl_Interp *interp);
-#endif
-#ifndef TclpGetDate_TCL_DECLARED
-#define TclpGetDate_TCL_DECLARED
 /* 133 */
-EXTERN struct tm *	TclpGetDate(CONST time_t *time, int useGMT);
-#endif
+EXTERN struct tm *	TclpGetDate(const time_t *time, int useGMT);
 /* Slot 134 is reserved */
 /* Slot 135 is reserved */
 /* Slot 136 is reserved */
 /* Slot 137 is reserved */
-#ifndef TclGetEnv_TCL_DECLARED
-#define TclGetEnv_TCL_DECLARED
 /* 138 */
-EXTERN CONST84_RETURN char * TclGetEnv(CONST char *name,
+EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
 				Tcl_DString *valuePtr);
-#endif
 /* Slot 139 is reserved */
 /* Slot 140 is reserved */
-#ifndef TclpGetCwd_TCL_DECLARED
-#define TclpGetCwd_TCL_DECLARED
 /* 141 */
 EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
 				Tcl_DString *cwdPtr);
-#endif
-#ifndef TclSetByteCodeFromAny_TCL_DECLARED
-#define TclSetByteCodeFromAny_TCL_DECLARED
 /* 142 */
 EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, CompileHookProc *hookProc,
 				ClientData clientData);
-#endif
-#ifndef TclAddLiteralObj_TCL_DECLARED
-#define TclAddLiteralObj_TCL_DECLARED
 /* 143 */
 EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
 				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
-#endif
-#ifndef TclHideLiteral_TCL_DECLARED
-#define TclHideLiteral_TCL_DECLARED
 /* 144 */
 EXTERN void		TclHideLiteral(Tcl_Interp *interp,
 				struct CompileEnv *envPtr, int index);
-#endif
-#ifndef TclGetAuxDataType_TCL_DECLARED
-#define TclGetAuxDataType_TCL_DECLARED
 /* 145 */
-EXTERN struct AuxDataType * TclGetAuxDataType(char *typeName);
-#endif
-#ifndef TclHandleCreate_TCL_DECLARED
-#define TclHandleCreate_TCL_DECLARED
+EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
 /* 146 */
-EXTERN TclHandle	TclHandleCreate(VOID *ptr);
-#endif
-#ifndef TclHandleFree_TCL_DECLARED
-#define TclHandleFree_TCL_DECLARED
+EXTERN TclHandle	TclHandleCreate(void *ptr);
 /* 147 */
 EXTERN void		TclHandleFree(TclHandle handle);
-#endif
-#ifndef TclHandlePreserve_TCL_DECLARED
-#define TclHandlePreserve_TCL_DECLARED
 /* 148 */
 EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
-#endif
-#ifndef TclHandleRelease_TCL_DECLARED
-#define TclHandleRelease_TCL_DECLARED
 /* 149 */
 EXTERN void		TclHandleRelease(TclHandle handle);
-#endif
-#ifndef TclRegAbout_TCL_DECLARED
-#define TclRegAbout_TCL_DECLARED
 /* 150 */
 EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
-#endif
-#ifndef TclRegExpRangeUniChar_TCL_DECLARED
-#define TclRegExpRangeUniChar_TCL_DECLARED
 /* 151 */
 EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, int index,
 				int *startPtr, int *endPtr);
-#endif
-#ifndef TclSetLibraryPath_TCL_DECLARED
-#define TclSetLibraryPath_TCL_DECLARED
 /* 152 */
 EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
-#endif
-#ifndef TclGetLibraryPath_TCL_DECLARED
-#define TclGetLibraryPath_TCL_DECLARED
 /* 153 */
 EXTERN Tcl_Obj *	TclGetLibraryPath(void);
-#endif
 /* Slot 154 is reserved */
 /* Slot 155 is reserved */
-#ifndef TclRegError_TCL_DECLARED
-#define TclRegError_TCL_DECLARED
 /* 156 */
-EXTERN void		TclRegError(Tcl_Interp *interp, CONST char *msg,
+EXTERN void		TclRegError(Tcl_Interp *interp, const char *msg,
 				int status);
-#endif
-#ifndef TclVarTraceExists_TCL_DECLARED
-#define TclVarTraceExists_TCL_DECLARED
 /* 157 */
 EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
-				CONST char *varName);
-#endif
-#ifndef TclSetStartupScriptFileName_TCL_DECLARED
-#define TclSetStartupScriptFileName_TCL_DECLARED
+				const char *varName);
 /* 158 */
-EXTERN void		TclSetStartupScriptFileName(CONST char *filename);
-#endif
-#ifndef TclGetStartupScriptFileName_TCL_DECLARED
-#define TclGetStartupScriptFileName_TCL_DECLARED
+EXTERN void		TclSetStartupScriptFileName(const char *filename);
 /* 159 */
-EXTERN CONST84_RETURN char * TclGetStartupScriptFileName(void);
-#endif
+EXTERN const char *	TclGetStartupScriptFileName(void);
 /* Slot 160 is reserved */
-#ifndef TclChannelTransform_TCL_DECLARED
-#define TclChannelTransform_TCL_DECLARED
 /* 161 */
 EXTERN int		TclChannelTransform(Tcl_Interp *interp,
 				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
-#endif
-#ifndef TclChannelEventScriptInvoker_TCL_DECLARED
-#define TclChannelEventScriptInvoker_TCL_DECLARED
 /* 162 */
 EXTERN void		TclChannelEventScriptInvoker(ClientData clientData,
 				int flags);
-#endif
-#ifndef TclGetInstructionTable_TCL_DECLARED
-#define TclGetInstructionTable_TCL_DECLARED
 /* 163 */
-EXTERN VOID *		TclGetInstructionTable(void);
-#endif
-#ifndef TclExpandCodeArray_TCL_DECLARED
-#define TclExpandCodeArray_TCL_DECLARED
+EXTERN const void *	TclGetInstructionTable(void);
 /* 164 */
-EXTERN void		TclExpandCodeArray(VOID *envPtr);
-#endif
-#ifndef TclpSetInitialEncodings_TCL_DECLARED
-#define TclpSetInitialEncodings_TCL_DECLARED
+EXTERN void		TclExpandCodeArray(void *envPtr);
 /* 165 */
 EXTERN void		TclpSetInitialEncodings(void);
-#endif
-#ifndef TclListObjSetElement_TCL_DECLARED
-#define TclListObjSetElement_TCL_DECLARED
 /* 166 */
 EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int index,
 				Tcl_Obj *valuePtr);
-#endif
-#ifndef TclSetStartupScriptPath_TCL_DECLARED
-#define TclSetStartupScriptPath_TCL_DECLARED
 /* 167 */
 EXTERN void		TclSetStartupScriptPath(Tcl_Obj *pathPtr);
-#endif
-#ifndef TclGetStartupScriptPath_TCL_DECLARED
-#define TclGetStartupScriptPath_TCL_DECLARED
 /* 168 */
 EXTERN Tcl_Obj *	TclGetStartupScriptPath(void);
-#endif
-#ifndef TclpUtfNcmp2_TCL_DECLARED
-#define TclpUtfNcmp2_TCL_DECLARED
 /* 169 */
-EXTERN int		TclpUtfNcmp2(CONST char *s1, CONST char *s2,
+EXTERN int		TclpUtfNcmp2(const char *s1, const char *s2,
 				unsigned long n);
-#endif
-#ifndef TclCheckInterpTraces_TCL_DECLARED
-#define TclCheckInterpTraces_TCL_DECLARED
 /* 170 */
 EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
-				CONST char *command, int numChars,
+				const char *command, int numChars,
 				Command *cmdPtr, int result, int traceFlags,
-				int objc, Tcl_Obj *CONST objv[]);
-#endif
-#ifndef TclCheckExecutionTraces_TCL_DECLARED
-#define TclCheckExecutionTraces_TCL_DECLARED
+				int objc, Tcl_Obj *const objv[]);
 /* 171 */
 EXTERN int		TclCheckExecutionTraces(Tcl_Interp *interp,
-				CONST char *command, int numChars,
+				const char *command, int numChars,
 				Command *cmdPtr, int result, int traceFlags,
-				int objc, Tcl_Obj *CONST objv[]);
-#endif
-#ifndef TclInThreadExit_TCL_DECLARED
-#define TclInThreadExit_TCL_DECLARED
+				int objc, Tcl_Obj *const objv[]);
 /* 172 */
 EXTERN int		TclInThreadExit(void);
-#endif
-#ifndef TclUniCharMatch_TCL_DECLARED
-#define TclUniCharMatch_TCL_DECLARED
 /* 173 */
-EXTERN int		TclUniCharMatch(CONST Tcl_UniChar *string,
-				int strLen, CONST Tcl_UniChar *pattern,
+EXTERN int		TclUniCharMatch(const Tcl_UniChar *string,
+				int strLen, const Tcl_UniChar *pattern,
 				int ptnLen, int flags);
-#endif
 /* Slot 174 is reserved */
-#ifndef TclCallVarTraces_TCL_DECLARED
-#define TclCallVarTraces_TCL_DECLARED
 /* 175 */
 EXTERN int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
-				Var *varPtr, CONST char *part1,
-				CONST char *part2, int flags,
+				Var *varPtr, const char *part1,
+				const char *part2, int flags,
 				int leaveErrMsg);
-#endif
-#ifndef TclCleanupVar_TCL_DECLARED
-#define TclCleanupVar_TCL_DECLARED
 /* 176 */
 EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
-#endif
-#ifndef TclVarErrMsg_TCL_DECLARED
-#define TclVarErrMsg_TCL_DECLARED
 /* 177 */
-EXTERN void		TclVarErrMsg(Tcl_Interp *interp, CONST char *part1,
-				CONST char *part2, CONST char *operation,
-				CONST char *reason);
-#endif
-#ifndef Tcl_SetStartupScript_TCL_DECLARED
-#define Tcl_SetStartupScript_TCL_DECLARED
+EXTERN void		TclVarErrMsg(Tcl_Interp *interp, const char *part1,
+				const char *part2, const char *operation,
+				const char *reason);
 /* 178 */
 EXTERN void		Tcl_SetStartupScript(Tcl_Obj *pathPtr,
-				CONST char *encodingName);
-#endif
-#ifndef Tcl_GetStartupScript_TCL_DECLARED
-#define Tcl_GetStartupScript_TCL_DECLARED
+				const char *encodingName);
 /* 179 */
-EXTERN Tcl_Obj *	Tcl_GetStartupScript(CONST char **encodingNamePtr);
-#endif
+EXTERN Tcl_Obj *	Tcl_GetStartupScript(const char **encodingNamePtr);
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
-#ifndef TclpLocaltime_TCL_DECLARED
-#define TclpLocaltime_TCL_DECLARED
 /* 182 */
-EXTERN struct tm *	TclpLocaltime(CONST time_t *clock);
-#endif
-#ifndef TclpGmtime_TCL_DECLARED
-#define TclpGmtime_TCL_DECLARED
+EXTERN struct tm *	TclpLocaltime(const time_t *clock);
 /* 183 */
-EXTERN struct tm *	TclpGmtime(CONST time_t *clock);
-#endif
+EXTERN struct tm *	TclpGmtime(const time_t *clock);
 /* Slot 184 is reserved */
 /* Slot 185 is reserved */
 /* Slot 186 is reserved */
@@ -851,363 +481,294 @@ EXTERN struct tm *	TclpGmtime(CONST time_t *clock);
 /* Slot 195 is reserved */
 /* Slot 196 is reserved */
 /* Slot 197 is reserved */
-#ifndef TclObjGetFrame_TCL_DECLARED
-#define TclObjGetFrame_TCL_DECLARED
 /* 198 */
 EXTERN int		TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
 				CallFrame **framePtrPtr);
-#endif
 /* Slot 199 is reserved */
-#ifndef TclpObjRemoveDirectory_TCL_DECLARED
-#define TclpObjRemoveDirectory_TCL_DECLARED
 /* 200 */
 EXTERN int		TclpObjRemoveDirectory(Tcl_Obj *pathPtr,
 				int recursive, Tcl_Obj **errorPtr);
-#endif
-#ifndef TclpObjCopyDirectory_TCL_DECLARED
-#define TclpObjCopyDirectory_TCL_DECLARED
 /* 201 */
 EXTERN int		TclpObjCopyDirectory(Tcl_Obj *srcPathPtr,
 				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
-#endif
-#ifndef TclpObjCreateDirectory_TCL_DECLARED
-#define TclpObjCreateDirectory_TCL_DECLARED
 /* 202 */
 EXTERN int		TclpObjCreateDirectory(Tcl_Obj *pathPtr);
-#endif
-#ifndef TclpObjDeleteFile_TCL_DECLARED
-#define TclpObjDeleteFile_TCL_DECLARED
 /* 203 */
 EXTERN int		TclpObjDeleteFile(Tcl_Obj *pathPtr);
-#endif
-#ifndef TclpObjCopyFile_TCL_DECLARED
-#define TclpObjCopyFile_TCL_DECLARED
 /* 204 */
 EXTERN int		TclpObjCopyFile(Tcl_Obj *srcPathPtr,
 				Tcl_Obj *destPathPtr);
-#endif
-#ifndef TclpObjRenameFile_TCL_DECLARED
-#define TclpObjRenameFile_TCL_DECLARED
 /* 205 */
 EXTERN int		TclpObjRenameFile(Tcl_Obj *srcPathPtr,
 				Tcl_Obj *destPathPtr);
-#endif
-#ifndef TclpObjStat_TCL_DECLARED
-#define TclpObjStat_TCL_DECLARED
 /* 206 */
 EXTERN int		TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-#endif
-#ifndef TclpObjAccess_TCL_DECLARED
-#define TclpObjAccess_TCL_DECLARED
 /* 207 */
 EXTERN int		TclpObjAccess(Tcl_Obj *pathPtr, int mode);
-#endif
-#ifndef TclpOpenFileChannel_TCL_DECLARED
-#define TclpOpenFileChannel_TCL_DECLARED
 /* 208 */
 EXTERN Tcl_Channel	TclpOpenFileChannel(Tcl_Interp *interp,
 				Tcl_Obj *pathPtr, int mode, int permissions);
-#endif
 /* Slot 209 is reserved */
 /* Slot 210 is reserved */
 /* Slot 211 is reserved */
-#ifndef TclpFindExecutable_TCL_DECLARED
-#define TclpFindExecutable_TCL_DECLARED
 /* 212 */
-EXTERN void		TclpFindExecutable(CONST char *argv0);
-#endif
-#ifndef TclGetObjNameOfExecutable_TCL_DECLARED
-#define TclGetObjNameOfExecutable_TCL_DECLARED
+EXTERN void		TclpFindExecutable(const char *argv0);
 /* 213 */
 EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
-#endif
-#ifndef TclSetObjNameOfExecutable_TCL_DECLARED
-#define TclSetObjNameOfExecutable_TCL_DECLARED
 /* 214 */
 EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
 				Tcl_Encoding encoding);
-#endif
-#ifndef TclStackAlloc_TCL_DECLARED
-#define TclStackAlloc_TCL_DECLARED
 /* 215 */
-EXTERN VOID *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
-#endif
-#ifndef TclStackFree_TCL_DECLARED
-#define TclStackFree_TCL_DECLARED
+EXTERN void *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
 /* 216 */
-EXTERN void		TclStackFree(Tcl_Interp *interp, VOID *freePtr);
-#endif
-#ifndef TclPushStackFrame_TCL_DECLARED
-#define TclPushStackFrame_TCL_DECLARED
+EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
 /* 217 */
 EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
 				Tcl_CallFrame **framePtrPtr,
 				Tcl_Namespace *namespacePtr,
 				int isProcCallFrame);
-#endif
-#ifndef TclPopStackFrame_TCL_DECLARED
-#define TclPopStackFrame_TCL_DECLARED
 /* 218 */
 EXTERN void		TclPopStackFrame(Tcl_Interp *interp);
-#endif
 /* Slot 219 is reserved */
 /* Slot 220 is reserved */
 /* Slot 221 is reserved */
 /* Slot 222 is reserved */
 /* Slot 223 is reserved */
-#ifndef TclGetPlatform_TCL_DECLARED
-#define TclGetPlatform_TCL_DECLARED
 /* 224 */
 EXTERN TclPlatformType * TclGetPlatform(void);
-#endif
-#ifndef TclTraceDictPath_TCL_DECLARED
-#define TclTraceDictPath_TCL_DECLARED
 /* 225 */
 EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
 				Tcl_Obj *rootPtr, int keyc,
-				Tcl_Obj *CONST keyv[], int flags);
-#endif
-#ifndef TclObjBeingDeleted_TCL_DECLARED
-#define TclObjBeingDeleted_TCL_DECLARED
+				Tcl_Obj *const keyv[], int flags);
 /* 226 */
 EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
-#endif
-#ifndef TclSetNsPath_TCL_DECLARED
-#define TclSetNsPath_TCL_DECLARED
 /* 227 */
 EXTERN void		TclSetNsPath(Namespace *nsPtr, int pathLength,
 				Tcl_Namespace *pathAry[]);
-#endif
-#ifndef TclObjInterpProcCore_TCL_DECLARED
-#define TclObjInterpProcCore_TCL_DECLARED
-/* 228 */
-EXTERN int		TclObjInterpProcCore(register Tcl_Interp *interp,
-				Tcl_Obj *procNameObj, int skip,
-				ProcErrorProc errorProc);
-#endif
-#ifndef TclPtrMakeUpvar_TCL_DECLARED
-#define TclPtrMakeUpvar_TCL_DECLARED
+/* Slot 228 is reserved */
 /* 229 */
 EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
-				CONST char *myName, int myFlags, int index);
-#endif
-#ifndef TclObjLookupVar_TCL_DECLARED
-#define TclObjLookupVar_TCL_DECLARED
+				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,
+				Tcl_Obj *part1Ptr, const char *part2,
+				int flags, const char *msg,
+				const int createPart1, const int createPart2,
 				Var **arrayPtrPtr);
-#endif
-#ifndef TclGetNamespaceFromObj_TCL_DECLARED
-#define TclGetNamespaceFromObj_TCL_DECLARED
 /* 231 */
 EXTERN int		TclGetNamespaceFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
-#endif
-#ifndef TclEvalObjEx_TCL_DECLARED
-#define TclEvalObjEx_TCL_DECLARED
 /* 232 */
 EXTERN int		TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags, CONST CmdFrame *invoker, int word);
-#endif
-#ifndef TclGetSrcInfoForPc_TCL_DECLARED
-#define TclGetSrcInfoForPc_TCL_DECLARED
+				int flags, const CmdFrame *invoker, int word);
 /* 233 */
 EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
-#endif
-#ifndef TclVarHashCreateVar_TCL_DECLARED
-#define TclVarHashCreateVar_TCL_DECLARED
 /* 234 */
 EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
-				CONST char *key, int *newPtr);
-#endif
-#ifndef TclInitVarHashTable_TCL_DECLARED
-#define TclInitVarHashTable_TCL_DECLARED
+				const char *key, int *newPtr);
 /* 235 */
 EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
 				Namespace *nsPtr);
-#endif
-#ifndef TclBackgroundException_TCL_DECLARED
-#define TclBackgroundException_TCL_DECLARED
 /* 236 */
 EXTERN void		TclBackgroundException(Tcl_Interp *interp, int code);
-#endif
-/* Slot 237 is reserved */
-/* Slot 238 is reserved */
-/* Slot 239 is reserved */
-/* Slot 240 is reserved */
-/* Slot 241 is reserved */
-/* Slot 242 is reserved */
-#ifndef TclDbDumpActiveObjects_TCL_DECLARED
-#define TclDbDumpActiveObjects_TCL_DECLARED
+/* 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);
-#endif
-/* Slot 244 is reserved */
-/* Slot 245 is reserved */
-/* Slot 246 is reserved */
-/* Slot 247 is reserved */
-/* Slot 248 is reserved */
-#ifndef TclDoubleDigits_TCL_DECLARED
-#define TclDoubleDigits_TCL_DECLARED
+/* 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);
-#endif
+/* 250 */
+EXTERN void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
+				int force);
+/* 251 */
+EXTERN int		TclRegisterLiteral(void *envPtr, char *bytes,
+				int length, int flags);
 
 typedef struct TclIntStubs {
     int magic;
-    struct TclIntStubHooks *hooks;
+    void *hooks;
 
-    VOID *reserved0;
-    VOID *reserved1;
-    VOID *reserved2;
+    void (*reserved0)(void);
+    void (*reserved1)(void);
+    void (*reserved2)(void);
     void (*tclAllocateFreeObjects) (void); /* 3 */
-    VOID *reserved4;
+    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 (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
-    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
-    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
+    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 (*reserved13)(void);
     int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
-    VOID *reserved15;
+    void (*reserved15)(void);
     void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
-    VOID *reserved17;
-    VOID *reserved18;
-    VOID *reserved19;
-    VOID *reserved20;
-    VOID *reserved21;
-    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 */
+    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 *reserved27;
+    void (*reserved26)(void);
+    void (*reserved27)(void);
     Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
-    VOID *reserved29;
-    VOID *reserved30;
-    CONST char * (*tclGetExtension) (CONST char *name); /* 31 */
-    int (*tclGetFrame) (Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr); /* 32 */
-    VOID *reserved33;
+    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;
-    int (*tclGetLong) (Tcl_Interp *interp, CONST char *str, long *longPtr); /* 36 */
-    int (*tclGetLoadedPackages) (Tcl_Interp *interp, char *targetName); /* 37 */
-    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr); /* 38 */
+    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 */
+    int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
     Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
-    char * (*tclpGetUserHome) (CONST char *name, Tcl_DString *bufferPtr); /* 42 */
-    VOID *reserved43;
-    int (*tclGuessPackageName) (CONST char *fileName, Tcl_DString *bufPtr); /* 44 */
+    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 *reserved48;
-    VOID *reserved49;
+    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 (*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 */
+    int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
     Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
-    VOID *reserved56;
-    VOID *reserved57;
-    Var * (*tclLookupVar) (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) (CONST char *start, CONST char *end); /* 60 */
+    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 *reserved66;
-    VOID *reserved67;
-    VOID *reserved68;
+    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 *reserved71;
-    VOID *reserved72;
-    VOID *reserved73;
+    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 */
-    int (*tclpGetTimeZone) (unsigned long time); /* 78 */
-    VOID *reserved79;
-    VOID *reserved80;
+    void (*reserved78)(void);
+    void (*reserved79)(void);
+    void (*reserved80)(void);
     char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
-    VOID *reserved82;
-    VOID *reserved83;
-    VOID *reserved84;
-    VOID *reserved85;
-    VOID *reserved86;
-    VOID *reserved87;
-    char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags); /* 88 */
+    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 (*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 */
+    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */
     void (*tclProcDeleteProc) (ClientData clientData); /* 93 */
-    VOID *reserved94;
-    VOID *reserved95;
-    int (*tclRenameCommand) (Tcl_Interp *interp, CONST char *oldName, CONST char *newName); /* 96 */
+    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 *reserved100;
-    char * (*tclSetPreInitScript) (char *string); /* 101 */
+    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 (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
     int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
-    VOID *reserved105;
-    VOID *reserved106;
-    VOID *reserved107;
+    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 (*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 */
+    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_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_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 */
+    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 */
+    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
     void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
     int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
-    struct tm * (*tclpGetDate) (CONST time_t *time, int useGMT); /* 133 */
-    VOID *reserved134;
-    VOID *reserved135;
-    VOID *reserved136;
-    VOID *reserved137;
-    CONST84_RETURN char * (*tclGetEnv) (CONST char *name, Tcl_DString *valuePtr); /* 138 */
-    VOID *reserved139;
-    VOID *reserved140;
+    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 */
-    struct AuxDataType * (*tclGetAuxDataType) (char *typeName); /* 145 */
-    TclHandle (*tclHandleCreate) (VOID *ptr); /* 146 */
+    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 */
@@ -1215,52 +776,52 @@ typedef struct TclIntStubs {
     void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */
     void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
     Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
-    VOID *reserved154;
-    VOID *reserved155;
-    void (*tclRegError) (Tcl_Interp *interp, CONST char *msg, int status); /* 156 */
-    Var * (*tclVarTraceExists) (Tcl_Interp *interp, CONST char *varName); /* 157 */
-    void (*tclSetStartupScriptFileName) (CONST char *filename); /* 158 */
-    CONST84_RETURN char * (*tclGetStartupScriptFileName) (void); /* 159 */
-    VOID *reserved160;
+    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 (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
+    const char * (*tclGetStartupScriptFileName) (void); /* 159 */
+    void (*reserved160)(void);
     int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
     void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
-    VOID * (*tclGetInstructionTable) (void); /* 163 */
-    void (*tclExpandCodeArray) (VOID *envPtr); /* 164 */
+    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 (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
     Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
-    int (*tclpUtfNcmp2) (CONST char *s1, CONST char *s2, unsigned long n); /* 169 */
-    int (*tclCheckInterpTraces) (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 170 */
-    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 171 */
+    int (*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;
-    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, CONST char *part1, CONST char *part2, int flags, int leaveErrMsg); /* 175 */
+    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 (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, CONST char *encodingName); /* 178 */
-    Tcl_Obj * (*tcl_GetStartupScript) (CONST char **encodingNamePtr); /* 179 */
-    VOID *reserved180;
-    VOID *reserved181;
-    struct tm * (*tclpLocaltime) (CONST time_t *clock); /* 182 */
-    struct tm * (*tclpGmtime) (CONST time_t *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 (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
+    void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
+    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
+    void (*reserved180)(void);
+    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 (*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 */
@@ -1270,56 +831,58 @@ typedef struct TclIntStubs {
     int (*tclpObjStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 206 */
     int (*tclpObjAccess) (Tcl_Obj *pathPtr, int mode); /* 207 */
     Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
-    VOID *reserved209;
-    VOID *reserved210;
-    VOID *reserved211;
-    void (*tclpFindExecutable) (CONST char *argv0); /* 212 */
+    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 */
+    void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
+    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
     int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
     void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
-    VOID *reserved219;
-    VOID *reserved220;
-    VOID *reserved221;
-    VOID *reserved222;
-    VOID *reserved223;
+    void (*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 */
+    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
     int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
     void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
-    int (*tclObjInterpProcCore) (register Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc errorProc); /* 228 */
-    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, CONST char *myName, int myFlags, int index); /* 229 */
-    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr); /* 230 */
+    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 */
+    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 */
+    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
     void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
     void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
-    VOID *reserved237;
-    VOID *reserved238;
-    VOID *reserved239;
-    VOID *reserved240;
-    VOID *reserved241;
-    VOID *reserved242;
+    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 */
-    VOID *reserved244;
-    VOID *reserved245;
-    VOID *reserved246;
-    VOID *reserved247;
-    VOID *reserved248;
+    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 */
+    int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
 } TclIntStubs;
 
-extern TclIntStubs *tclIntStubsPtr;
+extern const TclIntStubs *tclIntStubsPtr;
 
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
 
 /*
  * Inline function declarations:
@@ -1328,556 +891,308 @@ extern TclIntStubs *tclIntStubsPtr;
 /* Slot 0 is reserved */
 /* Slot 1 is reserved */
 /* Slot 2 is reserved */
-#ifndef TclAllocateFreeObjects
 #define TclAllocateFreeObjects \
 	(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
-#endif
 /* Slot 4 is reserved */
-#ifndef TclCleanupChildren
 #define TclCleanupChildren \
 	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
-#endif
-#ifndef TclCleanupCommand
 #define TclCleanupCommand \
 	(tclIntStubsPtr->tclCleanupCommand) /* 6 */
-#endif
-#ifndef TclCopyAndCollapse
 #define TclCopyAndCollapse \
 	(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
-#endif
-#ifndef TclCopyChannel
-#define TclCopyChannel \
-	(tclIntStubsPtr->tclCopyChannel) /* 8 */
-#endif
-#ifndef TclCreatePipeline
+#define TclCopyChannelOld \
+	(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
 #define TclCreatePipeline \
 	(tclIntStubsPtr->tclCreatePipeline) /* 9 */
-#endif
-#ifndef TclCreateProc
 #define TclCreateProc \
 	(tclIntStubsPtr->tclCreateProc) /* 10 */
-#endif
-#ifndef TclDeleteCompiledLocalVars
 #define TclDeleteCompiledLocalVars \
 	(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
-#endif
-#ifndef TclDeleteVars
 #define TclDeleteVars \
 	(tclIntStubsPtr->tclDeleteVars) /* 12 */
-#endif
 /* Slot 13 is reserved */
-#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 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 */
-#endif
 /* Slot 33 is reserved */
-#ifndef TclGetIntForIndex
 #define TclGetIntForIndex \
 	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
-#endif
 /* Slot 35 is reserved */
-#ifndef TclGetLong
-#define TclGetLong \
-	(tclIntStubsPtr->tclGetLong) /* 36 */
-#endif
-#ifndef TclGetLoadedPackages
+/* Slot 36 is reserved */
 #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 */
-#endif
 /* Slot 43 is reserved */
-#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 TclInitCompiledLocals
 #define TclInitCompiledLocals \
 	(tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
-#endif
-#ifndef TclInterpInit
 #define TclInterpInit \
 	(tclIntStubsPtr->tclInterpInit) /* 51 */
-#endif
 /* Slot 52 is reserved */
-#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 */
-#endif
 /* Slot 65 is reserved */
 /* Slot 66 is reserved */
 /* Slot 67 is reserved */
 /* 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 */
-#endif
-#ifndef TclpGetTimeZone
-#define TclpGetTimeZone \
-	(tclIntStubsPtr->tclpGetTimeZone) /* 78 */
-#endif
+/* Slot 78 is reserved */
 /* 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 */
-#endif
 /* Slot 94 is reserved */
 /* 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
-#ifndef TclSockMinimumBuffersOld
 #define TclSockMinimumBuffersOld \
 	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
-#endif
 /* Slot 105 is reserved */
 /* Slot 106 is reserved */
 /* Slot 107 is reserved */
-#ifndef TclTeardownNamespace
 #define TclTeardownNamespace \
 	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
-#endif
-#ifndef TclUpdateReturnInfo
 #define TclUpdateReturnInfo \
 	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
-#endif
-#ifndef TclSockMinimumBuffers
 #define TclSockMinimumBuffers \
 	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
-#endif
-#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 */
-#endif
 /* Slot 134 is reserved */
 /* Slot 135 is reserved */
 /* 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 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 */
-#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 */
-#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 */
-#ifndef TclCallVarTraces
 #define TclCallVarTraces \
 	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
-#endif
-#ifndef TclCleanupVar
 #define TclCleanupVar \
 	(tclIntStubsPtr->tclCleanupVar) /* 176 */
-#endif
-#ifndef TclVarErrMsg
 #define TclVarErrMsg \
 	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
-#endif
-#ifndef Tcl_SetStartupScript
 #define Tcl_SetStartupScript \
 	(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
-#endif
-#ifndef Tcl_GetStartupScript
 #define Tcl_GetStartupScript \
 	(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
-#endif
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
-#ifndef TclpLocaltime
 #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 */
@@ -1892,169 +1207,125 @@ extern TclIntStubs *tclIntStubsPtr;
 /* Slot 195 is reserved */
 /* Slot 196 is reserved */
 /* Slot 197 is reserved */
-#ifndef TclObjGetFrame
 #define TclObjGetFrame \
 	(tclIntStubsPtr->tclObjGetFrame) /* 198 */
-#endif
 /* Slot 199 is reserved */
-#ifndef TclpObjRemoveDirectory
 #define TclpObjRemoveDirectory \
 	(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
-#endif
-#ifndef TclpObjCopyDirectory
 #define TclpObjCopyDirectory \
 	(tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */
-#endif
-#ifndef TclpObjCreateDirectory
 #define TclpObjCreateDirectory \
 	(tclIntStubsPtr->tclpObjCreateDirectory) /* 202 */
-#endif
-#ifndef TclpObjDeleteFile
 #define TclpObjDeleteFile \
 	(tclIntStubsPtr->tclpObjDeleteFile) /* 203 */
-#endif
-#ifndef TclpObjCopyFile
 #define TclpObjCopyFile \
 	(tclIntStubsPtr->tclpObjCopyFile) /* 204 */
-#endif
-#ifndef TclpObjRenameFile
 #define TclpObjRenameFile \
 	(tclIntStubsPtr->tclpObjRenameFile) /* 205 */
-#endif
-#ifndef TclpObjStat
 #define TclpObjStat \
 	(tclIntStubsPtr->tclpObjStat) /* 206 */
-#endif
-#ifndef TclpObjAccess
 #define TclpObjAccess \
 	(tclIntStubsPtr->tclpObjAccess) /* 207 */
-#endif
-#ifndef TclpOpenFileChannel
 #define TclpOpenFileChannel \
 	(tclIntStubsPtr->tclpOpenFileChannel) /* 208 */
-#endif
 /* Slot 209 is reserved */
 /* Slot 210 is reserved */
 /* Slot 211 is reserved */
-#ifndef TclpFindExecutable
 #define TclpFindExecutable \
 	(tclIntStubsPtr->tclpFindExecutable) /* 212 */
-#endif
-#ifndef TclGetObjNameOfExecutable
 #define TclGetObjNameOfExecutable \
 	(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
-#endif
-#ifndef TclSetObjNameOfExecutable
 #define TclSetObjNameOfExecutable \
 	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
-#endif
-#ifndef TclStackAlloc
 #define TclStackAlloc \
 	(tclIntStubsPtr->tclStackAlloc) /* 215 */
-#endif
-#ifndef TclStackFree
 #define TclStackFree \
 	(tclIntStubsPtr->tclStackFree) /* 216 */
-#endif
-#ifndef TclPushStackFrame
 #define TclPushStackFrame \
 	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
-#endif
-#ifndef TclPopStackFrame
 #define TclPopStackFrame \
 	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
-#endif
 /* Slot 219 is reserved */
 /* Slot 220 is reserved */
 /* Slot 221 is reserved */
 /* Slot 222 is reserved */
 /* Slot 223 is reserved */
-#ifndef TclGetPlatform
 #define TclGetPlatform \
 	(tclIntStubsPtr->tclGetPlatform) /* 224 */
-#endif
-#ifndef TclTraceDictPath
 #define TclTraceDictPath \
 	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
-#endif
-#ifndef TclObjBeingDeleted
 #define TclObjBeingDeleted \
 	(tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
-#endif
-#ifndef TclSetNsPath
 #define TclSetNsPath \
 	(tclIntStubsPtr->tclSetNsPath) /* 227 */
-#endif
-#ifndef TclObjInterpProcCore
-#define TclObjInterpProcCore \
-	(tclIntStubsPtr->tclObjInterpProcCore) /* 228 */
-#endif
-#ifndef TclPtrMakeUpvar
+/* Slot 228 is reserved */
 #define TclPtrMakeUpvar \
 	(tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */
-#endif
-#ifndef TclObjLookupVar
 #define TclObjLookupVar \
 	(tclIntStubsPtr->tclObjLookupVar) /* 230 */
-#endif
-#ifndef TclGetNamespaceFromObj
 #define TclGetNamespaceFromObj \
 	(tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
-#endif
-#ifndef TclEvalObjEx
 #define TclEvalObjEx \
 	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
-#endif
-#ifndef TclGetSrcInfoForPc
 #define TclGetSrcInfoForPc \
 	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
-#endif
-#ifndef TclVarHashCreateVar
 #define TclVarHashCreateVar \
 	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
-#endif
-#ifndef TclInitVarHashTable
 #define TclInitVarHashTable \
 	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
-#endif
-#ifndef TclBackgroundException
 #define TclBackgroundException \
 	(tclIntStubsPtr->tclBackgroundException) /* 236 */
-#endif
-/* Slot 237 is reserved */
-/* Slot 238 is reserved */
-/* Slot 239 is reserved */
-/* Slot 240 is reserved */
-/* Slot 241 is reserved */
-/* Slot 242 is reserved */
-#ifndef TclDbDumpActiveObjects
+#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 */
-#endif
-/* Slot 244 is reserved */
-/* Slot 245 is reserved */
-/* Slot 246 is reserved */
-/* Slot 247 is reserved */
-/* Slot 248 is reserved */
-#ifndef TclDoubleDigits
+#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 */
-#endif
+#define TclSetSlaveCancelFlags \
+	(tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclRegisterLiteral \
+	(tclIntStubsPtr->tclRegisterLiteral) /* 251 */
 
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
 
-#if !defined(_WIN64)
-/* See bug 510001: TclSockMinimumBuffers needs plat imp */
-#   undef TclSockMinimumBuffers
-#   define TclSockMinimumBuffers(a,b) TclSockMinimumBuffersOld(PTR2INT(a),b)
-#endif
-
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT
 
+#undef TclGetStartupScriptFileName
+#undef TclSetStartupScriptFileName
+#undef TclGetStartupScriptPath
+#undef TclSetStartupScriptPath
+#undef TclBackgroundException
+
 #if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+#   undef Tcl_SetStartupScript
+#   define Tcl_SetStartupScript \
+	    (tclStubsPtr->tcl_SetStartupScript) /* 622 */
+#   undef Tcl_GetStartupScript
+#   define Tcl_GetStartupScript \
+	    (tclStubsPtr->tcl_GetStartupScript) /* 623 */
 #   undef Tcl_CreateNamespace
 #   define Tcl_CreateNamespace \
 	   (tclStubsPtr->tcl_CreateNamespace) /* 506 */
@@ -2093,4 +1364,7 @@ extern TclIntStubs *tclIntStubsPtr;
 	   (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
 #endif
 
+#undef TclCopyChannelOld
+#undef TclSockMinimumBuffersOld
+
 #endif /* _TCLINTDECLS */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index fc20d09..ac06787 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,7 +13,7 @@
 #ifndef _TCLINTPLATDECLS
 #define _TCLINTPLATDECLS
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   define Tcl_DirEntry void
 #   define DIR void
 #endif
@@ -45,86 +45,44 @@ extern "C" {
  * Exported function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef TclGetAndDetachPids_TCL_DECLARED
-#define TclGetAndDetachPids_TCL_DECLARED
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 0 */
 EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
 				Tcl_Channel chan);
-#endif
-#ifndef TclpCloseFile_TCL_DECLARED
-#define TclpCloseFile_TCL_DECLARED
 /* 1 */
 EXTERN int		TclpCloseFile(TclFile file);
-#endif
-#ifndef TclpCreateCommandChannel_TCL_DECLARED
-#define TclpCreateCommandChannel_TCL_DECLARED
 /* 2 */
 EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
 				TclFile writeFile, TclFile errorFile,
 				int numPids, Tcl_Pid *pidPtr);
-#endif
-#ifndef TclpCreatePipe_TCL_DECLARED
-#define TclpCreatePipe_TCL_DECLARED
 /* 3 */
 EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-#endif
-#ifndef TclpCreateProcess_TCL_DECLARED
-#define TclpCreateProcess_TCL_DECLARED
 /* 4 */
 EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				CONST char **argv, TclFile inputFile,
+				const char **argv, TclFile inputFile,
 				TclFile outputFile, TclFile errorFile,
 				Tcl_Pid *pidPtr);
-#endif
 /* Slot 5 is reserved */
-#ifndef TclpMakeFile_TCL_DECLARED
-#define TclpMakeFile_TCL_DECLARED
 /* 6 */
 EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-#endif
-#ifndef TclpOpenFile_TCL_DECLARED
-#define TclpOpenFile_TCL_DECLARED
 /* 7 */
-EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
-#endif
-#ifndef TclUnixWaitForFile_TCL_DECLARED
-#define TclUnixWaitForFile_TCL_DECLARED
+EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
 /* 8 */
 EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-#endif
-#ifndef TclpCreateTempFile_TCL_DECLARED
-#define TclpCreateTempFile_TCL_DECLARED
 /* 9 */
-EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
-#endif
-#ifndef TclpReaddir_TCL_DECLARED
-#define TclpReaddir_TCL_DECLARED
+EXTERN TclFile		TclpCreateTempFile(const char *contents);
 /* 10 */
 EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
-#endif
-#ifndef TclpLocaltime_unix_TCL_DECLARED
-#define TclpLocaltime_unix_TCL_DECLARED
 /* 11 */
-EXTERN struct tm *	TclpLocaltime_unix(CONST time_t *clock);
-#endif
-#ifndef TclpGmtime_unix_TCL_DECLARED
-#define TclpGmtime_unix_TCL_DECLARED
+EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
 /* 12 */
-EXTERN struct tm *	TclpGmtime_unix(CONST time_t *clock);
-#endif
-#ifndef TclpInetNtoa_TCL_DECLARED
-#define TclpInetNtoa_TCL_DECLARED
+EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
 /* 13 */
 EXTERN char *		TclpInetNtoa(struct in_addr addr);
-#endif
-#ifndef TclUnixCopyFile_TCL_DECLARED
-#define TclUnixCopyFile_TCL_DECLARED
 /* 14 */
-EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
-				CONST Tcl_StatBuf *statBufPtr,
+EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
+				const Tcl_StatBuf *statBufPtr,
 				int dontCopyAtts);
-#endif
 /* Slot 15 is reserved */
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
@@ -139,286 +97,146 @@ EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
 /* Slot 28 is reserved */
-#ifndef TclWinCPUID_TCL_DECLARED
-#define TclWinCPUID_TCL_DECLARED
 /* 29 */
 EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
-#endif
+/* 30 */
+EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
+				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+				Tcl_Obj *resultingNameObj);
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
-#ifndef TclWinConvertError_TCL_DECLARED
-#define TclWinConvertError_TCL_DECLARED
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 /* 0 */
 EXTERN void		TclWinConvertError(DWORD errCode);
-#endif
-#ifndef TclWinConvertWSAError_TCL_DECLARED
-#define TclWinConvertWSAError_TCL_DECLARED
 /* 1 */
 EXTERN void		TclWinConvertWSAError(DWORD errCode);
-#endif
-#ifndef TclWinGetServByName_TCL_DECLARED
-#define TclWinGetServByName_TCL_DECLARED
 /* 2 */
-EXTERN struct servent *	 TclWinGetServByName(CONST char *nm,
-				CONST char *proto);
-#endif
-#ifndef TclWinGetSockOpt_TCL_DECLARED
-#define TclWinGetSockOpt_TCL_DECLARED
+EXTERN struct servent *	 TclWinGetServByName(const char *nm,
+				const char *proto);
 /* 3 */
 EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
 				char *optval, int *optlen);
-#endif
-#ifndef TclWinGetTclInstance_TCL_DECLARED
-#define TclWinGetTclInstance_TCL_DECLARED
 /* 4 */
 EXTERN HINSTANCE	TclWinGetTclInstance(void);
-#endif
-#ifndef TclUnixWaitForFile_TCL_DECLARED
-#define TclUnixWaitForFile_TCL_DECLARED
 /* 5 */
 EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-#endif
-#ifndef TclWinNToHS_TCL_DECLARED
-#define TclWinNToHS_TCL_DECLARED
 /* 6 */
 EXTERN unsigned short	TclWinNToHS(unsigned short ns);
-#endif
-#ifndef TclWinSetSockOpt_TCL_DECLARED
-#define TclWinSetSockOpt_TCL_DECLARED
 /* 7 */
 EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
-				CONST char *optval, int optlen);
-#endif
-#ifndef TclpGetPid_TCL_DECLARED
-#define TclpGetPid_TCL_DECLARED
+				const char *optval, int optlen);
 /* 8 */
 EXTERN int		TclpGetPid(Tcl_Pid pid);
-#endif
-#ifndef TclWinGetPlatformId_TCL_DECLARED
-#define TclWinGetPlatformId_TCL_DECLARED
 /* 9 */
 EXTERN int		TclWinGetPlatformId(void);
-#endif
-#ifndef TclpReaddir_TCL_DECLARED
-#define TclpReaddir_TCL_DECLARED
 /* 10 */
 EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
-#endif
-#ifndef TclGetAndDetachPids_TCL_DECLARED
-#define TclGetAndDetachPids_TCL_DECLARED
 /* 11 */
 EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
 				Tcl_Channel chan);
-#endif
-#ifndef TclpCloseFile_TCL_DECLARED
-#define TclpCloseFile_TCL_DECLARED
 /* 12 */
 EXTERN int		TclpCloseFile(TclFile file);
-#endif
-#ifndef TclpCreateCommandChannel_TCL_DECLARED
-#define TclpCreateCommandChannel_TCL_DECLARED
 /* 13 */
 EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
 				TclFile writeFile, TclFile errorFile,
 				int numPids, Tcl_Pid *pidPtr);
-#endif
-#ifndef TclpCreatePipe_TCL_DECLARED
-#define TclpCreatePipe_TCL_DECLARED
 /* 14 */
 EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-#endif
-#ifndef TclpCreateProcess_TCL_DECLARED
-#define TclpCreateProcess_TCL_DECLARED
 /* 15 */
 EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				CONST char **argv, TclFile inputFile,
+				const char **argv, TclFile inputFile,
 				TclFile outputFile, TclFile errorFile,
 				Tcl_Pid *pidPtr);
-#endif
-#ifndef TclpIsAtty_TCL_DECLARED
-#define TclpIsAtty_TCL_DECLARED
 /* 16 */
 EXTERN int		TclpIsAtty(int fd);
-#endif
-#ifndef TclUnixCopyFile_TCL_DECLARED
-#define TclUnixCopyFile_TCL_DECLARED
 /* 17 */
-EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
-				CONST Tcl_StatBuf *statBufPtr,
+EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
+				const Tcl_StatBuf *statBufPtr,
 				int dontCopyAtts);
-#endif
-#ifndef TclpMakeFile_TCL_DECLARED
-#define TclpMakeFile_TCL_DECLARED
 /* 18 */
 EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-#endif
-#ifndef TclpOpenFile_TCL_DECLARED
-#define TclpOpenFile_TCL_DECLARED
 /* 19 */
-EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
-#endif
-#ifndef TclWinAddProcess_TCL_DECLARED
-#define TclWinAddProcess_TCL_DECLARED
+EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
 /* 20 */
 EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
-#endif
-#ifndef TclpInetNtoa_TCL_DECLARED
-#define TclpInetNtoa_TCL_DECLARED
 /* 21 */
 EXTERN char *		TclpInetNtoa(struct in_addr addr);
-#endif
-#ifndef TclpCreateTempFile_TCL_DECLARED
-#define TclpCreateTempFile_TCL_DECLARED
 /* 22 */
-EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
-#endif
-#ifndef TclpGetTZName_TCL_DECLARED
-#define TclpGetTZName_TCL_DECLARED
-/* 23 */
-EXTERN char *		TclpGetTZName(int isdst);
-#endif
-#ifndef TclWinNoBackslash_TCL_DECLARED
-#define TclWinNoBackslash_TCL_DECLARED
+EXTERN TclFile		TclpCreateTempFile(const char *contents);
+/* Slot 23 is reserved */
 /* 24 */
 EXTERN char *		TclWinNoBackslash(char *path);
-#endif
 /* Slot 25 is reserved */
-#ifndef TclWinSetInterfaces_TCL_DECLARED
-#define TclWinSetInterfaces_TCL_DECLARED
 /* 26 */
 EXTERN void		TclWinSetInterfaces(int wide);
-#endif
-#ifndef TclWinFlushDirtyChannels_TCL_DECLARED
-#define TclWinFlushDirtyChannels_TCL_DECLARED
 /* 27 */
 EXTERN void		TclWinFlushDirtyChannels(void);
-#endif
-#ifndef TclWinResetInterfaces_TCL_DECLARED
-#define TclWinResetInterfaces_TCL_DECLARED
 /* 28 */
 EXTERN void		TclWinResetInterfaces(void);
-#endif
-#ifndef TclWinCPUID_TCL_DECLARED
-#define TclWinCPUID_TCL_DECLARED
 /* 29 */
 EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
-#endif
+/* 30 */
+EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
+				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+				Tcl_Obj *resultingNameObj);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef TclGetAndDetachPids_TCL_DECLARED
-#define TclGetAndDetachPids_TCL_DECLARED
 /* 0 */
 EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
 				Tcl_Channel chan);
-#endif
-#ifndef TclpCloseFile_TCL_DECLARED
-#define TclpCloseFile_TCL_DECLARED
 /* 1 */
 EXTERN int		TclpCloseFile(TclFile file);
-#endif
-#ifndef TclpCreateCommandChannel_TCL_DECLARED
-#define TclpCreateCommandChannel_TCL_DECLARED
 /* 2 */
 EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
 				TclFile writeFile, TclFile errorFile,
 				int numPids, Tcl_Pid *pidPtr);
-#endif
-#ifndef TclpCreatePipe_TCL_DECLARED
-#define TclpCreatePipe_TCL_DECLARED
 /* 3 */
 EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-#endif
-#ifndef TclpCreateProcess_TCL_DECLARED
-#define TclpCreateProcess_TCL_DECLARED
 /* 4 */
 EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				CONST char **argv, TclFile inputFile,
+				const char **argv, TclFile inputFile,
 				TclFile outputFile, TclFile errorFile,
 				Tcl_Pid *pidPtr);
-#endif
 /* Slot 5 is reserved */
-#ifndef TclpMakeFile_TCL_DECLARED
-#define TclpMakeFile_TCL_DECLARED
 /* 6 */
 EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-#endif
-#ifndef TclpOpenFile_TCL_DECLARED
-#define TclpOpenFile_TCL_DECLARED
 /* 7 */
-EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
-#endif
-#ifndef TclUnixWaitForFile_TCL_DECLARED
-#define TclUnixWaitForFile_TCL_DECLARED
+EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
 /* 8 */
 EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-#endif
-#ifndef TclpCreateTempFile_TCL_DECLARED
-#define TclpCreateTempFile_TCL_DECLARED
 /* 9 */
-EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
-#endif
-#ifndef TclpReaddir_TCL_DECLARED
-#define TclpReaddir_TCL_DECLARED
+EXTERN TclFile		TclpCreateTempFile(const char *contents);
 /* 10 */
 EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
-#endif
-#ifndef TclpLocaltime_unix_TCL_DECLARED
-#define TclpLocaltime_unix_TCL_DECLARED
 /* 11 */
-EXTERN struct tm *	TclpLocaltime_unix(CONST time_t *clock);
-#endif
-#ifndef TclpGmtime_unix_TCL_DECLARED
-#define TclpGmtime_unix_TCL_DECLARED
+EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
 /* 12 */
-EXTERN struct tm *	TclpGmtime_unix(CONST time_t *clock);
-#endif
-#ifndef TclpInetNtoa_TCL_DECLARED
-#define TclpInetNtoa_TCL_DECLARED
+EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
 /* 13 */
 EXTERN char *		TclpInetNtoa(struct in_addr addr);
-#endif
-#ifndef TclUnixCopyFile_TCL_DECLARED
-#define TclUnixCopyFile_TCL_DECLARED
 /* 14 */
-EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
-				CONST Tcl_StatBuf *statBufPtr,
+EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
+				const Tcl_StatBuf *statBufPtr,
 				int dontCopyAtts);
-#endif
-#ifndef TclMacOSXGetFileAttribute_TCL_DECLARED
-#define TclMacOSXGetFileAttribute_TCL_DECLARED
 /* 15 */
 EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
 				int objIndex, Tcl_Obj *fileName,
 				Tcl_Obj **attributePtrPtr);
-#endif
-#ifndef TclMacOSXSetFileAttribute_TCL_DECLARED
-#define TclMacOSXSetFileAttribute_TCL_DECLARED
 /* 16 */
 EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
 				int objIndex, Tcl_Obj *fileName,
 				Tcl_Obj *attributePtr);
-#endif
-#ifndef TclMacOSXCopyFileAttributes_TCL_DECLARED
-#define TclMacOSXCopyFileAttributes_TCL_DECLARED
 /* 17 */
-EXTERN int		TclMacOSXCopyFileAttributes(CONST char *src,
-				CONST char *dst,
-				CONST Tcl_StatBuf *statBufPtr);
-#endif
-#ifndef TclMacOSXMatchType_TCL_DECLARED
-#define TclMacOSXMatchType_TCL_DECLARED
+EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
+				const char *dst,
+				const Tcl_StatBuf *statBufPtr);
 /* 18 */
 EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
-				CONST char *pathName, CONST char *fileName,
+				const char *pathName, const char *fileName,
 				Tcl_StatBuf *statBufPtr,
 				Tcl_GlobTypeData *types);
-#endif
-#ifndef TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
-#define TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
 /* 19 */
 EXTERN void		TclMacOSXNotifierAddRunLoopMode(
-				CONST VOID *runLoopMode);
-#endif
+				const void *runLoopMode);
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
 /* Slot 22 is reserved */
@@ -428,58 +246,60 @@ EXTERN void		TclMacOSXNotifierAddRunLoopMode(
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
 /* Slot 28 is reserved */
-#ifndef TclWinCPUID_TCL_DECLARED
-#define TclWinCPUID_TCL_DECLARED
 /* 29 */
 EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
-#endif
+/* 30 */
+EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
+				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
+				Tcl_Obj *resultingNameObj);
 #endif /* MACOSX */
 
 typedef struct TclIntPlatStubs {
     int magic;
-    struct TclIntPlatStubHooks *hooks;
+    void *hooks;
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
     int (*tclpCloseFile) (TclFile file); /* 1 */
     Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
     int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
-    VOID *reserved5;
+    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
+    void (*reserved5)(void);
     TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
-    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
+    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
     int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
-    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
+    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
     Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
-    struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */
-    struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */
+    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
+    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
     char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
-    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
-    VOID *reserved15;
-    VOID *reserved16;
-    VOID *reserved17;
-    VOID *reserved18;
-    VOID *reserved19;
-    VOID *reserved20;
-    VOID *reserved21;
-    VOID *reserved22;
-    VOID *reserved23;
-    VOID *reserved24;
-    VOID *reserved25;
-    VOID *reserved26;
-    VOID *reserved27;
-    VOID *reserved28;
+    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
+    void (*reserved15)(void);
+    void (*reserved16)(void);
+    void (*reserved17)(void);
+    void (*reserved18)(void);
+    void (*reserved19)(void);
+    void (*reserved20)(void);
+    void (*reserved21)(void);
+    void (*reserved22)(void);
+    void (*reserved23)(void);
+    void (*reserved24)(void);
+    void (*reserved25)(void);
+    void (*reserved26)(void);
+    void (*reserved27)(void);
+    void (*reserved28)(void);
     int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     void (*tclWinConvertError) (DWORD errCode); /* 0 */
     void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
-    struct servent * (*tclWinGetServByName) (CONST char *nm, CONST char *proto); /* 2 */
+    struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
     int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
     HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
     int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
     unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
-    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, CONST char *optval, int optlen); /* 7 */
+    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
     int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
     int (*tclWinGetPlatformId) (void); /* 9 */
     Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
@@ -487,126 +307,100 @@ typedef struct TclIntPlatStubs {
     int (*tclpCloseFile) (TclFile file); /* 12 */
     Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
     int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
+    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
     int (*tclpIsAtty) (int fd); /* 16 */
-    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
+    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
     TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
-    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */
+    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
     void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
     char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
-    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */
-    char * (*tclpGetTZName) (int isdst); /* 23 */
+    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
+    void (*reserved23)(void);
     char * (*tclWinNoBackslash) (char *path); /* 24 */
-    VOID *reserved25;
+    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 */
+    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
     int (*tclpCloseFile) (TclFile file); /* 1 */
     Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
     int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
-    VOID *reserved5;
+    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
+    void (*reserved5)(void);
     TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
-    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
+    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
     int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
-    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
+    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
     Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
-    struct tm * (*tclpLocaltime_unix) (CONST time_t *clock); /* 11 */
-    struct tm * (*tclpGmtime_unix) (CONST time_t *clock); /* 12 */
+    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
+    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
     char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
-    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
+    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
     int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
     int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
-    int (*tclMacOSXCopyFileAttributes) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr); /* 17 */
-    int (*tclMacOSXMatchType) (Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
-    void (*tclMacOSXNotifierAddRunLoopMode) (CONST VOID *runLoopMode); /* 19 */
-    VOID *reserved20;
-    VOID *reserved21;
-    VOID *reserved22;
-    VOID *reserved23;
-    VOID *reserved24;
-    VOID *reserved25;
-    VOID *reserved26;
-    VOID *reserved27;
-    VOID *reserved28;
+    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
+    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
+    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
+    void (*reserved20)(void);
+    void (*reserved21)(void);
+    void (*reserved22)(void);
+    void (*reserved23)(void);
+    void (*reserved24)(void);
+    void (*reserved25)(void);
+    void (*reserved26)(void);
+    void (*reserved27)(void);
+    void (*reserved28)(void);
     int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
 #endif /* MACOSX */
 } TclIntPlatStubs;
 
-extern TclIntPlatStubs *tclIntPlatStubsPtr;
+extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
 
 /*
  * Inline function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef TclGetAndDetachPids
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
 #define TclGetAndDetachPids \
 	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
-#endif
-#ifndef TclpCloseFile
 #define TclpCloseFile \
 	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
-#endif
-#ifndef TclpCreateCommandChannel
 #define TclpCreateCommandChannel \
 	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
-#endif
-#ifndef TclpCreatePipe
 #define TclpCreatePipe \
 	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
-#endif
-#ifndef TclpCreateProcess
 #define TclpCreateProcess \
 	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
-#endif
 /* Slot 5 is reserved */
-#ifndef TclpMakeFile
 #define TclpMakeFile \
 	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
-#endif
-#ifndef TclpOpenFile
 #define TclpOpenFile \
 	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
-#endif
-#ifndef TclUnixWaitForFile
 #define TclUnixWaitForFile \
 	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
-#endif
-#ifndef TclpCreateTempFile
 #define TclpCreateTempFile \
 	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 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 TclpInetNtoa
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
-#endif
-#ifndef TclUnixCopyFile
 #define TclUnixCopyFile \
 	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
-#endif
 /* Slot 15 is reserved */
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
@@ -621,208 +415,113 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
 /* Slot 28 is reserved */
-#ifndef TclWinCPUID
 #define TclWinCPUID \
 	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#endif
+#define TclUnixOpenTemporaryFile \
+	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
-#ifndef TclWinConvertError
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 #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
-#ifndef TclUnixWaitForFile
 #define TclUnixWaitForFile \
 	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
-#endif
-#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 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
-#ifndef TclpIsAtty
 #define TclpIsAtty \
 	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
-#endif
-#ifndef TclUnixCopyFile
 #define TclUnixCopyFile \
 	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
-#endif
-#ifndef TclpMakeFile
 #define TclpMakeFile \
 	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
-#endif
-#ifndef TclpOpenFile
 #define TclpOpenFile \
 	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
-#endif
-#ifndef TclWinAddProcess
 #define TclWinAddProcess \
 	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
-#endif
-#ifndef TclpInetNtoa
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
-#endif
-#ifndef TclpCreateTempFile
 #define TclpCreateTempFile \
 	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
-#endif
-#ifndef TclpGetTZName
-#define TclpGetTZName \
-	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
-#endif
-#ifndef TclWinNoBackslash
+/* Slot 23 is reserved */
 #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
+#define TclUnixOpenTemporaryFile \
+	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef TclGetAndDetachPids
 #define TclGetAndDetachPids \
 	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
-#endif
-#ifndef TclpCloseFile
 #define TclpCloseFile \
 	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
-#endif
-#ifndef TclpCreateCommandChannel
 #define TclpCreateCommandChannel \
 	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
-#endif
-#ifndef TclpCreatePipe
 #define TclpCreatePipe \
 	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
-#endif
-#ifndef TclpCreateProcess
 #define TclpCreateProcess \
 	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
-#endif
 /* Slot 5 is reserved */
-#ifndef TclpMakeFile
 #define TclpMakeFile \
 	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
-#endif
-#ifndef TclpOpenFile
 #define TclpOpenFile \
 	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
-#endif
-#ifndef TclUnixWaitForFile
 #define TclUnixWaitForFile \
 	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
-#endif
-#ifndef TclpCreateTempFile
 #define TclpCreateTempFile \
 	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 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 TclpInetNtoa
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
-#endif
-#ifndef TclUnixCopyFile
 #define TclUnixCopyFile \
 	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
-#endif
-#ifndef TclMacOSXGetFileAttribute
 #define TclMacOSXGetFileAttribute \
 	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
-#endif
-#ifndef TclMacOSXSetFileAttribute
 #define TclMacOSXSetFileAttribute \
 	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
-#endif
-#ifndef TclMacOSXCopyFileAttributes
 #define TclMacOSXCopyFileAttributes \
 	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
-#endif
-#ifndef TclMacOSXMatchType
 #define TclMacOSXMatchType \
 	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
-#endif
-#ifndef TclMacOSXNotifierAddRunLoopMode
 #define TclMacOSXNotifierAddRunLoopMode \
 	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
-#endif
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
 /* Slot 22 is reserved */
@@ -832,13 +531,13 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 /* Slot 26 is reserved */
 /* Slot 27 is reserved */
 /* Slot 28 is reserved */
-#ifndef TclWinCPUID
 #define TclWinCPUID \
 	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#endif
+#define TclUnixOpenTemporaryFile \
+	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
 #endif /* MACOSX */
 
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
 
@@ -846,8 +545,12 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TCL_STORAGE_CLASS DLLIMPORT
 #undef TclpLocaltime_unix
 #undef TclpGmtime_unix
+#undef TclWinConvertWSAError
+#define TclWinConvertWSAError TclWinConvertError
+#undef TclpInetNtoa
+#define TclpInetNtoa inet_ntoa
 
-#if defined(__WIN32__)
+#if defined(_WIN32)
 #   undef TclWinNToHS
 #   undef TclWinGetServByName
 #   undef TclWinGetSockOpt
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index dbbf10a..8a0d653 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -19,7 +19,7 @@
  * above. This variable can be modified by the function below.
  */
 
-static char *tclPreInitScript = NULL;
+static const char *tclPreInitScript = NULL;
 
 /* Forward declaration */
 struct Target;
@@ -225,6 +225,9 @@ 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_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,
@@ -276,6 +279,12 @@ static void		DeleteScriptLimitCallback(ClientData clientData);
 static void		RunLimitHandlers(LimitHandler *handlerPtr,
 			    Tcl_Interp *interp);
 static void		TimeLimitCallback(ClientData clientData);
+
+/* NRE enabling */
+static Tcl_NRPostProc	NRPostInvokeHidden;
+static Tcl_ObjCmdProc	NRInterpCmd;
+static Tcl_ObjCmdProc	NRSlaveCmd;
+
 
 /*
  *----------------------------------------------------------------------
@@ -294,11 +303,11 @@ static void		TimeLimitCallback(ClientData clientData);
  *----------------------------------------------------------------------
  */
 
-char *
+const char *
 TclSetPreInitScript(
-    char *string)		/* Pointer to a script. */
+    const char *string)		/* Pointer to a script. */
 {
-    char *prevString = tclPreInitScript;
+    const char *prevString = tclPreInitScript;
     tclPreInitScript = string;
     return(prevString);
 }
@@ -328,8 +337,8 @@ Tcl_Init(
 {
     if (tclPreInitScript != NULL) {
 	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
-	    return (TCL_ERROR);
-	};
+	    return TCL_ERROR;
+	}
     }
 
     /*
@@ -464,7 +473,7 @@ TclInterpInit(
     Master *masterPtr;
     Slave *slavePtr;
 
-    interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
+    interpInfoPtr = ckalloc(sizeof(InterpInfo));
     ((Interp *) interp)->interpInfo = interpInfoPtr;
 
     masterPtr = &interpInfoPtr->master;
@@ -478,7 +487,8 @@ TclInterpInit(
     slavePtr->interpCmd		= NULL;
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
 
-    Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
+    Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
+	    NULL, NULL);
 
     Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
     return TCL_OK;
@@ -560,7 +570,7 @@ InterpInfoDeleteProc(
     }
     Tcl_DeleteHashTable(&slavePtr->aliasTable);
 
-    ckfree((char *) interpInfoPtr);
+    ckfree(interpInfoPtr);
 }
 
 /*
@@ -587,21 +597,34 @@ Tcl_InterpObjCmd(
     int objc,				/* Number of arguments. */
     Tcl_Obj *const objv[])		/* Argument objects. */
 {
+    return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
+}
+
+static int
+NRInterpCmd(
+    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 *options[] = {
-	"alias",	"aliases",	"bgerror",	"create",
-	"debug",	"delete",	"eval",		"exists",	"expose",
-	"hide",		"hidden",	"issafe",	"invokehidden",
-	"limit",	"marktrusted",	"recursionlimit","slaves",
-	"share",	"target",	"transfer",
+    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
     };
     enum option {
-	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CREATE,
-	OPT_DEBUG,	OPT_DELETE,	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,
-	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
-	OPT_LIMIT,	OPT_MARKTRUSTED,OPT_RECLIMIT,	OPT_SLAVES,
-	OPT_SHARE,	OPT_TARGET,	OPT_TRANSFER
+	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
     };
 
     if (objc < 2) {
@@ -614,12 +637,12 @@ Tcl_InterpObjCmd(
     }
     switch ((enum option) index) {
     case OPT_ALIAS: {
-	Tcl_Interp *slaveInterp, *masterInterp;
+	Tcl_Interp *masterInterp;
 
 	if (objc < 4) {
 	aliasArgs:
 	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
+		    "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?");
 	    return TCL_ERROR;
 	}
 	slaveInterp = GetInterp(interp, objv[2]);
@@ -637,29 +660,19 @@ Tcl_InterpObjCmd(
 	    if (masterInterp == NULL) {
 		return TCL_ERROR;
 	    }
-	    if (TclGetString(objv[5])[0] == '\0') {
-		if (objc == 6) {
-		    return AliasDelete(interp, slaveInterp, objv[3]);
-		}
-	    } else {
-		return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
-			objv[5], objc - 6, objv + 6);
-	    }
+
+	    return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
+		    objv[5], objc - 6, objv + 6);
 	}
 	goto aliasArgs;
     }
-    case OPT_ALIASES: {
-	Tcl_Interp *slaveInterp;
-
+    case OPT_ALIASES:
 	slaveInterp = GetInterp2(interp, objc, objv);
 	if (slaveInterp == NULL) {
 	    return TCL_ERROR;
 	}
 	return AliasList(interp, slaveInterp);
-    }
-    case OPT_BGERROR: {
-	Tcl_Interp *slaveInterp;
-
+    case OPT_BGERROR:
 	if (objc != 3 && objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?");
 	    return TCL_ERROR;
@@ -669,12 +682,83 @@ Tcl_InterpObjCmd(
 	    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) {
+		return TCL_ERROR;
+	    }
+
+	    switch ((enum option) index) {
+	    case OPT_UNWIND:
+		/*
+		 * The evaluation stack in the target interp is to be unwound.
+		 */
+
+		flags |= TCL_CANCEL_UNWIND;
+		break;
+	    case OPT_LAST:
+		i++;
+		goto endOfForLoop;
+	    }
+	}
+
+    endOfForLoop:
+	if (i < objc - 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "?-unwind? ?--? ?path? ?result?");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * 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 (slaveInterp == NULL) {
+		return TCL_ERROR;
+	    }
+	    i++;
+	} else {
+	    slaveInterp = interp;
+	}
+
+	if (i < objc) {
+	    resultObjPtr = objv[i];
+
+	    /*
+	     * Tcl_CancelEval removes this reference.
+	     */
+
+	    Tcl_IncrRefCount(resultObjPtr);
+	    i++;
+	} else {
+	    resultObjPtr = NULL;
+	}
+
+	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 *options[] = {
+	static const char *const createOptions[] = {
 	    "-safe",	"--", NULL
 	};
 	enum option {
@@ -691,8 +775,8 @@ Tcl_InterpObjCmd(
 	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) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
+			"option", 0, &index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
 		if (index == OPT_SAFE) {
@@ -738,13 +822,11 @@ Tcl_InterpObjCmd(
 	Tcl_SetObjResult(interp, slavePtr);
 	return TCL_OK;
     }
-    case OPT_DEBUG: {
-	/* TIP #378 */
-	Tcl_Interp *slaveInterp;
-
+    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;
@@ -754,11 +836,9 @@ Tcl_InterpObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
-    }
     case OPT_DELETE: {
 	int i;
 	InterpInfo *iiPtr;
-	Tcl_Interp *slaveInterp;
 
 	for (i = 2; i < objc; i++) {
 	    slaveInterp = GetInterp(interp, objv[i]);
@@ -767,6 +847,8 @@ Tcl_InterpObjCmd(
 	    } else if (slaveInterp == interp) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"cannot delete the current interpreter", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			"DELETESELF", NULL);
 		return TCL_ERROR;
 	    }
 	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
@@ -775,9 +857,7 @@ Tcl_InterpObjCmd(
 	}
 	return TCL_OK;
     }
-    case OPT_EVAL: {
-	Tcl_Interp *slaveInterp;
-
+    case OPT_EVAL:
 	if (objc < 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
 	    return TCL_ERROR;
@@ -787,12 +867,9 @@ Tcl_InterpObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
-    }
     case OPT_EXISTS: {
-	int exists;
-	Tcl_Interp *slaveInterp;
+	int exists = 1;
 
-	exists = 1;
 	slaveInterp = GetInterp2(interp, objc, objv);
 	if (slaveInterp == NULL) {
 	    if (objc > 3) {
@@ -804,9 +881,7 @@ Tcl_InterpObjCmd(
 	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
 	return TCL_OK;
     }
-    case OPT_EXPOSE: {
-	Tcl_Interp *slaveInterp;
-
+    case OPT_EXPOSE:
 	if ((objc < 4) || (objc > 5)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?");
 	    return TCL_ERROR;
@@ -816,10 +891,7 @@ Tcl_InterpObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
-    }
-    case OPT_HIDE: {
-	Tcl_Interp *slaveInterp;		/* A slave. */
-
+    case OPT_HIDE:
 	if ((objc < 4) || (objc > 5)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?");
 	    return TCL_ERROR;
@@ -829,31 +901,23 @@ Tcl_InterpObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
-    }
-    case OPT_HIDDEN: {
-	Tcl_Interp *slaveInterp;		/* A slave. */
-
+    case OPT_HIDDEN:
 	slaveInterp = GetInterp2(interp, objc, objv);
 	if (slaveInterp == NULL) {
 	    return TCL_ERROR;
 	}
 	return SlaveHidden(interp, slaveInterp);
-    }
-    case OPT_ISSAFE: {
-	Tcl_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, index;
+	int i;
 	const char *namespaceName;
-	Tcl_Interp *slaveInterp;
-	static const char *hiddenOptions[] = {
+	static const char *const hiddenOptions[] = {
 	    "-global",	"-namespace",	"--", NULL
 	};
 	enum hiddenOption {
@@ -895,8 +959,7 @@ Tcl_InterpObjCmd(
 		objv + i);
     }
     case OPT_LIMIT: {
-	Tcl_Interp *slaveInterp;
-	static const char *limitTypes[] = {
+	static const char *const limitTypes[] = {
 	    "commands", "time", NULL
 	};
 	enum LimitTypes {
@@ -905,7 +968,8 @@ Tcl_InterpObjCmd(
 	int limitType;
 
 	if (objc < 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?");
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "path limitType ?-option value ...?");
 	    return TCL_ERROR;
 	}
 	slaveInterp = GetInterp(interp, objv[2]);
@@ -923,9 +987,7 @@ Tcl_InterpObjCmd(
 	    return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
 	}
     }
-    case OPT_MARKTRUSTED: {
-	Tcl_Interp *slaveInterp;
-
+    case OPT_MARKTRUSTED:
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path");
 	    return TCL_ERROR;
@@ -935,10 +997,7 @@ Tcl_InterpObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveMarkTrusted(interp, slaveInterp);
-    }
-    case OPT_RECLIMIT: {
-	Tcl_Interp *slaveInterp;
-
+    case OPT_RECLIMIT:
 	if (objc != 3 && objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
 	    return TCL_ERROR;
@@ -948,9 +1007,7 @@ Tcl_InterpObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
-    }
     case OPT_SLAVES: {
-	Tcl_Interp *slaveInterp;
 	InterpInfo *iiPtr;
 	Tcl_Obj *resultPtr;
 	Tcl_HashEntry *hPtr;
@@ -974,8 +1031,7 @@ Tcl_InterpObjCmd(
     }
     case OPT_TRANSFER:
     case OPT_SHARE: {
-	Tcl_Interp *slaveInterp;		/* A slave. */
-	Tcl_Interp *masterInterp;		/* Its master. */
+	Tcl_Interp *masterInterp;	/* The master of the slave. */
 	Tcl_Channel chan;
 
 	if (objc != 5) {
@@ -988,7 +1044,7 @@ Tcl_InterpObjCmd(
 	}
 	chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
 	if (chan == NULL) {
-	    TclTransferResult(masterInterp, TCL_OK, interp);
+	    Tcl_TransferResult(masterInterp, TCL_OK, interp);
 	    return TCL_ERROR;
 	}
 	slaveInterp = GetInterp(interp, objv[4]);
@@ -1003,18 +1059,17 @@ Tcl_InterpObjCmd(
 	     */
 
 	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
-		TclTransferResult(masterInterp, TCL_OK, interp);
+		Tcl_TransferResult(masterInterp, TCL_OK, interp);
 		return TCL_ERROR;
 	    }
 	}
 	return TCL_OK;
     }
     case OPT_TARGET: {
-	Tcl_Interp *slaveInterp;
 	InterpInfo *iiPtr;
 	Tcl_HashEntry *hPtr;
 	Alias *aliasPtr;
-	char *aliasName;
+	const char *aliasName;
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "path alias");
@@ -1031,18 +1086,20 @@ Tcl_InterpObjCmd(
 	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "alias \"%s\" in path \"%s\" not found",
+		    aliasName, Tcl_GetString(objv[2])));
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
 		    NULL);
 	    return TCL_ERROR;
 	}
 	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "target interpreter for alias \"%s\" in path \"%s\" is "
+		    "not my descendant", aliasName, Tcl_GetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+		    "TARGETSHROUDED", NULL);
 	    return TCL_ERROR;
 	}
 	return TCL_OK;
@@ -1119,8 +1176,7 @@ Tcl_CreateAlias(
     int i;
     int result;
 
-    objv = (Tcl_Obj **)
-	    TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
+    objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
     for (i = 0; i < argc; i++) {
 	objv[i] = Tcl_NewStringObj(argv[i], -1);
 	Tcl_IncrRefCount(objv[i]);
@@ -1221,7 +1277,8 @@ Tcl_GetAlias(
 
     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"alias \"%s\" not found", aliasName));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
 	return TCL_ERROR;
     }
@@ -1240,7 +1297,7 @@ Tcl_GetAlias(
     }
     if (argvPtr != NULL) {
 	*argvPtr = (const char **)
-		ckalloc((unsigned) sizeof(const char *) * (objc - 1));
+		ckalloc(sizeof(const char *) * (objc - 1));
 	for (i = 1; i < objc; i++) {
 	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
 	}
@@ -1282,7 +1339,8 @@ Tcl_GetAliasObj(
 
     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"alias \"%s\" not found", aliasName));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
 	return TCL_ERROR;
     }
@@ -1354,7 +1412,7 @@ TclPreventAliasLoop(
      * chain then we have a loop.
      */
 
-    aliasPtr = (Alias *) cmdPtr->objClientData;
+    aliasPtr = cmdPtr->objClientData;
     nextAliasPtr = aliasPtr;
     while (1) {
 	Tcl_Obj *cmdNamePtr;
@@ -1370,9 +1428,9 @@ TclPreventAliasLoop(
 	     * [Bug #641195]
 	     */
 
-	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
-		    Tcl_GetCommandName(cmdInterp, cmd),
-		    "\": interpreter deleted", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "cannot define or rename alias \"%s\": interpreter deleted",
+		    Tcl_GetCommandName(cmdInterp, cmd)));
 	    return TCL_ERROR;
 	}
 	cmdNamePtr = nextAliasPtr->objPtr;
@@ -1385,9 +1443,11 @@ TclPreventAliasLoop(
 	}
 	aliasCmdPtr = (Command *) aliasCmd;
 	if (aliasCmdPtr == cmdPtr) {
-	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
-		    Tcl_GetCommandName(cmdInterp, cmd),
-		    "\": would create a loop", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "cannot define or rename alias \"%s\": would create a loop",
+		    Tcl_GetCommandName(cmdInterp, cmd)));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+		    "ALIASLOOP", NULL);
 	    return TCL_ERROR;
 	}
 
@@ -1400,7 +1460,7 @@ TclPreventAliasLoop(
 	if (aliasCmdPtr->objProc != AliasObjCmd) {
 	    return TCL_OK;
 	}
-	nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
+	nextAliasPtr = aliasCmdPtr->objClientData;
     }
 
     /* NOTREACHED */
@@ -1443,8 +1503,7 @@ AliasCreate(
     Tcl_Obj **prefv;
     int isNew, i;
 
-    aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
-	    + objc * sizeof(Tcl_Obj *)));
+    aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
     aliasPtr->token = namePtr;
     Tcl_IncrRefCount(aliasPtr->token);
     aliasPtr->targetInterp = masterInterp;
@@ -1462,9 +1521,15 @@ 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,
 	    AliasObjCmdDeleteProc);
+    }
 
     if (TclPreventAliasLoop(interp, slaveInterp,
 	    aliasPtr->slaveCmd) != TCL_OK) {
@@ -1489,7 +1554,7 @@ AliasCreate(
 	cmdPtr->deleteData = NULL;
 	Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
 
-	ckfree((char *) aliasPtr);
+	ckfree(aliasPtr);
 
 	/*
 	 * The result was already set by TclPreventAliasLoop.
@@ -1507,7 +1572,7 @@ AliasCreate(
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     while (1) {
 	Tcl_Obj *newToken;
-	char *string;
+	const char *string;
 
 	string = TclGetString(aliasPtr->token);
 	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
@@ -1546,11 +1611,11 @@ AliasCreate(
      * interp alias {} foo {} zop		# Now recreate "foo"...
      */
 
-    targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
+    targetPtr = ckalloc(sizeof(Target));
     targetPtr->slaveCmd = aliasPtr->slaveCmd;
     targetPtr->slaveInterp = slaveInterp;
 
-    masterPtr = &((InterpInfo *) ((Interp*) masterInterp)->interpInfo)->master;
+    masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
     targetPtr->nextPtr = masterPtr->targetsPtr;
     targetPtr->prevPtr = NULL;
     if (masterPtr->targetsPtr != NULL) {
@@ -1601,8 +1666,8 @@ AliasDelete(
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr),
-		"\" not found", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"alias \"%s\" not found", TclGetString(namePtr)));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
 		TclGetString(namePtr), NULL);
 	return TCL_ERROR;
@@ -1719,6 +1784,54 @@ AliasList(
  */
 
 static int
+AliasNRCmd(
+    ClientData clientData,	/* Alias record. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument vector. */
+{
+    Alias *aliasPtr = clientData;
+    int prefc, cmdc, i;
+    Tcl_Obj **prefv, **cmdv;
+    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 (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+    }
+    TclSkipTailcall(interp);
+    return Tcl_NREvalObj(interp, listPtr, flags);
+}
+
+static int
 AliasObjCmd(
     ClientData clientData,	/* Alias record. */
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -1732,7 +1845,7 @@ AliasObjCmd(
     Tcl_Obj **prefv, **cmdv;
     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
     Interp *tPtr = (Interp *) targetInterp;
-    int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
+    int isRootEnsemble;
 
     /*
      * Append the arguments to the command prefix and invoke the command in
@@ -1745,7 +1858,7 @@ AliasObjCmd(
     if (cmdc <= ALIAS_CMDV_PREALLOC) {
 	cmdv = cmdArr;
     } else {
-	cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
+	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
     }
 
     memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
@@ -1762,13 +1875,7 @@ AliasObjCmd(
      * 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;
-    }
+    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)tPtr, 1, prefc, objv);
 
     /*
      * Protect the target interpreter if it isn't the same as the source
@@ -1791,9 +1898,7 @@ AliasObjCmd(
      */
 
     if (isRootEnsemble) {
-	tPtr->ensembleRewrite.sourceObjs = NULL;
-	tPtr->ensembleRewrite.numRemovedObjs = 0;
-	tPtr->ensembleRewrite.numInsertedObjs = 0;
+	TclResetRewriteEnsemble((Tcl_Interp *)tPtr, 1);
     }
 
     /*
@@ -1803,7 +1908,7 @@ AliasObjCmd(
      */
 
     if (targetInterp != interp) {
-	TclTransferResult(targetInterp, result, interp);
+	Tcl_TransferResult(targetInterp, result, interp);
 	Tcl_Release(targetInterp);
     }
 
@@ -1868,8 +1973,8 @@ AliasObjCmdDeleteProc(
 	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
     }
 
-    ckfree((char *) targetPtr);
-    ckfree((char *) aliasPtr);
+    ckfree(targetPtr);
+    ckfree(aliasPtr);
 }
 
 /*
@@ -1974,6 +2079,72 @@ 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
@@ -2003,17 +2174,19 @@ Tcl_GetInterpPath(
     InterpInfo *iiPtr;
 
     if (targetInterp == askingInterp) {
+	Tcl_SetObjResult(askingInterp, Tcl_NewObj());
 	return TCL_OK;
     }
     if (targetInterp == NULL) {
 	return TCL_ERROR;
     }
     iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
-    if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {
+    if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){
 	return TCL_ERROR;
     }
-    Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&iiPtr->master.slaveTable,
-	    iiPtr->slave.slaveEntryPtr));
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp),
+	    Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable,
+		    iiPtr->slave.slaveEntryPtr), -1));
     return TCL_OK;
 }
 
@@ -2067,8 +2240,8 @@ GetInterp(
 	}
     }
     if (searchInterp == NULL) {
-	Tcl_AppendResult(interp, "could not find interpreter \"",
-		TclGetString(pathPtr), "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"could not find interpreter \"%s\"", TclGetString(pathPtr)));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
 		TclGetString(pathPtr), NULL);
     }
@@ -2105,8 +2278,10 @@ SlaveBgerror(
 
 	if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
 		|| (length < 1)) {
-	    Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "cmdPrefix must be list of length >= 1", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+		    "BGERRORFORMAT", NULL);
 	    return TCL_ERROR;
 	}
 	TclSetBgErrorHandler(slaveInterp, objv[0]);
@@ -2144,7 +2319,7 @@ SlaveCreate(
     Slave *slavePtr;
     InterpInfo *masterInfoPtr;
     Tcl_HashEntry *hPtr;
-    char *path;
+    const char *path;
     int isNew, objc;
     Tcl_Obj **objv;
 
@@ -2173,8 +2348,9 @@ SlaveCreate(
     hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
 	    &isNew);
     if (isNew == 0) {
-	Tcl_AppendResult(interp, "interpreter named \"", path,
-		"\" already exists, cannot create", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"interpreter named \"%s\" already exists, cannot create",
+		path));
 	return NULL;
     }
 
@@ -2183,8 +2359,8 @@ SlaveCreate(
     slavePtr->masterInterp = masterInterp;
     slavePtr->slaveEntryPtr = hPtr;
     slavePtr->slaveInterp = slaveInterp;
-    slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
-	    SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
+    slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
+	    SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
     Tcl_SetHashValue(hPtr, slavePtr);
     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
@@ -2242,7 +2418,7 @@ SlaveCreate(
     return slaveInterp;
 
   error:
-    TclTransferResult(slaveInterp, TCL_ERROR, interp);
+    Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
   error2:
     Tcl_DeleteInterp(slaveInterp);
 
@@ -2273,17 +2449,29 @@ SlaveObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
+}
+
+static int
+NRSlaveCmd(
+    ClientData clientData,	/* Slave interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
     Tcl_Interp *slaveInterp = clientData;
     int index;
-    static const char *options[] = {
-	"alias",	"aliases",	"bgerror",	"debug",	"eval",
-	"expose",	"hide",		"hidden",	"issafe",
-	"invokehidden",	"limit",	"marktrusted",	"recursionlimit", NULL
+    static const char *const options[] = {
+	"alias",	"aliases",	"bgerror",	"debug",
+	"eval",		"expose",	"hide",		"hidden",
+	"issafe",	"invokehidden",	"limit",	"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_BGERROR,	OPT_DEBUG,
+	OPT_EVAL,	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,
+	OPT_ISSAFE,	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED,
+	OPT_RECLIMIT
     };
 
     if (slaveInterp == NULL) {
@@ -2314,7 +2502,7 @@ SlaveObjCmd(
 			objv[3], objc - 4, objv + 4);
 	    }
 	}
-	Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?");
+	Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?");
 	return TCL_ERROR;
     case OPT_ALIASES:
 	if (objc != 2) {
@@ -2330,7 +2518,7 @@ SlaveObjCmd(
 	return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
     case OPT_DEBUG:
 	/*
-	 * TIP #378 *
+	 * TIP #378
 	 * Currently only -frame supported, otherwise ?-option ?value? ...?
 	 */
 	if (objc > 4) {
@@ -2370,9 +2558,9 @@ SlaveObjCmd(
 	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
 	return TCL_OK;
     case OPT_INVOKEHIDDEN: {
-	int i, index;
+	int i;
 	const char *namespaceName;
-	static const char *hiddenOptions[] = {
+	static const char *const hiddenOptions[] = {
 	    "-global",	"-namespace",	"--", NULL
 	};
 	enum hiddenOption {
@@ -2410,7 +2598,7 @@ SlaveObjCmd(
 		objc - i, objv + i);
     }
     case OPT_LIMIT: {
-	static const char *limitTypes[] = {
+	static const char *const limitTypes[] = {
 	    "commands", "time", NULL
 	};
 	enum LimitTypes {
@@ -2419,7 +2607,7 @@ SlaveObjCmd(
 	int limitType;
 
 	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?");
+	    Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?");
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
@@ -2509,7 +2697,7 @@ SlaveObjCmdDeleteProc(
  *	A standard Tcl result.
  *
  * Side effects:
- *	May modify INTERP_DEBUG flag in the slave.
+ *	May modify INTERP_DEBUG_FRAME flag in the slave.
  *
  *----------------------------------------------------------------------
  */
@@ -2522,7 +2710,7 @@ SlaveDebugCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static const char *debugTypes[] = {
+    static const char *const debugTypes[] = {
 	"-frame", NULL
     };
     enum DebugTypes {
@@ -2541,8 +2729,8 @@ SlaveDebugCmd(
 		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) {
+	if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option",
+		0, &debugType) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (debugType == DEBUG_TYPE_FRAME) {
@@ -2551,11 +2739,13 @@ SlaveDebugCmd(
 			!= 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.
+		 * 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;
 		}
@@ -2592,7 +2782,16 @@ SlaveEval(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int result;
-    Tcl_Obj *objPtr;
+
+    /*
+     * 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_AllowExceptions(slaveInterp);
@@ -2602,19 +2801,20 @@ SlaveEval(
 	 * TIP #280: Make actual argument location available to eval'd script.
 	 */
 
-        Interp *iPtr = (Interp *) interp;
-	CmdFrame* invoker = iPtr->cmdFramePtr;
-	int word          = 0;
+	Interp *iPtr = (Interp *) interp;
+	CmdFrame *invoker = iPtr->cmdFramePtr;
+	int word = 0;
+
+	TclArgumentGet(interp, objv[0], &invoker, &word);
 
-	TclArgumentGet (interp, objv[0], &invoker, &word);
 	result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
     } else {
-	objPtr = Tcl_ConcatObj(objc, objv);
+	Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);
 	result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
 	Tcl_DecrRefCount(objPtr);
     }
-    TclTransferResult(slaveInterp, result, interp);
+    Tcl_TransferResult(slaveInterp, result, interp);
 
     Tcl_Release(slaveInterp);
     return result;
@@ -2644,19 +2844,21 @@ SlaveExpose(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument strings. */
 {
-    char *name;
+    const char *name;
 
     if (Tcl_IsSafe(interp)) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"permission denied: safe interpreter cannot expose commands",
 		-1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+		NULL);
 	return TCL_ERROR;
     }
 
     name = TclGetString(objv[(objc == 1) ? 0 : 1]);
     if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
 	    name) != TCL_OK) {
-	TclTransferResult(slaveInterp, TCL_ERROR, interp);
+	Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -2691,8 +2893,10 @@ SlaveRecursionLimit(
 
     if (objc) {
 	if (Tcl_IsSafe(interp)) {
-	    Tcl_AppendResult(interp, "permission denied: "
-		    "safe interpreters cannot change recursion limit", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: "
+		    "safe interpreters cannot change recursion limit", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+		    NULL);
 	    return TCL_ERROR;
 	}
 	if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
@@ -2701,6 +2905,8 @@ SlaveRecursionLimit(
 	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);
@@ -2708,6 +2914,7 @@ 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]);
@@ -2743,18 +2950,20 @@ SlaveHide(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument strings. */
 {
-    char *name;
+    const char *name;
 
     if (Tcl_IsSafe(interp)) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"permission denied: safe interpreter cannot hide commands",
 		-1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+		NULL);
 	return TCL_ERROR;
     }
 
     name = TclGetString(objv[(objc == 1) ? 0 : 1]);
     if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
-	TclTransferResult(slaveInterp, TCL_ERROR, interp);
+	Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -2831,6 +3040,8 @@ SlaveInvokeHidden(
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"not allowed to invoke hidden commands from safe interpreter",
 		-1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+		NULL);
 	return TCL_ERROR;
     }
 
@@ -2838,7 +3049,11 @@ SlaveInvokeHidden(
     Tcl_AllowExceptions(slaveInterp);
 
     if (namespaceName == NULL) {
-	result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+	NRE_callback *rootPtr = TOP_CB(slaveInterp);
+
+	Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
+		rootPtr, NULL, NULL);
+	return TclNRInvoke(NULL, slaveInterp, objc, objv);
     } else {
 	Namespace *nsPtr, *dummy1, *dummy2;
 	const char *tail;
@@ -2848,12 +3063,29 @@ SlaveInvokeHidden(
 		| TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
 	if (result == TCL_OK) {
 	    result = TclObjInvokeNamespace(slaveInterp, objc, objv,
-		    (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN);
+		    (Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN);
 	}
     }
 
-    TclTransferResult(slaveInterp, result, interp);
+    Tcl_TransferResult(slaveInterp, result, interp);
+
+    Tcl_Release(slaveInterp);
+    return result;
+}
+
+static int
+NRPostInvokeHidden(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
+    NRE_callback *rootPtr = (NRE_callback *)data[1];
 
+    if (interp != slaveInterp) {
+	result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
+	Tcl_TransferResult(slaveInterp, result, interp);
+    }
     Tcl_Release(slaveInterp);
     return result;
 }
@@ -2885,6 +3117,8 @@ SlaveMarkTrusted(
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"permission denied: safe interpreter cannot mark trusted",
 		-1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
+		NULL);
 	return TCL_ERROR;
     }
     ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
@@ -3140,8 +3374,9 @@ Tcl_LimitCheck(
 	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "command count limit exceeded", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
 	    Tcl_Release(interp);
 	    return TCL_ERROR;
 	}
@@ -3165,8 +3400,9 @@ Tcl_LimitCheck(
 		    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_SetObjResult(interp, Tcl_NewStringObj(
+			"time limit exceeded", -1));
+		Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
 		Tcl_Release(interp);
 		return TCL_ERROR;
 	    }
@@ -3219,7 +3455,7 @@ RunLimitHandlers(
 	 */
 
 	handlerPtr->flags |= LIMIT_HANDLER_ACTIVE;
-	(handlerPtr->handlerProc)(handlerPtr->clientData, interp);
+	handlerPtr->handlerProc(handlerPtr->clientData, interp);
 	handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE;
 
 	/*
@@ -3240,9 +3476,9 @@ RunLimitHandlers(
 
 	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
 	    if (handlerPtr->deleteProc != NULL) {
-		(handlerPtr->deleteProc)(handlerPtr->clientData);
+		handlerPtr->deleteProc(handlerPtr->clientData);
 	    }
-	    ckfree((char *) handlerPtr);
+	    ckfree(handlerPtr);
 	}
     }
 }
@@ -3289,7 +3525,7 @@ Tcl_LimitAddHandler(
      * Allocate a handler record.
      */
 
-    handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler));
+    handlerPtr = ckalloc(sizeof(LimitHandler));
     handlerPtr->flags = 0;
     handlerPtr->handlerProc = handlerProc;
     handlerPtr->clientData = clientData;
@@ -3406,9 +3642,9 @@ Tcl_LimitRemoveHandler(
 
 	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
 	    if (handlerPtr->deleteProc != NULL) {
-		(handlerPtr->deleteProc)(handlerPtr->clientData);
+		handlerPtr->deleteProc(handlerPtr->clientData);
 	    }
-	    ckfree((char *) handlerPtr);
+	    ckfree(handlerPtr);
 	}
 	return;
     }
@@ -3466,9 +3702,9 @@ TclLimitRemoveAllHandlers(
 
 	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
 	    if (handlerPtr->deleteProc != NULL) {
-		(handlerPtr->deleteProc)(handlerPtr->clientData);
+		handlerPtr->deleteProc(handlerPtr->clientData);
 	    }
-	    ckfree((char *) handlerPtr);
+	    ckfree(handlerPtr);
 	}
     }
 
@@ -3499,9 +3735,9 @@ TclLimitRemoveAllHandlers(
 
 	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
 	    if (handlerPtr->deleteProc != NULL) {
-		(handlerPtr->deleteProc)(handlerPtr->clientData);
+		handlerPtr->deleteProc(handlerPtr->clientData);
 	    }
-	    ckfree((char *) handlerPtr);
+	    ckfree(handlerPtr);
 	}
     }
 
@@ -3764,7 +4000,7 @@ TimeLimitCallback(
     code = Tcl_LimitCheck(interp);
     if (code != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
-	TclBackgroundException(interp, code);
+	Tcl_BackgroundException(interp, code);
     }
     Tcl_Release(interp);
 }
@@ -3896,7 +4132,7 @@ DeleteScriptLimitCallback(
     if (limitCBPtr->entryPtr != NULL) {
 	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
     }
-    ckfree((char *) limitCBPtr);
+    ckfree(limitCBPtr);
 }
 
 /*
@@ -3932,7 +4168,7 @@ CallScriptLimitCallback(
     code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
 	    TCL_EVAL_GLOBAL);
     if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
-	TclBackgroundException(limitCBPtr->interp, code);
+	Tcl_BackgroundException(limitCBPtr->interp, code);
     }
     Tcl_Release(limitCBPtr->interp);
 }
@@ -3987,7 +4223,7 @@ SetScriptLimitCallback(
 	return;
     }
 
-    hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key,
+    hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key,
 	    &isNew);
     if (!isNew) {
 	limitCBPtr = Tcl_GetHashValue(hashPtr);
@@ -3996,7 +4232,7 @@ SetScriptLimitCallback(
 		limitCBPtr);
     }
 
-    limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback));
+    limitCBPtr = ckalloc(sizeof(ScriptLimitCallback));
     limitCBPtr->interp = interp;
     limitCBPtr->scriptObj = scriptObj;
     limitCBPtr->entryPtr = hashPtr;
@@ -4151,7 +4387,7 @@ SlaveCommandLimitCmd(
     int objc,			/* Total number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-command", "-granularity", "-value", NULL
     };
     enum Options {
@@ -4171,8 +4407,9 @@ SlaveCommandLimitCmd(
      */
 
     if (interp == slaveInterp) {
-	Tcl_AppendResult(interp,
-		"limits on current interpreter inaccessible", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"limits on current interpreter inaccessible", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
 	return TCL_ERROR;
     }
 
@@ -4245,8 +4482,7 @@ SlaveCommandLimitCmd(
 	}
 	return TCL_OK;
     } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
-	Tcl_WrongNumArgs(interp, consumedObjc, objv,
-		"?-option? ?value? ?-option value ...?");
+	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
 	return TCL_ERROR;
     } else {
 	int i, scriptLen = 0, limitLen = 0;
@@ -4269,8 +4505,10 @@ SlaveCommandLimitCmd(
 		    return TCL_ERROR;
 		}
 		if (gran < 1) {
-		    Tcl_AppendResult(interp, "granularity must be at "
-			    "least 1", NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "granularity must be at least 1", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
 		break;
@@ -4284,8 +4522,10 @@ SlaveCommandLimitCmd(
 		    return TCL_ERROR;
 		}
 		if (limit < 0) {
-		    Tcl_AppendResult(interp, "command limit value must be at "
-			    "least 0", NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "command limit value must be at least 0", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
 		break;
@@ -4335,7 +4575,7 @@ SlaveTimeLimitCmd(
     int objc,				/* Total number of arguments. */
     Tcl_Obj *const objv[])		/* Argument objects. */
 {
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-command", "-granularity", "-milliseconds", "-seconds", NULL
     };
     enum Options {
@@ -4355,8 +4595,9 @@ SlaveTimeLimitCmd(
      */
 
     if (interp == slaveInterp) {
-	Tcl_AppendResult(interp,
-		"limits on current interpreter inaccessible", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"limits on current interpreter inaccessible", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
 	return TCL_ERROR;
     }
 
@@ -4446,8 +4687,7 @@ SlaveTimeLimitCmd(
 	}
 	return TCL_OK;
     } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
-	Tcl_WrongNumArgs(interp, consumedObjc, objv,
-		"?-option? ?value? ?-option value ...?");
+	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
 	return TCL_ERROR;
     } else {
 	int i, scriptLen = 0, milliLen = 0, secLen = 0;
@@ -4474,8 +4714,10 @@ SlaveTimeLimitCmd(
 		    return TCL_ERROR;
 		}
 		if (gran < 1) {
-		    Tcl_AppendResult(interp, "granularity must be at "
-			    "least 1", NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "granularity must be at least 1", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
 		break;
@@ -4489,11 +4731,13 @@ SlaveTimeLimitCmd(
 		    return TCL_ERROR;
 		}
 		if (tmp < 0) {
-		    Tcl_AppendResult(interp, "milliseconds must be at least 0",
-			    NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "milliseconds must be at least 0", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
-		limitMoment.usec = ((long)tmp)*1000;
+		limitMoment.usec = ((long) tmp)*1000;
 		break;
 	    case OPT_SEC:
 		secObj = objv[i+1];
@@ -4505,8 +4749,10 @@ SlaveTimeLimitCmd(
 		    return TCL_ERROR;
 		}
 		if (tmp < 0) {
-		    Tcl_AppendResult(interp, "seconds must be at least 0",
-			    NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "seconds must be at least 0", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
 		limitMoment.sec = tmp;
@@ -4521,13 +4767,19 @@ SlaveTimeLimitCmd(
 		 */
 
 		if (secObj != NULL && secLen == 0 && milliLen > 0) {
-		    Tcl_AppendResult(interp, "may only set -milliseconds "
-			    "if -seconds is not also being reset", NULL);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "may only set -milliseconds if -seconds is not "
+			    "also being reset", -1));
+		    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_SetObjResult(interp, Tcl_NewStringObj(
+			    "may only reset -milliseconds if -seconds is "
+			    "also being reset", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
+			    "BADUSAGE", NULL);
 		    return TCL_ERROR;
 		}
 	    }
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2dc2e47..7d1e3a8 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -65,12 +65,11 @@ typedef struct Link {
  */
 
 static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
-			    CONST char *name1, CONST char *name2, int flags);
+			    const char *name1, const char *name2, int flags);
 static Tcl_Obj *	ObjValue(Link *linkPtr);
-static int		GetInvalidIntFromObj(Tcl_Obj *objPtr,
-				int *intPtr);
-static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
-				double *doublePtr);
+static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
+static int		GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
+static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
 
 /*
  * Convenience macro for accessing the value of the C variable pointed to by a
@@ -106,7 +105,7 @@ static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
 int
 Tcl_LinkVar(
     Tcl_Interp *interp,		/* Interpreter in which varName exists. */
-    CONST char *varName,	/* Name of a global variable in interp. */
+    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
@@ -116,15 +115,15 @@ Tcl_LinkVar(
     Link *linkPtr;
     int code;
 
-    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
-	    LinkTraceProc, (ClientData) NULL);
+    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+	    TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
     if (linkPtr != NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"variable '%s' is already linked", varName));
 	return TCL_ERROR;
     }
 
-    linkPtr = (Link *) ckalloc(sizeof(Link));
+    linkPtr = ckalloc(sizeof(Link));
     linkPtr->interp = interp;
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(linkPtr->varName);
@@ -139,15 +138,15 @@ Tcl_LinkVar(
     if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
 	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree((char *) linkPtr);
+	ckfree(linkPtr);
 	return TCL_ERROR;
     }
-    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
-	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
-	    (ClientData) linkPtr);
+    code = Tcl_TraceVar2(interp, varName, NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    LinkTraceProc, linkPtr);
     if (code != TCL_OK) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree((char *) linkPtr);
+	ckfree(linkPtr);
     }
     return code;
 }
@@ -173,20 +172,19 @@ Tcl_LinkVar(
 void
 Tcl_UnlinkVar(
     Tcl_Interp *interp,		/* Interpreter containing variable to unlink */
-    CONST char *varName)	/* Global variable in interp to unlink. */
+    const char *varName)	/* Global variable in interp to unlink. */
 {
-    Link *linkPtr;
+    Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
 
-    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
-	    LinkTraceProc, (ClientData) NULL);
     if (linkPtr == NULL) {
 	return;
     }
-    Tcl_UntraceVar(interp, varName,
+    Tcl_UntraceVar2(interp, varName, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    LinkTraceProc, (ClientData) linkPtr);
+	    LinkTraceProc, linkPtr);
     Tcl_DecrRefCount(linkPtr->varName);
-    ckfree((char *) linkPtr);
+    ckfree(linkPtr);
 }
 
 /*
@@ -211,13 +209,12 @@ Tcl_UnlinkVar(
 void
 Tcl_UpdateLinkedVar(
     Tcl_Interp *interp,		/* Interpreter containing variable. */
-    CONST char *varName)	/* Name of global variable that is linked. */
+    const char *varName)	/* Name of global variable that is linked. */
 {
-    Link *linkPtr;
+    Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
     int savedFlag;
 
-    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
-	    LinkTraceProc, (ClientData) NULL);
     if (linkPtr == NULL) {
 	return;
     }
@@ -228,8 +225,8 @@ Tcl_UpdateLinkedVar(
     /*
      * Callback may have unlinked the variable. [Bug 1740631]
      */
-    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
-	    LinkTraceProc, (ClientData) NULL);
+    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
+	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
     if (linkPtr != NULL) {
 	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
     }
@@ -260,13 +257,14 @@ 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. */
+    const char *name1,		/* First part of variable name. */
+    const char *name2,		/* Second part of variable name. */
     int flags)			/* Miscellaneous additional information. */
 {
-    Link *linkPtr = (Link *) clientData;
-    int changed, valueLength;
-    CONST char *value;
+    Link *linkPtr = clientData;
+    int changed;
+    size_t valueLength;
+    const char *value;
     char **pp;
     Tcl_Obj *valueObj;
     int valueInt;
@@ -281,13 +279,13 @@ LinkTraceProc(
     if (flags & TCL_TRACE_UNSETS) {
 	if (Tcl_InterpDeleted(interp)) {
 	    Tcl_DecrRefCount(linkPtr->varName);
-	    ckfree((char *) linkPtr);
+	    ckfree(linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
 		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
-		    |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
+		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
 	}
 	return NULL;
     }
@@ -350,7 +348,7 @@ LinkTraceProc(
 	    changed = 1;
 	    break;
 	default:
-	    return "internal error: bad linked variable type";
+	    return (char *) "internal error: bad linked variable type";
 	}
 	if (changed) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -371,7 +369,7 @@ LinkTraceProc(
     if (linkPtr->flags & LINK_READ_ONLY) {
 	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		TCL_GLOBAL_ONLY);
-	return "linked variable is read-only";
+	return (char *) "linked variable is read-only";
     }
     valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
     if (valueObj == NULL) {
@@ -379,48 +377,39 @@ LinkTraceProc(
 	 * This shouldn't ever happen.
 	 */
 
-	return "internal error: linked variable couldn't be read";
+	return (char *) "internal error: linked variable couldn't be read";
     }
 
     switch (linkPtr->type) {
     case TCL_LINK_INT:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
-		!= TCL_OK) {
-	    if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK
+		&& GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-		return "variable must have integer value";
-	    }
+	    return (char *) "variable must have integer value";
 	}
 	LinkedVar(int) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_WIDE_INT:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
-		!= TCL_OK) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK
+		&& GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-		return "variable must have integer value";
-	    }
-	    linkPtr->lastValue.w = (Tcl_WideInt) valueInt;
+	    return (char *) "variable must have integer value";
 	}
 	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
 	break;
 
     case TCL_LINK_DOUBLE:
-	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
-		!= TCL_OK) {
+	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
 #ifdef ACCEPT_NAN
 	    if (valueObj->typePtr != &tclDoubleType) {
 #endif
-		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d)
-			!= TCL_OK) {
+		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
 		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 			TCL_GLOBAL_ONLY);
-		    return "variable must have real value";
+		    return (char *) "variable must have real value";
 		}
 #ifdef ACCEPT_NAN
 	    }
@@ -431,162 +420,126 @@ LinkTraceProc(
 	break;
 
     case TCL_LINK_BOOLEAN:
-	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
-		!= TCL_OK) {
+	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    return "variable must have boolean value";
+	    return (char *) "variable must have boolean value";
 	}
 	LinkedVar(int) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_CHAR:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
 		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have char value";
-	    }
+	    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;
+	LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;
 	break;
 
     case TCL_LINK_UCHAR:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
 		|| valueInt < 0 || valueInt > UCHAR_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have unsigned char value";
-	    }
+	    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;
+	LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;
 	break;
 
     case TCL_LINK_SHORT:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
 		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have short value";
-	    }
+	    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;
+	LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;
 	break;
 
     case TCL_LINK_USHORT:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
 		|| valueInt < 0 || valueInt > USHRT_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have unsigned short value";
-	    }
+	    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;
+	LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;
 	break;
 
     case TCL_LINK_UINT:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
 		|| valueWide < 0 || valueWide > UINT_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have unsigned int value";
-	    }
-	    linkPtr->lastValue.ui = (unsigned int)valueInt;
-	} else {
-	    linkPtr->lastValue.ui = (unsigned int)valueWide;
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return (char *) "variable must have unsigned int value";
 	}
-	LinkedVar(unsigned int) = linkPtr->lastValue.ui;
+	LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
 	break;
 
     case TCL_LINK_LONG:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
 		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have long value";
-	    }
-	    linkPtr->lastValue.l = (long)valueInt;
-	} else {
-	    linkPtr->lastValue.l = (long)valueWide;
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return (char *) "variable must have long value";
 	}
-	LinkedVar(long) = linkPtr->lastValue.l;
+	LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;
 	break;
 
     case TCL_LINK_ULONG:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
 		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have unsigned long value";
-	    }
-	    linkPtr->lastValue.ul = (unsigned long)valueInt;
-	} else {
-	    linkPtr->lastValue.ul = (unsigned long)valueWide;
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return (char *) "variable must have unsigned long value";
 	}
-	LinkedVar(unsigned long) = linkPtr->lastValue.ul;
+	LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
 	break;
 
     case TCL_LINK_WIDE_UINT:
 	/*
 	 * FIXME: represent as a bignum.
 	 */
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
-	    if (GetInvalidIntFromObj(valueObj, &valueInt)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have unsigned wide int value";
-	    }
-	    linkPtr->lastValue.uw = (Tcl_WideUInt)valueInt;
-	} else {
-	    linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
+	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return (char *) "variable must have unsigned wide int value";
 	}
-	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
+	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
 	break;
 
     case TCL_LINK_FLOAT:
-	if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
+	if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
+		&& GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK)
 		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
-	    if (GetInvalidDoubleFromObj(valueObj, &valueDouble)
-		    != TCL_OK) {
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		return "variable must have float value";
-	    }
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return (char *) "variable must have float value";
 	}
-	linkPtr->lastValue.f = (float)valueDouble;
-	LinkedVar(float) = linkPtr->lastValue.f;
+	LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble;
 	break;
 
     case TCL_LINK_STRING:
-	value = Tcl_GetStringFromObj(valueObj, &valueLength);
-	valueLength++;
+	value = TclGetString(valueObj);
+	valueLength = valueObj->length + 1;
 	pp = (char **) linkPtr->addr;
 
 	*pp = ckrealloc(*pp, valueLength);
-	memcpy(*pp, value, (unsigned) valueLength);
+	memcpy(*pp, value, valueLength);
 	break;
 
     default:
-	return "internal error: bad linked variable type";
+	return (char *) "internal error: bad linked variable type";
     }
     return NULL;
 }
@@ -724,49 +677,63 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
 /*
  * This function checks for integer representations, which are valid
  * when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
  * (upperand lowercase). See bug [39f6304c2e].
  */
 int
 GetInvalidIntFromObj(Tcl_Obj *objPtr,
 				int *intPtr)
 {
-    int length;
-    const char *str = TclGetStringFromObj(objPtr, &length);
+    const char *str = TclGetString(objPtr);
 
-    if ((length == 1) && strchr("+-", str[0])) {
-	*intPtr = (str[0] == '+');
-	return TCL_OK;
-    } else if ((length == 0) ||
-	    ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
+    if ((objPtr->length == 0) ||
+	    ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
 	*intPtr = 0;
 	return TCL_OK;
+    } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
+	*intPtr = (str[0] == '+');
+	return TCL_OK;
     }
     return TCL_ERROR;
 }
 
+int
+GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
+{
+    int intValue;
+
+    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    *widePtr = intValue;
+    return TCL_OK;
+}
+
 /*
  * This function checks for double representations, which are valid
  * when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
  * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
  */
 int
 GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
 				double *doublePtr)
 {
-    int intValue, result;
+    int intValue;
 
-    if ((objPtr->typePtr == &invalidRealType) ||
-	    (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) {
-	*doublePtr = objPtr->internalRep.doubleValue;
-	return TCL_OK;
+    if (objPtr->typePtr == &invalidRealType) {
+	goto gotdouble;
     }
-    result = GetInvalidIntFromObj(objPtr, &intValue);
-    if (result == TCL_OK) {
+    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
 	*doublePtr = (double) intValue;
+	return TCL_OK;
     }
-    return result;
+    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
+    gotdouble:
+	*doublePtr = objPtr->internalRep.doubleValue;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
 }
 
 /*
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index e1dba8c..344d0fd 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -18,8 +18,8 @@
  */
 
 static List *		AttemptNewList(Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[]);
-static List *		NewListIntRep(int objc, Tcl_Obj *CONST objv[], int p);
+			    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);
@@ -38,13 +38,17 @@ static void		UpdateStringOfList(Tcl_Obj *listPtr);
  * storage to avoid an auxiliary stack.
  */
 
-Tcl_ObjType tclListType = {
+const 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
 
 /*
  *----------------------------------------------------------------------
@@ -72,7 +76,7 @@ Tcl_ObjType tclListType = {
 static List *
 NewListIntRep(
     int objc,
-    Tcl_Obj *CONST objv[],
+    Tcl_Obj *const objv[],
     int p)
 {
     List *listRepPtr;
@@ -96,12 +100,11 @@ NewListIntRep(
 	return NULL;
     }
 
-    listRepPtr = (List *)
-	    attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
+    listRepPtr = attemptckalloc(LIST_SIZE(objc));
     if (listRepPtr == NULL) {
 	if (p) {
 	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
-		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
+		    LIST_SIZE(objc));
 	}
 	return NULL;
     }
@@ -134,7 +137,7 @@ 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.  
+ *	0 elements, with space to add objc more.
  *
  * Results:
  *	A new List struct with refCount 0 is returned. If some failure
@@ -152,7 +155,7 @@ static List *
 AttemptNewList(
     Tcl_Interp *interp,
     int objc,
-    Tcl_Obj *CONST objv[])
+    Tcl_Obj *const objv[])
 {
     List *listRepPtr = NewListIntRep(objc, objv, 0);
 
@@ -164,8 +167,9 @@ AttemptNewList(
 	} else {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "list creation failed: unable to alloc %u bytes",
-		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)))));
+		    LIST_SIZE(objc)));
 	}
+	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
     }
     return listRepPtr;
 }
@@ -202,7 +206,7 @@ AttemptNewList(
 Tcl_Obj *
 Tcl_NewListObj(
     int objc,			/* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
+    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
 {
     return Tcl_DbNewListObj(objc, objv, "unknown", 0);
 }
@@ -212,7 +216,7 @@ 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_Obj *const objv[])	/* An array of pointers to Tcl objects. */
 {
     List *listRepPtr;
     Tcl_Obj *listPtr;
@@ -273,8 +277,8 @@ Tcl_NewListObj(
 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
+    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. */
@@ -309,8 +313,8 @@ Tcl_DbNewListObj(
 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
+    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. */
@@ -345,7 +349,7 @@ 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_Obj *const objv[])	/* An array of pointers to Tcl objects. */
 {
     List *listRepPtr;
 
@@ -358,7 +362,6 @@ Tcl_SetListObj(
      */
 
     TclFreeIntRep(objPtr);
-    objPtr->typePtr = NULL;
     TclInvalidateStringRep(objPtr);
 
     /*
@@ -483,16 +486,13 @@ Tcl_ListObjGetElements(
  *
  * Tcl_ListObjAppendList --
  *
- *	This function appends the objects in the list referenced by
- *	elemListPtr to the list object referenced by listPtr. If listPtr is
- *	not already a list object, an attempt will be made to convert it to
- *	one.
+ *	This function appends the elements in the list value referenced by
+ *	elemListPtr to the list value referenced by listPtr.
  *
  * Results:
  *	The return value is normally TCL_OK. If listPtr or elemListPtr do not
- *	refer to list objects and they can not be converted to one, TCL_ERROR
- *	is returned and an error message is left in the interpreter's result
- *	if interp is not NULL.
+ *	refer to list values, 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
@@ -510,29 +510,27 @@ Tcl_ListObjAppendList(
     register Tcl_Obj *listPtr,	/* List object to append elements to. */
     Tcl_Obj *elemListPtr)	/* List obj with elements to append. */
 {
-    int listLen, objc, result;
+    int objc;
     Tcl_Obj **objv;
 
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
     }
 
-    result = TclListObjLength(interp, listPtr, &listLen);
-    if (result != TCL_OK) {
-	return result;
-    }
+    /*
+     * Pull the elements to append from elemListPtr.
+     */
 
-    result = TclListObjGetElements(interp, elemListPtr, &objc, &objv);
-    if (result != TCL_OK) {
-	return result;
+    if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
+	return TCL_ERROR;
     }
 
     /*
-     * Insert objc new elements starting after the lists's last element.
+     * Insert the new elements starting after the lists's last element.
      * Delete zero existing elements.
      */
 
-    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
+    return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
 }
 
 /*
@@ -568,9 +566,8 @@ Tcl_ListObjAppendElement(
     Tcl_Obj *listPtr,		/* List object to append objPtr to. */
     Tcl_Obj *objPtr)		/* Object to append to listPtr's list. */
 {
-    register List *listRepPtr;
-    register Tcl_Obj **elemPtrs;
-    int numElems, numRequired, newMax, newSize, i;
+    register List *listRepPtr, *newPtr = NULL;
+    int numElems, numRequired, needGrow, isShared, attempt;
 
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
@@ -591,52 +588,107 @@ Tcl_ListObjAppendElement(
     listRepPtr = ListRepPtr(listPtr);
     numElems = listRepPtr->elemCount;
     numRequired = numElems + 1 ;
+    needGrow = (numRequired > listRepPtr->maxElemCount);
+    isShared = (listRepPtr->refCount > 1);
 
-    /*
-     * If there is no room in the current array of element pointers, allocate
-     * a new, larger array and copy the pointers to it. If the List struct is
-     * shared, allocate a new one.
-     */
+    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 (numRequired > listRepPtr->maxElemCount){
-	newMax = 2 * numRequired;
-	newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *));
-    } else {
-	newMax = listRepPtr->maxElemCount;
-	newSize = 0;
+    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;
 
-    if (listRepPtr->refCount > 1) {
-	List *oldListRepPtr = listRepPtr;
-	Tcl_Obj **oldElems;
+	/*
+	 * 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.
+	     */
 
-	listRepPtr = AttemptNewList(interp, newMax, NULL);
-	if (listRepPtr == NULL) {
 	    return TCL_ERROR;
 	}
-	oldElems = &oldListRepPtr->elements;
-	elemPtrs = &listRepPtr->elements;
-	for (i=0; i<numElems; i++) {
-	    elemPtrs[i] = oldElems[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
+
+	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.
+	     */
+
+	    memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
+	    ckfree(listRepPtr);
 	}
-	listRepPtr->elemCount = numElems;
-	listRepPtr->refCount++;
-	oldListRepPtr->refCount--;
-	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
-    } else if (newSize) {
-	listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize);
-	listRepPtr->maxElemCount = newMax;
-	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+	listRepPtr = newPtr;
     }
+    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.
      */
 
-    elemPtrs = &listRepPtr->elements;
-    elemPtrs[numElems] = objPtr;
+    *(&listRepPtr->elements + listRepPtr->elemCount) = objPtr;
     Tcl_IncrRefCount(objPtr);
     listRepPtr->elemCount++;
 
@@ -800,23 +852,22 @@ Tcl_ListObjReplace(
     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
+    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;
+    int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
 
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
     }
     if (listPtr->typePtr != &tclListType) {
 	if (listPtr->bytes == tclEmptyStringRep) {
-	    if (objc) {
-		Tcl_SetListObj(listPtr, objc, NULL);
-	    } else {
+	    if (!objc) {
 		return TCL_OK;
 	    }
+	    Tcl_SetListObj(listPtr, objc, NULL);
 	} else {
 	    int result = SetListFromAny(interp, listPtr);
 
@@ -848,6 +899,7 @@ Tcl_ListObjReplace(
 	count = 0;
     } else if (first > INT_MAX - count /* Handle integer overflow */
 	    || numElems < first+count) {
+
 	count = numElems - first;
     }
 
@@ -861,12 +913,39 @@ Tcl_ListObjReplace(
     }
     isShared = (listRepPtr->refCount > 1);
     numRequired = numElems - count + objc; /* Known <= LIST_MAX */
+    needGrow = numRequired > listRepPtr->maxElemCount;
 
     for (i = 0;  i < objc;  i++) {
 	Tcl_IncrRefCount(objv[i]);
     }
 
-    if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
+    if (needGrow && !isShared) {
+	/* Try to use realloc */
+	List *newPtr = NULL;
+	int 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;
+	    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+	    elemPtrs = &listRepPtr->elements;
+	    listRepPtr->maxElemCount = attempt;
+	    needGrow = numRequired > listRepPtr->maxElemCount;
+	}
+    }
+    if (!needGrow && !isShared) {
 	int shift;
 
 	/*
@@ -903,29 +982,37 @@ Tcl_ListObjReplace(
 	Tcl_Obj **oldPtrs = elemPtrs;
 	int newMax;
 
-	if (numRequired > listRepPtr->maxElemCount){
+	if (needGrow){
 	    newMax = 2 * numRequired;
 	} else {
 	    newMax = listRepPtr->maxElemCount;
 	}
 
-	listRepPtr = AttemptNewList(interp, newMax, NULL);
-	if (listRepPtr == NULL) {
-	listRepPtr = AttemptNewList(interp, numRequired, NULL);
+	listRepPtr = AttemptNewList(NULL, newMax, NULL);
 	if (listRepPtr == NULL) {
-	    for (i = 0;  i < objc;  i++) {
-		/* See bug 3598580 */
+	    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) {
+		    for (i = 0;  i < objc;  i++) {
+			/* See bug 3598580 */
 #if TCL_MAJOR_VERSION > 8
-		Tcl_DecrRefCount(objv[i]);
+			Tcl_DecrRefCount(objv[i]);
 #else
-		objv[i]->refCount--;
+			objv[i]->refCount--;
 #endif
+		    }
+		    return TCL_ERROR;
+		}
 	    }
-	    return TCL_ERROR;
-	}
 	}
 
-	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
 	listRepPtr->refCount++;
 
 	elemPtrs = &listRepPtr->elements;
@@ -979,7 +1066,7 @@ Tcl_ListObjReplace(
 			(size_t) numAfterLast * sizeof(Tcl_Obj *));
 	    }
 
-	    ckfree((char *) oldListRepPtr);
+	    ckfree(oldListRepPtr);
 	}
     }
 
@@ -1039,8 +1126,6 @@ TclLindexList(
 {
 
     int index;			/* Index into the list. */
-    Tcl_Obj **indices = NULL;	/* Array of list indices. */
-    int indexCount = -1;	/* Size of the array of list indices. */
     Tcl_Obj *indexListCopy;
 
     /*
@@ -1080,8 +1165,19 @@ TclLindexList(
 	return TclLindexFlat(interp, listPtr, 1, &argPtr);
     }
 
-    TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
-    listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+    if (indexListCopy->typePtr == &tclListType) {
+	List *listRepPtr = ListRepPtr(indexListCopy);
+
+	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. */
+
+	Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
+	listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+    }
     Tcl_DecrRefCount(indexListCopy);
     return listPtr;
 }
@@ -1263,8 +1359,8 @@ TclLsetList(
  *
  * 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.
+ *	occurred. The returned object includes one reference count for the
+ *	pointer returned.
  *
  * Side effects:
  *	On entry, the reference count of the variable value does not reflect
@@ -1306,12 +1402,12 @@ TclLsetFlat(
 				/* Index args. */
     Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
 {
-    int index, result;
+    int index, result, len;
     Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
 
     /*
-     * If there are no indices, simply return the new value.
-     * (Without indices, [lset] is a synonym for [set].
+     * If there are no indices, simply return the new value.  (Without
+     * indices, [lset] is a synonym for [set].
      */
 
     if (indexCount == 0) {
@@ -1320,14 +1416,14 @@ TclLsetFlat(
     }
 
     /*
-     * 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 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.
      */
 
     subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
@@ -1339,21 +1435,25 @@ TclLsetFlat(
 
     retValuePtr = subListPtr;
     chainPtr = NULL;
+    result = TCL_OK;
 
     /*
-     * Loop through all the index arguments, and for each one dive
-     * into the appropriate sublist.
+     * Loop through all the index arguments, and for each one dive into the
+     * appropriate sublist.
      */
 
     do {
 	int elemCount;
 	Tcl_Obj *parentList, **elemPtrs;
 
-	/* Check for the possible error conditions... */
-	result = TCL_ERROR;
+	/*
+	 * Check for the possible error conditions...
+	 */
+
 	if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
 		!= TCL_OK) {
 	    /* ...the sublist we're indexing into isn't a list at all. */
+	    result = TCL_ERROR;
 	    break;
 	}
 
@@ -1361,35 +1461,42 @@ TclLsetFlat(
 	 * WARNING: the macro TclGetIntForIndexM is not safe for
 	 * post-increments, avoid '*indexArray++' here.
 	 */
-	
+
 	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++;
 	    break;
 	}
 	indexArray++;
 
-	if (index < 0 || index >= elemCount) {
+	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);
 	    }
+	    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.
+	 * 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.
 	 */
 
-	result = TCL_OK;
 	if (--indexCount) {
 	    parentList = subListPtr;
-	    subListPtr = elemPtrs[index];
+	    if (index == elemCount) {
+		subListPtr = Tcl_NewObj();
+	    } else {
+		subListPtr = elemPtrs[index];
+	    }
 	    if (Tcl_IsShared(subListPtr)) {
 		subListPtr = Tcl_DuplicateObj(subListPtr);
 	    }
@@ -1399,73 +1506,91 @@ TclLsetFlat(
 	     * 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.
+	     * subListPtr to become shared again, so detect that case and make
+	     * and store another copy.
 	     */
 
-	    TclListObjSetElement(NULL, parentList, index, subListPtr);
+	    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);
 	    }
 
 	    /*
-	     * 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.
+	     * 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 = (void *) chainPtr;
+	    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.
+     * 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;
 
 	if (result == TCL_OK) {
-
 	    /*
-	     * We're going to store valuePtr, so spoil string reps
-	     * of all containing lists.
+	     * We're going to store valuePtr, so spoil string reps of all
+	     * containing lists.
 	     */
 
 	    TclInvalidateStringRep(objPtr);
 	}
 
-	/* Clear away our intrep surgery mess */
-	chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+	/*
+	 * Clear away our intrep surgery mess.
+	 */
+
+	chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
 	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     }
 
     if (result != TCL_OK) {
-	/* 
-	 * Error return; message is already in interp. Clean up
-	 * any excess memory. 
+	/*
+	 * Error return; message is already in interp. Clean up any excess
+	 * memory.
 	 */
+
 	if (retValuePtr != listPtr) {
 	    Tcl_DecrRefCount(retValuePtr);
 	}
 	return NULL;
     }
 
-    /* Store valuePtr in proper sublist and return */
-    TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+    /*
+     * 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).
+     */
+
+    len = -1;
+    TclListObjLength(NULL, subListPtr, &len);
+    if (index == len) {
+	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
+    } else {
+	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+    }
     TclInvalidateStringRep(subListPtr);
     Tcl_IncrRefCount(retValuePtr);
     return retValuePtr;
@@ -1529,6 +1654,8 @@ TclListObjSetElement(
 	    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;
 	}
@@ -1540,7 +1667,6 @@ TclListObjSetElement(
 
     listRepPtr = ListRepPtr(listPtr);
     elemCount = listRepPtr->elemCount;
-    elemPtrs = &listRepPtr->elements;
 
     /*
      * Ensure that the index is in bounds.
@@ -1550,6 +1676,8 @@ TclListObjSetElement(
 	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;
     }
@@ -1559,25 +1687,30 @@ TclListObjSetElement(
      */
 
     if (listRepPtr->refCount > 1) {
-	List *oldListRepPtr = listRepPtr;
-	Tcl_Obj **oldElemPtrs = elemPtrs;
-	int i;
+	Tcl_Obj **dst, **src = &listRepPtr->elements;
+	List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);
 
-	listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
-	if (listRepPtr == NULL) {
-	    return TCL_ERROR;
+	if (newPtr == NULL) {
+	    newPtr = AttemptNewList(interp, elemCount, NULL);
+	    if (newPtr == NULL) {
+		return TCL_ERROR;
+	    }
 	}
-	listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
-	elemPtrs = &listRepPtr->elements;
-	for (i=0; i < elemCount; i++) {
-	    elemPtrs[i] = oldElemPtrs[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
+	newPtr->refCount++;
+	newPtr->elemCount = elemCount;
+	newPtr->canonicalFlag = listRepPtr->canonicalFlag;
+
+	dst = &newPtr->elements;
+	while (elemCount--) {
+	    *dst = *src++;
+	    Tcl_IncrRefCount(*dst++);
 	}
-	listRepPtr->refCount++;
-	listRepPtr->elemCount = elemCount;
-	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
-	oldListRepPtr->refCount--;
+
+	listRepPtr->refCount--;
+
+	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
     }
+    elemPtrs = &listRepPtr->elements;
 
     /*
      * Add a reference to the new list element.
@@ -1625,14 +1758,14 @@ FreeListInternalRep(
 {
     List *listRepPtr = ListRepPtr(listPtr);
 
-    if (--listRepPtr->refCount <= 0) {
+    if (listRepPtr->refCount-- <= 1) {
 	Tcl_Obj **elemPtrs = &listRepPtr->elements;
 	int i, numElems = listRepPtr->elemCount;
 
 	for (i = 0;  i < numElems;  i++) {
 	    Tcl_DecrRefCount(elemPtrs[i]);
 	}
-	ckfree((char *) listRepPtr);
+	ckfree(listRepPtr);
     }
 
     listPtr->typePtr = NULL;
@@ -1744,19 +1877,23 @@ SetListFromAny(
 	 */
 
 	estCount = TclMaxListLength(nextElem, length, &limit);
-	estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
+	estCount += (estCount == 0);	/* Smallest list struct holds 1
+					 * element. */
 	listRepPtr = AttemptNewList(interp, estCount, NULL);
 	if (listRepPtr == NULL) {
 	    return TCL_ERROR;
 	}
 	elemPtrs = &listRepPtr->elements;
 
-	/* Each iteration, parse and store a list element */
+	/*
+	 * Each iteration, parse and store a list element.
+	 */
+
 	while (nextElem < limit) {
 	    const char *elemStart;
 	    int elemSize, literal;
 
-	    if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem),
+	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
 		    &elemStart, &nextElem, &elemSize, &literal)) {
 		while (--elemPtrs >= &listRepPtr->elements) {
 		    Tcl_DecrRefCount(*elemPtrs);
@@ -1825,7 +1962,8 @@ UpdateStringOfList(
     List *listRepPtr = ListRepPtr(listPtr);
     int numElems = listRepPtr->elemCount;
     int i, length, bytesNeeded = 0;
-    char *elem, *dst;
+    const char *elem;
+    char *dst;
     Tcl_Obj **elemPtrs;
 
     /*
@@ -1836,7 +1974,9 @@ UpdateStringOfList(
 
     listRepPtr->canonicalFlag = 1;
 
-    /* Handle empty list case first, so rest of the routine is simpler */
+    /*
+     * Handle empty list case first, so rest of the routine is simpler.
+     */
 
     if (numElems == 0) {
 	listPtr->bytes = tclEmptyStringRep;
@@ -1851,12 +1991,15 @@ UpdateStringOfList(
     if (numElems <= LOCAL_SIZE) {
 	flagPtr = localFlags;
     } else {
-	/* We know numElems <= LIST_MAX, so this is safe. */
-	flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int));
+	/*
+	 * We know numElems <= LIST_MAX, so this is safe.
+	 */
+
+	flagPtr = ckalloc(numElems * sizeof(int));
     }
     elemPtrs = &listRepPtr->elements;
     for (i = 0; i < numElems; i++) {
-	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
 	elem = TclGetStringFromObj(elemPtrs[i], &length);
 	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
 	if (bytesNeeded < 0) {
@@ -1873,10 +2016,10 @@ UpdateStringOfList(
      */
 
     listPtr->length = bytesNeeded - 1;
-    listPtr->bytes = ckalloc((unsigned) bytesNeeded);
+    listPtr->bytes = ckalloc(bytesNeeded);
     dst = listPtr->bytes;
     for (i = 0; i < numElems; i++) {
-	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
+	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
 	elem = TclGetStringFromObj(elemPtrs[i], &length);
 	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
 	*dst++ = ' ';
@@ -1884,7 +2027,7 @@ UpdateStringOfList(
     listPtr->bytes[listPtr->length] = '\0';
 
     if (flagPtr != localFlags) {
-	ckfree((char *) flagPtr);
+	ckfree(flagPtr);
     }
 }
 
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index fb7c28a..4ae94a0 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -31,7 +31,7 @@
 static int		AddLocalLiteralEntry(CompileEnv *envPtr,
 			    Tcl_Obj *objPtr, int localHash);
 static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
-static unsigned int	HashString(const char *bytes, int length);
+static unsigned		HashString(const char *string, int length);
 #ifdef TCL_COMPILE_DEBUG
 static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
@@ -63,7 +63,7 @@ TclInitLiteralTable(
 				 * supplied by the caller. */
 {
 #if (TCL_SMALL_HASH_TABLE != 4)
-    Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4",
+    Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable",
 	    TCL_SMALL_HASH_TABLE);
 #endif
 
@@ -131,7 +131,7 @@ TclDeleteLiteralTable(
 	    objPtr = entryPtr->objPtr;
 	    TclDecrRefCount(objPtr);
 	    nextPtr = entryPtr->nextPtr;
-	    ckfree((char *) entryPtr);
+	    ckfree(entryPtr);
 	    entryPtr = nextPtr;
 	}
     }
@@ -141,7 +141,7 @@ TclDeleteLiteralTable(
      */
 
     if (tablePtr->buckets != tablePtr->staticBuckets) {
-	ckfree((char *) tablePtr->buckets);
+	ckfree(tablePtr->buckets);
     }
 }
 
@@ -157,16 +157,16 @@ TclDeleteLiteralTable(
  *
  * 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.
+ *	1, else 0. NULL is returned if newPtr==NULL and no literal is found.
  *
  * 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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
@@ -174,15 +174,17 @@ TclDeleteLiteralTable(
 Tcl_Obj *
 TclCreateLiteral(
     Interp *iPtr,
-    char *bytes,
-    int length,
-    unsigned int hash,       /* The string's hash. If -1, it will be computed here */
+    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)
 {
-    LiteralTable *globalTablePtr = &(iPtr->literalTable);
+    LiteralTable *globalTablePtr = &iPtr->literalTable;
     LiteralEntry *globalPtr;
     int globalHash;
     Tcl_Obj *objPtr;
@@ -191,7 +193,7 @@ TclCreateLiteral(
      * Is it in the interpreter's global literal table?
      */
 
-    if (hash == (unsigned int) -1) {
+    if (hash == (unsigned) -1) {
 	hash = HashString(bytes, length);
     }
     globalHash = (hash & globalTablePtr->mask);
@@ -212,7 +214,7 @@ TclCreateLiteral(
 	    if (globalPtrPtr) {
 		*globalPtrPtr = globalPtr;
 	    }
-	    if (flags & LITERAL_ON_HEAP) {
+	    if ((flags & LITERAL_ON_HEAP)) {
 		ckfree(bytes);
 	    }
 	    globalPtr->refCount++;
@@ -220,7 +222,7 @@ TclCreateLiteral(
 	}
     }
     if (!newPtr) {
-	if (flags & LITERAL_ON_HEAP) {
+	if ((flags & LITERAL_ON_HEAP)) {
 	    ckfree(bytes);
 	}
 	return NULL;
@@ -232,23 +234,33 @@ TclCreateLiteral(
      */
 
     TclNewObj(objPtr);
-    Tcl_IncrRefCount(objPtr);
-    if (flags & LITERAL_ON_HEAP) {
+    if ((flags & LITERAL_ON_HEAP)) {
 	objPtr->bytes = bytes;
 	objPtr->length = length;
     } else {
 	TclInitStringRep(objPtr, bytes, length);
     }
 
+    if ((flags & LITERAL_UNSHARED)) {
+	/*
+	 * Make clear, that no global value is returned
+	 */
+	if (globalPtrPtr != NULL) {
+	    *globalPtrPtr = NULL;
+	}
+	return objPtr;
+    }
+
 #ifdef TCL_COMPILE_DEBUG
     if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
-	Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
-		(length>60? 60 : length), bytes);
+	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
+		"TclRegisterLiteral", (length>60? 60 : length), bytes);
     }
 #endif
 
-    globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
+    globalPtr = ckalloc(sizeof(LiteralEntry));
     globalPtr->objPtr = objPtr;
+    Tcl_IncrRefCount(objPtr);
     globalPtr->refCount = 1;
     globalPtr->nsPtr = nsPtr;
     globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
@@ -280,8 +292,8 @@ TclCreateLiteral(
 	    }
 	}
 	if (!found) {
-	    Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
-		    (length>60? 60 : length), bytes);
+	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
+		    "TclRegisterLiteral", (length>60? 60 : length), bytes);
 	}
     }
 #endif /*TCL_COMPILE_DEBUG*/
@@ -303,6 +315,33 @@ TclCreateLiteral(
 /*
  *----------------------------------------------------------------------
  *
+ * TclFetchLiteral --
+ *
+ *	Fetch from a CompileEnv the literal value identified by an index
+ *	value, as returned by a prior call to TclRegisterLiteral().
+ *
+ * Results:
+ *	The literal value, or NULL if the index is out of range.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclFetchLiteral(
+    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
+				 * fetch the registered literal value. */
+    unsigned int index)		/* Index of the desired literal, as returned
+				 * by prior call to TclRegisterLiteral() */
+{
+    if (index >= (unsigned int) envPtr->literalArrayNext) {
+	return NULL;
+    }
+    return envPtr->literalArrayPtr[index].objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclRegisterLiteral --
  *
  *	Find, or if necessary create, an object in a CompileEnv literal array
@@ -329,7 +368,7 @@ TclCreateLiteral(
 
 int
 TclRegisterLiteral(
-    CompileEnv *envPtr,		/* Points to the CompileEnv in whose object
+    void *ePtr,		/* 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
@@ -339,15 +378,16 @@ TclRegisterLiteral(
 				 * first null character. */
     int flags)			/* If LITERAL_ON_HEAP then the caller already
 				 * malloc'd bytes and ownership is passed to
-				 * this function. If LITERAL_NS_SCOPE then
-				 * the literal shouldnot be shared accross
+				 * this function. If LITERAL_CMD_NAME then
+				 * the literal should not be shared accross
 				 * namespaces. */
 {
+    CompileEnv *envPtr = ePtr;
     Interp *iPtr = envPtr->iPtr;
-    LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    LiteralTable *localTablePtr = &envPtr->localLitTable;
     LiteralEntry *globalPtr, *localPtr;
     Tcl_Obj *objPtr;
-    unsigned int hash;
+    unsigned hash;
     int localHash, objIndex, new;
     Namespace *nsPtr;
 
@@ -368,7 +408,7 @@ TclRegisterLiteral(
 	if ((objPtr->length == length) && ((length == 0)
 		|| ((objPtr->bytes[0] == bytes[0])
 		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
-	    if (flags & LITERAL_ON_HEAP) {
+	    if ((flags & LITERAL_ON_HEAP)) {
 		ckfree(bytes);
 	    }
 	    objIndex = (localPtr - envPtr->literalArrayPtr);
@@ -381,14 +421,18 @@ TclRegisterLiteral(
     }
 
     /*
-     * The literal is new to this CompileEnv. Should it be shared accross
-     * namespaces? If it is a fully qualified name, the namespace
-     * specification is not needed to avoid sharing.
+     * 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_NS_SCOPE) && iPtr->varFramePtr
-	    && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
-	nsPtr = iPtr->varFramePtr->nsPtr;
+    if ((flags & LITERAL_CMD_NAME)) {
+	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
+	    nsPtr = iPtr->globalNsPtr;
+	} else {
+	    nsPtr = iPtr->varFramePtr->nsPtr;
+	}
     } else {
 	nsPtr = NULL;
     }
@@ -397,14 +441,16 @@ TclRegisterLiteral(
      * Is it in the interpreter's global literal table? If not, create it.
      */
 
-    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr,
-	    flags, &globalPtr);
+    globalPtr = NULL;
+    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
+	    &globalPtr);
     objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
 
 #ifdef TCL_COMPILE_DEBUG
-    if (globalPtr->refCount < 1) {
-	Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
-		(length>60? 60 : length), bytes, globalPtr->refCount);
+    if (globalPtr != NULL && 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*/
@@ -438,9 +484,9 @@ LookupLiteralEntry(
 				 * TclRegisterLiteral. */
 {
     Interp *iPtr = (Interp *) interp;
-    LiteralTable *globalTablePtr = &(iPtr->literalTable);
+    LiteralTable *globalTablePtr = &iPtr->literalTable;
     register LiteralEntry *entryPtr;
-    char *bytes;
+    const char *bytes;
     int length, globalHash;
 
     bytes = TclGetStringFromObj(objPtr, &length);
@@ -485,12 +531,12 @@ TclHideLiteral(
 				 * array. */
 {
     LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
-    LiteralTable *localTablePtr = &(envPtr->localLitTable);
+    LiteralTable *localTablePtr = &envPtr->localLitTable;
     int localHash, length;
-    char *bytes;
+    const 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
@@ -558,7 +604,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,7 +630,7 @@ TclAddLiteralObj(
  *
  * 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.
+ *	array of the CompileEnv's literal array if it becomes too large.
  *
  *----------------------------------------------------------------------
  */
@@ -593,10 +639,10 @@ 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. */
+    Tcl_Obj *objPtr,		/* 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;
 
@@ -637,8 +683,8 @@ AddLocalLiteralEntry(
 
 	if (!found) {
 	    bytes = Tcl_GetStringFromObj(objPtr, &length);
-	    Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
-		    (length>60? 60 : length), bytes);
+	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
+		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
 	}
     }
 #endif /*TCL_COMPILE_DEBUG*/
@@ -676,7 +722,7 @@ ExpandLocalLiteralArray(
      * 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;
@@ -690,14 +736,14 @@ ExpandLocalLiteralArray(
     }
 
     if (envPtr->mallocedLiteralArray) {
-	newArrayPtr = (LiteralEntry *) ckrealloc(
-		(char *)currArrayPtr, newSize);
+	newArrayPtr = ckrealloc(currArrayPtr, newSize);
     } else {
 	/*
 	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
-	 * code a ckrealloc equivalent for ourselves
+	 * code a ckrealloc equivalent for ourselves.
 	 */
-	newArrayPtr = (LiteralEntry *) ckalloc(newSize);
+
+	newArrayPtr = ckalloc(newSize);
 	memcpy(newArrayPtr, currArrayPtr, currBytes);
 	envPtr->mallocedLiteralArray = 1;
     }
@@ -755,11 +801,16 @@ TclReleaseLiteral(
 				 * TclRegisterLiteral. */
 {
     Interp *iPtr = (Interp *) interp;
-    LiteralTable *globalTablePtr = &(iPtr->literalTable);
+    LiteralTable *globalTablePtr;
     register LiteralEntry *entryPtr, *prevPtr;
-    char *bytes;
+    const char *bytes;
     int length, index;
 
+    if (iPtr == NULL) {
+	goto done;
+    }
+
+    globalTablePtr = &iPtr->literalTable;
     bytes = TclGetStringFromObj(objPtr, &length);
     index = (HashString(bytes, length) & globalTablePtr->mask);
 
@@ -786,7 +837,7 @@ TclReleaseLiteral(
 		} else {
 		    prevPtr->nextPtr = entryPtr->nextPtr;
 		}
-		ckfree((char *) entryPtr);
+		ckfree(entryPtr);
 		globalTablePtr->numEntries--;
 
 		TclDecrRefCount(objPtr);
@@ -803,6 +854,7 @@ TclReleaseLiteral(
      * Remove the reference corresponding to the local literal table entry.
      */
 
+    done:
     Tcl_DecrRefCount(objPtr);
 }
 
@@ -823,13 +875,12 @@ TclReleaseLiteral(
  *----------------------------------------------------------------------
  */
 
-static unsigned int
+static unsigned
 HashString(
-    register const char *bytes,	/* String for which to compute hash value. */
+    register const char *string,	/* String for which to compute hash value. */
     int length)			/* Number of bytes in the string. */
 {
-    register unsigned int result;
-    register int i;
+    register unsigned int result = 0;
 
     /*
      * I tried a zillion different hash functions and asked many other people
@@ -839,17 +890,33 @@ HashString(
      * following reasons:
      *
      * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
-     *	  multiplying by 9 is just about as good.
+     *    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.
+     *    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 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]
      */
 
-    result = 0;
-    for (i=0 ; i<length ; i++) {
-	result += (result<<3) + bytes[i];
+    if (length > 0) {
+	result = UCHAR(*string);
+	while (--length) {
+	    result += (result << 3) + UCHAR(*++string);
+	}
     }
     return result;
 }
@@ -881,7 +948,7 @@ RebuildLiteralTable(
     register LiteralEntry **oldChainPtr, **newChainPtr;
     register LiteralEntry *entryPtr;
     LiteralEntry **bucketPtr;
-    char *bytes;
+    const char *bytes;
     unsigned int oldSize;
     int count, index, length;
 
@@ -904,8 +971,7 @@ RebuildLiteralTable(
     }
 
     tablePtr->numBuckets *= 4;
-    tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
-	    (tablePtr->numBuckets * sizeof(LiteralEntry *)));
+    tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
     for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
 	    count>0 ; count--, newChainPtr++) {
 	*newChainPtr = NULL;
@@ -923,7 +989,7 @@ RebuildLiteralTable(
 	    index = (HashString(bytes, length) & tablePtr->mask);
 
 	    *oldChainPtr = entryPtr->nextPtr;
-	    bucketPtr = &(tablePtr->buckets[index]);
+	    bucketPtr = &tablePtr->buckets[index];
 	    entryPtr->nextPtr = *bucketPtr;
 	    *bucketPtr = entryPtr;
 	}
@@ -934,7 +1000,52 @@ RebuildLiteralTable(
      */
 
     if (oldBuckets != tablePtr->staticBuckets) {
-	ckfree((char *) oldBuckets);
+	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) {
+	if (literalObjPtr->typePtr == &tclCmdNameType) {
+	    TclFreeIntRep(literalObjPtr);
+	}
+	/* Balance the refcount effects of TclCreateLiteral() above */
+	Tcl_IncrRefCount(literalObjPtr);
+	TclReleaseLiteral(interp, literalObjPtr);
     }
 }
 
@@ -996,7 +1107,7 @@ TclLiteralStats(
      * Print out the histogram and a few other pieces of information.
      */
 
-    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+    result = ckalloc(NUM_COUNTERS*60 + 300);
     sprintf(result, "%d entries in table, %d buckets\n",
 	    tablePtr->numEntries, tablePtr->numBuckets);
     p = result + strlen(result);
@@ -1035,7 +1146,7 @@ TclVerifyLocalLiteralTable(
     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;
@@ -1048,23 +1159,20 @@ TclVerifyLocalLiteralTable(
 	    count++;
 	    if (localPtr->refCount != -1) {
 		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
-		Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
+		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
+			"TclVerifyLocalLiteralTable",
 			(length>60? 60 : length), bytes, localPtr->refCount);
 	    }
-	    if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
-		    localPtr->objPtr) == NULL) {
-		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
-		Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
-			(length>60? 60 : length), bytes);
-	    }
 	    if (localPtr->objPtr->bytes == NULL) {
-		Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
+		Tcl_Panic("%s: literal has NULL string rep",
+			"TclVerifyLocalLiteralTable");
 	    }
 	}
     }
     if (count != localTablePtr->numEntries) {
-	Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
-		count, localTablePtr->numEntries);
+	Tcl_Panic("%s: local literal table had %d entries, should be %d",
+		"TclVerifyLocalLiteralTable", count,
+		localTablePtr->numEntries);
     }
 }
 
@@ -1089,7 +1197,7 @@ TclVerifyGlobalLiteralTable(
     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;
@@ -1102,17 +1210,20 @@ TclVerifyGlobalLiteralTable(
 	    count++;
 	    if (globalPtr->refCount < 1) {
 		bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
-		Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
+			"TclVerifyGlobalLiteralTable",
 			(length>60? 60 : length), bytes, globalPtr->refCount);
 	    }
 	    if (globalPtr->objPtr->bytes == NULL) {
-		Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
+		Tcl_Panic("%s: literal has NULL string rep",
+			"TclVerifyGlobalLiteralTable");
 	    }
 	}
     }
     if (count != globalTablePtr->numEntries) {
-	Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
-		count, globalTablePtr->numEntries);
+	Tcl_Panic("%s: global literal table had %d entries, should be %d",
+		"TclVerifyGlobalLiteralTable", count,
+		globalTablePtr->numEntries);
     }
 }
 #endif /*TCL_COMPILE_DEBUG*/
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index ac863b9..7c70e03 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -55,11 +55,6 @@ typedef struct LoadedPackage {
 				 * in trusted interpreters. */
     int safeInterpRefCount;	/* How many times the package has been loaded
 				 * in safe interpreters. */
-    Tcl_FSUnloadFileProc *unLoadProcPtr;
-				/* Function to use to unload this package. If
-				 * NULL, then we do not attempt to unload the
-				 * package. If fileName is NULL, then this
-				 * field is irrelevant. */
     struct LoadedPackage *nextPtr;
 				/* Next in list of all packages loaded into
 				 * this application process. NULL means end of
@@ -129,19 +124,42 @@ Tcl_LoadObjCmd(
     LoadedPackage *pkgPtr, *defaultPtr;
     Tcl_DString pkgName, tmp, initName, safeInitName;
     Tcl_DString unloadName, safeUnloadName;
-    Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc;
     InterpPackage *ipFirstPtr, *ipPtr;
     int code, namesMatch, filesMatch, offset;
-    const char *symbols[4];
-    Tcl_PackageInitProc **procPtrs[4];
-    ClientData clientData;
-    char *p, *fullFileName, *packageName;
+    const char *symbols[2];
+    Tcl_PackageInitProc *initProc;
+    const char *p, *fullFileName, *packageName;
     Tcl_LoadHandle loadHandle;
-    Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
     Tcl_UniChar ch;
+    unsigned len;
+    int index, flags = 0;
+    Tcl_Obj *const *savedobjv = objv;
+    static const char *const options[] = {
+	"-global",		"-lazy",		"--",	NULL
+    };
+    enum options {
+	LOAD_GLOBAL,	LOAD_LAZY,	LOAD_LAST
+    };
 
+    while (objc > 2) {
+	if (TclGetString(objv[1])[0] != '-') {
+	    break;
+	}
+	if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	++objv; --objc;
+	if (LOAD_GLOBAL == (enum options) index) {
+	    flags |= TCL_LOAD_GLOBAL;
+	} else if (LOAD_LAZY == (enum options) index) {
+	    flags |= TCL_LOAD_LAZY;
+	} else {
+		break;
+	}
+    }
     if ((objc < 2) || (objc > 4)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
+	Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
 	return TCL_ERROR;
     }
     if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
@@ -164,9 +182,10 @@ Tcl_LoadObjCmd(
 	}
     }
     if ((fullFileName[0] == 0) && (packageName == NULL)) {
-	Tcl_SetResult(interp,
-		"must specify either file name or package name",
-		TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"must specify either file name or package name", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
+		NULL);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -177,7 +196,7 @@ Tcl_LoadObjCmd(
 
     target = interp;
     if (objc == 4) {
-	char *slaveIntName = Tcl_GetString(objv[3]);
+	const char *slaveIntName = Tcl_GetString(objv[3]);
 
 	target = Tcl_GetSlave(interp, slaveIntName);
 	if (target == NULL) {
@@ -203,9 +222,9 @@ Tcl_LoadObjCmd(
 	if (packageName == NULL) {
 	    namesMatch = 0;
 	} else {
-	    Tcl_DStringSetLength(&pkgName, 0);
+	    TclDStringClear(&pkgName);
 	    Tcl_DStringAppend(&pkgName, packageName, -1);
-	    Tcl_DStringSetLength(&tmp, 0);
+	    TclDStringClear(&tmp);
 	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
 	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
 	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
@@ -216,7 +235,7 @@ Tcl_LoadObjCmd(
 		namesMatch = 0;
 	    }
 	}
-	Tcl_DStringSetLength(&pkgName, 0);
+	TclDStringClear(&pkgName);
 
 	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
 	if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -230,9 +249,11 @@ Tcl_LoadObjCmd(
 	     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "file \"%s\" is already loaded for package \"%s\"",
+		    fullFileName, pkgPtr->packageName));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
+		    "SPLITPERSONALITY", NULL);
 	    code = TCL_ERROR;
 	    Tcl_MutexUnlock(&packageMutex);
 	    goto done;
@@ -250,8 +271,7 @@ Tcl_LoadObjCmd(
      */
 
     if (pkgPtr != NULL) {
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
-		"tclLoad", NULL);
+	ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
 	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	    if (ipPtr->pkgPtr == pkgPtr) {
 		code = TCL_OK;
@@ -267,8 +287,10 @@ Tcl_LoadObjCmd(
 	 */
 
 	if (fullFileName[0] == 0) {
-	    Tcl_AppendResult(interp, "package \"", packageName,
-		    "\" isn't loaded statically", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "package \"%s\" isn't loaded statically", packageName));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
+		    NULL);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -288,10 +310,9 @@ Tcl_LoadObjCmd(
 
 	    retc = TclGuessPackageName(fullFileName, &pkgName);
 	    if (!retc) {
-		Tcl_Obj *splitPtr;
-		Tcl_Obj *pkgGuessPtr;
+		Tcl_Obj *splitPtr, *pkgGuessPtr;
 		int pElements;
-		char *pkgGuess;
+		const char *pkgGuess;
 
 		/*
 		 * The platform-specific code couldn't figure out the module
@@ -324,13 +345,15 @@ Tcl_LoadObjCmd(
 		}
 		if (p == pkgGuess) {
 		    Tcl_DecrRefCount(splitPtr);
-		    Tcl_AppendResult(interp,
-			    "couldn't figure out package name for ",
-			    fullFileName, NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "couldn't figure out package name for %s",
+			    fullFileName));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
+			    "WHATPACKAGE", NULL);
 		    code = TCL_ERROR;
 		    goto done;
 		}
-		Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
+		Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
 		Tcl_DecrRefCount(splitPtr);
 	    }
 	}
@@ -349,14 +372,14 @@ Tcl_LoadObjCmd(
 	 * 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);
+	TclDStringAppendDString(&initName, &pkgName);
+	TclDStringAppendLiteral(&initName, "_Init");
+	TclDStringAppendDString(&safeInitName, &pkgName);
+	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
+	TclDStringAppendDString(&unloadName, &pkgName);
+	TclDStringAppendLiteral(&unloadName, "_Unload");
+	TclDStringAppendDString(&safeUnloadName, &pkgName);
+	TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
 
 	/*
 	 * Call platform-specific code to load the package and find the two
@@ -364,50 +387,38 @@ Tcl_LoadObjCmd(
 	 */
 
 	symbols[0] = Tcl_DStringValue(&initName);
-	symbols[1] = Tcl_DStringValue(&safeInitName);
-	symbols[2] = Tcl_DStringValue(&unloadName);
-	symbols[3] = Tcl_DStringValue(&safeUnloadName);
-	procPtrs[0] = &initProc;
-	procPtrs[1] = &safeInitProc;
-	procPtrs[2] = &unloadProc;
-	procPtrs[3] = &safeUnloadProc;
+	symbols[1] = NULL;
 
 	Tcl_MutexLock(&packageMutex);
-	code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs,
-		&loadHandle, &clientData, &unLoadProcPtr);
+	code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
+		&loadHandle);
 	Tcl_MutexUnlock(&packageMutex);
-	loadHandle = (Tcl_LoadHandle) clientData;
 	if (code != TCL_OK) {
 	    goto done;
 	}
 
-	if (*procPtrs[0] /* initProc */ == NULL) {
-	    Tcl_AppendResult(interp, "couldn't find procedure ",
-		    Tcl_DStringValue(&initName), NULL);
-	    if (unLoadProcPtr != NULL) {
-		(*unLoadProcPtr)(loadHandle);
-	    }
-	    code = TCL_ERROR;
-	    goto done;
-	}
-
 	/*
 	 * Create a new record to describe this package.
 	 */
 
-	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 = 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->unLoadProcPtr	   = unLoadProcPtr;
-	pkgPtr->initProc	   = *procPtrs[0];
-	pkgPtr->safeInitProc	   = *procPtrs[1];
-	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc*) *procPtrs[2];
-	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc*) *procPtrs[3];
+	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;
 
@@ -415,6 +426,13 @@ Tcl_LoadObjCmd(
 	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);
     }
 
     /*
@@ -423,52 +441,64 @@ Tcl_LoadObjCmd(
      */
 
     if (Tcl_IsSafe(target)) {
-	if (pkgPtr->safeInitProc != NULL) {
-	    code = (*pkgPtr->safeInitProc)(target);
-	} else {
-	    Tcl_AppendResult(interp,
-		    "can't use package in a safe interpreter: no ",
-		    pkgPtr->packageName, "_SafeInit procedure", NULL);
+	if (pkgPtr->safeInitProc == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't use package in a safe interpreter: no"
+		    " %s_SafeInit procedure", pkgPtr->packageName));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
+		    NULL);
 	    code = TCL_ERROR;
 	    goto done;
 	}
+	code = pkgPtr->safeInitProc(target);
     } else {
-	code = (*pkgPtr->initProc)(target);
+	if (pkgPtr->initProc == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't attach package to interpreter: no %s_Init procedure",
+		    pkgPtr->packageName));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
+		    NULL);
+	    code = TCL_ERROR;
+	    goto done;
+	}
+	code = pkgPtr->initProc(target);
     }
 
     /*
-     * Record the fact that the package has been loaded in the target
-     * interpreter.
+     * Test for whether the initialization failed. If so, transfer the error
+     * from the target interpreter to the originating one.
      */
 
-    if (code == TCL_OK) {
-	/*
-	 * Update the proper reference count.
-	 */
-
-	Tcl_MutexLock(&packageMutex);
-	if (Tcl_IsSafe(target)) {
-	    ++pkgPtr->safeInterpRefCount;
-	} else {
-	    ++pkgPtr->interpRefCount;
-	}
-	Tcl_MutexUnlock(&packageMutex);
+    if (code != TCL_OK) {
+	Tcl_TransferResult(target, code, interp);
+	goto done;
+    }
 
-	/*
-	 * Refetch ipFirstPtr: loading the package may have introduced
-	 * additional static packages at the head of the linked list!
-	 */
+    /*
+     * Record the fact that the package has been loaded in the target
+     * interpreter.
+     *
+     * Update the proper reference count.
+     */
 
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
-		"tclLoad", NULL);
-	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
-	ipPtr->pkgPtr = pkgPtr;
-	ipPtr->nextPtr = ipFirstPtr;
-	Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
-		(ClientData) ipPtr);
+    Tcl_MutexLock(&packageMutex);
+    if (Tcl_IsSafe(target)) {
+	pkgPtr->safeInterpRefCount++;
     } else {
-	TclTransferResult(target, code, interp);
+	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);
@@ -512,8 +542,8 @@ Tcl_UnloadObjCmd(
     int i, index, code, complain = 1, keepLibrary = 0;
     int trustedRefCount = -1, safeRefCount = -1;
     const char *fullFileName = "";
-    char *packageName;
-    static const char *options[] = {
+    const char *packageName;
+    static const char *const options[] = {
 	"-nocomplain", "-keeplibrary", "--", NULL
     };
     enum options {
@@ -556,7 +586,7 @@ Tcl_UnloadObjCmd(
   endOfForLoop:
     if ((objc-i < 1) || (objc-i > 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?switches? fileName ?packageName? ?interp?");
+		"?-switch ...? fileName ?packageName? ?interp?");
 	return TCL_ERROR;
     }
     if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
@@ -575,9 +605,10 @@ Tcl_UnloadObjCmd(
 	}
     }
     if ((fullFileName[0] == 0) && (packageName == NULL)) {
-	Tcl_SetResult(interp,
-		"must specify either file name or package name",
-		TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"must specify either file name or package name", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
+		NULL);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -588,8 +619,8 @@ Tcl_UnloadObjCmd(
 
     target = interp;
     if (objc - i == 3) {
-	char *slaveIntName;
-	slaveIntName = Tcl_GetString(objv[i+2]);
+	const char *slaveIntName = Tcl_GetString(objv[i + 2]);
+
 	target = Tcl_GetSlave(interp, slaveIntName);
 	if (target == NULL) {
 	    return TCL_ERROR;
@@ -615,9 +646,9 @@ Tcl_UnloadObjCmd(
 	if (packageName == NULL) {
 	    namesMatch = 0;
 	} else {
-	    Tcl_DStringSetLength(&pkgName, 0);
+	    TclDStringClear(&pkgName);
 	    Tcl_DStringAppend(&pkgName, packageName, -1);
-	    Tcl_DStringSetLength(&tmp, 0);
+	    TclDStringClear(&tmp);
 	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
 	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
 	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
@@ -628,7 +659,7 @@ Tcl_UnloadObjCmd(
 		namesMatch = 0;
 	    }
 	}
-	Tcl_DStringSetLength(&pkgName, 0);
+	TclDStringClear(&pkgName);
 
 	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
 	if (filesMatch && (namesMatch || (packageName == NULL))) {
@@ -647,8 +678,11 @@ Tcl_UnloadObjCmd(
 	 * It's an error to try unload a static package.
 	 */
 
-	Tcl_AppendResult(interp, "package \"", packageName,
-		"\" is loaded statically and cannot be unloaded", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"package \"%s\" is loaded statically and cannot be unloaded",
+		packageName));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
+		NULL);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -657,8 +691,10 @@ Tcl_UnloadObjCmd(
 	 * The DLL pointed by the provided filename has never been loaded.
 	 */
 
-	Tcl_AppendResult(interp, "file \"", fullFileName,
-		"\" has never been loaded", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"file \"%s\" has never been loaded", fullFileName));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
+		NULL);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -671,8 +707,7 @@ Tcl_UnloadObjCmd(
 
     code = TCL_ERROR;
     if (pkgPtr != NULL) {
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
-		"tclLoad", NULL);
+	ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
 	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	    if (ipPtr->pkgPtr == pkgPtr) {
 		code = TCL_OK;
@@ -685,8 +720,11 @@ Tcl_UnloadObjCmd(
 	 * The package has not been loaded in this interpreter.
 	 */
 
-	Tcl_AppendResult(interp, "file \"", fullFileName,
-		"\" has never been loaded in this interpreter", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"file \"%s\" has never been loaded in this interpreter",
+		fullFileName));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
+		NULL);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -699,16 +737,22 @@ Tcl_UnloadObjCmd(
 
     if (Tcl_IsSafe(target)) {
 	if (pkgPtr->safeUnloadProc == NULL) {
-	    Tcl_AppendResult(interp, "file \"", fullFileName,
-		    "\" cannot be unloaded under a safe interpreter", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "file \"%s\" cannot be unloaded under a safe interpreter",
+		    fullFileName));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+		    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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "file \"%s\" cannot be unloaded under a trusted interpreter",
+		    fullFileName));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+		    NULL);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -733,18 +777,18 @@ Tcl_UnloadObjCmd(
 	Tcl_MutexUnlock(&packageMutex);
 
 	if (Tcl_IsSafe(target)) {
-	    --safeRefCount;
+	    safeRefCount--;
 	} else {
-	    --trustedRefCount;
+	    trustedRefCount--;
 	}
 
 	if (safeRefCount <= 0 && trustedRefCount <= 0) {
 	    code = TCL_UNLOAD_DETACH_FROM_PROCESS;
 	}
     }
-    code = (*unloadProc)(target, code);
+    code = unloadProc(target, code);
     if (code != TCL_OK) {
-	TclTransferResult(target, code, interp);
+	Tcl_TransferResult(target, code, interp);
 	goto done;
     }
 
@@ -755,7 +799,7 @@ Tcl_UnloadObjCmd(
 
     Tcl_MutexLock(&packageMutex);
     if (Tcl_IsSafe(target)) {
-	--pkgPtr->safeInterpRefCount;
+	pkgPtr->safeInterpRefCount--;
 
 	/*
 	 * Do not let counter get negative.
@@ -765,7 +809,7 @@ Tcl_UnloadObjCmd(
 	    pkgPtr->safeInterpRefCount = 0;
 	}
     } else {
-	--pkgPtr->interpRefCount;
+	pkgPtr->interpRefCount--;
 
 	/*
 	 * Do not let counter get negative.
@@ -786,7 +830,7 @@ Tcl_UnloadObjCmd(
 	 * Unload the shared library from the application memory...
 	 */
 
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#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
@@ -795,14 +839,8 @@ Tcl_UnloadObjCmd(
 	 */
 
 	if (pkgPtr->fileName[0] != '\0') {
-	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
-
-	    if (unLoadProcPtr != NULL) {
-		Tcl_MutexLock(&packageMutex);
-		if ((pkgPtr->unloadProc != NULL) || (unLoadProcPtr == TclFSUnloadTempFile)) {
-		    (*unLoadProcPtr)(pkgPtr->loadHandle);
-		}
-
+	    Tcl_MutexLock(&packageMutex);
+	    if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
 		/*
 		 * Remove this library from the loaded library cache.
 		 */
@@ -824,8 +862,7 @@ Tcl_UnloadObjCmd(
 		 * Remove this library from the interpreter's library cache.
 		 */
 
-		ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
-			"tclLoad", NULL);
+		ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
 		ipPtr = ipFirstPtr;
 		if (ipPtr->pkgPtr == defaultPtr) {
 		    ipFirstPtr = ipFirstPtr->nextPtr;
@@ -841,22 +878,22 @@ Tcl_UnloadObjCmd(
 		    }
 		}
 		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
-			(ClientData) ipFirstPtr);
+			ipFirstPtr);
 		ckfree(defaultPtr->fileName);
 		ckfree(defaultPtr->packageName);
-		ckfree((char *) defaultPtr);
-		ckfree((char *) ipPtr);
+		ckfree(defaultPtr);
+		ckfree(ipPtr);
 		Tcl_MutexUnlock(&packageMutex);
 	    } else {
-		Tcl_AppendResult(interp, "file \"", fullFileName,
-			"\" cannot be unloaded: filesystem does not support unloading",
-			NULL);
 		code = TCL_ERROR;
 	    }
 	}
 #else
-	Tcl_AppendResult(interp, "file \"", fullFileName,
-		"\" cannot be unloaded: unloading disabled", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"file \"%s\" cannot be unloaded: unloading disabled",
+		fullFileName));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
+		NULL);
 	code = TCL_ERROR;
 #endif
     }
@@ -864,40 +901,10 @@ Tcl_UnloadObjCmd(
   done:
     Tcl_DStringFree(&pkgName);
     Tcl_DStringFree(&tmp);
-    if (!complain && code!=TCL_OK) {
+    if (!complain && (code != TCL_OK)) {
 	code = TCL_OK;
 	Tcl_ResetResult(interp);
     }
-    if (code == TCL_OK) {
-#if 0
-	/*
-	 * Result of [unload] was not documented in TIP#100, so force to be
-	 * the empty string by commenting this out. DKF.
-	 */
-
-	Tcl_Obj *resultObjPtr, *objPtr[2];
-
-	/*
-	 * Our result is the two reference counts.
-	 */
-
-	objPtr[0] = Tcl_NewIntObj(trustedRefCount);
-	objPtr[1] = Tcl_NewIntObj(safeRefCount);
-	if (objPtr[0] == NULL || objPtr[1] == NULL) {
-	    if (objPtr[0]) {
-		Tcl_DecrRefCount(objPtr[0]);
-	    }
-	    if (objPtr[1]) {
-		Tcl_DecrRefCount(objPtr[1]);
-	    }
-	} else {
-	    resultObjPtr = Tcl_NewListObj(2, objPtr);
-	    if (resultObjPtr != NULL) {
-		Tcl_SetObjResult(interp, resultObjPtr);
-	    }
-	}
-#endif
-    }
     return code;
 }
 
@@ -961,12 +968,11 @@ Tcl_StaticPackage(
      * to the list now.
      */
 
-    if ( pkgPtr == NULL ) {
-	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
-	pkgPtr->fileName	= (char *) ckalloc((unsigned) 1);
+    if (pkgPtr == NULL) {
+	pkgPtr = ckalloc(sizeof(LoadedPackage));
+	pkgPtr->fileName	= ckalloc(1);
 	pkgPtr->fileName[0]	= 0;
-	pkgPtr->packageName	= (char *)
-		ckalloc((unsigned) (strlen(pkgName) + 1));
+	pkgPtr->packageName	= ckalloc(strlen(pkgName) + 1);
 	strcpy(pkgPtr->packageName, pkgName);
 	pkgPtr->loadHandle	= NULL;
 	pkgPtr->initProc	= initProc;
@@ -984,10 +990,9 @@ Tcl_StaticPackage(
 	 * it's already loaded.
 	 */
 
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp,
-		"tclLoad", NULL);
-	for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
-	    if ( ipPtr->pkgPtr == pkgPtr ) {
+	ipFirstPtr = Tcl_GetAssocData(interp, "tclLoad", NULL);
+	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+	    if (ipPtr->pkgPtr == pkgPtr) {
 		return;
 	    }
 	}
@@ -997,11 +1002,10 @@ Tcl_StaticPackage(
 	 * loaded.
 	 */
 
-	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+	ipPtr = ckalloc(sizeof(InterpPackage));
 	ipPtr->pkgPtr = pkgPtr;
 	ipPtr->nextPtr = ipFirstPtr;
-	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc,
-		(ClientData) ipPtr);
+	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
     }
 }
 
@@ -1030,7 +1034,7 @@ int
 TclGetLoadedPackages(
     Tcl_Interp *interp,		/* Interpreter in which to return information
 				 * or error message. */
-    char *targetName)		/* Name of target interpreter or NULL. If
+    const char *targetName)	/* Name of target interpreter or NULL. If
 				 * NULL, return info about all interps;
 				 * otherwise, just return info about this
 				 * interpreter. */
@@ -1038,24 +1042,24 @@ TclGetLoadedPackages(
     Tcl_Interp *target;
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr;
-    const char *prefix;
+    Tcl_Obj *resultObj, *pkgDesc[2];
 
     if (targetName == NULL) {
 	/*
 	 * Return information about all of the available packages.
 	 */
 
-	prefix = "{";
+	resultObj = Tcl_NewObj();
 	Tcl_MutexLock(&packageMutex);
 	for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
 		pkgPtr = pkgPtr->nextPtr) {
-	    Tcl_AppendResult(interp, prefix, NULL);
-	    Tcl_AppendElement(interp, pkgPtr->fileName);
-	    Tcl_AppendElement(interp, pkgPtr->packageName);
-	    Tcl_AppendResult(interp, "}", NULL);
-	    prefix = " {";
+	    pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+	    pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewListObj(2, pkgDesc));
 	}
 	Tcl_MutexUnlock(&packageMutex);
+	Tcl_SetObjResult(interp, resultObj);
 	return TCL_OK;
     }
 
@@ -1068,16 +1072,15 @@ TclGetLoadedPackages(
     if (target == NULL) {
 	return TCL_ERROR;
     }
-    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", NULL);
-    prefix = "{";
-    for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+    ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
+    resultObj = Tcl_NewObj();
+    for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	pkgPtr = ipPtr->pkgPtr;
-	Tcl_AppendResult(interp, prefix, NULL);
-	Tcl_AppendElement(interp, pkgPtr->fileName);
-	Tcl_AppendElement(interp, pkgPtr->packageName);
-	Tcl_AppendResult(interp, "}", NULL);
-	prefix = " {";
+	pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+	pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+	Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
     }
+    Tcl_SetObjResult(interp, resultObj);
     return TCL_OK;
 }
 
@@ -1107,10 +1110,10 @@ LoadCleanupProc(
 {
     InterpPackage *ipPtr, *nextPtr;
 
-    ipPtr = (InterpPackage *) clientData;
+    ipPtr = clientData;
     while (ipPtr != NULL) {
 	nextPtr = ipPtr->nextPtr;
-	ckfree((char *) ipPtr);
+	ckfree(ipPtr);
 	ipPtr = nextPtr;
     }
 }
@@ -1140,15 +1143,15 @@ TclFinalizeLoad(void)
     /*
      * 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.
+     * 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__)
+#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
@@ -1157,18 +1160,13 @@ TclFinalizeLoad(void)
 	 */
 
 	if (pkgPtr->fileName[0] != '\0') {
-	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
-	    if ((unLoadProcPtr != NULL)
-		    && ((pkgPtr->unloadProc != NULL)
-		    || (unLoadProcPtr == TclFSUnloadTempFile))) {
-		(*unLoadProcPtr)(pkgPtr->loadHandle);
-	    }
+	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
 	}
 #endif
 
 	ckfree(pkgPtr->fileName);
 	ckfree(pkgPtr->packageName);
-	ckfree((char *) pkgPtr);
+	ckfree(pkgPtr);
     }
 }
 
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index af4ca81..6af5c4f 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -1,7 +1,7 @@
 /*
  * tclLoadNone.c --
  *
- *	This procedure provides a version of the TclLoadFile for use in
+ *	This procedure provides a version of the TclpDlopen for use in
  *	systems that don't support dynamic loading; it just returns an error.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
@@ -39,47 +39,23 @@ TclpDlopen(
     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. */
+    int flags)
 {
-    Tcl_SetResult(interp,
-	    "dynamic loading is not currently available on this system",
-	    TCL_STATIC);
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"dynamic loading is not currently available on this system",
+		-1));
+    }
     return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpFindSymbol --
- *
- *	Looks up a symbol, by name, through a handle associated with a
- *	previously loaded piece of code (shared library). This version of this
- *	routine should never be called because the associated TclpDlopen()
- *	function always returns an error.
- *
- * Results:
- *	Returns a pointer to the function associated with 'symbol' if it is
- *	found. Otherwise returns NULL and may leave an error message in the
- *	interp's result.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_PackageInitProc *
-TclpFindSymbol(
-    Tcl_Interp *interp,
-    Tcl_LoadHandle loadHandle,
-    CONST char *symbol)
-{
-    return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclGuessPackageName --
  *
  *	If the "load" command is invoked without providing a package name,
@@ -99,7 +75,7 @@ TclpFindSymbol(
 
 int
 TclGuessPackageName(
-    CONST char *fileName,	/* Name of file containing package (already
+    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. */
@@ -108,32 +84,6 @@ TclGuessPackageName(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * 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(
-    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
-				 * TclpDlopen(). The loadHandle is a token
-				 * that represents the loaded file. */
-{
-}
-
-/*
  * These functions are fallbacks if we somehow determine that the platform can
  * do loading from memory but the user wishes to disable it. They just report
  * (gracefully) that they fail.
@@ -156,11 +106,15 @@ TclpLoadMemory(
     int size,			/* Dummy: unused by this implementation */
     int codeSize,		/* Dummy: unused by this implementation */
     Tcl_LoadHandle *loadHandle,	/* Dummy: unused by this implementation */
-    Tcl_FSUnloadFileProc **unloadProcPtr)
+    Tcl_FSUnloadFileProc **unloadProcPtr,
+				/* Dummy: unused by this implementation */
+    int flags)
 				/* Dummy: unused by this implementation */
 {
-    Tcl_SetResult(interp, "dynamic loading from memory is not available "
-	    "on this system", TCL_STATIC);
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+		"is not available on this system", -1));
+    }
     return TCL_ERROR;
 }
 
diff --git a/generic/tclMain.c b/generic/tclMain.c
index b2206f8..927de7e 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -2,6 +2,11 @@
  * 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.
@@ -11,10 +16,23 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#include "tclInt.h"
+/*
+ * 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.
+ */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
+#if defined(TCL_ASCII_MAIN)
+#   ifdef UNICODE
+#	undef UNICODE
+#	undef _UNICODE
+#   else
+#	define UNICODE
+#	define _UNICODE
+#   endif
+#endif
+
+#include "tclInt.h"
 
 /*
  * The default prompt used when the user has not overridden it.
@@ -23,6 +41,40 @@
 #define DEFAULT_PRIMARY_PROMPT	"% "
 
 /*
+ * 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.
+ */
+
+#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).
@@ -33,9 +85,20 @@
 extern CRTIMPORT int	isatty(int fd);
 #endif
 
-static Tcl_Obj *tclStartupScriptPath = NULL;
-static Tcl_Obj *tclStartupScriptEncoding = NULL;
-static Tcl_MainLoopProc *mainLoopProc = NULL;
+/*
+ * The thread-local variables for this file's functions.
+ */
+
+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;
 
 /*
  * Structure definition for information used to keep the state of an
@@ -66,9 +129,14 @@ typedef struct InteractiveState {
  * Forward declarations for functions defined later in this file.
  */
 
-static void		Prompt(Tcl_Interp *interp, PromptType *promptPtr);
+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);
 
+#ifndef TCL_ASCII_MAIN
+static Tcl_ThreadDataKey dataKey;
+
 /*
  *----------------------------------------------------------------------
  *
@@ -88,27 +156,29 @@ static void		StdinProc(ClientData clientData, int mask);
 void
 Tcl_SetStartupScript(
     Tcl_Obj *path,		/* Filesystem path of startup script file */
-    CONST char *encoding)	/* Encoding of the data in that file */
+    const char *encoding)	/* Encoding of the data in that file */
 {
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     Tcl_Obj *newEncoding = NULL;
+
     if (encoding != NULL) {
 	newEncoding = Tcl_NewStringObj(encoding, -1);
     }
 
-    if (tclStartupScriptPath != NULL) {
-	Tcl_DecrRefCount(tclStartupScriptPath);
+    if (tsdPtr->path != NULL) {
+	Tcl_DecrRefCount(tsdPtr->path);
     }
-    tclStartupScriptPath = path;
-    if (tclStartupScriptPath != NULL) {
-	Tcl_IncrRefCount(tclStartupScriptPath);
+    tsdPtr->path = path;
+    if (tsdPtr->path != NULL) {
+	Tcl_IncrRefCount(tsdPtr->path);
     }
 
-    if (tclStartupScriptEncoding != NULL) {
-	Tcl_DecrRefCount(tclStartupScriptEncoding);
+    if (tsdPtr->encoding != NULL) {
+	Tcl_DecrRefCount(tsdPtr->encoding);
     }
-    tclStartupScriptEncoding = newEncoding;
-    if (tclStartupScriptEncoding != NULL) {
-	Tcl_IncrRefCount(tclStartupScriptEncoding);
+    tsdPtr->encoding = newEncoding;
+    if (tsdPtr->encoding != NULL) {
+	Tcl_IncrRefCount(tsdPtr->encoding);
     }
 }
 
@@ -124,131 +194,31 @@ Tcl_SetStartupScript(
  *	The path of the startup script; NULL if none has been set.
  *
  * Side effects:
- * 	If encodingPtr is not NULL, stores a (CONST char *) in it pointing to
- * 	the encoding name registered for the startup script. Tcl retains
- * 	ownership of the string, and may free it. Caller should make a copy
- * 	for long-term use.
+ *	If encodingPtr is not NULL, stores a (const char *) in it pointing to
+ *	the encoding name registered for the startup script. Tcl retains
+ *	ownership of the string, and may free it. Caller should make a copy
+ *	for long-term use.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
 Tcl_GetStartupScript(
-    CONST char **encodingPtr)	/* When not NULL, points to storage for the
-				 * (CONST char *) that points to the
+    const char **encodingPtr)	/* When not NULL, points to storage for the
+				 * (const char *) that points to the
 				 * registered encoding name for the startup
-				 * script */
+				 * script. */
 {
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
     if (encodingPtr != NULL) {
-	if (tclStartupScriptEncoding == NULL) {
+	if (tsdPtr->encoding == NULL) {
 	    *encodingPtr = NULL;
 	} else {
-	    *encodingPtr = Tcl_GetString(tclStartupScriptEncoding);
+	    *encodingPtr = Tcl_GetString(tsdPtr->encoding);
 	}
     }
-    return tclStartupScriptPath;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetStartupScriptPath --
- *
- *	Primes the startup script VFS path, used to override the command line
- *	processing.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	This function initializes the VFS path of the Tcl script to run at
- *	startup.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetStartupScriptPath(
-    Tcl_Obj *path)
-{
-    Tcl_SetStartupScript(path, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetStartupScriptPath --
- *
- *	Gets the startup script VFS path, used to override the command line
- *	processing.
- *
- * Results:
- *	The startup script VFS path, NULL if none has been set.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclGetStartupScriptPath(void)
-{
-    return Tcl_GetStartupScript(NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetStartupScriptFileName --
- *
- *	Primes the startup script file name, used to override the command line
- *	processing.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	This function initializes the file name of the Tcl script to run at
- *	startup.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetStartupScriptFileName(
-    CONST char *fileName)
-{
-    Tcl_Obj *path = Tcl_NewStringObj(fileName,-1);
-    Tcl_SetStartupScript(path, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetStartupScriptFileName --
- *
- *	Gets the startup script file name, used to override the command line
- *	processing.
- *
- * Results:
- *	The startup script file name, NULL if none has been set.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-CONST char *
-TclGetStartupScriptFileName(void)
-{
-    Tcl_Obj *path = Tcl_GetStartupScript(NULL);
-
-    if (path == NULL) {
-	return NULL;
-    }
-    return Tcl_GetString(path);
+    return tsdPtr->path;
 }
 
 /*----------------------------------------------------------------------
@@ -273,13 +243,13 @@ Tcl_SourceRCFile(
     Tcl_Interp *interp)		/* Interpreter to source rc file into. */
 {
     Tcl_DString temp;
-    CONST char *fileName;
-    Tcl_Channel errChannel;
+    const char *fileName;
+    Tcl_Channel chan;
 
     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
     if (fileName != NULL) {
 	Tcl_Channel c;
-	CONST char *fullName;
+	const char *fullName;
 
 	Tcl_DStringInit(&temp);
 	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
@@ -295,24 +265,25 @@ Tcl_SourceRCFile(
 	     */
 
 	    c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
-	    if (c != (Tcl_Channel) NULL) {
+	    if (c != NULL) {
 		Tcl_Close(NULL, c);
 		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
-		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-		    if (errChannel) {
-			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-			Tcl_WriteChars(errChannel, "\n", 1);
- 		    }
- 		}
- 	    }
+		    chan = Tcl_GetStdChannel(TCL_STDERR);
+		    if (chan) {
+			Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+			Tcl_WriteChars(chan, "\n", 1);
+		    }
+		}
+	    }
 	}
 	Tcl_DStringFree(&temp);
     }
 }
+#endif /* !TCL_ASCII_MAIN */
 
 /*----------------------------------------------------------------------
  *
- * Tcl_Main --
+ * Tcl_Main, Tcl_MainEx --
  *
  *	Main program for tclsh and most other Tcl-based applications.
  *
@@ -329,28 +300,31 @@ Tcl_SourceRCFile(
  */
 
 void
-Tcl_Main(
+Tcl_MainEx(
     int argc,			/* Number of arguments. */
-    char **argv,		/* Array of argument strings. */
-    Tcl_AppInitProc *appInitProc)
+    TCHAR **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)
 {
-    Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
-    CONST char *encodingName = NULL;
-    PromptType prompt = PROMPT_START;
-    int code, length, tty, exitCode = 0;
-    Tcl_Channel inChannel, outChannel, errChannel;
-    Tcl_Interp *interp;
-    Tcl_DString appName;
-
-    interp = Tcl_CreateInterp();
+    Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
+    const char *encodingName = NULL;
+    int code, exitCode = 0;
+    Tcl_MainLoopProc *mainLoopProc;
+    Tcl_Channel chan;
+    InteractiveState is;
+
     TclpSetInitialEncodings();
-    TclpFindExecutable(argv[0]);
+    TclpFindExecutable((const char *)argv[0]);
 
     Tcl_InitMemory(interp);
 
+    is.interp = interp;
+    is.prompt = PROMPT_START;
+    is.commandPtr = Tcl_NewObj();
+
     /*
      * If the application has not already set a startup script, parse the
      * first few command line arguments to determine the script path and
@@ -358,21 +332,23 @@ Tcl_Main(
      */
 
     if (NULL == Tcl_GetStartupScript(NULL)) {
-
 	/*
 	 * Check whether first 3 args (argv[1] - argv[3]) look like
-	 * 	-encoding ENCODING FILENAME
+	 *  -encoding ENCODING FILENAME
 	 * or like
-	 * 	FILENAME
+	 *  FILENAME
 	 */
 
-	if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
+	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
 		&& ('-' != argv[3][0])) {
-	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
+	    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) && ('-' != argv[1][0])) {
-	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
+	    Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
 	    argc--;
 	    argv++;
 	}
@@ -380,15 +356,11 @@ Tcl_Main(
 
     path = Tcl_GetStartupScript(&encodingName);
     if (path == NULL) {
-	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
+	appName = NewNativeObj(argv[0], -1);
     } else {
-	CONST char *pathName = Tcl_GetStringFromObj(path, &length);
-	Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
-	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
-	Tcl_SetStartupScript(path, encodingName);
+	appName = path;
     }
-    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
-    Tcl_DStringFree(&appName);
+    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
     argc--;
     argv++;
 
@@ -396,11 +368,7 @@ Tcl_Main(
 
     argvPtr = Tcl_NewListObj(0, NULL);
     while (argc--) {
-	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_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
     }
     Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
 
@@ -408,22 +376,22 @@ Tcl_Main(
      * Set the "tcl_interactive" variable.
      */
 
-    tty = isatty(0);
-    Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
-	    TCL_GLOBAL_ONLY);
+    is.tty = isatty(0);
+    Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
+	    Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY);
 
     /*
      * Invoke application-specific initialization.
      */
 
-    Tcl_Preserve((ClientData) interp);
-    if ((*appInitProc)(interp) != TCL_OK) {
-	errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	if (errChannel) {
-	    Tcl_WriteChars(errChannel,
+    Tcl_Preserve(interp);
+    if (appInitProc(interp) != TCL_OK) {
+	chan = Tcl_GetStdChannel(TCL_STDERR);
+	if (chan) {
+	    Tcl_WriteChars(chan,
 		    "application-specific initialization failed: ", -1);
-	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-	    Tcl_WriteChars(errChannel, "\n", 1);
+	    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+	    Tcl_WriteChars(chan, "\n", 1);
 	}
     }
     if (Tcl_InterpDeleted(interp)) {
@@ -432,18 +400,27 @@ Tcl_Main(
     if (Tcl_LimitExceeded(interp)) {
 	goto done;
     }
+    if (TclFullFinalizationRequested()) {
+	/*
+	 * Arrange for final deletion of the main interp
+	 */
+
+	/* ARGH Munchhausen effect */
+	Tcl_CreateExitHandler(FreeMainInterp, interp);
+    }
 
     /*
-     * If a script file was specified then just source that file and quit.
-     * Must fetch it again, as the appInitProc might have reset it.
+     * Invoke the script specified on the command line, if any. Must fetch it
+     * again, as the appInitProc might have reset it.
      */
 
     path = Tcl_GetStartupScript(&encodingName);
     if (path != NULL) {
+	Tcl_ResetResult(interp);
 	code = Tcl_FSEvalFileEx(interp, path, encodingName);
 	if (code != TCL_OK) {
-	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	    if (errChannel) {
+	    chan = Tcl_GetStdChannel(TCL_STDERR);
+	    if (chan) {
 		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
 		Tcl_Obj *keyPtr, *valuePtr;
 
@@ -453,9 +430,9 @@ Tcl_Main(
 		Tcl_DecrRefCount(keyPtr);
 
 		if (valuePtr) {
-		    Tcl_WriteObj(errChannel, valuePtr);
+		    Tcl_WriteObj(chan, valuePtr);
 		}
-		Tcl_WriteChars(errChannel, "\n", 1);
+		Tcl_WriteChars(chan, "\n", 1);
 		Tcl_DecrRefCount(options);
 	    }
 	    exitCode = 1;
@@ -479,45 +456,46 @@ Tcl_Main(
      * may have been changed.
      */
 
-    commandPtr = Tcl_NewObj();
-    Tcl_IncrRefCount(commandPtr);
+    Tcl_IncrRefCount(is.commandPtr);
 
     /*
      * Get a new value for tty if anyone writes to ::tcl_interactive
      */
 
-    Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
-    inChannel = Tcl_GetStdChannel(TCL_STDIN);
-    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-    while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
+    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();
 	if (mainLoopProc == NULL) {
-	    if (tty) {
-		Prompt(interp, &prompt);
+	    int length;
+
+	    if (is.tty) {
+		Prompt(interp, &is);
 		if (Tcl_InterpDeleted(interp)) {
 		    break;
 		}
 		if (Tcl_LimitExceeded(interp)) {
 		    break;
 		}
-		inChannel = Tcl_GetStdChannel(TCL_STDIN);
-		if (inChannel == (Tcl_Channel) NULL) {
+		is.input = Tcl_GetStdChannel(TCL_STDIN);
+		if (is.input == NULL) {
 		    break;
 		}
 	    }
-	    if (Tcl_IsShared(commandPtr)) {
-		Tcl_DecrRefCount(commandPtr);
-		commandPtr = Tcl_DuplicateObj(commandPtr);
-		Tcl_IncrRefCount(commandPtr);
+	    if (Tcl_IsShared(is.commandPtr)) {
+		Tcl_DecrRefCount(is.commandPtr);
+		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+		Tcl_IncrRefCount(is.commandPtr);
 	    }
-	    length = Tcl_GetsObj(inChannel, commandPtr);
+	    length = Tcl_GetsObj(is.input, is.commandPtr);
 	    if (length < 0) {
-		if (Tcl_InputBlocked(inChannel)) {
+		if (Tcl_InputBlocked(is.input)) {
 		    /*
 		     * This can only happen if stdin has been set to
-		     * non-blocking.  In that case cycle back and try again.
+		     * 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.
+		     * event loop running). If this causes bad CPU hogging, we
+		     * might try toggling the blocking on stdin instead.
 		     */
 
 		    continue;
@@ -531,48 +509,51 @@ Tcl_Main(
 	    }
 
 	    /*
-	     * 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. Have
+	     * to add it back before testing completeness, because it can make
+	     * a difference. [Bug 1775878]
 	     */
 
-	    if (Tcl_IsShared(commandPtr)) {
-		Tcl_DecrRefCount(commandPtr);
-		commandPtr = Tcl_DuplicateObj(commandPtr);
-		Tcl_IncrRefCount(commandPtr);
+	    if (Tcl_IsShared(is.commandPtr)) {
+		Tcl_DecrRefCount(is.commandPtr);
+		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
+		Tcl_IncrRefCount(is.commandPtr);
 	    }
-	    Tcl_AppendToObj(commandPtr, "\n", 1);
-	    if (!TclObjCommandComplete(commandPtr)) {
-		prompt = PROMPT_CONTINUE;
+	    Tcl_AppendToObj(is.commandPtr, "\n", 1);
+	    if (!TclObjCommandComplete(is.commandPtr)) {
+		is.prompt = PROMPT_CONTINUE;
 		continue;
 	    }
 
-	    prompt = PROMPT_START;
+	    is.prompt = PROMPT_START;
+
 	    /*
-	     * The final newline is syntactically redundant, and causes
-	     * some error messages troubles deeper in, so lop it back off.
+	     * The final newline is syntactically redundant, and causes some
+	     * error messages troubles deeper in, so lop it back off.
 	     */
-	    Tcl_GetStringFromObj(commandPtr, &length);
-	    Tcl_SetObjLength(commandPtr, --length);
-	    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
-	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
-	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	    Tcl_DecrRefCount(commandPtr);
-	    commandPtr = Tcl_NewObj();
-	    Tcl_IncrRefCount(commandPtr);
+
+	    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);
 	    if (code != TCL_OK) {
-		if (errChannel) {
-		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-		    Tcl_WriteChars(errChannel, "\n", 1);
+		chan = Tcl_GetStdChannel(TCL_STDERR);
+		if (chan) {
+		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+		    Tcl_WriteChars(chan, "\n", 1);
 		}
- 	    } else if (tty) {
+	    } else if (is.tty) {
 		resultPtr = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(resultPtr);
 		Tcl_GetStringFromObj(resultPtr, &length);
-		if ((length > 0) && outChannel) {
-		    Tcl_WriteObj(outChannel, resultPtr);
-		    Tcl_WriteChars(outChannel, "\n", 1);
+		chan = Tcl_GetStdChannel(TCL_STDOUT);
+		if ((length > 0) && chan) {
+		    Tcl_WriteObj(chan, resultPtr);
+		    Tcl_WriteChars(chan, "\n", 1);
 		}
 		Tcl_DecrRefCount(resultPtr);
 	    }
@@ -583,76 +564,51 @@ Tcl_Main(
 	     * channel handler for stdin.
 	     */
 
-	    InteractiveState *isPtr = NULL;
-
-	    if (inChannel) {
-		if (tty) {
-		    Prompt(interp, &prompt);
+	    if (is.input) {
+		if (is.tty) {
+		    Prompt(interp, &is);
 		}
-		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);
+
+		Tcl_CreateChannelHandler(is.input, TCL_READABLE,
+			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);
+	    mainLoopProc();
+	    Tcl_SetMainLoop(NULL);
+
+	    if (is.input) {
+		Tcl_DeleteChannelHandler(is.input, StdinProc, &is);
 	    }
-	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
-	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	    is.input = Tcl_GetStdChannel(TCL_STDIN);
 	}
-#ifdef TCL_MEM_DEBUG
 
 	/*
 	 * This code here only for the (unsupported and deprecated) [checkmem]
 	 * command.
 	 */
 
+#ifdef TCL_MEM_DEBUG
 	if (tclMemDumpFileName != NULL) {
-	    mainLoopProc = NULL;
+	    Tcl_SetMainLoop(NULL);
 	    Tcl_DeleteInterp(interp);
 	}
-#endif
+#endif /* TCL_MEM_DEBUG */
     }
 
   done:
-    if ((exitCode == 0) && (mainLoopProc != NULL)
-	    && !Tcl_LimitExceeded(interp)) {
+    mainLoopProc = TclGetMainLoop();
+    if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) {
 	/*
 	 * If everything has gone OK so far, call the main loop proc, if it
 	 * exists. Packages (like Tk) can set it to start processing events at
 	 * this point.
 	 */
 
-	(*mainLoopProc)();
-	mainLoopProc = NULL;
+	mainLoopProc();
+	Tcl_SetMainLoop(NULL);
     }
-    if (commandPtr != NULL) {
-	Tcl_DecrRefCount(commandPtr);
+    if (is.commandPtr != NULL) {
+	Tcl_DecrRefCount(is.commandPtr);
     }
 
     /*
@@ -661,36 +617,41 @@ Tcl_Main(
      * exit. The Tcl_EvalObjEx 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.
-	 */
+    if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
+	Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
 
-	if (!Tcl_InterpDeleted(interp)) {
-	    Tcl_DeleteInterp(interp);
-	}
+	Tcl_IncrRefCount(cmd);
+	Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(cmd);
     }
-    Tcl_SetStartupScript(NULL, NULL);
 
     /*
-     * If we get here, the master interp has been deleted. Allow its
-     * destruction with the last matching Tcl_Release.
+     * 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_Release((ClientData) interp);
     Tcl_Exit(exitCode);
 }
+
+#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_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
+}
+#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */
 
+#ifndef TCL_ASCII_MAIN
+
 /*
  *---------------------------------------------------------------
  *
@@ -699,7 +660,7 @@ Tcl_Main(
  *	Sets an alternative main loop function.
  *
  * Results:
- *	Returns the previously defined main loop function.
+ *	None.
  *
  * Side effects:
  *	This function will be called before Tcl exits, allowing for the
@@ -712,8 +673,75 @@ void
 Tcl_SetMainLoop(
     Tcl_MainLoopProc *proc)
 {
-    mainLoopProc = proc;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    tsdPtr->mainLoopProc = proc;
+}
+
+/*
+ *---------------------------------------------------------------
+ *
+ * TclGetMainLoop --
+ *
+ *	Returns the current alternative main loop function.
+ *
+ * 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..
+ *
+ * Side effects:
+ *	None (other than possible creation of this file's TSD block).
+ *
+ *---------------------------------------------------------------
+ */
+
+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)
+{
+#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 /* PURIFY */
 }
+#endif /* !TCL_ASCII_MAIN */
 
 /*
  *----------------------------------------------------------------------
@@ -740,11 +768,11 @@ StdinProc(
     ClientData clientData,	/* The state of interactive cmd line */
     int mask)			/* Not used. */
 {
-    InteractiveState *isPtr = (InteractiveState *) clientData;
+    int code, length;
+    InteractiveState *isPtr = 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);
@@ -765,7 +793,7 @@ StdinProc(
 
 	    Tcl_Exit(0);
 	}
-	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
+	Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
 	return;
     }
 
@@ -790,30 +818,31 @@ StdinProc(
      * things, this will trash the text of the command being evaluated.
      */
 
-    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
+    Tcl_CreateChannelHandler(chan, 0, StdinProc, 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 != (Tcl_Channel) NULL) {
-	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
-		(ClientData) isPtr);
+    if (chan != NULL) {
+	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
     }
     if (code != TCL_OK) {
-	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	if (errChannel != (Tcl_Channel) NULL) {
-	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-	    Tcl_WriteChars(errChannel, "\n", 1);
+	chan = Tcl_GetStdChannel(TCL_STDERR);
+
+	if (chan != NULL) {
+	    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+	    Tcl_WriteChars(chan, "\n", 1);
 	}
     } else if (isPtr->tty) {
 	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	chan = Tcl_GetStdChannel(TCL_STDOUT);
+
 	Tcl_IncrRefCount(resultPtr);
 	Tcl_GetStringFromObj(resultPtr, &length);
-	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
-	    Tcl_WriteObj(outChannel, resultPtr);
-	    Tcl_WriteChars(outChannel, "\n", 1);
+	if ((length > 0) && (chan != NULL)) {
+	    Tcl_WriteObj(chan, resultPtr);
+	    Tcl_WriteChars(chan, "\n", 1);
 	}
 	Tcl_DecrRefCount(resultPtr);
     }
@@ -823,8 +852,8 @@ StdinProc(
      */
 
   prompt:
-    if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
-	Prompt(interp, &(isPtr->prompt));
+    if (isPtr->tty && (isPtr->input != NULL)) {
+	Prompt(interp, isPtr);
 	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
     }
 }
@@ -849,20 +878,19 @@ StdinProc(
 static void
 Prompt(
     Tcl_Interp *interp,		/* Interpreter to use for prompting. */
-    PromptType *promptPtr)	/* Points to type of prompt to print. Filled
-				 * with PROMPT_NONE after a prompt is
-				 * printed. */
+    InteractiveState *isPtr)	/* InteractiveState. Filled with PROMPT_NONE
+				 * after a prompt is printed. */
 {
     Tcl_Obj *promptCmdPtr;
     int code;
-    Tcl_Channel outChannel, errChannel;
+    Tcl_Channel chan;
 
-    if (*promptPtr == PROMPT_NONE) {
+    if (isPtr->prompt == PROMPT_NONE) {
 	return;
     }
 
     promptCmdPtr = Tcl_GetVar2Ex(interp,
-	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+	    (isPtr->prompt==PROMPT_CONTINUE ? "tcl_prompt2" : "tcl_prompt1"),
 	    NULL, TCL_GLOBAL_ONLY);
 
     if (Tcl_InterpDeleted(interp)) {
@@ -870,31 +898,58 @@ Prompt(
     }
     if (promptCmdPtr == NULL) {
     defaultPrompt:
-	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-	if ((*promptPtr == PROMPT_START)
-		&& (outChannel != (Tcl_Channel) NULL)) {
-	    Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT,
-		    strlen(DEFAULT_PRIMARY_PROMPT));
+	if (isPtr->prompt == PROMPT_START) {
+	    chan = Tcl_GetStdChannel(TCL_STDOUT);
+	    if (chan != NULL) {
+		Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
+			strlen(DEFAULT_PRIMARY_PROMPT));
+	    }
 	}
     } else {
 	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (script that generates prompt)");
-	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
-	    if (errChannel != (Tcl_Channel) NULL) {
-		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
-		Tcl_WriteChars(errChannel, "\n", 1);
+	    chan = Tcl_GetStdChannel(TCL_STDERR);
+	    if (chan != NULL) {
+		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+		Tcl_WriteChars(chan, "\n", 1);
 	    }
 	    goto defaultPrompt;
 	}
     }
 
-    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
-    if (outChannel != (Tcl_Channel) NULL) {
-	Tcl_Flush(outChannel);
+    chan = Tcl_GetStdChannel(TCL_STDOUT);
+    if (chan != NULL) {
+	Tcl_Flush(chan);
+    }
+    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 = clientData;
+
+    /*if (TclInExit()) return;*/
+
+    if (!Tcl_InterpDeleted(interp)) {
+	Tcl_DeleteInterp(interp);
     }
-    *promptPtr = PROMPT_NONE;
+    Tcl_SetStartupScript(NULL, NULL);
+    Tcl_Release(interp);
 }
 
 /*
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 4b72e03..a8d351f 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -5,8 +5,7 @@
  *	commands and global variables. The global :: namespace is the
  *	traditional Tcl "global" scope. Other namespaces are created as
  *	children of the global namespace. These other namespaces contain
- *	special-purpose commands and variables for packages. Also includes the
- *	TIP#112 ensemble machinery.
+ *	special-purpose commands and variables for packages.
  *
  * Copyright (c) 1993-1997 Lucent Technologies.
  * Copyright (c) 1997 Sun Microsystems, Inc.
@@ -25,6 +24,7 @@
  */
 
 #include "tclInt.h"
+#include "tclCompile.h" /* for TclLogCommandInfo visibility */
 
 /*
  * Thread-local storage used to avoid having a global lock on data that is not
@@ -53,12 +53,12 @@ static Tcl_ThreadDataKey dataKey;
  */
 
 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. */
+    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
@@ -67,82 +67,6 @@ typedef struct ResolvedNsName {
 } ResolvedNsName;
 
 /*
- * 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.
- */
-
-typedef struct EnsembleConfig {
-    Namespace *nsPtr;		/* The namspace backing this ensemble up. */
-    Tcl_Command token;		/* The token for the command that provides
-				 * ensemble support for the namespace, or NULL
-				 * if the command has been deleted (or never
-				 * existed; the global namespace never has an
-				 * ensemble command.) */
-    int epoch;			/* The epoch at which this ensemble's table of
-				 * exported commands is valid. */
-    char **subcommandArrayPtr;	/* Array of ensemble subcommand names. At all
-				 * consistent points, this will have the same
-				 * number of entries as there are entries in
-				 * the subcommandTable hash. */
-    Tcl_HashTable subcommandTable;
-				/* Hash table of ensemble subcommand names,
-				 * which are its keys so this also provides
-				 * the storage management for those subcommand
-				 * names. The contents of the entry values are
-				 * object version the prefix lists to use when
-				 * substituting for the command/subcommand to
-				 * build the ensemble implementation command.
-				 * Has to be stored here as well as in
-				 * subcommandDict because that field is NULL
-				 * when we are deriving the ensemble from the
-				 * namespace exports list. FUTURE WORK: use
-				 * object hash table here. */
-    struct EnsembleConfig *next;/* The next ensemble in the linked list of
-				 * ensembles associated with a namespace. If
-				 * this field points to this ensemble, the
-				 * structure has already been unlinked from
-				 * all lists, and cannot be found by scanning
-				 * the list from the namespace's ensemble
-				 * field. */
-    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX, ENS_DEAD
-				 * and ENSEMBLE_COMPILE. */
-
-    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
-
-    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
-				 * subcommands to their implementing command
-				 * prefixes, or NULL if we are to build the
-				 * map automatically from the namespace
-				 * exports. */
-    Tcl_Obj *subcmdList;	/* List of commands that this ensemble
-				 * actually provides, and whose implementation
-				 * will be built using the subcommandDict (if
-				 * present and defined) and by simple mapping
-				 * to the namespace otherwise. If NULL,
-				 * indicates that we are using the (dynamic)
-				 * list of currently exported commands. */
-    Tcl_Obj *unknownHandler;	/* Script prefix used to handle the case when
-				 * no match is found (according to the rule
-				 * defined by flag bit TCL_ENSEMBLE_PREFIX) or
-				 * NULL to use the default error-generating
-				 * behaviour. The script execution gets all
-				 * the arguments to the ensemble command
-				 * (including objv[0]) and will have the
-				 * results passed directly back to the caller
-				 * (including the error code) unless the code
-				 * is TCL_CONTINUE in which case the
-				 * subcommand will be reparsed by the ensemble
-				 * core, presumably because the ensemble
-				 * itself has been updated. */
-} EnsembleConfig;
-
-#define ENS_DEAD	0x1	/* Flag value to say that the ensemble is dead
-				 * and on its way out. */
-
-/*
  * Declarations for functions local to this file:
  */
 
@@ -167,6 +91,8 @@ 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,
@@ -175,10 +101,10 @@ static int		NamespaceCurrentCmd(ClientData dummy,
 			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
-static int		NamespaceEnsembleCmd(ClientData dummy,
-			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
+static int		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,
@@ -190,6 +116,8 @@ 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,
@@ -203,25 +131,14 @@ static int		NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
 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[]);
+			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static int		NsEnsembleImplementationCmd(ClientData clientData,
-			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
-static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
-static int		NsEnsembleStringOrder(const void *strPtr1,
-			    const void *strPtr2);
-static void		DeleteEnsembleConfig(ClientData clientData);
-static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
-			    EnsembleConfig *ensemblePtr,
-			    const char *subcmdName, Tcl_Obj *prefixObjPtr);
-static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
-static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static void		StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
 static void		UnlinkNsPath(Namespace *nsPtr);
 
+static Tcl_NRPostProc NsEval_Callback;
+
 /*
  * 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
@@ -229,7 +146,7 @@ static void		UnlinkNsPath(Namespace *nsPtr);
  * the object.
  */
 
-static Tcl_ObjType nsNameType = {
+static const Tcl_ObjType nsNameType = {
     "nsName",			/* the type's name */
     FreeNsNameInternalRep,	/* freeIntRepProc */
     DupNsNameInternalRep,	/* dupIntRepProc */
@@ -238,18 +155,31 @@ static Tcl_ObjType nsNameType = {
 };
 
 /*
- * 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.
+ * Array of values describing how to implement each standard subcommand of the
+ * "namespace" command.
  */
 
-Tcl_ObjType tclEnsembleCmdType = {
-    "ensembleCommand",		/* the type's name */
-    FreeEnsembleCmdRep,		/* freeIntRepProc */
-    DupEnsembleCmdRep,		/* dupIntRepProc */
-    StringOfEnsembleCmdRep,	/* updateStringProc */
-    NULL			/* setFromAnyProc */
+static const EnsembleImplMap defaultNamespaceMap[] = {
+    {"children",   NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
+    {"code",	   NamespaceCodeCmd,	TclCompileNamespaceCodeCmd, NULL, NULL, 0},
+    {"current",	   NamespaceCurrentCmd,	TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
+    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
+    {"eval",	   NamespaceEvalCmd,	NULL, NRNamespaceEvalCmd, NULL, 0},
+    {"exists",	   NamespaceExistsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"export",	   NamespaceExportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+    {"forget",	   NamespaceForgetCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+    {"import",	   NamespaceImportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
+    {"inscope",	   NamespaceInscopeCmd,	NULL, NRNamespaceInscopeCmd, NULL, 0},
+    {"origin",	   NamespaceOriginCmd,	TclCompileNamespaceOriginCmd, NULL, NULL, 0},
+    {"parent",	   NamespaceParentCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"path",	   NamespacePathCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
+    {"tail",	   NamespaceTailCmd,	TclCompileNamespaceTailCmd, NULL, NULL, 0},
+    {"unknown",	   NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"upvar",	   NamespaceUpvarCmd,	TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
+    {"which",	   NamespaceWhichCmd,	TclCompileNamespaceWhichCmd, NULL, NULL, 0},
+    {NULL, NULL, NULL, NULL, NULL, 0}
 };
 
 /*
@@ -412,6 +342,7 @@ Tcl_PushCallFrame(
     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
@@ -420,6 +351,7 @@ Tcl_PushCallFrame(
 
     iPtr->framePtr = framePtr;
     iPtr->varFramePtr = framePtr;
+
     return TCL_OK;
 }
 
@@ -465,7 +397,7 @@ Tcl_PopCallFrame(
 
     if (framePtr->varTablePtr != NULL) {
 	TclDeleteVars(iPtr, framePtr->varTablePtr);
-	ckfree((char *) framePtr->varTablePtr);
+	ckfree(framePtr->varTablePtr);
 	framePtr->varTablePtr = NULL;
     }
     if (framePtr->numCompiledLocals > 0) {
@@ -489,6 +421,10 @@ Tcl_PopCallFrame(
 	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
+
+    if (framePtr->tailcallPtr) {
+	TclSetTailcall(interp, framePtr->tailcallPtr);
+    }
 }
 
 /*
@@ -529,7 +465,7 @@ TclPushStackFrame(
 				 * treated as references to namespace
 				 * variables. */
 {
-    *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
+    *framePtrPtr = TclStackAlloc(interp, sizeof(CallFrame));
     return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
 	    isProcCallFrame);
 }
@@ -538,7 +474,7 @@ void
 TclPopStackFrame(
     Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
 {
-    CallFrame *freePtr = ((Interp *)interp)->framePtr;
+    CallFrame *freePtr = ((Interp *) interp)->framePtr;
 
     Tcl_PopCallFrame(interp);
     TclStackFree(interp, freePtr);
@@ -569,9 +505,9 @@ EstablishErrorCodeTraces(
     const char *name2,
     int flags)
 {
-    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+    Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
 	    ErrorCodeRead, NULL);
-    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+    Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
 	    EstablishErrorCodeTraces, NULL);
     return NULL;
 }
@@ -601,7 +537,7 @@ ErrorCodeRead(
     const char *name2,
     int flags)
 {
-    Interp *iPtr = (Interp *)interp;
+    Interp *iPtr = (Interp *) interp;
 
     if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
 	return NULL;
@@ -643,9 +579,9 @@ EstablishErrorInfoTraces(
     const char *name2,
     int flags)
 {
-    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
+    Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
 	    ErrorInfoRead, NULL);
-    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
+    Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
 	    EstablishErrorInfoTraces, NULL);
     return NULL;
 }
@@ -781,9 +717,10 @@ Tcl_CreateNamespace(
      */
 
     if (*name == '\0') {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "can't create namespace \"\": "
-		"only global namespace can have empty name", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
+                " \"\": only global namespace can have empty name", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+		"CREATEGLOBAL", NULL);
 	Tcl_DStringFree(&tmpBuffer);
 	return NULL;
     }
@@ -811,9 +748,18 @@ Tcl_CreateNamespace(
      * already exist in the parent namespace.
      */
 
-    if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
-	Tcl_AppendResult(interp, "can't create namespace \"", name,
-		"\": already exists", NULL);
+    if (
+#ifndef BREAK_NAMESPACE_COMPAT
+	Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
+#else
+	parentPtr->childTablePtr != NULL &&
+	Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
+#endif
+    ) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create namespace \"%s\": already exists", name));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+		"CREATEEXISTING", NULL);
 	Tcl_DStringFree(&tmpBuffer);
 	return NULL;
     }
@@ -824,14 +770,19 @@ Tcl_CreateNamespace(
      */
 
   doCreate:
-    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
-    nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1));
-    strcpy(nsPtr->name, simpleName);
+    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
     Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
+#else
+    nsPtr->childTablePtr = NULL;
+#endif
     nsPtr->nsId = ++(tsdPtr->numNsCreated);
     nsPtr->interp = interp;
     nsPtr->flags = 0;
@@ -853,10 +804,12 @@ Tcl_CreateNamespace(
     nsPtr->commandPathLength = 0;
     nsPtr->commandPathArray = NULL;
     nsPtr->commandPathSourceList = NULL;
+    nsPtr->earlyDeleteProc = NULL;
 
     if (parentPtr != NULL) {
-	entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
-		&newEntry);
+	entryPtr = Tcl_CreateHashEntry(
+		TclGetNamespaceChildTable((Tcl_Namespace *) parentPtr),
+		simpleName, &newEntry);
 	Tcl_SetHashValue(entryPtr, nsPtr);
     } else {
 	/*
@@ -882,10 +835,9 @@ Tcl_CreateNamespace(
 	if (ancestorPtr != globalNsPtr) {
 	    register Tcl_DString *tempPtr = namePtr;
 
-	    Tcl_DStringAppend(buffPtr, "::", 2);
+	    TclDStringAppendLiteral(buffPtr, "::");
 	    Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
-	    Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr),
-		    Tcl_DStringLength(namePtr));
+	    TclDStringAppendDString(buffPtr, namePtr);
 
 	    /*
 	     * Clear the unwanted buffer or we end up appending to previous
@@ -893,7 +845,7 @@ Tcl_CreateNamespace(
 	     * very wrong (and strange).
 	     */
 
-	    Tcl_DStringSetLength(namePtr, 0);
+	    TclDStringClear(namePtr);
 
 	    /*
 	     * Now swap the buffer pointers so that we build in the other
@@ -908,7 +860,7 @@ Tcl_CreateNamespace(
 
     name = Tcl_DStringValue(namePtr);
     nameLen = Tcl_DStringLength(namePtr);
-    nsPtr->fullName = ckalloc((unsigned) (nameLen+1));
+    nsPtr->fullName = ckalloc(nameLen + 1);
     memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
 
     Tcl_DStringFree(&buffer1);
@@ -916,6 +868,16 @@ Tcl_CreateNamespace(
     Tcl_DStringFree(&tmpBuffer);
 
     /*
+     * 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.
      */
 
@@ -950,6 +912,50 @@ Tcl_DeleteNamespace(
     Namespace *globalNsPtr = (Namespace *)
 	    TclGetGlobalNamespace((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 == TclNRInterpCoroutine) {
+	    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.
@@ -1000,8 +1006,9 @@ Tcl_DeleteNamespace(
     if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
 	nsPtr->flags |= NS_DYING;
 	if (nsPtr->parentPtr != NULL) {
-	    entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
-		    nsPtr->name);
+	    entryPtr = Tcl_FindHashEntry(
+		    TclGetNamespaceChildTable((Tcl_Namespace *)
+			    nsPtr->parentPtr), nsPtr->name);
 	    if (entryPtr != NULL) {
 		Tcl_DeleteHashEntry(entryPtr);
 	    }
@@ -1030,7 +1037,14 @@ Tcl_DeleteNamespace(
 
 	    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);
 
 	    /*
@@ -1091,8 +1105,6 @@ TclTeardownNamespace(
     Interp *iPtr = (Interp *) nsPtr->interp;
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
-    Tcl_Namespace *childNsPtr;
-    Tcl_Command cmd;
     int i;
 
     /*
@@ -1107,16 +1119,31 @@ TclTeardownNamespace(
     /*
      * 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.
+     * command table. Because of traces (and the desire to avoid the quadratic
+     * problems of just using Tcl_FirstHashEntry over and over, [Bug
+     * f97d4ee020]) we copy to a temporary array and then delete all those
+     * commands.
      */
 
-    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);
+    while (nsPtr->cmdTable.numEntries > 0) {
+	int length = nsPtr->cmdTable.numEntries;
+	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Command *) * length);
+
+	i = 0;
+	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+		entryPtr != NULL;
+		entryPtr = Tcl_NextHashEntry(&search)) {
+	    cmds[i] = Tcl_GetHashValue(entryPtr);
+	    cmds[i]->refCount++;
+	    i++;
+	}
+	for (i = 0 ; i < length ; i++) {
+	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+		    (Tcl_Command) cmds[i]);
+	    TclCleanupCommandMacro(cmds[i]);
+	}
+	TclStackFree((Tcl_Interp *) iPtr, cmds);
     }
     Tcl_DeleteHashTable(&nsPtr->cmdTable);
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
@@ -1126,8 +1153,9 @@ TclTeardownNamespace(
      */
 
     if (nsPtr->parentPtr != NULL) {
-	entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
-		nsPtr->name);
+	entryPtr = Tcl_FindHashEntry(
+		TclGetNamespaceChildTable((Tcl_Namespace *)
+			nsPtr->parentPtr), nsPtr->name);
 	if (entryPtr != NULL) {
 	    Tcl_DeleteHashEntry(entryPtr);
 	}
@@ -1144,6 +1172,7 @@ TclTeardownNamespace(
     }
     if (nsPtr->commandPathSourceList != NULL) {
 	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+
 	do {
 	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
 		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
@@ -1159,17 +1188,57 @@ TclTeardownNamespace(
      *
      * 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.
+     * being deleted.  Because of traces (and the desire to avoid the
+     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+     * f97d4ee020]) we copy to a temporary array and then delete all those
+     * namespaces.
      *
-     * Don't optimize to Tcl_NextHashEntry() because of traces.
+     * Important: leave the hash table itself still live.
      */
 
-    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-	    entryPtr != NULL;
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
-	childNsPtr = Tcl_GetHashValue(entryPtr);
-	Tcl_DeleteNamespace(childNsPtr);
+#ifndef BREAK_NAMESPACE_COMPAT
+    while (nsPtr->childTable.numEntries > 0) {
+	int length = nsPtr->childTable.numEntries;
+	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		sizeof(Namespace *) * length);
+
+	i = 0;
+	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+		entryPtr != NULL;
+		entryPtr = Tcl_NextHashEntry(&search)) {
+	    children[i] = Tcl_GetHashValue(entryPtr);
+	    children[i]->refCount++;
+	    i++;
+	}
+	for (i = 0 ; i < length ; i++) {
+	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+	    TclNsDecrRefCount(children[i]);
+	}
+	TclStackFree((Tcl_Interp *) iPtr, children);
+    }
+#else
+    if (nsPtr->childTablePtr != NULL) {
+	while (nsPtr->childTablePtr->numEntries > 0) {
+	    int length = nsPtr->childTablePtr->numEntries;
+	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+		    sizeof(Namespace *) * length);
+
+	    i = 0;
+	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+		    entryPtr != NULL;
+		    entryPtr = Tcl_NextHashEntry(&search)) {
+		children[i] = Tcl_GetHashValue(entryPtr);
+		children[i]->refCount++;
+		i++;
+	    }
+	    for (i = 0 ; i < length ; i++) {
+		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+		TclNsDecrRefCount(children[i]);
+	    }
+	    TclStackFree((Tcl_Interp *) iPtr, children);
+	}
     }
+#endif
 
     /*
      * Free the namespace's export pattern array.
@@ -1179,7 +1248,7 @@ TclTeardownNamespace(
 	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
 	    ckfree(nsPtr->exportArrayPtr[i]);
 	}
-	ckfree((char *) nsPtr->exportArrayPtr);
+	ckfree(nsPtr->exportArrayPtr);
 	nsPtr->exportArrayPtr = NULL;
 	nsPtr->numExportPatterns = 0;
 	nsPtr->maxExportPatterns = 0;
@@ -1190,7 +1259,7 @@ TclTeardownNamespace(
      */
 
     if (nsPtr->deleteProc != NULL) {
-	(*nsPtr->deleteProc)(nsPtr->clientData);
+	nsPtr->deleteProc(nsPtr->clientData);
     }
     nsPtr->deleteProc = NULL;
     nsPtr->clientData = NULL;
@@ -1233,8 +1302,34 @@ 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    ckfree((char *) nsPtr);
+void
+TclNsDecrRefCount(
+    Namespace *nsPtr)
+{
+    nsPtr->refCount--;
+    if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+	NamespaceFree(nsPtr);
+    }
 }
 
 /*
@@ -1299,7 +1394,7 @@ Tcl_Export(
 	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
 		ckfree(nsPtr->exportArrayPtr[i]);
 	    }
-	    ckfree((char *) nsPtr->exportArrayPtr);
+	    ckfree(nsPtr->exportArrayPtr);
 	    nsPtr->exportArrayPtr = NULL;
 	    TclInvalidateNsCmdLookup(nsPtr);
 	    nsPtr->numExportPatterns = 0;
@@ -1315,8 +1410,9 @@ 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_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
+                " \"%s\": pattern can't specify a namespace", pattern));
+	Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
 	return TCL_ERROR;
     }
 
@@ -1345,8 +1441,7 @@ Tcl_Export(
     if (neededElems > nsPtr->maxExportPatterns) {
 	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
 		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
-	nsPtr->exportArrayPtr = (char **)
-		ckrealloc((char *) nsPtr->exportArrayPtr,
+	nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr,
 		sizeof(char *) * nsPtr->maxExportPatterns);
     }
 
@@ -1355,7 +1450,7 @@ Tcl_Export(
      */
 
     len = strlen(pattern);
-    patternCpy = ckalloc((unsigned) (len + 1));
+    patternCpy = ckalloc(len + 1);
     memcpy(patternCpy, pattern, (unsigned) len + 1);
 
     nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
@@ -1521,27 +1616,30 @@ Tcl_Import(
      */
 
     if (strlen(pattern) == 0) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
+	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
 	return TCL_ERROR;
     }
     TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
 	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (importNsPtr == NULL) {
-	Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
-		pattern, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "unknown namespace in import pattern \"%s\"", pattern));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
 	return TCL_ERROR;
     }
     if (importNsPtr == nsPtr) {
 	if (pattern == simplePattern) {
-	    Tcl_AppendResult(interp,
-		    "no namespace specified in import pattern \"", pattern,
-		    "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "no namespace specified in import pattern \"%s\"",
+                    pattern));
+	    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL);
 	} else {
-	    Tcl_AppendResult(interp, "import pattern \"", pattern,
-		    "\" tries to import from namespace \"",
-		    importNsPtr->name, "\" into itself", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "import pattern \"%s\" tries to import from namespace"
+                    " \"%s\" into itself", pattern, importNsPtr->name));
+	    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL);
 	}
 	return TCL_ERROR;
     }
@@ -1564,6 +1662,7 @@ Tcl_Import(
     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) {
@@ -1611,7 +1710,8 @@ DoImport(
      */
 
     while (!exported && (i < importNsPtr->numExportPatterns)) {
-	exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]);
+	exported |= Tcl_StringMatch(cmdName,
+		importNsPtr->exportArrayPtr[i++]);
     }
     if (!exported) {
 	return TCL_OK;
@@ -1639,7 +1739,7 @@ DoImport(
 	Tcl_DStringInit(&ds);
 	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
 	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
-	    Tcl_DStringAppend(&ds, "::", 2);
+	    TclDStringAppendLiteral(&ds, "::");
 	}
 	Tcl_DStringAppend(&ds, cmdName, -1);
 
@@ -1651,25 +1751,27 @@ DoImport(
 	cmdPtr = Tcl_GetHashValue(hPtr);
 	if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
 	    Command *overwrite = Tcl_GetHashValue(found);
-	    Command *link = cmdPtr;
-
-	    while (link->deleteProc == DeleteImportedCmd) {
-		ImportedCmdData *dataPtr = link->objClientData;
-
-		link = dataPtr->realCmdPtr;
-		if (overwrite == link) {
-		    Tcl_AppendResult(interp, "import pattern \"", pattern,
-			    "\" would create a loop containing command \"",
-			    Tcl_DStringValue(&ds), "\"", NULL);
+	    Command *linkCmd = cmdPtr;
+
+	    while (linkCmd->deleteProc == DeleteImportedCmd) {
+		dataPtr = linkCmd->objClientData;
+		linkCmd = dataPtr->realCmdPtr;
+		if (overwrite == linkCmd) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                            "import pattern \"%s\" would create a loop"
+                            " containing command \"%s\"",
+                            pattern, Tcl_DStringValue(&ds)));
 		    Tcl_DStringFree(&ds);
+		    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
 		    return TCL_ERROR;
 		}
 	    }
 	}
 
-	dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
-	importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
-		InvokeImportedCmd, dataPtr, DeleteImportedCmd);
+	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;
@@ -1680,7 +1782,7 @@ DoImport(
 	 * and add it to the import ref list in the "real" command.
 	 */
 
-	refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+	refPtr = ckalloc(sizeof(ImportRef));
 	refPtr->importedCmdPtr = (Command *) importedCmd;
 	refPtr->nextPtr = cmdPtr->importRefPtr;
 	cmdPtr->importRefPtr = refPtr;
@@ -1698,8 +1800,9 @@ DoImport(
 		return TCL_OK;
 	    }
 	}
-	Tcl_AppendResult(interp, "can't import command \"", cmdName,
-		"\": already exists", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "can't import command \"%s\": already exists", cmdName));
+	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1766,9 +1869,9 @@ Tcl_ForgetImport(
 	    &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (sourceNsPtr == NULL) {
-	Tcl_AppendResult(interp,
-		"unknown namespace in namespace forget pattern \"",
-		pattern, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown namespace in namespace forget pattern \"%s\"",
+		pattern));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
 	return TCL_ERROR;
     }
@@ -1779,13 +1882,13 @@ Tcl_ForgetImport(
 	 */
 
 	if (TclMatchIsTrivial(simplePattern)) {
-	    Command *cmdPtr;
-
 	    hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
-	    if ((hPtr != NULL)
-		    && (cmdPtr = Tcl_GetHashValue(hPtr))
-		    && (cmdPtr->deleteProc == DeleteImportedCmd)) {
-		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	    if (hPtr != NULL) {
+		Command *cmdPtr = Tcl_GetHashValue(hPtr);
+
+		if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) {
+		    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+		}
 	    }
 	    return TCL_OK;
 	}
@@ -1836,7 +1939,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);
 	}
     }
@@ -1905,17 +2008,29 @@ TclGetOriginalCommand(
  */
 
 static int
-InvokeImportedCmd(
+InvokeImportedNRCmd(
     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. */
 {
-    register ImportedCmdData *dataPtr = clientData;
-    register Command *realCmdPtr = dataPtr->realCmdPtr;
+    ImportedCmdData *dataPtr = clientData;
+    Command *realCmdPtr = dataPtr->realCmdPtr;
+
+    TclSkipTailcall(interp);
+    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
+}
 
-    return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+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);
 }
 
@@ -1964,8 +2079,8 @@ DeleteImportedCmd(
 	    } else {
 		prevPtr->nextPtr = refPtr->nextPtr;
 	    }
-	    ckfree((char *) refPtr);
-	    ckfree((char *) dataPtr);
+	    ckfree(refPtr);
+	    ckfree(dataPtr);
 	    return;
 	}
 	prevPtr = refPtr;
@@ -2198,7 +2313,7 @@ TclGetNamespaceForQualName(
 	     * qualName since it may be a string constant.
 	     */
 
-	    Tcl_DStringSetLength(&buffer, 0);
+	    TclDStringClear(&buffer);
 	    Tcl_DStringAppend(&buffer, start, len);
 	    nsName = Tcl_DStringValue(&buffer);
 	}
@@ -2211,7 +2326,15 @@ TclGetNamespaceForQualName(
 	 */
 
 	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) {
@@ -2220,8 +2343,8 @@ TclGetNamespaceForQualName(
 		(void) TclPushStackFrame(interp, &framePtr,
 			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
 
-		nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
-			NULL, NULL);
+		nsPtr = (Namespace *)
+			Tcl_CreateNamespace(interp, nsName, NULL, NULL);
 		TclPopStackFrame(interp);
 
 		if (nsPtr == NULL) {
@@ -2238,7 +2361,15 @@ TclGetNamespaceForQualName(
 	 */
 
 	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 {
@@ -2341,9 +2472,11 @@ Tcl_FindNamespace(
 
     if (nsPtr != NULL) {
 	return (Tcl_Namespace *) nsPtr;
-    } else if (flags & TCL_LEAVE_ERR_MSG) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL);
+    }
+
+    if (flags & TCL_LEAVE_ERR_MSG) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "unknown namespace \"%s\"", name));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
     }
     return NULL;
@@ -2418,7 +2551,7 @@ Tcl_FindCommand(
 	Tcl_Command cmd;
 
 	if (cxtNsPtr->cmdResProc) {
-	    result = (*cxtNsPtr->cmdResProc)(interp, name,
+	    result = cxtNsPtr->cmdResProc(interp, name,
 		    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
 	} else {
 	    result = TCL_CONTINUE;
@@ -2426,14 +2559,16 @@ Tcl_FindCommand(
 
 	while (result == TCL_CONTINUE && resPtr) {
 	    if (resPtr->cmdResProc) {
-		result = (*resPtr->cmdResProc)(interp, name,
+		result = resPtr->cmdResProc(interp, name,
 			(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
 	    }
 	    resPtr = resPtr->nextPtr;
 	}
 
 	if (result == TCL_OK) {
+	    ((Command *)cmd)->flags |= CMD_VIA_RESOLVER;
 	    return cmd;
+
 	} else if (result != TCL_CONTINUE) {
 	    return NULL;
 	}
@@ -2525,12 +2660,13 @@ Tcl_FindCommand(
     }
 
     if (cmdPtr != NULL) {
+	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
 	return (Tcl_Command) cmdPtr;
     }
 
     if (flags & TCL_LEAVE_ERR_MSG) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "unknown command \"%s\"", name));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
     }
     return NULL;
@@ -2581,8 +2717,8 @@ TclResetShadowedCmdRefs(
     int found, i;
     int trailFront = -1;
     int trailSize = 5;		/* Formerly NUM_TRAIL_ELEMS. */
-    Namespace **trailPtr = (Namespace **)
-	    TclStackAlloc(interp, trailSize * sizeof(Namespace *));
+    Namespace **trailPtr = TclStackAlloc(interp,
+	    trailSize * sizeof(Namespace *));
 
     /*
      * Start at the namespace containing the new command, and work up through
@@ -2618,8 +2754,17 @@ TclResetShadowedCmdRefs(
 
 	for (i = trailFront;  i >= 0;  i--) {
 	    trailNsPtr = trailPtr[i];
+#ifndef BREAK_NAMESPACE_COMPAT
 	    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 {
@@ -2647,7 +2792,7 @@ TclResetShadowedCmdRefs(
 		 * for a fresh compilation of every bytecode.
 		 */
 
-		if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL) {
+		if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL){
 		    nsPtr->resolverEpoch++;
 		}
 	    }
@@ -2661,8 +2806,9 @@ TclResetShadowedCmdRefs(
 	trailFront++;
 	if (trailFront == trailSize) {
 	    int newSize = 2 * trailSize;
-	    trailPtr = (Namespace **) TclStackRealloc(interp,
-		    trailPtr, newSize * sizeof(Namespace *));
+
+	    trailPtr = TclStackRealloc(interp, trailPtr,
+		    newSize * sizeof(Namespace *));
 	    trailSize = newSize;
 	}
 	trailPtr[trailFront] = nsPtr;
@@ -2710,7 +2856,7 @@ TclGetNamespaceFromObj(
 	     * Get the current namespace name.
 	     */
 
-	    NamespaceCurrentCmd(NULL, interp, 2, NULL);
+	    NamespaceCurrentCmd(NULL, interp, 1, NULL);
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "namespace \"%s\" not found in \"%s\"", name,
 		    Tcl_GetStringResult(interp)));
@@ -2733,22 +2879,22 @@ GetNamespaceFromObj(
 
     if (objPtr->typePtr == &nsNameType) {
 	/*
-	 * Check that the ResolvedNsName is still valid; avoid letting the ref 
+	 * Check that the ResolvedNsName is still valid; avoid letting the ref
 	 * cross interps.
 	 */
 
-	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
+	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))))) {
+		(refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
 	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
 	    return TCL_OK;
 	}
     }
     if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
-	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
+	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
 	return TCL_OK;
     }
@@ -2758,139 +2904,25 @@ GetNamespaceFromObj(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_NamespaceObjCmd --
+ * TclInitNamespaceCmd --
  *
- *	Invoked to implement the "namespace" command that creates, deletes, or
- *	manipulates Tcl namespaces. Handles the following syntax:
- *
- *	    namespace children ?name? ?pattern?
- *	    namespace code arg
- *	    namespace current
- *	    namespace delete ?name name...?
- *	    namespace ensemble subcommand ?arg...?
- *	    namespace eval name arg ?arg...?
- *	    namespace exists name
- *	    namespace export ?-clear? ?pattern pattern...?
- *	    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
+ *	This function is called to create the "namespace" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
- *	Returns TCL_OK if the command is successful. Returns TCL_ERROR if
- *	anything goes wrong.
+ *	Handle for the namespace command, or NULL on failure.
  *
  * Side effects:
- *	Based on the subcommand name (e.g., "import"), this function
- *	dispatches to a corresponding function NamespaceXXXCmd defined
- *	statically in this file. This function's side effects depend on
- *	whatever that subcommand function does. If there is an error, this
- *	function returns an error message in the interpreter's result object.
- *	Otherwise it may return a result in the interpreter's result object.
+ *	none
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_NamespaceObjCmd(
-    ClientData clientData,	/* Arbitrary value passed to cmd. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+Tcl_Command
+TclInitNamespaceCmd(
+    Tcl_Interp *interp)		/* Current interpreter. */
 {
-    static const char *subCmds[] = {
-	"children", "code", "current", "delete", "ensemble",
-	"eval", "exists", "export", "forget", "import",
-	"inscope", "origin", "parent", "path", "qualifiers",
-	"tail", "unknown", "upvar", "which", NULL
-    };
-    enum NSSubCmdIdx {
-	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
-	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
-	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
-	NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
-    };
-    int index, result;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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 NSEnsembleIdx:
-	result = NamespaceEnsembleCmd(clientData, interp, objc, objv);
-	break;
-    case NSEvalIdx:
-	result = NamespaceEvalCmd(clientData, interp, objc, objv);
-	break;
-    case NSExistsIdx:
-	result = NamespaceExistsCmd(clientData, interp, objc, objv);
-	break;
-    case NSExportIdx:
-	result = NamespaceExportCmd(clientData, interp, objc, objv);
-	break;
-    case NSForgetIdx:
-	result = NamespaceForgetCmd(clientData, interp, objc, objv);
-	break;
-    case NSImportIdx:
-	result = NamespaceImportCmd(clientData, interp, objc, objv);
-	break;
-    case NSInscopeIdx:
-	result = NamespaceInscopeCmd(clientData, interp, objc, objv);
-	break;
-    case NSOriginIdx:
-	result = NamespaceOriginCmd(clientData, interp, objc, objv);
-	break;
-    case NSParentIdx:
-	result = NamespaceParentCmd(clientData, interp, objc, objv);
-	break;
-    case NSPathIdx:
-	result = NamespacePathCmd(clientData, interp, objc, objv);
-	break;
-    case NSQualifiersIdx:
-	result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
-	break;
-    case NSTailIdx:
-	result = NamespaceTailCmd(clientData, interp, objc, objv);
-	break;
-    case NSUpvarIdx:
-	result = NamespaceUpvarCmd(clientData, interp, objc, objv);
-	break;
-    case NSUnknownIdx:
-	result = NamespaceUnknownCmd(clientData, interp, objc, objv);
-	break;
-    case NSWhichIdx:
-	result = NamespaceWhichCmd(clientData, interp, objc, objv);
-	break;
-    }
-    return result;
+    return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);
 }
 
 /*
@@ -2924,7 +2956,7 @@ NamespaceChildrenCmd(
     Tcl_Namespace *namespacePtr;
     Namespace *nsPtr, *childNsPtr;
     Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
-    char *pattern = NULL;
+    const char *pattern = NULL;
     Tcl_DString buffer;
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
@@ -2934,15 +2966,15 @@ NamespaceChildrenCmd(
      * Get a pointer to the specified namespace, or the current namespace.
      */
 
-    if (objc == 2) {
+    if (objc == 1) {
 	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    } else if ((objc == 3) || (objc == 4)) {
-	if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+    } else if ((objc == 2) || (objc == 3)) {
+	if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){
 	    return TCL_ERROR;
 	}
 	nsPtr = (Namespace *) namespacePtr;
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?name? ?pattern?");
 	return TCL_ERROR;
     }
 
@@ -2951,15 +2983,15 @@ NamespaceChildrenCmd(
      */
 
     Tcl_DStringInit(&buffer);
-    if (objc == 4) {
-	char *name = TclGetString(objv[3]);
+    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);
+		TclDStringAppendLiteral(&buffer, "::");
 	    }
 	    Tcl_DStringAppend(&buffer, name, -1);
 	    pattern = Tcl_DStringValue(&buffer);
@@ -2978,13 +3010,27 @@ NamespaceChildrenCmd(
 	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
 	    goto searchDone;
 	}
-	if (Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL) {
+	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
     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)
@@ -3038,11 +3084,11 @@ NamespaceCodeCmd(
 {
     Namespace *currNsPtr;
     Tcl_Obj *listPtr, *objPtr;
-    register char *arg;
+    register const char *arg;
     int length;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "arg");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg");
 	return TCL_ERROR;
     }
 
@@ -3054,10 +3100,10 @@ NamespaceCodeCmd(
      " "namespace" command.  [Bug 3202171].
      */
 
-    arg = TclGetStringFromObj(objv[2], &length);
-    if (*arg==':' && length > 20 
+    arg = TclGetStringFromObj(objv[1], &length);
+    if (*arg==':' && length > 20
 	    && strncmp(arg, "::namespace inscope ", 20) == 0) {
-	Tcl_SetObjResult(interp, objv[2]);
+	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     }
 
@@ -3083,7 +3129,7 @@ NamespaceCodeCmd(
     }
     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
 
-    Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
+    Tcl_ListObjAppendElement(interp, listPtr, objv[1]);
 
     Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
@@ -3119,8 +3165,8 @@ NamespaceCurrentCmd(
 {
     register Namespace *currNsPtr;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
 	return TCL_ERROR;
     }
 
@@ -3181,11 +3227,11 @@ NamespaceDeleteCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
-    char *name;
+    const char *name;
     register int i;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
+    if (objc < 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
 	return TCL_ERROR;
     }
 
@@ -3195,14 +3241,14 @@ NamespaceDeleteCmd(
      * command line are valid, and report any errors.
      */
 
-    for (i = 2;  i < objc;  i++) {
+    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);
+		|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "unknown namespace \"%s\" in namespace delete command",
+		    TclGetString(objv[i])));
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
 		    TclGetString(objv[i]), NULL);
 	    return TCL_ERROR;
@@ -3213,7 +3259,7 @@ NamespaceDeleteCmd(
      * Okay, now delete each namespace.
      */
 
-    for (i = 2;  i < objc;  i++) {
+    for (i = 1;  i < objc;  i++) {
 	name = TclGetString(objv[i]);
 	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
 	if (namespacePtr) {
@@ -3252,18 +3298,32 @@ NamespaceDeleteCmd(
 
 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. */
+{
+    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;
     Tcl_Obj *objPtr;
     int result;
 
-    if (objc < 4) {
-	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
 	return TCL_ERROR;
     }
 
@@ -3272,14 +3332,14 @@ NamespaceEvalCmd(
      * namespace object along the way.
      */
 
-    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    result = GetNamespaceFromObj(interp, objv[1], &namespacePtr);
 
     /*
      * If the namespace wasn't found, try to create it.
      */
 
     if (result == TCL_ERROR) {
-	char *name = TclGetString(objv[2]);
+	const char *name = TclGetString(objv[1]);
 
 	namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
 	if (namespacePtr == NULL) {
@@ -3294,26 +3354,20 @@ NamespaceEvalCmd(
 
     /* This is needed to satisfy GCC 3.3's strict aliasing rules */
     framePtrPtr = &framePtr;
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
 	    namespacePtr, /*isProcCallFrame*/ 0);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
 
-    framePtr->objc = objc;
-    framePtr->objv = objv;
+    framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
 
-    if (objc == 4) {
+    if (objc == 3) {
 	/*
 	 * 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);
+	objPtr = objv[2];
+	invoker = iPtr->cmdFramePtr;
+	word = 3;
+	TclArgumentGet(interp, objPtr, &invoker, &word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -3321,24 +3375,39 @@ NamespaceEvalCmd(
 	 * object when it decrements its refcount after eval'ing it.
 	 */
 
-	objPtr = Tcl_ConcatObj(objc-3, objv+3);
+	objPtr = Tcl_ConcatObj(objc-2, objv+2);
+	invoker = NULL;
+	word = 0;
+    }
 
-	/*
-	 * TIP #280: Make invoking context available to eval'd script.
-	 */
+    /*
+     * TIP #280: Make invoking context available to eval'd script.
+     */
 
-	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
-    }
+    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 eval \"%.*s%s\" script line %d)",
+		"\n    (in namespace %s \"%.*s%s\" script line %d)",
+		cmd,
 		(overflow ? limit : length), namespacePtr->fullName,
-		(overflow ? "..." : ""), interp->errorLine));
+		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
     }
 
     /*
@@ -3379,13 +3448,13 @@ NamespaceExistsCmd(
 {
     Tcl_Namespace *namespacePtr;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "name");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
 
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    GetNamespaceFromObj(interp, objv[2], &namespacePtr) == TCL_OK));
+	    GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
     return TCL_OK;
 }
 
@@ -3434,8 +3503,8 @@ NamespaceExportCmd(
 {
     int firstArg, i;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
+    if (objc < 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
 	return TCL_ERROR;
     }
 
@@ -3444,7 +3513,7 @@ NamespaceExportCmd(
      * the namespace's current export pattern list.
      */
 
-    if (objc == 2) {
+    if (objc == 1) {
 	Tcl_Obj *listPtr = Tcl_NewObj();
 
 	(void) Tcl_AppendExportList(interp, NULL, listPtr);
@@ -3456,7 +3525,7 @@ NamespaceExportCmd(
      * Process the optional "-clear" argument.
      */
 
-    firstArg = 2;
+    firstArg = 1;
     if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) {
 	Tcl_Export(interp, NULL, "::", 1);
 	Tcl_ResetResult(interp);
@@ -3513,15 +3582,15 @@ NamespaceForgetCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *pattern;
+    const char *pattern;
     register int i, result;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+    if (objc < 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
 	return TCL_ERROR;
     }
 
-    for (i = 2;  i < objc;  i++) {
+    for (i = 1;  i < objc;  i++) {
 	pattern = TclGetString(objv[i]);
 	result = Tcl_ForgetImport(interp, NULL, pattern);
 	if (result != TCL_OK) {
@@ -3579,12 +3648,12 @@ NamespaceImportCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int allowOverwrite = 0;
-    char *string, *pattern;
+    const char *string, *pattern;
     register int i, result;
     int firstArg;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
+    if (objc < 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
 	return TCL_ERROR;
     }
 
@@ -3592,7 +3661,7 @@ NamespaceImportCmd(
      * Skip over the optional "-force" as the first argument.
      */
 
-    firstArg = 2;
+    firstArg = 1;
     if (firstArg < objc) {
 	string = TclGetString(objv[firstArg]);
 	if ((*string == '-') && (strcmp(string, "-force") == 0)) {
@@ -3601,7 +3670,7 @@ NamespaceImportCmd(
 	}
     } else {
 	/*
-	 * When objc == 2, command is just [namespace import]. Introspection
+	 * When objc == 1, command is just [namespace import]. Introspection
 	 * form to return list of imported commands.
 	 */
 
@@ -3677,6 +3746,17 @@ 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. */
@@ -3684,10 +3764,11 @@ NamespaceInscopeCmd(
 {
     Tcl_Namespace *namespacePtr;
     CallFrame *framePtr, **framePtrPtr;
-    int i, result;
+    int i;
+    Tcl_Obj *cmdObjPtr;
 
-    if (objc < 4) {
-	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
 	return TCL_ERROR;
     }
 
@@ -3695,7 +3776,7 @@ NamespaceInscopeCmd(
      * Resolve the namespace reference.
      */
 
-    if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+    if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -3705,14 +3786,10 @@ NamespaceInscopeCmd(
 
     framePtrPtr = &framePtr;		/* This is needed to satisfy GCC's
 					 * strict aliasing rules. */
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
 	    namespacePtr, /*isProcCallFrame*/ 0);
-    if (result != TCL_OK) {
-	return result;
-    }
 
-    framePtr->objc = objc;
-    framePtr->objv = objv;
+    framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
 
     /*
      * Execute the command. If there is just one argument, just treat it as a
@@ -3721,44 +3798,29 @@ NamespaceInscopeCmd(
      * of extra arguments to form the command to evaluate.
      */
 
-    if (objc == 4) {
-	result = Tcl_EvalObjEx(interp, objv[3], 0);
+    if (objc == 3) {
+	cmdObjPtr = objv[2];
     } else {
 	Tcl_Obj *concatObjv[2];
-	register Tcl_Obj *listPtr, *cmdObjPtr;
+	register Tcl_Obj *listPtr;
 
 	listPtr = Tcl_NewListObj(0, NULL);
-	for (i = 4;  i < objc;  i++) {
-	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK) {
+	for (i = 3;  i < objc;  i++) {
+	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){
 		Tcl_DecrRefCount(listPtr);	/* Free unneeded obj. */
 		return TCL_ERROR;
 	    }
 	}
 
-	concatObjv[0] = objv[3];
+	concatObjv[0] = objv[2];
 	concatObjv[1] = listPtr;
 	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
-	result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
 	Tcl_DecrRefCount(listPtr);    /* We're done with the list object. */
     }
 
-    if (result == TCL_ERROR) {
-	int length = strlen(namespacePtr->fullName);
-	int limit = 200;
-	int overflow = (length > limit);
-
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (in namespace inscope \"%.*s%s\" script line %d)",
-		(overflow ? limit : length), namespacePtr->fullName,
-		(overflow ? "..." : ""), interp->errorLine));
-    }
-
-    /*
-     * Restore the previous "current" namespace.
-     */
-
-    TclPopStackFrame(interp);
-    return result;
+    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
+	    NULL, NULL);
+    return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
 }
 
 /*
@@ -3800,17 +3862,17 @@ NamespaceOriginCmd(
     Tcl_Command command, origCommand;
     Tcl_Obj *resultPtr;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "name");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
 
-    command = Tcl_GetCommandFromObj(interp, objv[2]);
+    command = Tcl_GetCommandFromObj(interp, objv[1]);
     if (command == NULL) {
-	Tcl_AppendResult(interp, "invalid command name \"",
-		TclGetString(objv[2]), "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "invalid command name \"%s\"", TclGetString(objv[1])));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
-		TclGetString(objv[2]), NULL);
+		TclGetString(objv[1]), NULL);
 	return TCL_ERROR;
     }
     origCommand = TclGetOriginalCommand(command);
@@ -3860,14 +3922,14 @@ NamespaceParentCmd(
 {
     Tcl_Namespace *nsPtr;
 
-    if (objc == 2) {
+    if (objc == 1) {
 	nsPtr = TclGetCurrentNamespace(interp);
-    } else if (objc == 3) {
-	if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+    } else if (objc == 2) {
+	if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
 	return TCL_ERROR;
     }
 
@@ -3921,8 +3983,8 @@ NamespacePathCmd(
     Tcl_Obj **nsObjv;
     Tcl_Namespace **namespaceList = NULL;
 
-    if (objc > 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
 	return TCL_ERROR;
     }
 
@@ -3930,17 +3992,16 @@ NamespacePathCmd(
      * If no path is given, return the current path.
      */
 
-    if (objc == 2) {
-	/*
-	 * Not a very fast way to compute this, but easy to get right.
-	 */
+    if (objc == 1) {
+	Tcl_Obj *resultObj = Tcl_NewObj();
 
 	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
 	    if (nsPtr->commandPathArray[i].nsPtr != NULL) {
-		Tcl_AppendElement(interp,
-			nsPtr->commandPathArray[i].nsPtr->fullName);
+		Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+			nsPtr->commandPathArray[i].nsPtr->fullName, -1));
 	    }
 	}
+	Tcl_SetObjResult(interp, resultObj);
 	return TCL_OK;
     }
 
@@ -3948,12 +4009,12 @@ NamespacePathCmd(
      * There is a path given, so parse it into an array of namespace pointers.
      */
 
-    if (TclListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) {
+    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
 	goto badNamespace;
     }
     if (nsObjc != 0) {
-	namespaceList = (Tcl_Namespace **)
-		TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc);
+	namespaceList = TclStackAlloc(interp,
+		sizeof(Tcl_Namespace *) * nsObjc);
 
 	for (i=0 ; i<nsObjc ; i++) {
 	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
@@ -4004,7 +4065,7 @@ TclSetNsPath(
     Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
 {
     if (pathLength != 0) {
-	NamespacePathEntry *tmpPathArray = (NamespacePathEntry *)
+	NamespacePathEntry *tmpPathArray =
 		ckalloc(sizeof(NamespacePathEntry) * pathLength);
 	int i;
 
@@ -4060,6 +4121,7 @@ UnlinkNsPath(
     int i;
     for (i=0 ; i<nsPtr->commandPathLength ; i++) {
 	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];
+
 	if (nsPathPtr->prevPtr != NULL) {
 	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
 	}
@@ -4072,7 +4134,7 @@ UnlinkNsPath(
 	    }
 	}
     }
-    ckfree((char *) nsPtr->commandPathArray);
+    ckfree(nsPtr->commandPathArray);
 }
 
 /*
@@ -4100,6 +4162,7 @@ TclInvalidateNsPath(
     Namespace *nsPtr)
 {
     NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;
+
     while (nsPathPtr != NULL) {
 	if (nsPathPtr->nsPtr != NULL) {
 	    nsPathPtr->creatorNsPtr->cmdRefEpoch++;
@@ -4140,11 +4203,11 @@ NamespaceQualifiersCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    register char *name, *p;
+    register const char *name, *p;
     int length;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "string");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string");
 	return TCL_ERROR;
     }
 
@@ -4153,7 +4216,7 @@ NamespaceQualifiersCmd(
      * the last "::" qualifier.
      */
 
-    name = TclGetString(objv[2]);
+    name = TclGetString(objv[1]);
     for (p = name;  *p != '\0';  p++) {
 	/* empty body */
     }
@@ -4212,14 +4275,14 @@ NamespaceUnknownCmd(
     Tcl_Obj *resultPtr;
     int rc;
 
-    if (objc > 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?script?");
 	return TCL_ERROR;
     }
 
     currNsPtr = TclGetCurrentNamespace(interp);
 
-    if (objc == 2) {
+    if (objc == 1) {
 	/*
 	 * Introspection - return the current namespace handler.
 	 */
@@ -4230,9 +4293,9 @@ NamespaceUnknownCmd(
 	}
 	Tcl_SetObjResult(interp, resultPtr);
     } else {
-	rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[2]);
+	rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[1]);
 	if (rc == TCL_OK) {
-	    Tcl_SetObjResult(interp, objv[2]);
+	    Tcl_SetObjResult(interp, objv[1]);
 	}
 	return rc;
     }
@@ -4263,10 +4326,10 @@ Tcl_GetNamespaceUnknownHandler(
 				 * exists. */
     Tcl_Namespace *nsPtr)	/* The namespace. */
 {
-    Namespace *currNsPtr = (Namespace *)nsPtr;
+    Namespace *currNsPtr = (Namespace *) nsPtr;
 
     if (currNsPtr->unknownHandlerPtr == NULL &&
-	    currNsPtr == ((Interp *)interp)->globalNsPtr) {
+	    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
@@ -4307,7 +4370,7 @@ Tcl_SetNamespaceUnknownHandler(
     Tcl_Obj *handlerPtr)	/* The new handler, or NULL to reset. */
 {
     int lstlen = 0;
-    Namespace *currNsPtr = (Namespace *)nsPtr;
+    Namespace *currNsPtr = (Namespace *) nsPtr;
 
     /*
      * Ensure that we check for errors *first* before we change anything.
@@ -4395,10 +4458,10 @@ NamespaceTailCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    register char *name, *p;
+    register const char *name, *p;
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "string");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "string");
 	return TCL_ERROR;
     }
 
@@ -4407,7 +4470,7 @@ NamespaceTailCmd(
      * qualifier.
      */
 
-    name = TclGetString(objv[2]);
+    name = TclGetString(objv[1]);
     for (p = name;  *p != '\0';  p++) {
 	/* empty body */
     }
@@ -4456,31 +4519,30 @@ NamespaceUpvarCmd(
     Interp *iPtr = (Interp *) interp;
     Tcl_Namespace *nsPtr, *savedNsPtr;
     Var *otherPtr, *arrayPtr;
-    char *myName;
+    const char *myName;
 
-    if (objc < 5 || !(objc & 1)) {
-	Tcl_WrongNumArgs(interp, 2, objv,
-		"ns otherVar myVar ?otherVar myVar ...?");
+    if (objc < 2 || (objc & 1)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
 	return TCL_ERROR;
     }
 
-    if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
+    if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    objc -= 3;
-    objv += 3;
+    objc -= 2;
+    objv += 2;
 
     for (; objc>0 ; objc-=2, objv+=2) {
 	/*
-	 * Locate the other variable
+	 * 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);
+		(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
+		"access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
 	if (otherPtr == NULL) {
 	    return TCL_ERROR;
@@ -4528,22 +4590,22 @@ NamespaceWhichCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static const char *opts[] = {
+    static const char *const opts[] = {
 	"-command", "-variable", NULL
     };
     int lookupType = 0;
     Tcl_Obj *resultPtr;
 
-    if (objc < 3 || objc > 4) {
+    if (objc < 2 || objc > 3) {
     badArgs:
-	Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
 	return TCL_ERROR;
-    } else if (objc == 4) {
+    } else if (objc == 3) {
 	/*
 	 * Look for a flag controlling the lookup.
 	 */
 
-	if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0,
+	if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
 		&lookupType) != TCL_OK) {
 	    /*
 	     * Preserve old style of error message!
@@ -4602,9 +4664,7 @@ FreeNsNameInternalRep(
     register Tcl_Obj *objPtr)	/* nsName object with internal representation
 				 * to free. */
 {
-    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
-	    objPtr->internalRep.twoPtrValue.ptr1;
-    Namespace *nsPtr;
+    ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     /*
      * Decrement the reference count of the namespace. If there are no more
@@ -4613,19 +4673,14 @@ FreeNsNameInternalRep(
 
     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.
 	 */
 
-	nsPtr = resNamePtr->nsPtr;
-	nsPtr->refCount--;
-	if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
-	    NamespaceFree(nsPtr);
-	}
-	ckfree((char *) resNamePtr);
+	TclNsDecrRefCount(resNamePtr->nsPtr);
+	ckfree(resNamePtr);
     }
     objPtr->typePtr = NULL;
 }
@@ -4654,8 +4709,7 @@ DupNsNameInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
-    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
-	    srcPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
     copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
     resNamePtr->refCount++;
@@ -4718,13 +4772,12 @@ SetNsNameFromAny(
 
 	if (objPtr->typePtr == &nsNameType) {
 	    TclFreeIntRep(objPtr);
-	    objPtr->typePtr = NULL;
 	}
 	return TCL_ERROR;
     }
 
     nsPtr->refCount++;
-    resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
+    resNamePtr = ckalloc(sizeof(ResolvedNsName));
     resNamePtr->nsPtr = nsPtr;
     if ((name[0] == ':') && (name[1] == ':')) {
 	resNamePtr->refNsPtr = NULL;
@@ -4741,2177 +4794,271 @@ SetNsNameFromAny(
 /*
  *----------------------------------------------------------------------
  *
- * NamespaceEnsembleCmd --
+ * TclGetNamespaceCommandTable --
  *
- *	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?
+ *	Returns the hash table of commands.
  *
  * Results:
- *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *	Pointer to the hash table.
  *
  * Side effects:
- *	Creates the ensemble for the namespace if one did not previously
- *	exist. Alternatively, alters the way that the ensemble's subcommand =>
- *	implementation prefix is configured.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-NamespaceEnsembleCmd(
-    ClientData dummy,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Namespace *nsPtr;
-    Tcl_Command token;
-    static const char *subcommands[] = {
-	"configure", "create", "exists", NULL
-    };
-    enum EnsSubcmds {
-	ENS_CONFIG, ENS_CREATE, ENS_EXISTS
-    };
-    static const char *createOptions[] = {
-	"-command", "-map", "-prefixes", "-subcommands", "-unknown", NULL
-    };
-    enum EnsCreateOpts {
-	CRT_CMD, CRT_MAP, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
-    };
-    static const char *configOptions[] = {
-	"-map", "-namespace", "-prefixes", "-subcommands", "-unknown", NULL
-    };
-    enum EnsConfigOpts {
-	CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
-    };
-    int index;
-
-    nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
-	if (!Tcl_InterpDeleted(interp)) {
-	    Tcl_AppendResult(interp,
-		    "tried to manipulate ensemble of deleted namespace", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "subcommand", 0,
-	    &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum EnsSubcmds) index) {
-    case ENS_CREATE: {
-	char *name;
-	Tcl_DictSearch search;
-	Tcl_Obj *listObj;
-	int done, len, allocatedMapFlag = 0;
-	/*
-	 * Defaults
-	 */
-	Tcl_Obj *subcmdObj = NULL;
-	Tcl_Obj *mapObj = NULL;
-	int permitPrefix = 1;
-	Tcl_Obj *unknownObj = NULL;
-
-	objv += 3;
-	objc -= 3;
-
-	/*
-	 * Work out what name to use for the command to create. If supplied,
-	 * it is either fully specified or relative to the current namespace.
-	 * If not supplied, it is exactly the name of the current namespace.
-	 */
-
-	name = nsPtr->fullName;
-
-	/*
-	 * Parse the option list, applying type checks as we go. Note that we
-	 * are not incrementing any reference counts in the objects at this
-	 * stage, so the presence of an option multiple times won't cause any
-	 * memory leaks.
-	 */
-
-	for (; objc>1 ; objc-=2,objv+=2 ) {
-	    if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, "option",
-		    0, &index) != TCL_OK) {
-		if (allocatedMapFlag) {
-		    Tcl_DecrRefCount(mapObj);
-		}
-		return TCL_ERROR;
-	    }
-	    switch ((enum EnsCreateOpts) index) {
-	    case CRT_CMD:
-		name = TclGetString(objv[1]);
-		continue;
-	    case CRT_SUBCMDS:
-		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		subcmdObj = (len > 0 ? objv[1] : NULL);
-		continue;
-	    case CRT_MAP: {
-		Tcl_Obj *patchedDict = NULL, *subcmdObj;
-
-		/*
-		 * Verify that the map is sensible.
-		 */
-
-		if (Tcl_DictObjFirst(interp, objv[1], &search,
-			&subcmdObj, &listObj, &done) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		if (done) {
-		    mapObj = NULL;
-		    continue;
-		}
-		do {
-		    Tcl_Obj **listv;
-		    char *cmd;
-
-		    if (TclListObjGetElements(interp, listObj, &len,
-			    &listv) != TCL_OK) {
-			Tcl_DictObjDone(&search);
-			if (patchedDict) {
-			    Tcl_DecrRefCount(patchedDict);
-			}
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
-		    }
-		    if (len < 1) {
-			Tcl_SetResult(interp,
-				"ensemble subcommand implementations "
-				"must be non-empty lists", TCL_STATIC);
-			Tcl_DictObjDone(&search);
-			if (patchedDict) {
-			    Tcl_DecrRefCount(patchedDict);
-			}
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
-		    }
-		    cmd = TclGetString(listv[0]);
-		    if (!(cmd[0] == ':' && cmd[1] == ':')) {
-			Tcl_Obj *newList = Tcl_NewListObj(len, listv);
-			Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1);
-
-			if (nsPtr->parentPtr) {
-			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
-			}
-			Tcl_AppendObjToObj(newCmd, listv[0]);
-			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
-			if (patchedDict == NULL) {
-			    patchedDict = Tcl_DuplicateObj(objv[1]);
-			}
-			Tcl_DictObjPut(NULL, patchedDict, subcmdObj, newList);
-		    }
-		    Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
-		} while (!done);
-
-		if (allocatedMapFlag) {
-		    Tcl_DecrRefCount(mapObj);
-		}
-		mapObj = (patchedDict ? patchedDict : objv[1]);
-		if (patchedDict) {
-		    allocatedMapFlag = 1;
-		}
-		continue;
-	    }
-	    case CRT_PREFIX:
-		if (Tcl_GetBooleanFromObj(interp, objv[1],
-			&permitPrefix) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		continue;
-	    case CRT_UNKNOWN:
-		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		unknownObj = (len > 0 ? objv[1] : NULL);
-		continue;
-	    }
-	}
-
-	/*
-	 * Create the ensemble. Note that this might delete another ensemble
-	 * linked to the same namespace, so we must be careful. However, we
-	 * should be OK because we only link the namespace into the list once
-	 * we've created it (and after any deletions have occurred.)
-	 */
-
-	token = Tcl_CreateEnsemble(interp, name, NULL,
-		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
-	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
-	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
-	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
-
-	/*
-	 * Tricky! Must ensure that the result is not shared (command delete
-	 * traces could have corrupted the pristine object that we started
-	 * with). [Snit test rename-1.5]
-	 */
-
-	Tcl_ResetResult(interp);
-	Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
-	return TCL_OK;
-    }
-
-    case ENS_EXISTS:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-		Tcl_FindEnsemble(interp, objv[3], 0) != NULL));
-	return TCL_OK;
-
-    case ENS_CONFIG:
-	if (objc < 4 || (objc != 5 && objc & 1)) {
-	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname ?opt? ?value? ...");
-	    return TCL_ERROR;
-	}
-	token = Tcl_FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
-	if (token == NULL) {
-	    return TCL_ERROR;
-	}
-
-	if (objc == 5) {
-	    Tcl_Obj *resultObj = NULL;		/* silence gcc 4 warning */
-
-	    if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
-		    0, &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch ((enum EnsConfigOpts) index) {
-	    case CONF_SUBCMDS:
-		Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
-		if (resultObj != NULL) {
-		    Tcl_SetObjResult(interp, resultObj);
-		}
-		break;
-	    case CONF_MAP:
-		Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
-		if (resultObj != NULL) {
-		    Tcl_SetObjResult(interp, resultObj);
-		}
-		break;
-	    case CONF_NAMESPACE: {
-		Tcl_Namespace *namespacePtr = NULL; /* silence gcc 4 warning */
-
-		Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
-		Tcl_SetResult(interp, ((Namespace *)namespacePtr)->fullName,
-			TCL_VOLATILE);
-		break;
-	    }
-	    case CONF_PREFIX: {
-		int flags = 0;			/* silence gcc 4 warning */
-
-		Tcl_GetEnsembleFlags(NULL, token, &flags);
-		Tcl_SetObjResult(interp,
-			Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
-		break;
-	    }
-	    case CONF_UNKNOWN:
-		Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
-		if (resultObj != NULL) {
-		    Tcl_SetObjResult(interp, resultObj);
-		}
-		break;
-	    }
-	    return TCL_OK;
-
-	} else if (objc == 4) {
-	    /*
-	     * Produce list of all information.
-	     */
-
-	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
-	    Tcl_Namespace *namespacePtr = NULL;	/* silence gcc 4 warning */
-	    int flags = 0;			/* silence gcc 4 warning */
-
-	    TclNewObj(resultObj);
-
-	    /* -map option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_MAP], -1));
-	    Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
-
-	    /* -namespace option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_NAMESPACE], -1));
-	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(((Namespace *)namespacePtr)->fullName,
-		    -1));
-
-	    /* -prefix option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
-	    Tcl_GetEnsembleFlags(NULL, token, &flags);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
-
-	    /* -subcommands option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_SUBCMDS], -1));
-	    Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
-
-	    /* -unknown option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_UNKNOWN], -1));
-	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
-
-	    Tcl_SetObjResult(interp, resultObj);
-	    return TCL_OK;
-	} else {
-	    Tcl_DictSearch search;
-	    Tcl_Obj *listObj;
-	    int done, len, allocatedMapFlag = 0;
-	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL,
-		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
-	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */
-
-	    Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
-	    Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
-	    Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
-	    Tcl_GetEnsembleFlags(NULL, token, &flags);
-	    permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
-
-	    objv += 4;
-	    objc -= 4;
-
-	    /*
-	     * Parse the option list, applying type checks as we go. Note that
-	     * we are not incrementing any reference counts in the objects at
-	     * this stage, so the presence of an option multiple times won't
-	     * cause any memory leaks.
-	     */
-
-	    for (; objc>0 ; objc-=2,objv+=2 ) {
-		if (Tcl_GetIndexFromObj(interp, objv[0], configOptions,
-			"option", 0, &index) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		switch ((enum EnsConfigOpts) index) {
-		case CONF_SUBCMDS:
-		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
-		    }
-		    subcmdObj = (len > 0 ? objv[1] : NULL);
-		    continue;
-		case CONF_MAP: {
-		    Tcl_Obj *patchedDict = NULL, *subcmdObj;
-
-		    /*
-		     * Verify that the map is sensible.
-		     */
-
-		    if (Tcl_DictObjFirst(interp, objv[1], &search,
-			    &subcmdObj, &listObj, &done) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
-		    }
-		    if (done) {
-			mapObj = NULL;
-			continue;
-		    }
-		    do {
-			Tcl_Obj **listv;
-			char *cmd;
-
-			if (TclListObjGetElements(interp, listObj, &len,
-				&listv) != TCL_OK) {
-			    Tcl_DictObjDone(&search);
-			    if (patchedDict) {
-				Tcl_DecrRefCount(patchedDict);
-			    }
-			    if (allocatedMapFlag) {
-				Tcl_DecrRefCount(mapObj);
-			    }
-			    return TCL_ERROR;
-			}
-			if (len < 1) {
-			    Tcl_SetResult(interp,
-				    "ensemble subcommand implementations "
-				    "must be non-empty lists", TCL_STATIC);
-			    Tcl_DictObjDone(&search);
-			    if (patchedDict) {
-				Tcl_DecrRefCount(patchedDict);
-			    }
-			    if (allocatedMapFlag) {
-				Tcl_DecrRefCount(mapObj);
-			    }
-			    return TCL_ERROR;
-			}
-			cmd = TclGetString(listv[0]);
-			if (!(cmd[0] == ':' && cmd[1] == ':')) {
-			    Tcl_Obj *newList = Tcl_NewListObj(len, listv);
-			    Tcl_Obj *newCmd =
-				    Tcl_NewStringObj(nsPtr->fullName, -1);
-			    if (nsPtr->parentPtr) {
-				Tcl_AppendStringsToObj(newCmd, "::", NULL);
-			    }
-			    Tcl_AppendObjToObj(newCmd, listv[0]);
-			    Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
-			    if (patchedDict == NULL) {
-				patchedDict = Tcl_DuplicateObj(objv[1]);
-			    }
-			    Tcl_DictObjPut(NULL, patchedDict, subcmdObj,
-				    newList);
-			}
-			Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
-		    } while (!done);
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    mapObj = (patchedDict ? patchedDict : objv[1]);
-		    if (patchedDict) {
-			allocatedMapFlag = 1;
-		    }
-		    continue;
-		}
-		case CONF_NAMESPACE:
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    Tcl_AppendResult(interp, "option -namespace is read-only",
-			    NULL);
-		    return TCL_ERROR;
-		case CONF_PREFIX:
-		    if (Tcl_GetBooleanFromObj(interp, objv[1],
-			    &permitPrefix) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
-		    }
-		    continue;
-		case CONF_UNKNOWN:
-		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
-		    }
-		    unknownObj = (len > 0 ? objv[1] : NULL);
-		    continue;
-		}
-	    }
-
-	    /*
-	     * Update the namespace now that we've finished the parsing stage.
-	     */
-
-	    flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
-		    : flags&~TCL_ENSEMBLE_PREFIX);
-	    Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
-	    Tcl_SetEnsembleMappingDict(interp, token, mapObj);
-	    Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
-	    Tcl_SetEnsembleFlags(interp, token, flags);
-	    return TCL_OK;
-	}
-
-    default:
-	Tcl_Panic("unexpected ensemble command");
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateEnsemble --
- *
- *	Create a simple ensemble attached to the given namespace.
- *
- * Results:
- *	The token for the command created.
- *
- * Side effects:
- *	The ensemble is created and marked for compilation.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-Tcl_CreateEnsemble(
-    Tcl_Interp *interp,
-    const char *name,
-    Tcl_Namespace *namespacePtr,
-    int flags)
-{
-    Namespace *nsPtr = (Namespace *) namespacePtr;
-    EnsembleConfig *ensemblePtr = (EnsembleConfig *)
-	    ckalloc(sizeof(EnsembleConfig));
-    Tcl_Obj *nameObj = NULL;
-
-    if (nsPtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    }
-
-    /*
-     * 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->unknownHandler = NULL;
-    ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
-	    NsEnsembleImplementationCmd, 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_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 *cmdPtr;
-	    const char *bytes;
-
-	    if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdPtr) != TCL_OK) {
-		Tcl_DictObjDone(&search);
-		return TCL_ERROR;
-	    }
-	    bytes = TclGetString(cmdPtr);
-	    if (bytes[0] != ':' || bytes[1] != ':') {
-		Tcl_AppendResult(interp,
-			"ensemble target is not a fully-qualified command",
-			NULL);
-		Tcl_DictObjDone(&search);
-		return TCL_ERROR;
-	    }
-	}
-
-	if (size < 1) {
-	    mapDict = NULL;
-	}
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    oldDict = ensemblePtr->subcommandDict;
-    ensemblePtr->subcommandDict = mapDict;
-    if (mapDict != NULL) {
-	Tcl_IncrRefCount(mapDict);
-    }
-    if (oldDict != NULL) {
-	TclDecrRefCount(oldDict);
-    }
-
-    /*
-     * Trigger an eventual recomputation of the ensemble command set. Note
-     * that this is slightly tricky, as it means that we are not actually
-     * counting the number of namespace export actions, but it is the simplest
-     * way to go!
-     */
-
-    ensemblePtr->nsPtr->exportLookupEpoch++;
-
-    /*
-     * Special hack to make compiling of [info exists] work when the
-     * dictionary is modified.
-     */
-
-    if (cmdPtr->compileProc != NULL) {
-	((Interp *)interp)->compileEpoch++;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetEnsembleUnknownHandler --
- *
- *	Set the unknown handler for a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an ensemble
- *	or the unknown handler - if non-NULL - is not a list).
- *
- * Side effects:
- *	The ensemble is updated and marked for recompilation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_SetEnsembleUnknownHandler(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Obj *unknownList)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-    Tcl_Obj *oldList;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	return TCL_ERROR;
-    }
-    if (unknownList != NULL) {
-	int length;
-
-	if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (length < 1) {
-	    unknownList = NULL;
-	}
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    oldList = ensemblePtr->unknownHandler;
-    ensemblePtr->unknownHandler = unknownList;
-    if (unknownList != NULL) {
-	Tcl_IncrRefCount(unknownList);
-    }
-    if (oldList != NULL) {
-	TclDecrRefCount(oldList);
-    }
-
-    /*
-     * Trigger an eventual recomputation of the ensemble command set. Note
-     * that this is slightly tricky, as it means that we are not actually
-     * counting the number of namespace export actions, but it is the simplest
-     * way to go!
-     */
-
-    ensemblePtr->nsPtr->exportLookupEpoch++;
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetEnsembleFlags --
- *
- *	Set the flags for a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble).
- *
- * Side effects:
- *	The ensemble is updated and marked for recompilation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_SetEnsembleFlags(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    int flags)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-    int wasCompiled;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	return TCL_ERROR;
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;
-
-    /*
-     * This API refuses to set the ENS_DEAD flag...
-     */
-
-    ensemblePtr->flags &= ENS_DEAD;
-    ensemblePtr->flags |= flags & ~ENS_DEAD;
-
-    /*
-     * Trigger an eventual recomputation of the ensemble command set. Note
-     * that this is slightly tricky, as it means that we are not actually
-     * counting the number of namespace export actions, but it is the simplest
-     * way to go!
-     */
-
-    ensemblePtr->nsPtr->exportLookupEpoch++;
-
-    /*
-     * If the ENSEMBLE_COMPILE flag status was changed, install or remove the
-     * compiler function and bump the interpreter's compilation epoch so that
-     * bytecode gets regenerated.
-     */
-
-    if (flags & ENSEMBLE_COMPILE) {
-	if (!wasCompiled) {
-	    ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble;
-	    ((Interp *) interp)->compileEpoch++;
-	}
-    } else {
-	if (wasCompiled) {
-	    ((Command*) ensemblePtr->token)->compileProc = NULL;
-	    ((Interp *) interp)->compileEpoch++;
-	}
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleSubcommandList --
- *
- *	Get the list of subcommands associated with a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble). The list of subcommands is returned by updating the
- *	variable pointed to by the last parameter (NULL if this is to be
- *	derived from the mapping dictionary or the associated namespace's
- *	exported commands).
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleSubcommandList(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Obj **subcmdListPtr)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    *subcmdListPtr = ensemblePtr->subcmdList;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleMappingDict --
- *
- *	Get the command mapping dictionary associated with a particular
- *	ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble). The mapping dict is returned by updating the variable
- *	pointed to by the last parameter (NULL if none is installed).
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleMappingDict(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Obj **mapDictPtr)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    *mapDictPtr = ensemblePtr->subcommandDict;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleUnknownHandler --
- *
- *	Get the unknown handler associated with a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble). The unknown handler is returned by updating the variable
- *	pointed to by the last parameter (NULL if no handler is installed).
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleUnknownHandler(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Obj **unknownListPtr)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    *unknownListPtr = ensemblePtr->unknownHandler;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleFlags --
- *
- *	Get the flags for a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble). The flags are returned by updating the variable pointed to
- *	by the last parameter.
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleFlags(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    int *flagsPtr)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    *flagsPtr = ensemblePtr->flags;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetEnsembleNamespace --
- *
- *	Get the namespace associated with a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble). Namespace is returned by updating the variable pointed to
- *	by the last parameter.
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleNamespace(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Namespace **namespacePtrPtr)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindEnsemble --
- *
- *	Given a command name, get the ensemble token for it, allowing for
- *	[namespace import]s. [Bug 1017022]
- *
- * Results:
- *	The token for the ensemble command with the given name, or NULL if the
- *	command either does not exist or is not an ensemble (when an error
- *	message will be written into the interp if thats non-NULL).
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-Tcl_FindEnsemble(
-    Tcl_Interp *interp,		/* Where to do the lookup, and where to write
-				 * the errors if TCL_LEAVE_ERR_MSG is set in
-				 * the flags. */
-    Tcl_Obj *cmdNameObj,	/* Name of command to look up. */
-    int flags)			/* Either 0 or TCL_LEAVE_ERR_MSG; other flags
-				 * are probably not useful. */
-{
-    Command *cmdPtr;
-
-    cmdPtr = (Command *)
-	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
-    if (cmdPtr == NULL) {
-	return NULL;
-    }
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	/*
-	 * Reuse existing infrastructure for following import link chains
-	 * rather than duplicating it.
-	 */
-
-	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
-
-	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	    if (flags & TCL_LEAVE_ERR_MSG) {
-		Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
-			"\" is not an ensemble command", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
-			TclGetString(cmdNameObj), NULL);
-	    }
-	    return NULL;
-	}
-    }
-
-    return (Tcl_Command) cmdPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_IsEnsemble --
- *
- *	Simple test for ensemble-hood that takes into account imported
- *	ensemble commands as well.
- *
- * Results:
- *	Boolean value
- *
- * Side effects:
- *	None
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_IsEnsemble(
-    Tcl_Command token)
+Tcl_HashTable *
+TclGetNamespaceCommandTable(
+    Tcl_Namespace *nsPtr)
 {
-    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;
+    return &((Namespace *) nsPtr)->cmdTable;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclMakeEnsemble --
+ * TclGetNamespaceChildTable --
  *
- *	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.
+ *	Returns the hash table of child namespaces.
  *
  * Results:
- *	Handle for the ensemble, or NULL if creation of it fails.
+ *	Pointer to the hash table.
  *
  * Side effects:
- *	May advance bytecode compilation epoch.
+ *	Might allocate memory.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Command
-TclMakeEnsemble(
-    Tcl_Interp *interp,
-    const char *name,
-    const EnsembleImplMap map[])
+Tcl_HashTable *
+TclGetNamespaceChildTable(
+    Tcl_Namespace *nsPtr)
 {
-    Tcl_Command ensemble;	/* The overall ensemble. */
-    Tcl_Namespace *tclNsPtr;	/* Reference to the "::tcl" namespace. */
-    Tcl_DString buf;
-
-    tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
-	    TCL_CREATE_NS_IF_UNKNOWN);
-    if (tclNsPtr == NULL) {
-	Tcl_Panic("unable to find or create ::tcl namespace!");
-    }
-    Tcl_DStringInit(&buf);
-    Tcl_DStringAppend(&buf, "::tcl::", -1);
-    Tcl_DStringAppend(&buf, name, -1);
-    tclNsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
-	    TCL_CREATE_NS_IF_UNKNOWN);
-    if (tclNsPtr == NULL) {
-	Tcl_Panic("unable to find or create %s namespace!",
-		Tcl_DStringValue(&buf));
-    }
-    ensemble = Tcl_CreateEnsemble(interp, Tcl_DStringValue(&buf)+5, tclNsPtr,
-	    TCL_ENSEMBLE_PREFIX);
-    Tcl_DStringAppend(&buf, "::", -1);
-    if (ensemble != NULL) {
-	Tcl_Obj *mapDict;
-	int i, compile = 0;
-
-	TclNewObj(mapDict);
-	for (i=0 ; map[i].name != NULL ; i++) {
-	    Tcl_Obj *fromObj, *toObj;
-	    Command *cmdPtr;
-
-	    fromObj = Tcl_NewStringObj(map[i].name, -1);
-	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
-		    Tcl_DStringLength(&buf));
-	    Tcl_AppendToObj(toObj, map[i].name, -1);
-	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
-	    cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
-		    TclGetString(toObj), map[i].proc, NULL, NULL);
-	    cmdPtr->compileProc = map[i].compileProc;
-	    compile |= (map[i].compileProc != NULL);
-	}
-	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
-	if (compile) {
-	    Tcl_SetEnsembleFlags(interp, ensemble,
-		    TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
-	}
-    }
-    Tcl_DStringFree(&buf);
-
-    return ensemble;
+    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);
+    }
+    return nPtr->childTablePtr;
+#endif
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * NsEnsembleImplementationCmd --
+ * TclLogCommandInfo --
  *
- *	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.
+ *	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.
  *
  * 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.
+ *	None.
  *
  * 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.
+ *	Information about the command is added to errorInfo/errorStack and the
+ *	line number stored internally in the interpreter is set.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-NsEnsembleImplementationCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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 */
 {
-    EnsembleConfig *ensemblePtr = clientData;
-				/* The ensemble itself. */
-    Tcl_Obj **tempObjv;		/* Space used to construct the list of
-				 * arguments to pass to the command that
-				 * implements the ensemble subcommand. */
-    int result;			/* The result of the subcommand execution. */
-    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
-				 * the command that implements the
-				 * subcommand. */
-    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
-				 * specified but not yet cached command
-				 * names. */
-    Tcl_Obj **prefixObjv;	/* The list of objects to substitute in as the
-				 * target command prefix. */
-    int prefixObjc;		/* Size of prefixObjv of course! */
-    int reparseCount = 0;	/* Number of reparses. */
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
-	return TCL_ERROR;
-    }
+    register const char *p;
+    Interp *iPtr = (Interp *) interp;
+    int overflow, limit = 150;
+    Var *varPtr, *arrayPtr;
 
-  restartEnsembleParse:
-    if (ensemblePtr->nsPtr->flags & NS_DYING) {
+    if (iPtr->flags & ERR_ALREADY_LOGGED) {
 	/*
-	 * Don't know how we got here, but make things give up quickly.
+	 * Someone else has already logged error information for this command;
+	 * we shouldn't add anything more.
 	 */
 
-	if (!Tcl_InterpDeleted(interp)) {
-	    Tcl_AppendResult(interp,
-		    "ensemble activated for deleted namespace", NULL);
-	}
-	return TCL_ERROR;
+	return;
     }
 
-    /*
-     * 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) {
+    if (command != NULL) {
 	/*
-	 * 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.
+	 * Compute the line number where the error occurred.
 	 */
 
-	if (objv[1]->typePtr == &tclEnsembleCmdType) {
-	    EnsembleCmdRep *ensembleCmd = objv[1]->internalRep.twoPtrValue.ptr1;
-
-	    if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
-		    ensembleCmd->epoch == ensemblePtr->epoch &&
-		    ensembleCmd->token == ensemblePtr->token) {
-		prefixObj = ensembleCmd->realPrefixObj;
-		Tcl_IncrRefCount(prefixObj);
-		goto runResultingSubcommand;
+	iPtr->errorLine = 1;
+	for (p = script; p != command; p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
 	    }
 	}
-    } else {
-	BuildEnsembleConfig(ensemblePtr);
-	ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
-    }
-
-    /*
-     * Look in the hashtable for the subcommand name; this is the fastest way
-     * of all.
-     */
-
-    hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
-	    TclGetString(objv[1]));
-    if (hPtr != NULL) {
-	char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
-
-	prefixObj = Tcl_GetHashValue(hPtr);
 
-	/*
-	 * Cache for later in the subcommand object.
-	 */
-
-	MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
-    } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
-	/*
-	 * Could not map, no prefixing, go to unknown/error handling.
-	 */
-
-	goto unknownOrAmbiguousSubcommand;
-    } else {
-	/*
-	 * If we've not already confirmed the command with the hash as part of
-	 * building our export table, we need to scan the sorted array for
-	 * matches.
-	 */
-
-	char *subcmdName;	/* Name of the subcommand, or unique prefix of
-				 * it (will be an error for a non-unique
-				 * prefix). */
-	char *fullName = NULL;	/* Full name of the subcommand. */
-	int stringLength, i;
-	int tableLength = ensemblePtr->subcommandTable.numEntries;
-
-	subcmdName = TclGetString(objv[1]);
-	stringLength = objv[1]->length;
-	for (i=0 ; i<tableLength ; i++) {
-	    register int cmp = strncmp(subcmdName,
-		    ensemblePtr->subcommandArrayPtr[i],
-		    (unsigned) stringLength);
-
-	    if (cmp == 0) {
-		if (fullName != NULL) {
-		    /*
-		     * Since there's never the exact-match case to worry about
-		     * (hash search filters this), getting here indicates that
-		     * our subcommand is an ambiguous prefix of (at least) two
-		     * exported subcommands, which is an error case.
-		     */
-
-		    goto unknownOrAmbiguousSubcommand;
-		}
-		fullName = ensemblePtr->subcommandArrayPtr[i];
-	    } else if (cmp < 0) {
-		/*
-		 * Because we are searching a sorted table, we can now stop
-		 * searching because we have gone past anything that could
-		 * possibly match.
-		 */
-
-		break;
-	    }
+	if (length < 0) {
+	    length = strlen(command);
 	}
-	if (fullName == 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)) {
 	    /*
-	     * The subcommand is not a prefix of anything, so bail out!
+	     * Should not happen.
 	     */
 
-	    goto unknownOrAmbiguousSubcommand;
-	}
-	hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName);
-	if (hPtr == NULL) {
-	    Tcl_Panic("full name %s not found in supposedly synchronized hash",
-		    fullName);
-	}
-	prefixObj = Tcl_GetHashValue(hPtr);
-
-	/*
-	 * Cache for later in the subcommand object.
-	 */
-
-	MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
-    }
-
-    Tcl_IncrRefCount(prefixObj);
-  runResultingSubcommand:
-
-    /*
-     * Do the real work of execution of the subcommand by building an array of
-     * objects (note that this is potentially not the same length as the
-     * number of arguments to this ensemble command), populating it and then
-     * feeding it back through the main command-lookup engine. In theory, we
-     * could look up the command in the namespace ourselves, as we already
-     * have the namespace in which it is guaranteed to exist, but we don't do
-     * that (the cacheing of the command object used should help with that.)
-     */
-
-    {
-	Interp *iPtr = (Interp *) interp;
-	int isRootEnsemble;
-	Tcl_Obj *copyObj;
-
-	/*
-	 * Get the prefix that we're rewriting to. To do this we need to
-	 * ensure that the internal representation of the list does not change
-	 * so that we can safely keep the internal representations of the
-	 * elements in the list.
-	 */
-
-	copyObj = TclListObjCopy(NULL, prefixObj);
-	TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
-
-	/*
-	 * Record what arguments the script sent in so that things like
-	 * Tcl_WrongNumArgs can give the correct error message.
-	 */
-
-	isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-	if (isRootEnsemble) {
-	    iPtr->ensembleRewrite.sourceObjs = objv;
-	    iPtr->ensembleRewrite.numRemovedObjs = 2;
-	    iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
+	    return;
 	} else {
-	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
-
-	    if (ni < 2) {
-		iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
-		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
-	    } else {
-		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
-	    }
-	}
-
-	/*
-	 * Allocate a workspace and build the list of arguments to pass to the
-	 * target command in it.
-	 */
-
-	tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
-		(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
-	memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
-	memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
-
-	/*
-	 * Hand off to the target command.
-	 */
+	    Tcl_HashEntry *hPtr
+		    = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+	    VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
 
-	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
-		TCL_EVAL_INVOKE);
-
-	/*
-	 * Clean up.
-	 */
-
-	TclStackFree(interp, tempObjv);
-	Tcl_DecrRefCount(copyObj);
-	if (isRootEnsemble) {
-	    iPtr->ensembleRewrite.sourceObjs = NULL;
-	    iPtr->ensembleRewrite.numRemovedObjs = 0;
-	    iPtr->ensembleRewrite.numInsertedObjs = 0;
-	}
-    }
-    Tcl_DecrRefCount(prefixObj);
-    return result;
-
-  unknownOrAmbiguousSubcommand:
-    /*
-     * Have not been able to match the subcommand asked for with a real
-     * subcommand that we export. See whether a handler has been registered
-     * for dealing with this situation. Will only call (at most) once for any
-     * particular ensemble invocation.
-     */
-
-    if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
-	int paramc, i;
-	Tcl_Obj **paramv, *unknownCmd, *ensObj;
-
-	unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
-	TclNewObj(ensObj);
-	Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
-	Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
-	for (i=1 ; i<objc ; i++) {
-	    Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
-	}
-	TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
-	Tcl_Preserve(ensemblePtr);
-	Tcl_IncrRefCount(unknownCmd);
-	result = Tcl_EvalObjv(interp, paramc, paramv, 0);
-	if (result == TCL_OK) {
-	    prefixObj = Tcl_GetObjResult(interp);
-	    Tcl_IncrRefCount(prefixObj);
-	    Tcl_DecrRefCount(unknownCmd);
-	    Tcl_Release(ensemblePtr);
-	    Tcl_ResetResult(interp);
-	    if (ensemblePtr->flags & ENS_DEAD) {
-		Tcl_DecrRefCount(prefixObj);
-		Tcl_SetResult(interp,
-			"unknown subcommand handler deleted its ensemble",
-			TCL_STATIC);
-		return TCL_ERROR;
-	    }
-
-	    /*
-	     * Namespace is still there. Check if the result is a valid list.
-	     * If it is, and it is non-empty, that list is what we are using
-	     * as our replacement.
-	     */
-
-	    if (TclListObjLength(interp, prefixObj, &prefixObjc) != TCL_OK) {
-		Tcl_DecrRefCount(prefixObj);
-		Tcl_AddErrorInfo(interp, "\n    while parsing result of "
-			"ensemble unknown subcommand handler");
-		return TCL_ERROR;
-	    }
-	    if (prefixObjc > 0) {
-		goto runResultingSubcommand;
-	    }
-
-	    /*
-	     * Namespace alive & empty result => reparse.
-	     */
+	    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_DecrRefCount(prefixObj);
-	    goto restartEnsembleParse;
-	}
-	if (!Tcl_InterpDeleted(interp)) {
-	    if (result != TCL_ERROR) {
-		char buf[TCL_INTEGER_SPACE];
-
-		Tcl_ResetResult(interp);
-		Tcl_SetResult(interp,
-			"unknown subcommand handler returned bad code: ",
-			TCL_STATIC);
-		switch (result) {
-		case TCL_RETURN:
-		    Tcl_AppendResult(interp, "return", NULL);
-		    break;
-		case TCL_BREAK:
-		    Tcl_AppendResult(interp, "break", NULL);
-		    break;
-		case TCL_CONTINUE:
-		    Tcl_AppendResult(interp, "continue", NULL);
-		    break;
-		default:
-		    sprintf(buf, "%d", result);
-		    Tcl_AppendResult(interp, buf, NULL);
-		}
-		Tcl_AddErrorInfo(interp, "\n    result of "
-			"ensemble unknown subcommand handler: ");
-		Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
-	    } else {
-		Tcl_AddErrorInfo(interp,
-			"\n    (ensemble unknown subcommand handler)");
+		Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
+			TCL_GLOBAL_ONLY);
 	    }
 	}
-	Tcl_DecrRefCount(unknownCmd);
-	Tcl_Release(ensemblePtr);
-	return TCL_ERROR;
     }
 
     /*
-     * We cannot determine what subcommand to hand off to, so generate a
-     * (standard) failure message. Note the one odd case compared with
-     * standard ensemble-like command, which is where a namespace has no
-     * exported commands at all...
+     * TIP #348
      */
 
-    Tcl_ResetResult(interp);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
-	    TclGetString(objv[1]), NULL);
-    if (ensemblePtr->subcommandTable.numEntries == 0) {
-	Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]),
-		"\": namespace ", ensemblePtr->nsPtr->fullName,
-		" does not export any commands", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
-		TclGetString(objv[1]), NULL);
-	return TCL_ERROR;
-    }
-    Tcl_AppendResult(interp, "unknown ",
-	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
-	    "subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
-    if (ensemblePtr->subcommandTable.numEntries == 1) {
-	Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
-    } else {
-	int i;
+    if (Tcl_IsShared(iPtr->errorStack)) {
+	Tcl_Obj *newObj;
 
-	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
-	    Tcl_AppendResult(interp,
-		    ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
-	}
-	Tcl_AppendResult(interp, "or ",
-		ensemblePtr->subcommandArrayPtr[i], NULL);
+	newObj = Tcl_DuplicateObj(iPtr->errorStack);
+	Tcl_DecrRefCount(iPtr->errorStack);
+	Tcl_IncrRefCount(newObj);
+	iPtr->errorStack = newObj;
     }
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
-	    TclGetString(objv[1]), NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MakeCachedEnsembleCommand --
- *
- *	Cache what we've computed so far; it's not nice to repeatedly copy
- *	strings about. Note that to do this, we start by deleting any old
- *	representation that there was (though if it was an out of date
- *	ensemble rep, we can skip some of the deallocation process.)
- *
- * Results:
- *	None
- *
- * Side effects:
- *	Alters the internal representation of the first object parameter.
- *
- *----------------------------------------------------------------------
- */
+    if (iPtr->resetErrorStack) {
+	int len;
 
-static void
-MakeCachedEnsembleCommand(
-    Tcl_Obj *objPtr,
-    EnsembleConfig *ensemblePtr,
-    const char *subcommandName,
-    Tcl_Obj *prefixObjPtr)
-{
-    register EnsembleCmdRep *ensembleCmd;
-    int length;
+	iPtr->resetErrorStack = 0;
+	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
 
-    if (objPtr->typePtr == &tclEnsembleCmdType) {
-	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
-	Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
-	ensembleCmd->nsPtr->refCount--;
-	if ((ensembleCmd->nsPtr->refCount == 0)
-		&& (ensembleCmd->nsPtr->flags & NS_DEAD)) {
-	    NamespaceFree(ensembleCmd->nsPtr);
-	}
-	ckfree(ensembleCmd->fullSubcmdName);
-    } else {
 	/*
-	 * Kill the old internal rep, and replace it with a brand new one of
-	 * our own.
+	 * Reset while keeping the list intrep as much as possible.
 	 */
 
-	TclFreeIntRep(objPtr);
-	ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
-	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
-	objPtr->typePtr = &tclEnsembleCmdType;
-    }
+	Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+	if (pc != NULL) {
+	    Tcl_Obj *innerContext;
 
-    /*
-     * Populate the internal rep.
-     */
-
-    ensembleCmd->nsPtr = ensemblePtr->nsPtr;
-    ensembleCmd->epoch = ensemblePtr->epoch;
-    ensembleCmd->token = ensemblePtr->token;
-    ensemblePtr->nsPtr->refCount++;
-    ensembleCmd->realPrefixObj = prefixObjPtr;
-    length = strlen(subcommandName)+1;
-    ensembleCmd->fullSubcmdName = ckalloc((unsigned) length);
-    memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
-    Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteEnsembleConfig --
- *
- *	Destroys the data structure used to represent an ensemble. This is
- *	called when the ensemble's command is deleted (which happens
- *	automatically if the ensemble's namespace is deleted.) Maintainers
- *	should note that ensembles should be deleted by deleting their
- *	commands.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Memory is (eventually) deallocated.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DeleteEnsembleConfig(
-    ClientData clientData)
-{
-    EnsembleConfig *ensemblePtr = clientData;
-    Namespace *nsPtr = ensemblePtr->nsPtr;
-    Tcl_HashSearch search;
-    Tcl_HashEntry *hEnt;
-
-    /*
-     * Unlink from the ensemble chain if it has not been marked as having been
-     * done already.
-     */
-
-    if (ensemblePtr->next != ensemblePtr) {
-	EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles;
-	if (ensPtr == ensemblePtr) {
-	    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
-	} else {
-	    while (ensPtr != NULL) {
-		if (ensPtr->next == ensemblePtr) {
-		    ensPtr->next = ensemblePtr->next;
-		    break;
-		}
-		ensPtr = ensPtr->next;
+	    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));
 	}
     }
 
-    /*
-     * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
-     * whether disaster happened anyway.
-     */
-
-    ensemblePtr->flags |= ENS_DEAD;
-
-    /*
-     * Kill the pointer-containing fields.
-     */
-
-    if (ensemblePtr->subcommandTable.numEntries != 0) {
-	ckfree((char *) ensemblePtr->subcommandArrayPtr);
-    }
-    hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
-    while (hEnt != NULL) {
-	Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
-
-	Tcl_DecrRefCount(prefixObj);
-	hEnt = Tcl_NextHashEntry(&search);
-    }
-    Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
-    if (ensemblePtr->subcmdList != NULL) {
-	Tcl_DecrRefCount(ensemblePtr->subcmdList);
-    }
-    if (ensemblePtr->subcommandDict != NULL) {
-	Tcl_DecrRefCount(ensemblePtr->subcommandDict);
-    }
-    if (ensemblePtr->unknownHandler != NULL) {
-	Tcl_DecrRefCount(ensemblePtr->unknownHandler);
-    }
-
-    /*
-     * Arrange for the structure to be reclaimed. Note that this is complex
-     * because we have to make sure that we can react sensibly when an
-     * ensemble is deleted during the process of initialising the ensemble
-     * (especially the unknown callback.)
-     */
-
-    Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BuildEnsembleConfig --
- *
- *	Create the internal data structures that describe how an ensemble
- *	looks, being a hash mapping from the full command name to the Tcl list
- *	that describes the implementation prefix words, and a sorted array of
- *	all the full command names to allow for reasonably efficient
- *	unambiguous prefix handling.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Reallocates and rebuilds the hash table and array stored at the
- *	ensemblePtr argument. For large ensembles or large namespaces, this is
- *	a potentially expensive operation.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-BuildEnsembleConfig(
-    EnsembleConfig *ensemblePtr)
-{
-    Tcl_HashSearch search;	/* Used for scanning the set of commands in
-				 * the namespace that backs up this
-				 * ensemble. */
-    int i, j, isNew;
-    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
-    Tcl_HashEntry *hPtr;
-
-    if (hash->numEntries != 0) {
+    if (!iPtr->framePtr->objc) {
 	/*
-	 * Remove pre-existing table.
+	 * Special frame, nothing to report.
 	 */
-
-	Tcl_HashSearch search;
-
-	ckfree((char *) ensemblePtr->subcommandArrayPtr);
-	hPtr = Tcl_FirstHashEntry(hash, &search);
-	while (hPtr != NULL) {
-	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
-	    Tcl_DecrRefCount(prefixObj);
-	    hPtr = Tcl_NextHashEntry(&search);
-	}
-	Tcl_DeleteHashTable(hash);
-	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
-    }
-
-    /*
-     * See if we've got an export list. If so, we will only export exactly
-     * those commands, which may be either implemented by the prefix in the
-     * subcommandDict or mapped directly onto the namespace's commands.
-     */
-
-    if (ensemblePtr->subcmdList != NULL) {
-	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
-	int subcmdc;
-
-	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
-		&subcmdv);
-	for (i=0 ; i<subcmdc ; i++) {
-	    char *name = TclGetString(subcmdv[i]);
-
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-
-	    /*
-	     * Skip non-unique cases.
-	     */
-
-	    if (!isNew) {
-		continue;
-	    }
-
-	    /*
-	     * Look in our dictionary (if present) for the command.
-	     */
-
-	    if (ensemblePtr->subcommandDict != NULL) {
-		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
-			&target);
-		if (target != NULL) {
-		    Tcl_SetHashValue(hPtr, target);
-		    Tcl_IncrRefCount(target);
-		    continue;
-		}
-	    }
-
-	    /*
-	     * Not there, so map onto the namespace. Note in this case that we
-	     * do not guarantee that the command is actually there; that is
-	     * the programmer's responsibility (or [::unknown] of course).
-	     */
-
-	    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
-	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
-		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
-	    } else {
-		Tcl_AppendStringsToObj(cmdObj, name, NULL);
-	    }
-	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
-	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
-	    Tcl_IncrRefCount(cmdPrefixObj);
-	}
-    } else if (ensemblePtr->subcommandDict != NULL) {
+    } else if (iPtr->varFramePtr != iPtr->framePtr) {
 	/*
-	 * 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.
+	 * uplevel case, [lappend errorstack UP $relativelevel]
 	 */
 
-	Tcl_DictSearch dictSearch;
-	Tcl_Obj *keyObj, *valueObj;
-	int done;
-
-	Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
-		&keyObj, &valueObj, &done);
-	while (!done) {
-	    char *name = TclGetString(keyObj);
-
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-	    Tcl_SetHashValue(hPtr, valueObj);
-	    Tcl_IncrRefCount(valueObj);
-	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
-	}
-    } else {
+	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) {
 	/*
-	 * 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.
+	 * normal case, [lappend errorstack CALL [info level 0]]
 	 */
 
-	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
-	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
-	    char *nsCmdName =		/* Name of command in namespace. */
-		    Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
-
-	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
-		if (Tcl_StringMatch(nsCmdName,
-			ensemblePtr->nsPtr->exportArrayPtr[i])) {
-		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
-
-		    /*
-		     * Remember, hash entries have a full reference to the
-		     * substituted part of the command (as a list) as their
-		     * content!
-		     */
-
-		    if (isNew) {
-			Tcl_Obj *cmdObj, *cmdPrefixObj;
-
-			TclNewObj(cmdObj);
-			Tcl_AppendStringsToObj(cmdObj,
-				ensemblePtr->nsPtr->fullName,
-				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
-				nsCmdName, NULL);
-			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
-			Tcl_SetHashValue(hPtr, cmdPrefixObj);
-			Tcl_IncrRefCount(cmdPrefixObj);
-		    }
-		    break;
-		}
-	    }
-	}
-    }
-
-    if (hash->numEntries == 0) {
-	ensemblePtr->subcommandArrayPtr = NULL;
-	return;
-    }
-
-    /*
-     * Create a sorted array of all subcommands in the ensemble; hash tables
-     * are all very well for a quick look for an exact match, but they can't
-     * determine things like whether a string is a prefix of another (not
-     * without lots of preparation anyway) and they're no good for when we're
-     * generating the error message either.
-     *
-     * We do this by filling an array with the names (we use the hash keys
-     * directly to save a copy, since any time we change the array we change
-     * the hash too, and vice versa) and running quicksort over the array.
-     */
-
-    ensemblePtr->subcommandArrayPtr = (char **)
-	    ckalloc(sizeof(char *) * hash->numEntries);
-
-    /*
-     * Fill array from both ends as this makes us less likely to end up with
-     * performance problems in qsort(), which is good. Note that doing this
-     * makes this code much more opaque, but the naive alternatve:
-     *
-     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
-     *	       hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
-     *     ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr);
-     * }
-     *
-     * can produce long runs of precisely ordered table entries when the
-     * commands in the namespace are declared in a sorted fashion (an ordering
-     * some people like) and the hashing functions (or the command names
-     * themselves) are fairly unfortunate. By filling from both ends, it
-     * requires active malice (and probably a debugger) to get qsort() to have
-     * awful runtime behaviour.
-     */
-
-    i = 0;
-    j = hash->numEntries;
-    hPtr = Tcl_FirstHashEntry(hash, &search);
-    while (hPtr != NULL) {
-	ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr);
-	hPtr = Tcl_NextHashEntry(&search);
-	if (hPtr == NULL) {
-	    break;
-	}
-	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
-	hPtr = Tcl_NextHashEntry(&search);
-    }
-    if (hash->numEntries > 1) {
-	qsort(ensemblePtr->subcommandArrayPtr, (unsigned)hash->numEntries,
-		sizeof(char *), NsEnsembleStringOrder);
+	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
+	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
+		iPtr->framePtr->objc, iPtr->framePtr->objv));
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * NsEnsembleStringOrder --
+ * TclErrorStackResetIf --
  *
- *	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.
+ *	The TIP 348 reset/no-bc part of TLCI, for specific use by
+ *	TclCompileSyntaxError.
  *
  * 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.
+ *	Reset errorstack if it needs be, and in that case remember the
+ *	passed-in error message as inner context.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-FreeEnsembleCmdRep(
-    Tcl_Obj *objPtr)
+void
+TclErrorStackResetIf(
+    Tcl_Interp *interp,
+    const char *msg,
+    int length)
 {
-    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+    Interp *iPtr = (Interp *) interp;
+
+    if (Tcl_IsShared(iPtr->errorStack)) {
+	Tcl_Obj *newObj;
 
-    Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
-    ckfree(ensembleCmd->fullSubcmdName);
-    ensembleCmd->nsPtr->refCount--;
-    if ((ensembleCmd->nsPtr->refCount == 0)
-	    && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
-	NamespaceFree(ensembleCmd->nsPtr);
+	newObj = Tcl_DuplicateObj(iPtr->errorStack);
+	Tcl_DecrRefCount(iPtr->errorStack);
+	Tcl_IncrRefCount(newObj);
+	iPtr->errorStack = newObj;
     }
-    ckfree((char *) ensembleCmd);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupEnsembleCmdRep --
- *
- *	Makes one Tcl_Obj into a copy of another that is a subcommand of an
- *	ensemble.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Memory is allocated, and the namespace that the ensemble is built on
- *	top of gains another reference.
- *
- *----------------------------------------------------------------------
- */
+    if (iPtr->resetErrorStack) {
+	int len;
 
-static void
-DupEnsembleCmdRep(
-    Tcl_Obj *objPtr,
-    Tcl_Obj *copyPtr)
-{
-    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
-    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)
-	    ckalloc(sizeof(EnsembleCmdRep));
-    int length = strlen(ensembleCmd->fullSubcmdName);
-
-    copyPtr->typePtr = &tclEnsembleCmdType;
-    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
-    ensembleCopy->nsPtr = ensembleCmd->nsPtr;
-    ensembleCopy->epoch = ensembleCmd->epoch;
-    ensembleCopy->token = ensembleCmd->token;
-    ensembleCopy->nsPtr->refCount++;
-    ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
-    Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
-    ensembleCopy->fullSubcmdName = ckalloc((unsigned) length+1);
-    memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
-	    (unsigned) length+1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringOfEnsembleCmdRep --
- *
- *	Creates a string representation of a Tcl_Obj that holds a subcommand
- *	of an ensemble.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object gains a string (UTF-8) representation.
- *
- *----------------------------------------------------------------------
- */
+	iPtr->resetErrorStack = 0;
+	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
 
-static void
-StringOfEnsembleCmdRep(
-    Tcl_Obj *objPtr)
-{
-    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
-    int length = strlen(ensembleCmd->fullSubcmdName);
+	/*
+	 * Reset while keeping the list intrep as much as possible.
+	 */
 
-    objPtr->length = length;
-    objPtr->bytes = ckalloc((unsigned) length+1);
-    memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
+	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));
+    }
 }
 
 /*
@@ -6920,15 +5067,15 @@ StringOfEnsembleCmdRep(
  * Tcl_LogCommandInfo --
  *
  *	This function is invoked after an error occurs in an interpreter. It
- *	adds information to iPtr->errorInfo field to describe the command that
- *	was being executed when the error occurred.
+ *	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 and the line
- *	number stored internally in the interpreter is set.
+ *	Information about the command is added to errorInfo/errorStack and the
+ *	line number stored internally in the interpreter is set.
  *
  *----------------------------------------------------------------------
  */
@@ -6943,73 +5090,15 @@ Tcl_LogCommandInfo(
     int length)			/* Number of bytes in command (-1 means use
 				 * all bytes up to first null byte). */
 {
-    register const char *p;
-    Interp *iPtr = (Interp *) interp;
-    int overflow, limit = 150;
-    Var *varPtr, *arrayPtr;
-
-    if (iPtr->flags & ERR_ALREADY_LOGGED) {
-	/*
-	 * Someone else has already logged error information for this command;
-	 * we shouldn't add anything more.
-	 */
-
-	return;
-    }
-
-    /*
-     * Compute the line number where the error occurred.
-     */
-
-    iPtr->errorLine = 1;
-    for (p = script; p != command; p++) {
-	if (*p == '\n') {
-	    iPtr->errorLine++;
-	}
-    }
-
-    if (length < 0) {
-	length = strlen(command);
-    }
-    overflow = (length > limit);
-    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-	    "\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
-	    ? "while executing" : "invoked from within"),
-	    (overflow ? limit : length), command, (overflow ? "..." : "")));
-
-    varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
-	    NULL, 0, 0, &arrayPtr);
-    if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
-	/*
-	 * Should not happen.
-	 */
-
-	return;
-    } else {
-	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
-		(char *) varPtr);
-	VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
-
-	if (tracePtr->traceProc != EstablishErrorInfoTraces) {
-	    /*
-	     * The most recent trace set on ::errorInfo is not the one the
-	     * core itself puts on last. This means some other code is tracing
-	     * the variable, and the additional trace(s) might be write traces
-	     * that expect the timing of writes to ::errorInfo that existed
-	     * Tcl releases before 8.5. To satisfy that compatibility need, we
-	     * write the current -errorinfo value to the ::errorInfo variable.
-	     */
-
-	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
-		    TCL_GLOBAL_ONLY);
-	}
-    }
+    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
 }
+
 
 /*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
  * End:
  */
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index b45539a..e76bca8 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -17,7 +17,14 @@
 
 #include "tclInt.h"
 
-extern TclStubs tclStubs;
+/*
+ * 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
+};
 
 /*
  * For each event source (created with Tcl_CreateEventSource) there is a
@@ -88,7 +95,7 @@ TCL_DECLARE_MUTEX(listLock)
  */
 
 static void		QueueEvent(ThreadSpecificData *tsdPtr,
-			    Tcl_Event* evPtr, Tcl_QueuePosition position);
+			    Tcl_Event *evPtr, Tcl_QueuePosition position);
 
 /*
  *----------------------------------------------------------------------
@@ -126,7 +133,7 @@ TclInitNotifier(void)
 
 	tsdPtr = TCL_TSD_INIT(&dataKey);
 	tsdPtr->threadId = threadId;
-	tsdPtr->clientData = tclStubs.tcl_InitNotifier();
+	tsdPtr->clientData = Tcl_InitNotifier();
 	tsdPtr->initialized = 1;
 	tsdPtr->nextPtr = firstNotifierPtr;
 	firstNotifierPtr = tsdPtr;
@@ -174,7 +181,7 @@ TclFinalizeNotifier(void)
     for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
 	hold = evPtr;
 	evPtr = evPtr->nextPtr;
-	ckfree((char *) hold);
+	ckfree(hold);
     }
     tsdPtr->firstEventPtr = NULL;
     tsdPtr->lastEventPtr = NULL;
@@ -182,9 +189,7 @@ TclFinalizeNotifier(void)
 
     Tcl_MutexLock(&listLock);
 
-    if (tclStubs.tcl_FinalizeNotifier) {
-	tclStubs.tcl_FinalizeNotifier(tsdPtr->clientData);
-    }
+    Tcl_FinalizeNotifier(tsdPtr->clientData);
     Tcl_MutexFinalize(&(tsdPtr->queueMutex));
     for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
 	    prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
@@ -211,9 +216,8 @@ TclFinalizeNotifier(void)
  *	None.
  *
  * Side effects:
- *	Overstomps part of the stub vector. This relies on hooks added to the
- *	default functions in case those are called directly (i.e., not through
- *	the stub table.)
+ *	Set the tclNotifierHooks global, which is checked in the default
+ *	notifier functions.
  *
  *----------------------------------------------------------------------
  */
@@ -222,16 +226,7 @@ void
 Tcl_SetNotifier(
     Tcl_NotifierProcs *notifierProcPtr)
 {
-#if !defined(__WIN32__) /* 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;
+    tclNotifierHooks = *notifierProcPtr;
 }
 
 /*
@@ -281,7 +276,7 @@ Tcl_CreateEventSource(
 				 * checkProc. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
+    EventSource *sourcePtr = ckalloc(sizeof(EventSource));
 
     sourcePtr->setupProc = setupProc;
     sourcePtr->checkProc = checkProc;
@@ -302,7 +297,7 @@ Tcl_CreateEventSource(
  *	None.
  *
  * Side effects:
- *	The given event source is cancelled, so its function will never again
+ *	The given event source is canceled, so its function will never again
  *	be called. If no such source exists, nothing happens.
  *
  *----------------------------------------------------------------------
@@ -335,7 +330,7 @@ Tcl_DeleteEventSource(
 	} else {
 	    prevPtr->nextPtr = sourcePtr->nextPtr;
 	}
-	ckfree((char *) sourcePtr);
+	ckfree(sourcePtr);
 	return;
     }
 }
@@ -358,7 +353,7 @@ Tcl_DeleteEventSource(
 
 void
 Tcl_QueueEvent(
-    Tcl_Event* evPtr,		/* Event to add to queue. The storage space
+    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
@@ -367,6 +362,7 @@ Tcl_QueueEvent(
 				 * TCL_QUEUE_MARK. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
     QueueEvent(tsdPtr, evPtr, position);
 }
 
@@ -416,7 +412,7 @@ Tcl_ThreadQueueEvent(
     if (tsdPtr) {
 	QueueEvent(tsdPtr, evPtr, position);
     } else {
-	ckfree((char *) evPtr);
+	ckfree(evPtr);
     }
     Tcl_MutexUnlock(&listLock);
 }
@@ -520,14 +516,13 @@ QueueEvent(
 void
 Tcl_DeleteEvents(
     Tcl_EventDeleteProc *proc,	/* The function to call. */
-    ClientData clientData)    	/* The type-specific data. */
+    ClientData clientData)	/* The 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 *hold;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     Tcl_MutexLock(&(tsdPtr->queueMutex));
@@ -540,7 +535,7 @@ Tcl_DeleteEvents(
     prevPtr = NULL;
     evPtr = tsdPtr->firstEventPtr;
     while (evPtr != NULL) {
-	if ((*proc)(evPtr, clientData) == 1) {
+	if (proc(evPtr, clientData) == 1) {
 	    /*
 	     * This event should be deleted. Unlink it.
 	     */
@@ -568,7 +563,7 @@ Tcl_DeleteEvents(
 
 	    hold = evPtr;
 	    evPtr = evPtr->nextPtr;
-	    ckfree((char *) hold);
+	    ckfree(hold);
 	} else {
 	    /*
 	     * Event is to be retained.
@@ -672,7 +667,7 @@ Tcl_ServiceEvent(
 	 */
 
 	Tcl_MutexUnlock(&(tsdPtr->queueMutex));
-	result = (*proc)(evPtr, flags);
+	result = proc(evPtr, flags);
 	Tcl_MutexLock(&(tsdPtr->queueMutex));
 
 	if (result) {
@@ -707,7 +702,7 @@ Tcl_ServiceEvent(
 		}
 	    }
 	    if (evPtr) {
-		ckfree((char *) evPtr);
+		ckfree(evPtr);
 	    }
 	    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 	    return 1;
@@ -774,9 +769,7 @@ Tcl_SetServiceMode(
 
     oldMode = tsdPtr->serviceMode;
     tsdPtr->serviceMode = mode;
-    if (tclStubs.tcl_ServiceModeHook) {
-	tclStubs.tcl_ServiceModeHook(mode);
-    }
+    Tcl_ServiceModeHook(mode);
     return oldMode;
 }
 
@@ -801,7 +794,7 @@ Tcl_SetServiceMode(
 
 void
 Tcl_SetMaxBlockTime(
-    Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
+    const Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
 				 * next blocking operation in the event
 				 * tsdPtr-> */
 {
@@ -934,7 +927,7 @@ Tcl_DoOneEvent(
 	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
 		sourcePtr = sourcePtr->nextPtr) {
 	    if (sourcePtr->setupProc) {
-		(sourcePtr->setupProc)(sourcePtr->clientData, flags);
+		sourcePtr->setupProc(sourcePtr->clientData, flags);
 	    }
 	}
 	tsdPtr->inTraversal = 0;
@@ -963,7 +956,7 @@ Tcl_DoOneEvent(
 	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
 		sourcePtr = sourcePtr->nextPtr) {
 	    if (sourcePtr->checkProc) {
-		(sourcePtr->checkProc)(sourcePtr->clientData, flags);
+		sourcePtr->checkProc(sourcePtr->clientData, flags);
 	    }
 	}
 
@@ -1073,13 +1066,13 @@ Tcl_ServiceAll(void)
     for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
 	    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) {
 	if (sourcePtr->checkProc) {
-	    (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
+	    sourcePtr->checkProc(sourcePtr->clientData, TCL_ALL_EVENTS);
 	}
     }
 
@@ -1132,9 +1125,7 @@ Tcl_ThreadAlert(
     Tcl_MutexLock(&listLock);
     for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
 	if (tsdPtr->threadId == threadId) {
-	    if (tclStubs.tcl_AlertNotifier) {
-		tclStubs.tcl_AlertNotifier(tsdPtr->clientData);
-	    }
+	    Tcl_AlertNotifier(tsdPtr->clientData);
 	    break;
 	}
     }
diff --git a/generic/tclOO.c b/generic/tclOO.c
new file mode 100644
index 0000000..ec666ee
--- /dev/null
+++ b/generic/tclOO.c
@@ -0,0 +1,3037 @@
+/*
+ * tclOO.c --
+ *
+ *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
+ *
+ * Copyright (c) 2005-2012 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 void		ClearMixins(Class *clsPtr);
+static void		ClearSuperclasses(Class *clsPtr);
+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 Tcl_NRPostProc	FinalizeAlloc;
+static Tcl_NRPostProc	FinalizeNext;
+static Tcl_NRPostProc	FinalizeObjectCall;
+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 inline void	SquelchCachedName(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}}
+};
+
+/*
+ * And for the oo::class constructor...
+ */
+
+static const Tcl_MethodType classConstructor = {
+    TCL_OO_METHOD_VERSION_CURRENT,
+    "oo::class constructor",
+    TclOO_Class_Constructor, 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 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_PATCHLEVEL,
+	    (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;
+    Command *cmdPtr;
+    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>");
+    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
+    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
+    Tcl_IncrRefCount(fPtr->constructorName);
+    Tcl_IncrRefCount(fPtr->destructorName);
+    Tcl_IncrRefCount(fPtr->clonedName);
+    Tcl_IncrRefCount(fPtr->defineName);
+    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++) {
+	TclDStringAppendLiteral(&buffer, "::oo::define::");
+	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++) {
+	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
+	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);
+    TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
+    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);
+    TclDecrRefCount(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.
+     */
+
+    TclNewLiteralStringObj(namePtr, "new");
+    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
+	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
+    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
+	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
+
+    /*
+     * Create non-object commands and plug ourselves into the Tcl [info]
+     * ensemble.
+     */
+
+    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+	    NULL, TclOONextObjCmd, NULL, NULL);
+    cmdPtr->compileProc = TclCompileObjectNextCmd;
+    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+	    NULL, TclOONextToObjCmd, NULL, NULL);
+    cmdPtr->compileProc = TclCompileObjectNextToCmd;
+    cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
+	    TclOOSelfObjCmd, NULL, NULL);
+    cmdPtr->compileProc = TclCompileObjectSelfCmd;
+    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);
+    TclDecrRefCount(fPtr->unknownMethodNameObj);
+    TclDecrRefCount(fPtr->constructorName);
+    TclDecrRefCount(fPtr->destructorName);
+    TclDecrRefCount(fPtr->clonedName);
+    TclDecrRefCount(fPtr->defineName);
+    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);
+	TclDStringAppendLiteral(&buffer, "::");
+	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;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SquelchCachedName --
+ *
+ *	Encapsulates how to throw away a cached object name. Called from
+ *	object rename traces and at object destruction.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+SquelchCachedName(
+    Object *oPtr)
+{
+    if (oPtr->cachedNameObj) {
+	Tcl_DecrRefCount(oPtr->cachedNameObj);
+	oPtr->cachedNameObj = NULL;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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,	/* What it's getting renamed to. (unused) */
+    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) {
+	SquelchCachedName(oPtr);
+	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_BackgroundException(interp, result);
+	    }
+	    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);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClearMixins, ClearSuperclasses --
+ *
+ *	Utility functions for correctly clearing the list of mixins or
+ *	superclasses of a class. Will ckfree() the list storage.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ClearMixins(
+    Class *clsPtr)
+{
+    int i;
+    Class *mixinPtr;
+
+    if (clsPtr->mixins.num == 0) {
+	return;
+    }
+
+    FOREACH(mixinPtr, clsPtr->mixins) {
+	TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
+    }
+    ckfree(clsPtr->mixins.list);
+    clsPtr->mixins.list = NULL;
+    clsPtr->mixins.num = 0;
+}
+
+static void
+ClearSuperclasses(
+    Class *clsPtr)
+{
+    int i;
+    Class *superPtr;
+
+    if (clsPtr->superclasses.num == 0) {
+	return;
+    }
+
+    FOREACH(superPtr, clsPtr->superclasses) {
+	TclOORemoveFromSubclasses(clsPtr, superPtr);
+    }
+    ckfree(clsPtr->superclasses.list);
+    clsPtr->superclasses.list = NULL;
+    clsPtr->superclasses.num = 0;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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) {
+	    int j;
+	    if (instancePtr->selfCls == clsPtr) {
+		instancePtr->flags |= CLASS_GONE;
+	    }
+	    for(j=0 ; j<instancePtr->mixins.num ; j++) {
+		Class *mixin = instancePtr->mixins.list[j];
+		if (mixin == clsPtr) {
+		    instancePtr->mixins.list[j] = NULL;
+		}
+	    }
+	    if (instancePtr != NULL && !IsRoot(instancePtr)) {
+		AddRef(instancePtr);
+	    }
+	}
+    }
+
+    /*
+     * Squelch classes that this class has been mixed into.
+     */
+
+    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+	if (!Deleted(mixinSubclassPtr->thisPtr)) {
+	    Tcl_DeleteCommandFromToken(interp,
+		    mixinSubclassPtr->thisPtr->command);
+	}
+	ClearMixins(mixinSubclassPtr);
+	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 (IsRoot(subclassPtr)) {
+	    continue;
+	}
+	if (!Deleted(subclassPtr->thisPtr)) {
+	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
+	}
+	ClearSuperclasses(subclassPtr);
+	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);
+		/*
+		 * Tcl_DeleteCommandFromToken() may have done to whole
+		 * job for us.  Roll back and check again.
+		 */
+		i--;
+		continue;
+	    }
+	    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) {
+	    TclDecrRefCount(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) && !(oPtr->flags & CLASS_GONE)) {
+	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
+    }
+
+    FOREACH(mixinPtr, oPtr->mixins) {
+	if (mixinPtr) {
+	    TclOORemoveFromInstances(oPtr, mixinPtr);
+	}
+    }
+    if (i) {
+	ckfree(oPtr->mixins.list);
+    }
+
+    FOREACH(filterObj, oPtr->filters) {
+	TclDecrRefCount(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) {
+	TclDecrRefCount(variableObj);
+    }
+    if (i) {
+	ckfree(oPtr->variables.list);
+    }
+
+    if (oPtr->chainCache) {
+	TclOODeleteChainCache(oPtr->chainCache);
+    }
+
+    SquelchCachedName(oPtr);
+
+    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 this was a class, there's additional deletion work to do.
+     */
+
+    if (clsPtr != NULL) {
+	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) {
+	    TclDecrRefCount(filterObj);
+	}
+	if (i) {
+	    ckfree(clsPtr->filters.list);
+	    clsPtr->filters.num = 0;
+	}
+
+	ClearMixins(clsPtr);
+
+	ClearSuperclasses(clsPtr);
+
+	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) {
+	    TclDecrRefCount(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)) {
+	if (!IsRootClass(clsPtr)) {
+	    DelRef(clsPtr->instances.list[i]);
+	}
+	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.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.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_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create object \"%s\": command already exists with"
+		" that name", nameStr));
+	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 isRoot, 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]
+	     */
+
+	    isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
+	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
+		    objc, objv);
+
+	    if (isRoot) {
+		TclResetRewriteEnsemble(interp, 1);
+	    }
+
+	    /*
+	     * 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_SetObjResult(interp, Tcl_NewStringObj(
+			"object deleted in constructor", -1));
+		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] Also take care to make sure that we have
+		 * the name of the command before we delete it. [Bug
+		 * 9dd1bd7a74]
+		 */
+
+		if (!Deleted(oPtr)) {
+		    (void) TclOOObjectName(interp, 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create object \"%s\": command already exists with"
+		" that name", nameStr));
+	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 (TclInitRewriteEnsemble(interp, skip, skip, objv)) {
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+    }
+
+    /*
+     * 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_SetObjResult(interp, Tcl_NewStringObj(
+		"object deleted in constructor", -1));
+	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] Also take care to make sure that we have the name of the
+	 * command before we delete it. [Bug 9dd1bd7a74]
+	 */
+
+	if (!Deleted(oPtr)) {
+	    (void) TclOOObjectName(interp, 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_SetObjResult(interp, Tcl_NewStringObj(
+		"may not clone the class of classes", -1));
+	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 && mixinPtr != o2Ptr->selfCls) {
+	    TclOORemoveFromInstances(o2Ptr, mixinPtr);
+	}
+    }
+    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
+    FOREACH(mixinPtr, o2Ptr->mixins) {
+	if (mixinPtr && 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) {
+	    TclDecrRefCount(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);
+	TclDecrRefCount(mappedMethodName);
+	if (contextPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "impossible to invoke method \"%s\": no defined method or"
+		    " unknown method", TclGetString(methodNamePtr)));
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "impossible to invoke method \"%s\": no defined method or"
+		    " unknown method", TclGetString(methodNamePtr)));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+		    "no valid method implementation", -1));
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"no next %s implementation", methodType));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"no next %s implementation", methodType));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+	    "%s does not refer to an object", TclGetString(objPtr)));
+    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
new file mode 100644
index 0000000..265ba88
--- /dev/null
+++ b/generic/tclOO.decls
@@ -0,0 +1,218 @@
+# tclOO.decls --
+#
+#	This file contains the declarations for all supported public functions
+#	that are exported by the TclOO package that is embedded within the Tcl
+#	library via the stubs table.  This file is used to generate the
+#	tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
+#
+# Copyright (c) 2008-2013 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.
+
+library tclOO
+
+######################################################################
+# Public API, exposed for general users of TclOO.
+#
+
+interface tclOO
+hooks tclOOInt
+scspec TCLAPI
+
+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 of
+# TclOO; not intended for general use and does not have any commitment to
+# long-term support.
+#
+
+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
new file mode 100644
index 0000000..46f01fb
--- /dev/null
+++ b/generic/tclOO.h
@@ -0,0 +1,147 @@
+/*
+ * 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-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.
+ */
+
+#ifndef TCLOO_H_INCLUDED
+#define TCLOO_H_INCLUDED
+
+/*
+ * 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
+ * tests/ooNext2.test
+ * unix/tclooConfig.sh
+ * win/tclooConfig.sh
+ */
+
+#define TCLOO_VERSION "1.0.5"
+#define TCLOO_PATCHLEVEL TCLOO_VERSION
+
+#include "tcl.h"
+
+/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern const char *TclOOInitializeStubs(
+	Tcl_Interp *, const char *version);
+#define Tcl_OOInitStubs(interp) \
+    TclOOInitializeStubs((interp), TCLOO_VERSION)
+#ifndef USE_TCL_STUBS
+#   define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
+#endif
+
+/*
+ * 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"
+
+#ifdef __cplusplus
+}
+#endif
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
new file mode 100644
index 0000000..8cb80e5
--- /dev/null
+++ b/generic/tclOOBasic.c
@@ -0,0 +1,1245 @@
+/*
+ * tclOOBasic.c --
+ *
+ *	This file contains implementations of the "simple" commands and
+ *	methods from the object-system core.
+ *
+ * Copyright (c) 2005-2013 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 Tcl_NRPostProc	AfterNRDestructor;
+static Tcl_NRPostProc	DecrRefsPostClassConstructor;
+static Tcl_NRPostProc	FinalizeConstruction;
+static Tcl_NRPostProc	FinalizeEval;
+static Tcl_NRPostProc	NextRestoreFrame;
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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_Constructor --
+ *
+ *	Implementation for oo::class constructor.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_Constructor(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+    Tcl_Obj **invoke;
+
+    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"?definitionScript?");
+	return TCL_ERROR;
+    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
+	return TCL_OK;
+    }
+
+    /*
+     * Delegate to [oo::define] to do the work.
+     */
+
+    invoke = ckalloc(3 * sizeof(Tcl_Obj *));
+    invoke[0] = oPtr->fPtr->defineName;
+    invoke[1] = TclOOObjectName(interp, oPtr);
+    invoke[2] = objv[objc-1];
+
+    /*
+     * Must add references or errors in configuration script will cause
+     * trouble.
+     */
+
+    Tcl_IncrRefCount(invoke[0]);
+    Tcl_IncrRefCount(invoke[1]);
+    Tcl_IncrRefCount(invoke[2]);
+    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
+	    invoke, NULL, NULL, NULL);
+
+    /*
+     * Tricky point: do not want the extra reported level in the Tcl stack
+     * trace, so use TCL_EVAL_NOERR.
+     */
+
+    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
+}
+
+static int
+DecrRefsPostClassConstructor(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_Obj **invoke = data[0];
+
+    TclDecrRefCount(invoke[0]);
+    TclDecrRefCount(invoke[1]);
+    TclDecrRefCount(invoke[2]);
+    ckfree(invoke);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"object name must not be empty", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"object name must not be empty", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
+	return TCL_ERROR;
+    }
+    nsName = Tcl_GetStringFromObj(
+	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
+    if (len == 0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"namespace name must not be empty", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
+	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;
+    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).
+     */
+
+    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    Tcl_GetObjectNamespace(object), 0);
+    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);
+    Tcl_Obj *errorMsg;
+
+    /*
+     * 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);
+	const char *piece;
+
+	if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
+	    piece = "visible methods";
+	} else {
+	    piece = "methods";
+	}
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"object \"%s\" has no %s", TclGetString(tmpBuf), piece));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		TclGetString(objv[skip]), NULL);
+	return TCL_ERROR;
+    }
+
+    errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ",
+	    TclGetString(objv[skip]));
+    for (i=0 ; i<numMethodNames-1 ; i++) {
+	if (i) {
+	    Tcl_AppendToObj(errorMsg, ", ", -1);
+	}
+	Tcl_AppendToObj(errorMsg, methodNames[i], -1);
+    }
+    if (i) {
+	Tcl_AppendToObj(errorMsg, " or ", -1);
+    }
+    Tcl_AppendToObj(errorMsg, methodNames[i], -1);
+    ckfree(methodNames);
+    Tcl_SetObjResult(interp, errorMsg);
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "variable name \"%s\" illegal: must not contain namespace"
+		    " separator", varName));
+	    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. */
+{
+    Var *varPtr, *aryVar;
+    Tcl_Obj *varNamePtr, *argPtr;
+    const char *arg;
+
+    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"varName");
+	return TCL_ERROR;
+    }
+    argPtr = objv[objc-1];
+    arg = Tcl_GetString(argPtr);
+
+    /*
+     * Convert the variable name to fully-qualified form if it wasn't already.
+     * This has to be done prior to lookup because we can run into problems
+     * with resolvers otherwise. [Bug 3603695]
+     *
+     * We still need to do the lookup; the variable could be linked to another
+     * variable and we want the target's name.
+     */
+
+    if (arg[0] == ':' && arg[1] == ':') {
+	varNamePtr = argPtr;
+    } else {
+	Tcl_Namespace *namespacePtr =
+		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
+
+	varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
+	Tcl_AppendToObj(varNamePtr, "::", 2);
+	Tcl_AppendObjToObj(varNamePtr, argPtr);
+    }
+    Tcl_IncrRefCount(varNamePtr);
+    varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
+	    TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);
+    Tcl_DecrRefCount(varNamePtr);
+    if (varPtr == NULL) {
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now that we've pinned down what variable we're really talking about
+     * (including traversing variable links), convert back to a name.
+     */
+
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s may only be called from inside a method",
+		TclGetString(objv[0])));
+	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, NextRestoreFrame, 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;
+    const char *methodType;
+
+    /*
+     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s may only be called from inside a method",
+		TclGetString(objv[0])));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" is not a class", TclGetString(objv[1])));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", 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, NextRestoreFrame, 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.
+     */
+
+    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+	methodType = "constructor";
+    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+	methodType = "destructor";
+    } else {
+	methodType = "method";
+    }
+
+    for (i=contextPtr->index ; i>=0 ; i--) {
+	struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
+
+	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s implementation by \"%s\" not reachable from here",
+		    methodType, TclGetString(objv[1])));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+		    NULL);
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "%s has no non-filter implementation by \"%s\"",
+	    methodType, TclGetString(objv[1])));
+    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+    return TCL_ERROR;
+}
+
+static int
+NextRestoreFrame(
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s may only be called from inside a method",
+		TclGetString(objv[0])));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "method not defined by a class", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+		    "not inside a filtering context", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+		    "caller is not an object", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+			"method without declarer!", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+			"method without declarer!", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+		    "not inside a filtering context", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+			"method without declarer!", -1));
+		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);
+	    }
+	    TclDStringAppendLiteral(&buffer, "::");
+	    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;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
new file mode 100644
index 0000000..ac0b94d
--- /dev/null
+++ b/generic/tclOOCall.c
@@ -0,0 +1,1539 @@
+/*
+ * tclOOCall.c --
+ *
+ *	This file contains the method call chain management code for the
+ *	object-system core.
+ *
+ * Copyright (c) 2005-2012 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)
+#define BUILDING_MIXINS	   0x400000
+#define TRAVERSED_MIXIN	   0x800000
+#define OBJECT_MIXIN	   0x1000000
+#define MIXIN_CONSISTENT(flags) \
+    (((flags) & OBJECT_MIXIN) ||					\
+	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static void		AddClassFiltersToCallContext(Object *const oPtr,
+			    Class *clsPtr, struct ChainBuilder *const cbPtr,
+			    Tcl_HashTable *const doneFilters, int flags);
+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, int flags);
+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 Tcl_NRPostProc	FinalizeMethodRefs;
+static void		FreeMethodNameRep(Tcl_Obj *objPtr);
+static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
+			    int flags, int reuseMask);
+static Tcl_NRPostProc	ResetFilterFlags;
+static Tcl_NRPostProc	SetFilterFlags;
+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 == NULL || 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++;
+    TclGetString(objPtr);
+    TclFreeIntRep(objPtr);
+    objPtr->typePtr = &methodNameType;
+    objPtr->internalRep.twoPtrValue.ptr1 = 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.twoPtrValue.ptr1;
+
+    dstPtr->typePtr = &methodNameType;
+    dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+    callPtr->refCount++;
+}
+
+static void
+FreeMethodNameRep(
+    Tcl_Obj *objPtr)
+{
+    register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+    TclOODeleteChain(callPtr);
+    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|TRAVERSED_MIXIN, &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|TRAVERSED_MIXIN, 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;
+
+		isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 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|TRAVERSED_MIXIN, filterDecl);
+	}
+	if (oPtr->methodsPtr) {
+	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
+	    if (hPtr != NULL) {
+		AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
+			doneFilters, filterDecl, flags);
+	    }
+	}
+    }
+    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. */
+    int flags)			/* Used to check if we're mixin-consistent
+				 * only. Mixin-consistent means that either
+				 * we're looking to add things from a mixin
+				 * and we have passed a mixin, or we're not
+				 * looking to add things from a mixin and have
+				 * not passed a mixin. */
+{
+    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.
+     *
+     * This is also where we enforce mixin-consistency.
+     */
+
+    if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
+	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.twoPtrValue.ptr1;
+	    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, BUILDING_MIXINS, NULL);
+	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,
+		    TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
+	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
+		    OBJECT_MIXIN);
+	}
+	FOREACH(filterObj, oPtr->filters) {
+	    AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
+		    BUILDING_MIXINS, NULL);
+	    AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
+		    NULL);
+	}
+	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
+		BUILDING_MIXINS);
+	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
+		0);
+	Tcl_DeleteHashTable(&doneFilters);
+    }
+    count = cb.filterLength = callPtr->numChain;
+
+    /*
+     * Add the actual method implementations. We have to do this twice to
+     * handle class mixins right.
+     */
+
+    AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
+	    flags|BUILDING_MIXINS, NULL);
+    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, BUILDING_MIXINS, 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,
+	    BUILDING_MIXINS);
+    AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
+    Tcl_DeleteHashTable(&doneFilters);
+    count = cb.filterLength = callPtr->numChain;
+
+    /*
+     * Add the actual method implementations.
+     */
+
+    AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
+	    flags|BUILDING_MIXINS, NULL);
+    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, BUILDING_MIXINS, NULL);
+	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 flags)			/* Whether we've gone along a mixin link
+				 * yet. */
+{
+    int i, clearedFlags =
+	    flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
+    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,
+		flags|TRAVERSED_MIXIN);
+    }
+
+    /*
+     * 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.
+     */
+
+    if (MIXIN_CONSISTENT(flags)) {
+	FOREACH(filterObj, clsPtr->filters) {
+	    int isNew;
+
+	    (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
+		    &isNew);
+	    if (isNew) {
+		AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+			doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
+		AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+			doneFilters, clearedFlags, 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,
+		    flags);
+	}
+    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|TRAVERSED_MIXIN, filterDecl);
+    }
+
+    if (flags & CONSTRUCTOR) {
+	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
+		filterDecl, flags);
+
+    } else if (flags & DESTRUCTOR) {
+	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
+		filterDecl, flags);
+    } 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, flags);
+	}
+    }
+
+    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
new file mode 100644
index 0000000..9fd62ec
--- /dev/null
+++ b/generic/tclOODecls.h
@@ -0,0 +1,234 @@
+/*
+ * This file is (mostly) automatically generated from tclOO.decls.
+ */
+
+#ifndef _TCLOODECLS
+#define _TCLOODECLS
+
+#ifndef TCLAPI
+#   ifdef BUILD_tcl
+#	define TCLAPI extern DLLEXPORT
+#   else
+#	define TCLAPI extern DLLIMPORT
+#   endif
+#endif
+
+#ifdef USE_TCL_STUBS
+#   undef USE_TCLOO_STUBS
+#   define USE_TCLOO_STUBS
+#endif
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TCLAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
+				Tcl_Object sourceObject,
+				const char *targetName,
+				const char *targetNamespaceName);
+/* 1 */
+TCLAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
+/* 2 */
+TCLAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
+/* 3 */
+TCLAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
+/* 4 */
+TCLAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+/* 5 */
+TCLAPI Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
+/* 6 */
+TCLAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
+/* 7 */
+TCLAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
+/* 8 */
+TCLAPI int		Tcl_MethodIsPublic(Tcl_Method method);
+/* 9 */
+TCLAPI int		Tcl_MethodIsType(Tcl_Method method,
+				const Tcl_MethodType *typePtr,
+				ClientData *clientDataPtr);
+/* 10 */
+TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
+/* 11 */
+TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
+				Tcl_Object object, Tcl_Obj *nameObj,
+				int isPublic, const Tcl_MethodType *typePtr,
+				ClientData clientData);
+/* 12 */
+TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+				Tcl_Obj *nameObj, int isPublic,
+				const Tcl_MethodType *typePtr,
+				ClientData clientData);
+/* 13 */
+TCLAPI 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 */
+TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
+/* 15 */
+TCLAPI int		Tcl_ObjectContextIsFiltering(
+				Tcl_ObjectContext context);
+/* 16 */
+TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+/* 17 */
+TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
+/* 18 */
+TCLAPI int		Tcl_ObjectContextSkippedArgs(
+				Tcl_ObjectContext context);
+/* 19 */
+TCLAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
+				const Tcl_ObjectMetadataType *typePtr);
+/* 20 */
+TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
+				const Tcl_ObjectMetadataType *typePtr,
+				ClientData metadata);
+/* 21 */
+TCLAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
+				const Tcl_ObjectMetadataType *typePtr);
+/* 22 */
+TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
+				const Tcl_ObjectMetadataType *typePtr,
+				ClientData metadata);
+/* 23 */
+TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+				Tcl_ObjectContext context, int objc,
+				Tcl_Obj *const *objv, int skip);
+/* 24 */
+TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+				Tcl_Object object);
+/* 25 */
+TCLAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
+/* 26 */
+TCLAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
+				Tcl_Class clazz, Tcl_Method method);
+/* 27 */
+TCLAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
+				Tcl_Class clazz, Tcl_Method method);
+/* 28 */
+TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
+				Tcl_Object object);
+
+typedef struct {
+    const struct TclOOIntStubs *tclOOIntStubs;
+} TclOOStubHooks;
+
+typedef struct TclOOStubs {
+    int magic;
+    const 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;
+
+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
new file mode 100644
index 0000000..8747ff5
--- /dev/null
+++ b/generic/tclOODefineCmds.c
@@ -0,0 +1,2677 @@
+/*
+ * 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-2013 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"
+
+/*
+ * The maximum length of fully-qualified object name to use in an errorinfo
+ * message. Longer than this will be curtailed.
+ */
+
+#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30
+
+/*
+ * 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 void		GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
+			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
+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) {
+		if (mixinPtr) {
+		    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 && 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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "method %s does not exist", TclGetString(fromPtr)));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot rename method to itself", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
+		return TCL_ERROR;
+	    } else if (!isNew) {
+	    renameToExisting:
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"method called %s already exists",
+			TclGetString(toPtr)));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+		"bad call of unknown handler", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+	    "invalid command name \"%s\"", soughtStr));
+    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;
+
+    if (namespacePtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"cannot process definitions; support namespace deleted",
+		-1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
+
+    /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
+
+    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    namespacePtr, FRAME_IS_OO_DEFINE);
+    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;
+    Tcl_Object object;
+
+    if ((iPtr->varFramePtr == NULL)
+	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"this command may only be called from within the context of"
+		" an ::oo::define or ::oo::objdefine command", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return NULL;
+    }
+    object = iPtr->varFramePtr->clientData;
+    if (Tcl_ObjectDeleted(object)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"this command cannot be called when the object has been"
+		" deleted", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return NULL;
+    }
+    return object;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+		TclGetString(className), NULL);
+	return NULL;
+    }
+    return oPtr->classPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * GenerateErrorInfo --
+ *	Factored out code to generate part of the error trace messages.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+GenerateErrorInfo(
+    Tcl_Interp *interp,		/* Where to store the error info trace. */
+    Object *oPtr,		/* What object (or class) was being configured
+				 * when the error occurred? */
+    Tcl_Obj *savedNameObj,	/* Name of object saved from before script was
+				 * evaluated, which is needed if the object
+				 * goes away part way through execution. OTOH,
+				 * if the object isn't deleted then its
+				 * current name (post-execution) has to be
+				 * used. This matters, because the object
+				 * could have been renamed... */
+    const char *typeOfSubject)	/* Part of the message, saying whether it was
+				 * an object, class or class-as-object that
+				 * was being configured. */
+{
+    int length;
+    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
+	    ? savedNameObj : TclOOObjectName(interp, oPtr);
+    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
+    int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
+    int overflow = (length > limit);
+
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
+	    typeOfSubject, (overflow ? limit : length), objName,
+	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s does not refer to a class",TclGetString(objv[1])));
+	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) {
+	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_IncrRefCount(objNameObj);
+	result = TclEvalObjEx(interp, objv[2], 0,
+		((Interp *)interp)->cmdFramePtr, 2);
+	if (result == TCL_ERROR) {
+	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
+	}
+	TclDecrRefCount(objNameObj);
+    } else {
+	Tcl_Obj *objPtr, *obj2Ptr, **objs;
+	Tcl_Command cmd;
+	int isRoot, 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!
+	 */
+
+	isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
+
+	/*
+	 * 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);
+	/* TODO: overflow? */
+	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);
+	if (isRoot) {
+	    TclResetRewriteEnsemble(interp, 1);
+	}
+	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 isRoot, 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) {
+	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_IncrRefCount(objNameObj);
+	result = TclEvalObjEx(interp, objv[2], 0,
+		((Interp *)interp)->cmdFramePtr, 2);
+	if (result == TCL_ERROR) {
+	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
+	}
+	TclDecrRefCount(objNameObj);
+    } else {
+	Tcl_Obj *objPtr, *obj2Ptr, **objs;
+	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!
+	 */
+
+	isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
+
+	/*
+	 * 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);
+	/* TODO: overflow? */
+	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);
+
+	if (isRoot) {
+	    TclResetRewriteEnsemble(interp, 1);
+	}
+	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) {
+	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_IncrRefCount(objNameObj);
+	result = TclEvalObjEx(interp, objv[1], 0,
+		((Interp *)interp)->cmdFramePtr, 2);
+	if (result == TCL_ERROR) {
+	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
+	}
+	TclDecrRefCount(objNameObj);
+    } else {
+	Tcl_Obj *objPtr, *obj2Ptr, **objs;
+	Tcl_Command cmd;
+	int isRoot, 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!
+	 */
+
+	isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv);
+
+	/*
+	 * 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);
+	/* TODO: overflow? */
+	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);
+	if (isRoot) {
+	    TclResetRewriteEnsemble(interp, 1);
+	}
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"may not modify the class of the root object class", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr->flags & ROOT_CLASS) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"may not modify the class of the class of classes", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"may not change a %sclass object into a %sclass object",
+		(oPtr->classPtr==NULL ? "non-" : ""),
+		(oPtr->classPtr==NULL ? "" : "non-")));
+	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 (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
+	    oPtr->flags &= ~CLASS_GONE;
+	}
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "may not mix a class into itself", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		    "may not mix a class into itself", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"may not modify the superclass of the root object", -1));
+	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.
+     *
+     * Note that zero classes is special, as it is equivalent to just the
+     * class of objects. [Bug 9d61624b3d]
+     */
+
+    if (superc == 0) {
+	superclasses = ckrealloc(superclasses, sizeof(Class *));
+	superclasses[0] = oPtr->fPtr->objectCls;
+	superc = 1;
+	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
+	    superclasses[0] = oPtr->fPtr->classCls;
+	}
+    } else {
+	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_SetObjResult(interp, Tcl_NewStringObj(
+			    "class should only be a direct superclass once",
+			    -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+		    goto failedAfterAlloc;
+		}
+	    }
+	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"attempt to form circular dependency graph", -1));
+		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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid declared variable name \"%s\": must not %s",
+		    varName, "contain namespace separators"));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
+	    return TCL_ERROR;
+	}
+	if (Tcl_StringMatch(varName, "*(*)")) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid declared variable name \"%s\": must not %s",
+		    varName, "refer to an array element"));
+	    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) {
+	if (mixinPtr) {
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid declared variable name \"%s\": must not %s",
+		    varName, "contain namespace separators"));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
+	    return TCL_ERROR;
+	}
+	if (Tcl_StringMatch(varName, "*(*)")) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid declared variable name \"%s\": must not %s",
+		    varName, "refer to an array element"));
+	    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
new file mode 100644
index 0000000..76eaef5
--- /dev/null
+++ b/generic/tclOOInfo.c
@@ -0,0 +1,1530 @@
+/*
+ * tclOODefineCmds.c --
+ *
+ *	This file contains the implementation of the ::oo-related [info]
+ *	subcommands.
+ *
+ * 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.
+ */
+
+#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;
+
+/*
+ * List of commands that are used to implement the [info object] subcommands.
+ */
+
+static const EnsembleImplMap infoObjectCmds[] = {
+    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
+    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
+    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
+    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+    {NULL, NULL, NULL, NULL, NULL, 0}
+};
+
+/*
+ * List of commands that are used to implement the [info class] subcommands.
+ */
+
+static const EnsembleImplMap infoClassCmds[] = {
+    {"call",	     InfoClassCallCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"constructor",  InfoClassConstrCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"definition",   InfoClassDefnCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+    {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
+    {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+    {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+    {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {NULL, NULL, NULL, NULL, NULL, 0}
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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_Command infoCmd;
+    Tcl_Obj *mapDict;
+
+    /*
+     * Build the ensembles used to implement [info object] and [info class].
+     */
+
+    TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds);
+    TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);
+
+    /*
+     * Install into the master [info] ensemble.
+     */
+
+    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
+    Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
+    Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
+	    Tcl_NewStringObj("::oo::InfoObject", -1));
+    Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
+	    Tcl_NewStringObj("::oo::InfoClass", -1));
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" is not a class", TclGetString(objPtr)));
+	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 (!mixinPtr) {
+		continue;
+	    }
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown method \"%s\"", TclGetString(objv[2])));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		TclGetString(objv[2]), NULL);
+	return TCL_ERROR;
+    }
+    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+    if (procPtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"definition not available for this kind of method", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown method \"%s\"", TclGetString(objv[2])));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		TclGetString(objv[2]), NULL);
+	return TCL_ERROR;
+    }
+    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
+    if (prefixObj == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"prefix argument list not available for this kind of method",
+		-1));
+	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, result = 0;
+
+    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;
+    }
+
+    /*
+     * Now we know what test we are doing, we can check we've got the right
+     * number of arguments.
+     */
+
+    switch ((enum IsACats) idx) {
+    case IsObject:
+    case IsClass:
+    case IsMetaclass:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objName");
+	    return TCL_ERROR;
+	}
+	break;
+    case IsMixin:
+    case IsType:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objName className");
+	    return TCL_ERROR;
+	}
+	break;
+    }
+
+    /*
+     * Perform the check. Note that we can guarantee that we will not fail
+     * from here on; "failures" result in a false-TCL_OK result.
+     */
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+    if (oPtr == NULL) {
+	goto failPrecondition;
+    }
+
+    switch ((enum IsACats) idx) {
+    case IsObject:
+	result = 1;
+	break;
+    case IsClass:
+	result = (oPtr->classPtr != NULL);
+	break;
+    case IsMetaclass:
+	if (oPtr->classPtr != NULL) {
+	    result = TclOOIsReachable(TclOOGetFoundation(interp)->classCls,
+		    oPtr->classPtr);
+	}
+	break;
+    case IsMixin:
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
+	if (o2Ptr == NULL) {
+	    goto failPrecondition;
+	}
+	if (o2Ptr->classPtr != NULL) {
+	    Class *mixinPtr;
+
+	    FOREACH(mixinPtr, oPtr->mixins) {
+		if (!mixinPtr) {
+		    continue;
+		}
+		if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
+		    result = 1;
+		    break;
+		}
+	    }
+	}
+	break;
+    case IsType:
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
+	if (o2Ptr == NULL) {
+	    goto failPrecondition;
+	}
+	if (o2Ptr->classPtr != NULL) {
+	    result = TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls);
+	}
+	break;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+    return TCL_OK;
+
+  failPrecondition:
+    Tcl_ResetResult(interp);
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown method \"%s\"", TclGetString(objv[2])));
+	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) {
+	if (!mixinPtr) {
+	    continue;
+	}
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"definition not available for this kind of method", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown method \"%s\"", TclGetString(objv[2])));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		TclGetString(objv[2]), NULL);
+	return TCL_ERROR;
+    }
+    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+    if (procPtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"definition not available for this kind of method", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"definition not available for this kind of method", -1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown method \"%s\"", TclGetString(objv[2])));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		TclGetString(objv[2]), NULL);
+	return TCL_ERROR;
+    }
+    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
+    if (prefixObj == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"prefix argument list not available for this kind of method",
+		-1));
+	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_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown method \"%s\"", TclGetString(objv[2])));
+	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) {
+	if (!mixinPtr) {
+	    continue;
+	}
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"cannot construct any call chain", -1));
+	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_SetObjResult(interp, Tcl_NewStringObj(
+		"cannot construct any call chain", -1));
+	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
new file mode 100644
index 0000000..b75ffdb
--- /dev/null
+++ b/generic/tclOOInt.h
@@ -0,0 +1,607 @@
+/*
+ * 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-2012 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. */
+} 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 CLASS_GONE	4	/* Indicates that the class of this object has
+				 * been deleted, and so the object should not
+				 * attempt to remove itself from its class. */
+#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. */
+    Tcl_Obj *defineName;	/* Fully qualified name of oo::define. */
+} 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_Constructor(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+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 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);
+
+/*
+ * 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
new file mode 100644
index 0000000..74a8d81
--- /dev/null
+++ b/generic/tclOOIntDecls.h
@@ -0,0 +1,166 @@
+/*
+ * This file is (mostly) automatically generated from tclOO.decls.
+ */
+
+#ifndef _TCLOOINTDECLS
+#define _TCLOOINTDECLS
+
+/* !BEGIN!: Do not edit below this line. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TCLAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
+/* 1 */
+TCLAPI 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 */
+TCLAPI 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 */
+TCLAPI Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
+				Object *oPtr, int flags, Tcl_Obj *nameObj,
+				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+				ProcedureMethod **pmPtrPtr);
+/* 4 */
+TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+				int flags, Tcl_Obj *nameObj,
+				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+				ProcedureMethod **pmPtrPtr);
+/* 5 */
+TCLAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+				int objc, Tcl_Obj *const *objv,
+				int publicOnly, Class *startCls);
+/* 6 */
+TCLAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
+/* 7 */
+TCLAPI Method *		TclOONewForwardMethod(Tcl_Interp *interp,
+				Class *clsPtr, int isPublic,
+				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
+/* 8 */
+TCLAPI Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
+				Tcl_Obj *prefixObj);
+/* 9 */
+TCLAPI 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 */
+TCLAPI 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 */
+TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
+				Tcl_Object object, Tcl_Class startCls,
+				int publicPrivate, int objc,
+				Tcl_Obj *const *objv);
+/* 12 */
+TCLAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
+				Tcl_Obj *const *filters);
+/* 13 */
+TCLAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
+				Class *classPtr, int numFilters,
+				Tcl_Obj *const *filters);
+/* 14 */
+TCLAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
+				Class *const *mixins);
+/* 15 */
+TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
+				Class *classPtr, int numMixins,
+				Class *const *mixins);
+
+typedef struct TclOOIntStubs {
+    int magic;
+    void *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;
+
+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
new file mode 100644
index 0000000..99a8bfc
--- /dev/null
+++ b/generic/tclOOMethod.c
@@ -0,0 +1,1763 @@
+/*
+ * tclOOMethod.c --
+ *
+ *	This file contains code to create and manage methods.
+ *
+ * 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"
+#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 Tcl_NRPostProc	FinalizeForwardCall;
+static Tcl_NRPostProc	FinalizePMCall;
+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-- <= 1)) {
+	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 = NULL;
+		cfPtr->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 = NULL;
+		cfPtr->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.twoPtrValue.ptr1;
+
+	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.
+     */
+
+    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);
+
+    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 (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;
+    Tcl_Obj *bodyObj, *argsObj;
+    CompiledLocal *localPtr;
+
+    /*
+     * Copy the argument list.
+     */
+
+    argsObj = Tcl_NewObj();
+    for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
+	    localPtr=localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_Obj *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, argsObj, argObj);
+	}
+    }
+
+    /*
+     * Must strip the internal representation in order to ensure that any
+     * bound references to instance variables are removed. [Bug 3609693]
+     */
+
+    bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
+    TclFreeIntRep(bodyObj);
+
+    /*
+     * Create the actual copy of the method record, manufacturing a new proc
+     * record.
+     */
+
+    pm2Ptr = ckalloc(sizeof(ProcedureMethod));
+    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
+    pm2Ptr->refCount = 1;
+    Tcl_IncrRefCount(argsObj);
+    Tcl_IncrRefCount(bodyObj);
+    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
+	    &pm2Ptr->procPtr) != TCL_OK) {
+	Tcl_DecrRefCount(argsObj);
+	Tcl_DecrRefCount(bodyObj);
+	ckfree(pm2Ptr);
+	return TCL_ERROR;
+    }
+    Tcl_DecrRefCount(argsObj);
+    Tcl_DecrRefCount(bodyObj);
+
+    if (pmPtr->cloneClientdataProc) {
+	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
+    }
+    *newClientData = pm2Ptr;
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewForwardInstanceMethod --
+ *
+ *	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;
+
+    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+	return NULL;
+    }
+    if (prefixLen < 1) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"method forward prefix must be non-empty", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
+	return NULL;
+    }
+
+    fmPtr = ckalloc(sizeof(ForwardMethod));
+    fmPtr->prefixObj = prefixObj;
+    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;
+
+    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+	return NULL;
+    }
+    if (prefixLen < 1) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"method forward prefix must be non-empty", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
+	return NULL;
+    }
+
+    fmPtr = ckalloc(sizeof(ForwardMethod));
+    fmPtr->prefixObj = prefixObj;
+    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;
+
+    /*
+     * 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);
+    Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+    /*
+     * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
+     * of the TCL_EVAL_NOERR flag results in an evaluation configuration
+     * very much like TCL_EVAL_INVOKE.
+     */
+    ((Interp *)interp)->lookupNsPtr
+	    = (Namespace *) contextPtr->oPtr->namespacePtr;
+    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
+}
+
+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;
+    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. */
+{
+    unsigned len = rewriteLength + objc - toRewrite;
+    Tcl_Obj **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 (TclInitRewriteEnsemble(interp, toRewrite, rewriteLength, objv)) {
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+    }
+    *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
new file mode 100644
index 0000000..900ab22
--- /dev/null
+++ b/generic/tclOOStubInit.c
@@ -0,0 +1,78 @@
+/*
+ * 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
new file mode 100644
index 0000000..a9fa212
--- /dev/null
+++ b/generic/tclOOStubLib.c
@@ -0,0 +1,71 @@
+/*
+ * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
+ */
+
+#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 pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef TclOOInitializeStubs
+
+MODULE_SCOPE const char *
+TclOOInitializeStubs(
+    Tcl_Interp *interp,
+    const char *version)
+{
+    int exact = 0;
+    const char *packageName = "TclOO";
+    const char *errMsg = NULL;
+    TclOOStubs *stubsPtr = NULL;
+    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+	    packageName, version, exact, &stubsPtr);
+
+    if (actualVersion == NULL) {
+	return NULL;
+    }
+    if (stubsPtr == NULL) {
+	errMsg = "missing stub table pointer";
+    } else {
+	tclOOStubsPtr = stubsPtr;
+	if (stubsPtr->hooks) {
+	    tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
+	} else {
+	    tclOOIntStubsPtr = NULL;
+	}
+	return actualVersion;
+    }
+    tclStubsPtr->tcl_ResetResult(interp);
+    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+	    " (requested version ", version, ", actual version ",
+	    actualVersion, "): ", errMsg, NULL);
+    return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 5b11071..a346987 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -16,7 +16,6 @@
 
 #include "tclInt.h"
 #include "tommath.h"
-#include <float.h>
 #include <math.h>
 
 /*
@@ -51,17 +50,17 @@ Tcl_Mutex tclObjMutex;
 
 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.
+ * 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
+    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. */
@@ -78,33 +77,28 @@ typedef struct ObjData {
  */
 
 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/stripped continuation lines. Its
-			       * keys are Tcl_Obj pointers, the values are
-			       * ContLineLoc pointers.  See the file
-			       * tclCompile.h for the definition of this
-			       * structure, and for references to all related
-			       * places in the core.
-			       */
+    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
+                                 * generated by a call to the function
+                                 * TclSubstTokens() from a literal text
+                                 * where bs+nl sequences occured in it, if
+                                 * any. I.e. this table keeps track of
+                                 * invisible 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)
-    /*
-     * Thread local table that is used to check that a Tcl_Obj was not
-     * allocated by some other thread.
-     */
-
-    Tcl_HashTable *objThreadMap;
+    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 */
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
 
-static void ContLineLocFree (char* clientData);
-static void TclThreadFinalizeContLines (ClientData clientData);
-static ThreadSpecificData* TclGetContLineTable (void);
+static void             TclThreadFinalizeContLines(ClientData clientData);
+static ThreadSpecificData *TclGetContLineTable(void);
 
 /*
  * Nested Tcl_Obj deletion management support
@@ -153,11 +147,11 @@ typedef struct PendingObjData {
 #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); \
+     * 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; \
+    (objPtrVar) = (contextPtr)->deletionStack;                          \
     (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
 
 /*
@@ -166,11 +160,15 @@ typedef struct PendingObjData {
 #ifndef TCL_THREADS
 static PendingObjData pendingObjData;
 #define ObjInitDeletionContext(contextPtr) \
-    PendingObjData *CONST contextPtr = &pendingObjData
+    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 = (PendingObjData *) \
+    PendingObjData *const contextPtr =                                  \
 	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
 #endif
 
@@ -179,29 +177,29 @@ static Tcl_ThreadDataKey pendingObjDataKey;
  */
 
 #define PACK_BIGNUM(bignum, objPtr) \
-    if ((bignum).used > 0x7fff) { \
-	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
-	*temp = bignum; \
-	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) temp; \
-	(objPtr)->internalRep.ptrAndLongRep.value = (unsigned long)(-1); \
-    } else { \
-	if ((bignum).alloc > 0x7fff) { \
-	    mp_shrink(&(bignum)); \
-	} \
-	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) (bignum).dp; \
-	(objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
-		| ((bignum).alloc << 15) | ((bignum).used)); \
+    if ((bignum).used > 0x7fff) {                                       \
+	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int));     \
+	*temp = bignum;                                                 \
+	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                 \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
+    } else {                                                            \
+	if ((bignum).alloc > 0x7fff) {                                  \
+	    mp_shrink(&(bignum));                                       \
+	}                                                               \
+	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
+		| ((bignum).alloc << 15) | ((bignum).used));            \
     }
 
 #define UNPACK_BIGNUM(objPtr, bignum) \
-    if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
-	(bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
-    } else { \
-	(bignum).dp = (mp_digit*) (objPtr)->internalRep.ptrAndLongRep.ptr; \
-	(bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
-	(bignum).alloc = \
-		((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
-	(bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
+    if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
+	(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
+    } else {                                                            \
+	(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1;          \
+	(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
+	(bignum).alloc =                                                \
+		(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7fff; \
+	(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7fff; \
     }
 
 /*
@@ -209,12 +207,11 @@ static Tcl_ThreadDataKey pendingObjDataKey;
  */
 
 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
+#ifndef TCL_WIDE_INT_IS_LONG
 static void		UpdateStringOfWideInt(Tcl_Obj *objPtr);
 static int		SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 #endif
@@ -246,56 +243,56 @@ static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  * implementations.
  */
 
-static Tcl_ObjType oldBooleanType = {
-    "boolean",				/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    NULL,				/* updateStringProc */
-    SetBooleanFromAny			/* setFromAnyProc */
+static const Tcl_ObjType oldBooleanType = {
+    "boolean",			/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    TclSetBooleanFromAny		/* setFromAnyProc */
 };
-Tcl_ObjType tclBooleanType = {
-    "booleanString",			/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    NULL,				/* updateStringProc */
-    SetBooleanFromAny			/* setFromAnyProc */
+const Tcl_ObjType tclBooleanType = {
+    "booleanString",		/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    TclSetBooleanFromAny		/* setFromAnyProc */
 };
-Tcl_ObjType tclDoubleType = {
-    "double",				/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    UpdateStringOfDouble,		/* updateStringProc */
-    SetDoubleFromAny			/* setFromAnyProc */
+const Tcl_ObjType tclDoubleType = {
+    "double",			/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    UpdateStringOfDouble,	/* updateStringProc */
+    SetDoubleFromAny		/* setFromAnyProc */
 };
-Tcl_ObjType tclIntType = {
-    "int",				/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    UpdateStringOfInt,			/* updateStringProc */
-    SetIntFromAny			/* setFromAnyProc */
+const Tcl_ObjType tclIntType = {
+    "int",			/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    UpdateStringOfInt,		/* updateStringProc */
+    SetIntFromAny		/* setFromAnyProc */
 };
-#ifndef NO_WIDE_TYPE
-Tcl_ObjType tclWideIntType = {
-    "wideInt",				/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    UpdateStringOfWideInt,		/* updateStringProc */
-    SetWideIntFromAny			/* setFromAnyProc */
+#ifndef TCL_WIDE_INT_IS_LONG
+const Tcl_ObjType tclWideIntType = {
+    "wideInt",			/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    UpdateStringOfWideInt,	/* updateStringProc */
+    SetWideIntFromAny		/* setFromAnyProc */
 };
 #endif
-Tcl_ObjType tclBignumType = {
-    "bignum",				/* name */
-    FreeBignum,				/* freeIntRepProc */
-    DupBignum,				/* dupIntRepProc */
-    UpdateStringOfBignum,		/* updateStringProc */
-    NULL				/* setFromAnyProc */
+const Tcl_ObjType tclBignumType = {
+    "bignum",			/* name */
+    FreeBignum,			/* freeIntRepProc */
+    DupBignum,			/* dupIntRepProc */
+    UpdateStringOfBignum,	/* updateStringProc */
+    NULL			/* setFromAnyProc */
 };
 
 /*
  * The structure below defines the Tcl obj hash key type.
  */
 
-Tcl_HashKeyType tclObjHashKeyType = {
+const Tcl_HashKeyType tclObjHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,	/* version */
     0,				/* flags */
     TclHashObjKey,		/* hashKeyProc */
@@ -317,14 +314,22 @@ Tcl_HashKeyType tclObjHashKeyType = {
  * 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] [Bug 07d13d99b0a9]
+ * TODO: Provide a better API for those extensions so that they can coexist...
  */
 
-static Tcl_ObjType tclCmdNameType = {
-    "cmdName",				/* name */
-    FreeCmdNameInternalRep,		/* freeIntRepProc */
-    DupCmdNameInternalRep,		/* dupIntRepProc */
-    NULL,				/* updateStringProc */
-    SetCmdNameFromAny			/* setFromAnyProc */
+Tcl_ObjType tclCmdNameType = {
+    "cmdName",			/* name */
+    FreeCmdNameInternalRep,	/* freeIntRepProc */
+    DupCmdNameInternalRep,	/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    SetCmdNameFromAny		/* setFromAnyProc */
 };
 
 /*
@@ -404,7 +409,7 @@ TclInitObjSubsystem(void)
 
     /* For backward compatibility only ... */
     Tcl_RegisterObjType(&oldBooleanType);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
     Tcl_RegisterObjType(&tclWideIntType);
 #endif
 
@@ -414,6 +419,7 @@ TclInitObjSubsystem(void)
     tclObjsFreed = 0;
     {
 	int i;
+
 	for (i=0 ; i<TCL_MAX_SHARED_OBJ_STATS ; i++) {
 	    tclObjsShared[i] = 0;
 	}
@@ -454,12 +460,12 @@ TclFinalizeThreadObjects(void)
 	    ObjData *objData = Tcl_GetHashValue(hPtr);
 
 	    if (objData != NULL) {
-		ckfree((char *) objData);
+		ckfree(objData);
 	    }
 	}
 
 	Tcl_DeleteHashTable(tablePtr);
-	ckfree((char *) tablePtr);
+	ckfree(tablePtr);
 	tsdPtr->objThreadMap = NULL;
     }
 #endif
@@ -521,8 +527,8 @@ TclFinalizeObjects(void)
  *----------------------------------------------------------------------
  */
 
-static ThreadSpecificData*
-TclGetContLineTable()
+static ThreadSpecificData *
+TclGetContLineTable(void)
 {
     /*
      * Initialize the hashtable tracking invisible continuation lines.  For
@@ -533,10 +539,11 @@ TclGetContLineTable()
      */
 
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
     if (!tsdPtr->lineCLPtr) {
-	tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
 	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
-	Tcl_CreateThreadExitHandler (TclThreadFinalizeContLines,NULL);
+	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
     }
     return tsdPtr;
 }
@@ -559,18 +566,17 @@ TclGetContLineTable()
  *----------------------------------------------------------------------
  */
 
-ContLineLoc*
-TclContinuationsEnter(Tcl_Obj* objPtr,
-		      int num,
-		      int* loc)
+ContLineLoc *
+TclContinuationsEnter(
+    Tcl_Obj *objPtr,
+    int num,
+    int *loc)
 {
     int newEntry;
     ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry* hPtr =
-	Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
-
-    ContLineLoc* clLocPtr =
-	(ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
+    Tcl_HashEntry *hPtr =
+	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
+    ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
 
     if (!newEntry) {
 	/*
@@ -589,18 +595,18 @@ TclContinuationsEnter(Tcl_Obj* objPtr,
 	 * incoming num/loc data even so. Because we are called from
 	 * TclContinuationsEnterDerived for this case, which modified the
 	 * stored locations (Rebased to the proper relative offset). Just
-	 * returning the stored entry and data would rebase them a second
-	 * time, or more, hosing the data. It is easier to simply replace, as
-	 * we are doing.
+	 * 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.
 	 */
 
-	ckfree((char *) Tcl_GetHashValue(hPtr));
+	ckfree(Tcl_GetHashValue(hPtr));
     }
 
     clLocPtr->num = num;
-    memcpy (&clLocPtr->loc, loc, num*sizeof(int));
-    clLocPtr->loc[num] = CLL_END; /* Sentinel */
-    Tcl_SetHashValue (hPtr, clLocPtr);
+    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
+    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
+    Tcl_SetHashValue(hPtr, clLocPtr);
 
     return clLocPtr;
 }
@@ -625,8 +631,14 @@ TclContinuationsEnter(Tcl_Obj* objPtr,
  */
 
 void
-TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
+TclContinuationsEnterDerived(
+    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
@@ -647,20 +659,15 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
      */
 
     /*
-     * First compute the range of the word within the script.
+     * First compute the range of the word within the script. (Is there a
+     * better way which doesn't shimmer?)
      */
 
-    int length, end, num;
-    int* wordCLLast = clNext;
-
-    Tcl_GetStringFromObj(objPtr, &length);
-    /* Is there a better way which doesn't shimmer ? */
-
-    end = start + length; /* first char after the word */
+    TclGetStringFromObj(objPtr, &length);
+    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) {
@@ -668,21 +675,19 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
     }
 
     /*
-     * 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;
 
 	    /*
@@ -704,9 +709,9 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
  * 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.
@@ -719,13 +724,16 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
  */
 
 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, (char*) originObjPtr);
+    Tcl_HashEntry *hPtr =
+            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
 
     if (hPtr) {
-	ContLineLoc* clLocPtr = (ContLineLoc*) Tcl_GetHashValue (hPtr);
+	ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
 
 	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
     }
@@ -740,8 +748,8 @@ TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
  *	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.
@@ -750,17 +758,18 @@ TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
  *----------------------------------------------------------------------
  */
 
-ContLineLoc*
-TclContinuationsGet(Tcl_Obj* objPtr)
+ContLineLoc *
+TclContinuationsGet(
+    Tcl_Obj *objPtr)
 {
     ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr);
+    Tcl_HashEntry *hPtr =
+            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
 
-    if (hPtr) {
-	return (ContLineLoc*) Tcl_GetHashValue (hPtr);
-    } else {
-	return NULL;
+    if (!hPtr) {
+        return NULL;
     }
+    return Tcl_GetHashValue(hPtr);
 }
 
 /*
@@ -782,7 +791,8 @@ TclContinuationsGet(Tcl_Obj* objPtr)
  */
 
 static void
-TclThreadFinalizeContLines (ClientData clientData)
+TclThreadFinalizeContLines(
+    ClientData clientData)
 {
     /*
      * Release the hashtable tracking invisible continuation lines.
@@ -793,46 +803,16 @@ TclThreadFinalizeContLines (ClientData clientData)
     Tcl_HashSearch hSearch;
 
     for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
-	 hPtr != NULL;
-	 hPtr = Tcl_NextHashEntry(&hSearch)) {
-	/*
-	 * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
-	 * here we can be sure that the compiler will not hold references to
-	 * the data in the hashtable, and using TEF might bork the
-	 * finalization sequence.
-	 */
-	ContLineLocFree (Tcl_GetHashValue (hPtr));
-	Tcl_DeleteHashEntry (hPtr);
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+	ckfree(Tcl_GetHashValue(hPtr));
+	Tcl_DeleteHashEntry(hPtr);
     }
-    Tcl_DeleteHashTable (tsdPtr->lineCLPtr);
-    ckfree((char *) tsdPtr->lineCLPtr);
+    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
+    ckfree(tsdPtr->lineCLPtr);
     tsdPtr->lineCLPtr = NULL;
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * ContLineLocFree --
- *
- *	The freProc for continuation line location tables.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Releases memory.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static void
-ContLineLocFree (char* clientData)
-{
-    ckfree (clientData);
-}
-
-/*
  *--------------------------------------------------------------
  *
  * Tcl_RegisterObjType --
@@ -853,7 +833,7 @@ ContLineLocFree (char* clientData)
 
 void
 Tcl_RegisterObjType(
-    Tcl_ObjType *typePtr)	/* Information about object type; storage must
+    const Tcl_ObjType *typePtr)	/* Information about object type; storage must
 				 * be statically allocated (must live
 				 * forever). */
 {
@@ -940,17 +920,17 @@ Tcl_AppendAllObjTypes(
  *----------------------------------------------------------------------
  */
 
-Tcl_ObjType *
+const Tcl_ObjType *
 Tcl_GetObjType(
-    CONST char *typeName)	/* Name of Tcl object type to look up. */
+    const char *typeName)	/* Name of Tcl object type to look up. */
 {
     register Tcl_HashEntry *hPtr;
-    Tcl_ObjType *typePtr = NULL;
+    const Tcl_ObjType *typePtr = NULL;
 
     Tcl_MutexLock(&tableMutex);
     hPtr = Tcl_FindHashEntry(&typeTable, typeName);
     if (hPtr != NULL) {
-	typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+	typePtr = Tcl_GetHashValue(hPtr);
     }
     Tcl_MutexUnlock(&tableMutex);
     return typePtr;
@@ -980,7 +960,7 @@ int
 Tcl_ConvertToType(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
     Tcl_Obj *objPtr,		/* The object to convert. */
-    Tcl_ObjType *typePtr)	/* The target type. */
+    const Tcl_ObjType *typePtr)	/* The target type. */
 {
     if (objPtr->typePtr == typePtr) {
 	return TCL_OK;
@@ -1075,7 +1055,7 @@ TclDbDumpActiveObjects(
 void
 TclDbInitNewObj(
     register Tcl_Obj *objPtr,
-    register CONST char *file,	/* The name of the source file calling this
+    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. */
@@ -1099,12 +1079,11 @@ TclDbInitNewObj(
 	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
 	if (tsdPtr->objThreadMap == NULL) {
-	    tsdPtr->objThreadMap = (Tcl_HashTable *)
-		    ckalloc(sizeof(Tcl_HashTable));
+	    tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
 	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
 	}
 	tablePtr = tsdPtr->objThreadMap;
-	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) objPtr, &isNew);
+	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
 	if (!isNew) {
 	    Tcl_Panic("expected to create new entry for object map");
 	}
@@ -1113,7 +1092,7 @@ TclDbInitNewObj(
 	 * Record the debugging information.
 	 */
 
-	objData = (ObjData *) ckalloc(sizeof(ObjData));
+	objData = ckalloc(sizeof(ObjData));
 	objData->objPtr = objPtr;
 	objData->file = file;
 	objData->line = line;
@@ -1205,7 +1184,7 @@ Tcl_NewObj(void)
 
 Tcl_Obj *
 Tcl_DbNewObj(
-    register CONST char *file,	/* The name of the source file calling this
+    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. */
@@ -1223,7 +1202,7 @@ Tcl_DbNewObj(
 
 Tcl_Obj *
 Tcl_DbNewObj(
-    CONST char *file,		/* The name of the source file calling this
+    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. */
@@ -1272,12 +1251,12 @@ TclAllocateFreeObjects(void)
      * Purify apparently can't figure that out, and fires a false alarm.
      */
 
-    basePtr = (char *) ckalloc(bytesToAlloc);
+    basePtr = ckalloc(bytesToAlloc);
 
     prevPtr = NULL;
     objPtr = (Tcl_Obj *) basePtr;
     for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
-	objPtr->internalRep.twoPtrValue.ptr1 = (void *) prevPtr;
+	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
 	prevPtr = objPtr;
 	objPtr++;
     }
@@ -1314,7 +1293,7 @@ void
 TclFreeObj(
     register Tcl_Obj *objPtr)	/* The object to be freed. */
 {
-    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    register const Tcl_ObjType *typePtr = objPtr->typePtr;
 
     /*
      * This macro declares a variable, so must come here...
@@ -1347,7 +1326,7 @@ TclFreeObj(
 	    ObjData *objData = Tcl_GetHashValue(hPtr);
 
 	    if (objData != NULL) {
-		ckfree((char *) objData);
+		ckfree(objData);
 	    }
 
 	    Tcl_DeleteHashEntry(hPtr);
@@ -1362,7 +1341,7 @@ TclFreeObj(
      * and so on, is always a sign of a botch in the caller.
      */
     if (objPtr->refCount < -1) {
-	Tcl_Panic("Reference count for %lx was negative", objPtr);
+	Tcl_Panic("Reference count for %p was negative", objPtr);
     }
     /*
      * Now, in case we just approved drop from 1 to 0 as acceptable, make
@@ -1371,9 +1350,11 @@ TclFreeObj(
      */
     objPtr->refCount = -1;
 
-    /* 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' */
+    /*
+     * 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;
@@ -1389,19 +1370,19 @@ TclFreeObj(
 	}
 
 	Tcl_MutexLock(&tclObjMutex);
-	ckfree((char *) objPtr);
+	ckfree(objPtr);
 	Tcl_MutexUnlock(&tclObjMutex);
 	TclIncrObjsFreed();
 	ObjDeletionLock(context);
 	while (ObjOnStack(context)) {
 	    Tcl_Obj *objToFree;
 
-	    PopObjToDelete(context,objToFree);
+	    PopObjToDelete(context, objToFree);
 	    TCL_DTRACE_OBJ_FREE(objToFree);
 	    TclFreeIntRep(objToFree);
 
 	    Tcl_MutexLock(&tclObjMutex);
-	    ckfree((char *) objToFree);
+	    ckfree(objToFree);
 	    Tcl_MutexUnlock(&tclObjMutex);
 	    TclIncrObjsFreed();
 	}
@@ -1410,22 +1391,23 @@ TclFreeObj(
 
     /*
      * 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);
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+        Tcl_HashEntry *hPtr;
+
 	if (tsdPtr->lineCLPtr) {
-	    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
 	    if (hPtr) {
-		Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
-		Tcl_DeleteHashEntry (hPtr);
+		ckfree(Tcl_GetHashValue(hPtr));
+		Tcl_DeleteHashEntry(hPtr);
 	    }
 	}
     }
@@ -1436,9 +1418,11 @@ 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' */
+    /*
+     * 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;
@@ -1482,7 +1466,8 @@ TclFreeObj(
 	    ObjDeletionLock(context);
 	    while (ObjOnStack(context)) {
 		Tcl_Obj *objToFree;
-		PopObjToDelete(context,objToFree);
+
+		PopObjToDelete(context, objToFree);
 		TCL_DTRACE_OBJ_FREE(objToFree);
 		if ((objToFree->typePtr != NULL)
 			&& (objToFree->typePtr->freeIntRepProc != NULL)) {
@@ -1497,27 +1482,28 @@ TclFreeObj(
 
     /*
      * 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);
+	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+        Tcl_HashEntry *hPtr;
+
 	if (tsdPtr->lineCLPtr) {
-	    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
 	    if (hPtr) {
-		Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
-		Tcl_DeleteHashEntry (hPtr);
+		ckfree(Tcl_GetHashValue(hPtr));
+		Tcl_DeleteHashEntry(hPtr);
 	    }
 	}
     }
 }
-#endif
+#endif /* TCL_MEM_DEBUG */
 
 /*
  *----------------------------------------------------------------------
@@ -1543,7 +1529,6 @@ TclObjBeingDeleted(
 {
     return (objPtr->length == -1);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -1574,30 +1559,47 @@ TclObjBeingDeleted(
  *----------------------------------------------------------------------
  */
 
+#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(
-    register Tcl_Obj *objPtr)		/* The object to duplicate. */
+    Tcl_Obj *objPtr)		/* The object to duplicate. */
 {
-    register Tcl_ObjType *typePtr = objPtr->typePtr;
-    register Tcl_Obj *dupPtr;
+    Tcl_Obj *dupPtr;
 
     TclNewObj(dupPtr);
+    SetDuplicateObj(dupPtr, objPtr);
+    return dupPtr;
+}
 
-    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);
-	}
+void
+TclSetDuplicateObj(
+    Tcl_Obj *dupPtr,
+    Tcl_Obj *objPtr)
+{
+    if (Tcl_IsShared(dupPtr)) {
+	Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
     }
-    return dupPtr;
+    TclInvalidateStringRep(dupPtr);
+    TclFreeIntRep(dupPtr);
+    SetDuplicateObj(dupPtr, objPtr);
 }
 
 /*
@@ -1630,11 +1632,29 @@ Tcl_GetString(
 	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",
 		objPtr->typePtr->name);
     }
-    (*objPtr->typePtr->updateStringProc)(objPtr);
+    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);
+    }
     return objPtr->bytes;
 }
 
@@ -1669,13 +1689,7 @@ Tcl_GetStringFromObj(
 				 * rep's byte array length should * be stored.
 				 * If NULL, no length is stored. */
 {
-    if (objPtr->bytes == NULL) {
-	if (objPtr->typePtr->updateStringProc == NULL) {
-	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
-		    objPtr->typePtr->name);
-	}
-	(*objPtr->typePtr->updateStringProc)(objPtr);
-    }
+    (void) TclGetString(objPtr);
 
     if (lengthPtr != NULL) {
 	*lengthPtr = objPtr->length;
@@ -1708,7 +1722,6 @@ Tcl_InvalidateStringRep(
 {
     TclInvalidateStringRep(objPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -1740,7 +1753,7 @@ Tcl_Obj *
 Tcl_NewBooleanObj(
     register int boolValue)	/* Boolean used to initialize new object. */
 {
-    return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
+    return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
 }
 
 #else /* if not TCL_MEM_DEBUG */
@@ -1751,7 +1764,7 @@ Tcl_NewBooleanObj(
 {
     register Tcl_Obj *objPtr;
 
-    TclNewIntObj(objPtr, boolValue!=0);
+    TclNewBooleanObj(objPtr, boolValue);
     return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
@@ -1788,7 +1801,7 @@ Tcl_NewBooleanObj(
 Tcl_Obj *
 Tcl_DbNewBooleanObj(
     register int boolValue,	/* Boolean used to initialize new object. */
-    CONST char *file,		/* The name of the source file calling this
+    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. */
@@ -1808,7 +1821,7 @@ Tcl_DbNewBooleanObj(
 Tcl_Obj *
 Tcl_DbNewBooleanObj(
     register int boolValue,	/* Boolean used to initialize new object. */
-    CONST char *file,		/* The name of the source file calling this
+    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. */
@@ -1845,7 +1858,7 @@ Tcl_SetBooleanObj(
 	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
     }
 
-    TclSetIntObj(objPtr, boolValue!=0);
+    TclSetBooleanObj(objPtr, boolValue);
 }
 
 /*
@@ -1869,7 +1882,7 @@ Tcl_SetBooleanObj(
 
 int
 Tcl_GetBooleanFromObj(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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. */
 {
@@ -1891,7 +1904,7 @@ Tcl_GetBooleanFromObj(
 	     * sets the proper error message for us.
 	     */
 
-            double d;
+	    double d;
 
 	    if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
 		return TCL_ERROR;
@@ -1903,7 +1916,7 @@ Tcl_GetBooleanFromObj(
 	    *boolPtr = 1;
 	    return TCL_OK;
 	}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    *boolPtr = (objPtr->internalRep.wideValue != 0);
 	    return TCL_OK;
@@ -1917,7 +1930,7 @@ Tcl_GetBooleanFromObj(
 /*
  *----------------------------------------------------------------------
  *
- * SetBooleanFromAny --
+ * TclSetBooleanFromAny --
  *
  *	Attempt to generate a boolean internal form for the Tcl object
  *	"objPtr".
@@ -1934,8 +1947,8 @@ Tcl_GetBooleanFromObj(
  *----------------------------------------------------------------------
  */
 
-static int
-SetBooleanFromAny(
+int
+TclSetBooleanFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
     register Tcl_Obj *objPtr)	/* The object to convert. */
 {
@@ -1958,7 +1971,7 @@ SetBooleanFromAny(
 	    goto badBoolean;
 	}
 
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    goto badBoolean;
 	}
@@ -1976,13 +1989,14 @@ SetBooleanFromAny(
   badBoolean:
     if (interp != NULL) {
 	int length;
-	char *str = Tcl_GetStringFromObj(objPtr, &length);
+	const char *str = TclGetStringFromObj(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;
 }
@@ -1992,10 +2006,14 @@ ParseBoolean(
     register Tcl_Obj *objPtr)	/* The object to parse/convert. */
 {
     int i, length, newBool;
-    char lowerCase[6], *str = TclGetStringFromObj(objPtr, &length);
+    char lowerCase[6];
+    const char *str = TclGetStringFromObj(objPtr, &length);
 
     if ((length == 0) || (length > 5)) {
-	/* longest valid boolean string rep. is "false" */
+	/*
+         * Longest valid boolean string rep. is "false".
+         */
+
 	return TCL_ERROR;
     }
 
@@ -2021,6 +2039,7 @@ ParseBoolean(
 
     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':
@@ -2174,7 +2193,7 @@ Tcl_NewDoubleObj(
 Tcl_Obj *
 Tcl_DbNewDoubleObj(
     register double dblValue,	/* Double used to initialize the object. */
-    CONST char *file,		/* The name of the source file calling this
+    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. */
@@ -2194,7 +2213,7 @@ Tcl_DbNewDoubleObj(
 Tcl_Obj *
 Tcl_DbNewDoubleObj(
     register double dblValue,	/* Double used to initialize the object. */
-    CONST char *file,		/* The name of the source file calling this
+    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. */
@@ -2255,7 +2274,7 @@ Tcl_SetDoubleObj(
 
 int
 Tcl_GetDoubleFromObj(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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. */
 {
@@ -2265,6 +2284,8 @@ Tcl_GetDoubleFromObj(
 		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;
 	    }
@@ -2277,11 +2298,12 @@ Tcl_GetDoubleFromObj(
 	}
 	if (objPtr->typePtr == &tclBignumType) {
 	    mp_int big;
-	    UNPACK_BIGNUM( objPtr, big );
-	    *dblPtr = TclBignumToDouble( &big );
+
+	    UNPACK_BIGNUM(objPtr, big);
+	    *dblPtr = TclBignumToDouble(&big);
 	    return TCL_OK;
 	}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    *dblPtr = (double) objPtr->internalRep.wideValue;
 	    return TCL_OK;
@@ -2351,8 +2373,8 @@ UpdateStringOfDouble(
     Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
     len = strlen(buffer);
 
-    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
-    strcpy(objPtr->bytes, buffer);
+    objPtr->bytes = ckalloc(len + 1);
+    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
     objPtr->length = len;
 }
 
@@ -2386,8 +2408,8 @@ UpdateStringOfDouble(
  *----------------------------------------------------------------------
  */
 
-#ifdef TCL_MEM_DEBUG
 #undef Tcl_NewIntObj
+#ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
 Tcl_NewIntObj(
@@ -2427,6 +2449,7 @@ Tcl_NewIntObj(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_SetIntObj
 void
 Tcl_SetIntObj(
     register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
@@ -2467,7 +2490,7 @@ Tcl_SetIntObj(
 
 int
 Tcl_GetIntFromObj(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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. */
 {
@@ -2481,7 +2504,7 @@ Tcl_GetIntFromObj(
     }
     if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
 	if (interp != NULL) {
-	    CONST char *s =
+	    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);
@@ -2515,6 +2538,7 @@ SetIntFromAny(
     Tcl_Obj *objPtr)		/* Pointer to the object to convert */
 {
     long l;
+
     return TclGetLongFromObj(interp, objPtr, &l);
 }
 
@@ -2546,8 +2570,8 @@ UpdateStringOfInt(
 
     len = TclFormatInt(buffer, objPtr->internalRep.longValue);
 
-    objPtr->bytes = ckalloc((unsigned) len + 1);
-    strcpy(objPtr->bytes, buffer);
+    objPtr->bytes = ckalloc(len + 1);
+    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
     objPtr->length = len;
 }
 
@@ -2644,7 +2668,7 @@ 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
+    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. */
@@ -2665,7 +2689,7 @@ 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
+    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. */
@@ -2728,7 +2752,7 @@ Tcl_SetLongObj(
 
 int
 Tcl_GetLongFromObj(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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. */
 {
@@ -2737,7 +2761,7 @@ Tcl_GetLongFromObj(
 	    *longPtr = objPtr->internalRep.longValue;
 	    return TCL_OK;
 	}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    /*
 	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
@@ -2748,6 +2772,7 @@ Tcl_GetLongFromObj(
 	     */
 
 	    Tcl_WideInt w = objPtr->internalRep.wideValue;
+
 	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
 		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
 		*longPtr = Tcl_WideAsLong(w);
@@ -2756,18 +2781,16 @@ Tcl_GetLongFromObj(
 	    goto tooLarge;
 	}
 #endif
-        if (objPtr->typePtr == &tclDoubleType) {
-            if (interp != NULL) {
-		Tcl_Obj *msg;
-
-		TclNewLiteralStringObj(msg, "expected integer but got \"");
-		Tcl_AppendObjToObj(msg, objPtr);
-		Tcl_AppendToObj(msg, "\"", -1);
-		Tcl_SetObjResult(interp, msg);
+	if (objPtr->typePtr == &tclDoubleType) {
+	    if (interp != NULL) {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "expected integer but got \"%s\"",
+                        TclGetString(objPtr)));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
-        if (objPtr->typePtr == &tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a long, even
 	     * when auto-narrowing is enabled. Only those values in the signed
@@ -2778,11 +2801,12 @@ Tcl_GetLongFromObj(
 	    mp_int big;
 
 	    UNPACK_BIGNUM(objPtr, big);
-	    if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
+	    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;
+		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++;
@@ -2795,7 +2819,7 @@ Tcl_GetLongFromObj(
 		    return TCL_OK;
 		}
 	    }
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	tooLarge:
 #endif
 	    if (interp != NULL) {
@@ -2811,7 +2835,7 @@ Tcl_GetLongFromObj(
 	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
     return TCL_ERROR;
 }
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 
 /*
  *----------------------------------------------------------------------
@@ -2849,11 +2873,11 @@ UpdateStringOfWideInt(
 
     sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
     len = strlen(buffer);
-    objPtr->bytes = ckalloc((unsigned) len + 1);
+    objPtr->bytes = ckalloc(len + 1);
     memcpy(objPtr->bytes, buffer, len + 1);
     objPtr->length = len;
 }
-#endif /* !NO_WIDE_TYPE */
+#endif /* !TCL_WIDE_INT_IS_LONG */
 
 /*
  *----------------------------------------------------------------------
@@ -2947,7 +2971,7 @@ 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
+    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. */
@@ -2966,7 +2990,7 @@ 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
+    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. */
@@ -3008,7 +3032,7 @@ Tcl_SetWideIntObj(
 	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
 	TclSetLongObj(objPtr, (long) wideValue);
     } else {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	TclSetWideIntObj(objPtr, wideValue);
 #else
 	mp_int big;
@@ -3042,13 +3066,13 @@ Tcl_SetWideIntObj(
 
 int
 Tcl_GetWideIntFromObj(
-    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    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
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    *wideIntPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
@@ -3058,18 +3082,16 @@ Tcl_GetWideIntFromObj(
 	    *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
 	    return TCL_OK;
 	}
-        if (objPtr->typePtr == &tclDoubleType) {
-            if (interp != NULL) {
-		Tcl_Obj *msg;
-
-		TclNewLiteralStringObj(msg, "expected integer but got \"");
-		Tcl_AppendObjToObj(msg, objPtr);
-		Tcl_AppendToObj(msg, "\"", -1);
-		Tcl_SetObjResult(interp, msg);
+	if (objPtr->typePtr == &tclDoubleType) {
+	    if (interp != NULL) {
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "expected integer but got \"%s\"",
+                        TclGetString(objPtr)));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
-        if (objPtr->typePtr == &tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a
 	     * Tcl_WideInt, even when auto-narrowing is enabled.
@@ -3078,7 +3100,7 @@ Tcl_GetWideIntFromObj(
 	    mp_int big;
 
 	    UNPACK_BIGNUM(objPtr, big);
-	    if ((size_t)(big.used) <= (CHAR_BIT * sizeof(Tcl_WideInt)
+	    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);
@@ -3099,7 +3121,7 @@ Tcl_GetWideIntFromObj(
 	    }
 	    if (interp != NULL) {
 		const char *s = "integer value too large to represent";
-		Tcl_Obj* msg = Tcl_NewStringObj(s, -1);
+		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
 
 		Tcl_SetObjResult(interp, msg);
 		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
@@ -3110,7 +3132,7 @@ Tcl_GetWideIntFromObj(
 	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
     return TCL_ERROR;
 }
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 
 /*
  *----------------------------------------------------------------------
@@ -3136,7 +3158,7 @@ SetWideIntFromAny(
     Tcl_WideInt w;
     return Tcl_GetWideIntFromObj(interp, objPtr, &w);
 }
-#endif /* !NO_WIDE_TYPE */
+#endif /* !TCL_WIDE_INT_IS_LONG */
 
 /*
  *----------------------------------------------------------------------
@@ -3159,9 +3181,10 @@ FreeBignum(
 
     UNPACK_BIGNUM(objPtr, toFree);
     mp_clear(&toFree);
-    if ((long)(objPtr->internalRep.ptrAndLongRep.value) < 0) {
-	ckfree((char *)objPtr->internalRep.ptrAndLongRep.ptr);
+    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
+	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
     }
+    objPtr->typePtr = NULL;
 }
 
 /*
@@ -3223,7 +3246,7 @@ UpdateStringOfBignum(
     mp_int bignumVal;
     int size;
     int status;
-    char* stringVal;
+    char *stringVal;
 
     UNPACK_BIGNUM(objPtr, bignumVal);
     status = mp_radix_size(&bignumVal, 10, &size);
@@ -3242,13 +3265,13 @@ UpdateStringOfBignum(
 
 	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
     }
-    stringVal = ckalloc((size_t) size);
+    stringVal = ckalloc(size);
     status = mp_toradix_n(&bignumVal, stringVal, 10, size);
     if (status != MP_OKAY) {
 	Tcl_Panic("conversion failure in UpdateStringOfBignum");
     }
     objPtr->bytes = stringVal;
-    objPtr->length = size - 1;	/* size includes a trailing null byte */
+    objPtr->length = size - 1;	/* size includes a trailing NUL byte. */
 }
 
 /*
@@ -3281,7 +3304,7 @@ Tcl_Obj *
 Tcl_NewBignumObj(
     mp_int *bignumValue)
 {
-    Tcl_Obj* objPtr;
+    Tcl_Obj *objPtr;
 
     TclNewObj(objPtr);
     Tcl_SetBignumObj(objPtr, bignumValue);
@@ -3311,7 +3334,7 @@ Tcl_NewBignumObj(
 Tcl_Obj *
 Tcl_DbNewBignumObj(
     mp_int *bignumValue,
-    CONST char *file,
+    const char *file,
     int line)
 {
     Tcl_Obj *objPtr;
@@ -3324,7 +3347,7 @@ Tcl_DbNewBignumObj(
 Tcl_Obj *
 Tcl_DbNewBignumObj(
     mp_int *bignumValue,
-    CONST char *file,
+    const char *file,
     int line)
 {
     return Tcl_NewBignumObj(bignumValue);
@@ -3363,12 +3386,13 @@ GetBignumFromObj(
 	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->internalRep.twoPtrValue.ptr1 = NULL;
+		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 		objPtr->typePtr = NULL;
 		if (objPtr->bytes == NULL) {
 		    TclInitStringRep(objPtr, tclEmptyStringRep, 0);
@@ -3380,7 +3404,7 @@ GetBignumFromObj(
 	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
 	    return TCL_OK;
 	}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    TclBNInitBignumFromWideInt(bignumValue,
 		    objPtr->internalRep.wideValue);
@@ -3389,12 +3413,10 @@ GetBignumFromObj(
 #endif
 	if (objPtr->typePtr == &tclDoubleType) {
 	    if (interp != NULL) {
-		Tcl_Obj *msg;
-
-		TclNewLiteralStringObj(msg, "expected integer but got \"");
-		Tcl_AppendObjToObj(msg, objPtr);
-		Tcl_AppendToObj(msg, "\"", -1);
-		Tcl_SetObjResult(interp, msg);
+                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "expected integer but got \"%s\"",
+                        TclGetString(objPtr)));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -3497,11 +3519,12 @@ Tcl_SetBignumObj(
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
     }
-    if ((size_t)(bignumValue->used)
+    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;
+	unsigned char *bytes = (unsigned char *) &scratch;
+
 	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
 	    goto tooLargeForLong;
 	}
@@ -3520,13 +3543,14 @@ Tcl_SetBignumObj(
 	return;
     }
   tooLargeForLong:
-#ifndef NO_WIDE_TYPE
-    if ((size_t)(bignumValue->used)
+#ifndef TCL_WIDE_INT_IS_LONG
+    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;
 	}
@@ -3551,6 +3575,24 @@ Tcl_SetBignumObj(
     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,
@@ -3561,8 +3603,9 @@ TclSetBignumIntRep(
 
     /*
      * Clear the mp_int value.
-     * Don't call mp_clear() because it would free the digit array
-     * we just packed into the Tcl_Obj.
+     *
+     * Don't call mp_clear() because it would free the digit array we just
+     * packed into the Tcl_Obj.
      */
 
     bignumValue->dp = NULL;
@@ -3575,14 +3618,23 @@ TclSetBignumIntRep(
  *
  * 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(
+int
+TclGetNumberFromObj(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr,
     ClientData *clientDataPtr,
@@ -3595,18 +3647,18 @@ int TclGetNumberFromObj(
 	    } else {
 		*typePtr = TCL_NUMBER_DOUBLE;
 	    }
-	    *clientDataPtr = &(objPtr->internalRep.doubleValue);
+	    *clientDataPtr = &objPtr->internalRep.doubleValue;
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclIntType) {
 	    *typePtr = TCL_NUMBER_LONG;
-	    *clientDataPtr = &(objPtr->internalRep.longValue);
+	    *clientDataPtr = &objPtr->internalRep.longValue;
 	    return TCL_OK;
 	}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 	if (objPtr->typePtr == &tclWideIntType) {
 	    *typePtr = TCL_NUMBER_WIDE;
-	    *clientDataPtr = &(objPtr->internalRep.wideValue);
+	    *clientDataPtr = &objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
 #endif
@@ -3614,7 +3666,8 @@ int TclGetNumberFromObj(
 	    static Tcl_ThreadDataKey bignumKey;
 	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
 		    (int) sizeof(mp_int));
-	    UNPACK_BIGNUM( objPtr, *bigPtr );
+
+	    UNPACK_BIGNUM(objPtr, *bigPtr);
 	    *typePtr = TCL_NUMBER_BIG;
 	    *clientDataPtr = bigPtr;
 	    return TCL_OK;
@@ -3649,7 +3702,7 @@ 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
+    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. */
@@ -3669,23 +3722,21 @@ Tcl_DbIncrRefCount(
      */
 
     if (!TclInExit()) {
-	Tcl_HashTable *tablePtr;
-	Tcl_HashEntry *hPtr;
 	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+	Tcl_HashEntry *hPtr;
 
-	tablePtr = tsdPtr->objThreadMap;
 	if (!tablePtr) {
 	    Tcl_Panic("object table not initialized");
 	}
-	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
 	if (!hPtr) {
-	    Tcl_Panic("%s%s",
-		    "Trying to incr ref count of "
-		    "Tcl_Obj allocated in another thread");
+	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+                    "incr ref count");
 	}
     }
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
     ++(objPtr)->refCount;
 }
 
@@ -3714,7 +3765,7 @@ void
 Tcl_DbDecrRefCount(
     register Tcl_Obj *objPtr,	/* The object we are releasing a reference
 				 * to. */
-    CONST char *file,		/* The name of the source file calling this
+    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. */
@@ -3734,24 +3785,23 @@ Tcl_DbDecrRefCount(
      */
 
     if (!TclInExit()) {
-	Tcl_HashTable *tablePtr;
-	Tcl_HashEntry *hPtr;
 	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+	Tcl_HashEntry *hPtr;
 
-	tablePtr = tsdPtr->objThreadMap;
 	if (!tablePtr) {
 	    Tcl_Panic("object table not initialized");
 	}
-	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
 	if (!hPtr) {
-	    Tcl_Panic("%s%s",
-		    "Trying to decr ref count of "
-		    "Tcl_Obj allocated in another thread");
+	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+                    "decr ref count");
 	}
     }
-# endif
-#endif
-    if (--(objPtr)->refCount <= 0) {
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
+
+    if (objPtr->refCount-- <= 1) {
 	TclFreeObj(objPtr);
     }
 }
@@ -3780,7 +3830,7 @@ 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
+    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. */
@@ -3800,22 +3850,21 @@ Tcl_DbIsShared(
      */
 
     if (!TclInExit()) {
-	Tcl_HashTable *tablePtr;
-	Tcl_HashEntry *hPtr;
 	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	tablePtr = tsdPtr->objThreadMap;
+	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+	Tcl_HashEntry *hPtr;
+
 	if (!tablePtr) {
 	    Tcl_Panic("object table not initialized");
 	}
-	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
 	if (!hPtr) {
-	    Tcl_Panic("%s%s",
-		    "Trying to check shared status of"
-		    "Tcl_Obj allocated in another thread");
+	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+                    "check shared status");
 	}
     }
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
 
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);
@@ -3827,7 +3876,7 @@ Tcl_DbIsShared(
 	tclObjsShared[0]++;
     }
     Tcl_MutexUnlock(&tclObjMutex);
-#endif
+#endif /* TCL_COMPILE_STATS */
 
     return ((objPtr)->refCount > 1);
 }
@@ -3881,11 +3930,10 @@ AllocObjEntry(
     Tcl_HashTable *tablePtr,	/* Hash table. */
     void *keyPtr)		/* Key to store in the hash table entry. */
 {
-    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
-    Tcl_HashEntry *hPtr;
+    Tcl_Obj *objPtr = keyPtr;
+    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
 
-    hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
-    hPtr->key.oneWordValue = (char *) objPtr;
+    hPtr->key.objPtr = objPtr;
     Tcl_IncrRefCount(objPtr);
     hPtr->clientData = NULL;
 
@@ -3914,18 +3962,17 @@ TclCompareObjKeys(
     void *keyPtr,		/* New key to compare. */
     Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
-    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+    Tcl_Obj *objPtr1 = keyPtr;
     Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
-    register CONST char *p1, *p2;
-    register int l1, l2;
+    register const char *p1, *p2;
+    register size_t l1, l2;
 
     /*
      * If the object pointers are the same then they match.
-     */
+     * OPT: this comparison was moved to the caller
 
-    if (objPtr1 == objPtr2) {
-	return 1;
-    }
+       if (objPtr1 == objPtr2) return 1;
+    */
 
     /*
      * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
@@ -3978,7 +4025,7 @@ TclFreeObjEntry(
     Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
 
     Tcl_DecrRefCount(objPtr);
-    ckfree((char *) hPtr);
+    ckfree(hPtr);
 }
 
 /*
@@ -4004,11 +4051,10 @@ TclHashObjKey(
     Tcl_HashTable *tablePtr,	/* Hash table. */
     void *keyPtr)		/* Key from which to compute hash value. */
 {
-    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
-    CONST char *string = TclGetString(objPtr);
-    int length = objPtr->length;
+    Tcl_Obj *objPtr = keyPtr;
+    int length;
+    const char *string = TclGetStringFromObj(objPtr, &length);
     unsigned int result = 0;
-    int i;
 
     /*
      * I tried a zillion different hash functions and asked many other people
@@ -4018,16 +4064,37 @@ TclHashObjKey(
      * following reasons:
      *
      * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
-     *	  multiplying by 9 is just about as good.
+     *    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.
+     *    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.
+     *
+     * See [tcl-Feature Request #2958832]
      */
 
-    for (i=0 ; i<length ; i++) {
-	result += (result << 3) + string[i];
+    if (length > 0) {
+	result = UCHAR(*string);
+	while (--length) {
+	    result += (result << 3) + UCHAR(*++string);
+	}
     }
     return result;
 }
@@ -4062,9 +4129,6 @@ Tcl_GetCommandFromObj(
 				 * global namespace. */
 {
     register ResolvedCmdName *resPtr;
-    register Command *cmdPtr;
-    Namespace *refNsPtr;
-    int result;
 
     /*
      * Get the internal representation, converting to a command type if
@@ -4085,31 +4149,37 @@ Tcl_GetCommandFromObj(
      * to discard the old rep and create a new one.
      */
 
-    resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
-    if ((objPtr->typePtr != &tclCmdNameType)
-	    || (resPtr == NULL)
-	    || (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch)
-	    || (cmdPtr->flags & CMD_IS_DELETED)
-	    || (interp != cmdPtr->nsPtr->interp)
-	    || (cmdPtr->nsPtr->flags & 	NS_DYING)
-	    || ((resPtr->refNsPtr != NULL) &&
-		     (((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp))
-			     != resPtr->refNsPtr)
-		     || (resPtr->refNsId != refNsPtr->nsId)
-		     || (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch)))
-	) {
-
-	result = tclCmdNameType.setFromAnyProc(interp, objPtr);
-
-	resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
-	if ((result == TCL_OK) && resPtr) {
-	    cmdPtr = resPtr->cmdPtr;
-	} else {
-	    cmdPtr = NULL;
-	}
+    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;
+            }
+        }
     }
 
-    return (Tcl_Command) cmdPtr;
+    /*
+     * OK, must create a new internal representation (or fail) as any cache we
+     * had is invalid one way or another.
+     */
+
+    /* See [] why we cannot call SetCmdNameFromAny() directly here. */
+    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
+        return NULL;
+    }
+    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
 }
 
 /*
@@ -4127,7 +4197,7 @@ Tcl_GetCommandFromObj(
  *	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
- *	TclExecuteByteCode has a chance to recognize that it was deleted.
+ *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
  *
  *----------------------------------------------------------------------
  */
@@ -4144,14 +4214,17 @@ TclSetCmdNameObj(
     Interp *iPtr = (Interp *) interp;
     register ResolvedCmdName *resPtr;
     register Namespace *currNsPtr;
-    char *name;
+    const char *name;
 
     if (objPtr->typePtr == &tclCmdNameType) {
-	return;
+	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+	if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
+	    return;
+	}
     }
 
     cmdPtr->refCount++;
-    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+    resPtr = ckalloc(sizeof(ResolvedCmdName));
     resPtr->cmdPtr = cmdPtr;
     resPtr->cmdEpoch = cmdPtr->cmdEpoch;
     resPtr->refCount = 1;
@@ -4177,7 +4250,7 @@ TclSetCmdNameObj(
     }
 
     TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
+    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     objPtr->typePtr = &tclCmdNameType;
 }
@@ -4208,8 +4281,7 @@ FreeCmdNameInternalRep(
     register Tcl_Obj *objPtr)	/* CmdName object with internal
 				 * representation to free. */
 {
-    register ResolvedCmdName *resPtr =
-	(ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     if (resPtr != NULL) {
 	/*
@@ -4217,8 +4289,7 @@ FreeCmdNameInternalRep(
 	 * there are no more uses, free the ResolvedCmdName structure.
 	 */
 
-	resPtr->refCount--;
-	if (resPtr->refCount == 0) {
+	if (resPtr->refCount-- == 1) {
 	    /*
 	     * Now free the cached command, unless it is still in its hash
 	     * table or if there are other references to it from other cmdName
@@ -4226,8 +4297,9 @@ FreeCmdNameInternalRep(
 	     */
 
 	    Command *cmdPtr = resPtr->cmdPtr;
+
 	    TclCleanupCommandMacro(cmdPtr);
-	    ckfree((char *) resPtr);
+	    ckfree(resPtr);
 	}
     }
     objPtr->typePtr = NULL;
@@ -4258,10 +4330,9 @@ DupCmdNameInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
-    register ResolvedCmdName *resPtr = (ResolvedCmdName *)
-	    srcPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
+    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
     if (resPtr != NULL) {
 	resPtr->refCount++;
@@ -4296,7 +4367,7 @@ SetCmdNameFromAny(
     register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     Interp *iPtr = (Interp *) interp;
-    char *name;
+    const char *name;
     register Command *cmdPtr;
     Namespace *currNsPtr;
     register ResolvedCmdName *resPtr;
@@ -4314,7 +4385,8 @@ SetCmdNameFromAny(
      */
 
     name = TclGetString(objPtr);
-    cmdPtr = (Command *) Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
+    cmdPtr = (Command *)
+	    Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
 
     /*
      * Free the old internalRep before setting the new one. Do this after
@@ -4324,7 +4396,7 @@ SetCmdNameFromAny(
 
     if (cmdPtr) {
 	cmdPtr->refCount++;
-	resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
+	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if ((objPtr->typePtr == &tclCmdNameType)
 		&& resPtr && (resPtr->refCount == 1)) {
 	    /*
@@ -4332,14 +4404,15 @@ SetCmdNameFromAny(
 	     */
 
 	    Command *oldCmdPtr = resPtr->cmdPtr;
+
 	    if (--oldCmdPtr->refCount == 0) {
 		TclCleanupCommandMacro(oldCmdPtr);
 	    }
 	} else {
 	    TclFreeIntRep(objPtr);
-	    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+	    resPtr = ckalloc(sizeof(ResolvedCmdName));
 	    resPtr->refCount = 1;
-	    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
+	    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
 	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 	    objPtr->typePtr = &tclCmdNameType;
 	}
@@ -4373,9 +4446,75 @@ SetCmdNameFromAny(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * 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 ptrBuffer[2*TCL_INTEGER_SPACE+6];
+    Tcl_Obj *descObj;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
+     * internal representation 0x45671234:0x98765432, string representation
+     * "1872361827361287"
+     */
+
+    sprintf(ptrBuffer, "%p", (void *) objv[1]);
+    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
+            " object pointer at %s",
+            objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+	    objv[1]->refCount, ptrBuffer);
+
+    if (objv[1]->typePtr) {
+	sprintf(ptrBuffer, "%p:%p",
+		(void *) objv[1]->internalRep.twoPtrValue.ptr1,
+		(void *) objv[1]->internalRep.twoPtrValue.ptr2);
+	Tcl_AppendPrintfToObj(descObj, ", internal representation %s",
+		ptrBuffer);
+    }
+
+    if (objv[1]->bytes) {
+        Tcl_AppendToObj(descObj, ", string representation \"", -1);
+	Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
+                16, "...");
+	Tcl_AppendToObj(descObj, "\"", -1);
+    } else {
+	Tcl_AppendToObj(descObj, ", no string representation", -1);
+    }
+
+    Tcl_SetObjResult(interp, descObj);
+    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/tclOptimize.c b/generic/tclOptimize.c
new file mode 100644
index 0000000..827d89d
--- /dev/null
+++ b/generic/tclOptimize.c
@@ -0,0 +1,444 @@
+/*
+ * tclOptimize.c --
+ *
+ *	This file contains the bytecode optimizer.
+ *
+ * Copyright (c) 2013 by Donal 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"
+#include <assert.h>
+
+/*
+ * Forward declarations.
+ */
+
+static void		AdvanceJumps(CompileEnv *envPtr);
+static void		ConvertZeroEffectToNOP(CompileEnv *envPtr);
+static void		LocateTargetAddresses(CompileEnv *envPtr,
+			    Tcl_HashTable *tablePtr);
+static void		TrimUnreachable(CompileEnv *envPtr);
+
+/*
+ * Helper macros.
+ */
+
+#define DefineTargetAddress(tablePtr, address) \
+    ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew))
+#define IsTargetAddress(tablePtr, address) \
+    (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL)
+#define AddrLength(address) \
+    (tclInstructionTable[*(unsigned char *)(address)].numBytes)
+#define InstLength(instruction) \
+    (tclInstructionTable[(unsigned char)(instruction)].numBytes)
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * LocateTargetAddresses --
+ *
+ *	Populate a hash table with places that we need to be careful around
+ *	because they're the targets of various kinds of jumps and other
+ *	non-local behavior.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+LocateTargetAddresses(
+    CompileEnv *envPtr,
+    Tcl_HashTable *tablePtr)
+{
+    unsigned char *currentInstPtr, *targetInstPtr;
+    int isNew, i;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch hSearch;
+
+    Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);
+
+    /*
+     * The starts of commands represent target addresses.
+     */
+
+    for (i=0 ; i<envPtr->numCommands ; i++) {
+	DefineTargetAddress(tablePtr,
+		envPtr->codeStart + envPtr->cmdMapPtr[i].codeOffset);
+    }
+
+    /*
+     * Find places where we should be careful about replacing instructions
+     * because they are the targets of various types of jumps.
+     */
+
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext ;
+	    currentInstPtr += AddrLength(currentInstPtr)) {
+	switch (*currentInstPtr) {
+	case INST_JUMP1:
+	case INST_JUMP_TRUE1:
+	case INST_JUMP_FALSE1:
+	    targetInstPtr = currentInstPtr+TclGetInt1AtPtr(currentInstPtr+1);
+	    goto storeTarget;
+	case INST_JUMP4:
+	case INST_JUMP_TRUE4:
+	case INST_JUMP_FALSE4:
+	case INST_START_CMD:
+	    targetInstPtr = currentInstPtr+TclGetInt4AtPtr(currentInstPtr+1);
+	    goto storeTarget;
+	case INST_BEGIN_CATCH4:
+	    targetInstPtr = envPtr->codeStart + envPtr->exceptArrayPtr[
+		    TclGetUInt4AtPtr(currentInstPtr+1)].codeOffset;
+	storeTarget:
+	    DefineTargetAddress(tablePtr, targetInstPtr);
+	    break;
+	case INST_JUMP_TABLE:
+	    hPtr = Tcl_FirstHashEntry(
+		    &JUMPTABLEINFO(envPtr, currentInstPtr+1)->hashTable,
+		    &hSearch);
+	    for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) {
+		targetInstPtr = currentInstPtr +
+			PTR2INT(Tcl_GetHashValue(hPtr));
+		DefineTargetAddress(tablePtr, targetInstPtr);
+	    }
+	    break;
+	case INST_RETURN_CODE_BRANCH:
+	    for (i=TCL_ERROR ; i<TCL_CONTINUE+1 ; i++) {
+		DefineTargetAddress(tablePtr, currentInstPtr + 2*i - 1);
+	    }
+	    break;
+	}
+    }
+
+    /*
+     * Add a marker *after* the last bytecode instruction. WARNING: points to
+     * one past the end!
+     */
+
+    DefineTargetAddress(tablePtr, currentInstPtr);
+
+    /*
+     * Enter in the targets of exception ranges.
+     */
+
+    for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
+	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+
+	if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+	    targetInstPtr = envPtr->codeStart + rangePtr->catchOffset;
+	    DefineTargetAddress(tablePtr, targetInstPtr);
+	} else {
+	    targetInstPtr = envPtr->codeStart + rangePtr->breakOffset;
+	    DefineTargetAddress(tablePtr, targetInstPtr);
+	    if (rangePtr->continueOffset >= 0) {
+		targetInstPtr = envPtr->codeStart + rangePtr->continueOffset;
+		DefineTargetAddress(tablePtr, targetInstPtr);
+	    }
+	}
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TrimUnreachable --
+ *
+ *	Converts code that provably can't be executed into NOPs and reduces
+ *	the overall reported length of the bytecode where that is possible.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+TrimUnreachable(
+    CompileEnv *envPtr)
+{
+    unsigned char *currentInstPtr;
+    Tcl_HashTable targets;
+
+    LocateTargetAddresses(envPtr, &targets);
+
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext-1 ;
+	    currentInstPtr += AddrLength(currentInstPtr)) {
+	int clear = 0;
+
+	if (*currentInstPtr != INST_DONE) {
+	    continue;
+	}
+
+	while (!IsTargetAddress(&targets, currentInstPtr + 1 + clear)) {
+	    clear += AddrLength(currentInstPtr + 1 + clear);
+	}
+	if (currentInstPtr + 1 + clear == envPtr->codeNext) {
+	    envPtr->codeNext -= clear;
+	} else {
+	    while (clear --> 0) {
+		*(currentInstPtr + 1 + clear) = INST_NOP;
+	    }
+	}
+    }
+
+    Tcl_DeleteHashTable(&targets);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ConvertZeroEffectToNOP --
+ *
+ *	Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
+ *	replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an
+ *	operation that guarantees the check for arithmeticity) and eliminate
+ *	LNOT when we can invert the following JUMP condition.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ConvertZeroEffectToNOP(
+    CompileEnv *envPtr)
+{
+    unsigned char *currentInstPtr;
+    int size;
+    Tcl_HashTable targets;
+
+    LocateTargetAddresses(envPtr, &targets);
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext ; currentInstPtr += size) {
+	int blank = 0, i, nextInst;
+
+	size = AddrLength(currentInstPtr);
+	while ((currentInstPtr + size < envPtr->codeNext)
+		&& *(currentInstPtr+size) == INST_NOP) {
+	    if (IsTargetAddress(&targets, currentInstPtr + size)) {
+		break;
+	    }
+	    size += InstLength(INST_NOP);
+	}
+	if (IsTargetAddress(&targets, currentInstPtr + size)) {
+	    continue;
+	}
+	nextInst = *(currentInstPtr + size);
+	switch (*currentInstPtr) {
+	case INST_PUSH1:
+	    if (nextInst == INST_POP) {
+		blank = size + InstLength(nextInst);
+	    } else if (nextInst == INST_STR_CONCAT1
+		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
+		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
+			TclGetUInt1AtPtr(currentInstPtr + 1));
+		int numBytes;
+
+		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
+		if (numBytes == 0) {
+		    blank = size + InstLength(nextInst);
+		}
+	    }
+	    break;
+	case INST_PUSH4:
+	    if (nextInst == INST_POP) {
+		blank = size + 1;
+	    } else if (nextInst == INST_STR_CONCAT1
+		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
+		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
+			TclGetUInt4AtPtr(currentInstPtr + 1));
+		int numBytes;
+
+		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
+		if (numBytes == 0) {
+		    blank = size + InstLength(nextInst);
+		}
+	    }
+	    break;
+
+	case INST_LNOT:
+	    switch (nextInst) {
+	    case INST_JUMP_TRUE1:
+		blank = size;
+		*(currentInstPtr + size) = INST_JUMP_FALSE1;
+		break;
+	    case INST_JUMP_FALSE1:
+		blank = size;
+		*(currentInstPtr + size) = INST_JUMP_TRUE1;
+		break;
+	    case INST_JUMP_TRUE4:
+		blank = size;
+		*(currentInstPtr + size) = INST_JUMP_FALSE4;
+		break;
+	    case INST_JUMP_FALSE4:
+		blank = size;
+		*(currentInstPtr + size) = INST_JUMP_TRUE4;
+		break;
+	    }
+	    break;
+
+	case INST_TRY_CVT_TO_NUMERIC:
+	    switch (nextInst) {
+	    case INST_JUMP_TRUE1:
+	    case INST_JUMP_TRUE4:
+	    case INST_JUMP_FALSE1:
+	    case INST_JUMP_FALSE4:
+	    case INST_INCR_SCALAR1:
+	    case INST_INCR_ARRAY1:
+	    case INST_INCR_ARRAY_STK:
+	    case INST_INCR_SCALAR_STK:
+	    case INST_INCR_STK:
+	    case INST_LOR:
+	    case INST_LAND:
+	    case INST_EQ:
+	    case INST_NEQ:
+	    case INST_LT:
+	    case INST_LE:
+	    case INST_GT:
+	    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:
+	    case INST_LNOT:
+	    case INST_BITNOT:
+	    case INST_UMINUS:
+	    case INST_UPLUS:
+	    case INST_TRY_CVT_TO_NUMERIC:
+		blank = size;
+		break;
+	    }
+	    break;
+	}
+
+	if (blank > 0) {
+	    for (i=0 ; i<blank ; i++) {
+		*(currentInstPtr + i) = INST_NOP;
+	    }
+	    size = blank;
+	}
+    }
+    Tcl_DeleteHashTable(&targets);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AdvanceJumps --
+ *
+ *	Advance jumps past NOPs and chained JUMPs. After this runs, the only
+ *	JUMPs that jump to a NOP or a JUMP will be length-1 ones that run out
+ *	of room in their opcode to be targeted to where they really belong.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AdvanceJumps(
+    CompileEnv *envPtr)
+{
+    unsigned char *currentInstPtr;
+    Tcl_HashTable jumps;
+
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext-1 ;
+	    currentInstPtr += AddrLength(currentInstPtr)) {
+	int offset, delta, isNew;
+
+	switch (*currentInstPtr) {
+	case INST_JUMP1:
+	case INST_JUMP_TRUE1:
+	case INST_JUMP_FALSE1:
+	    offset = TclGetInt1AtPtr(currentInstPtr + 1);
+	    Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
+	    for (delta=0 ; offset+delta != 0 ;) {
+		if (offset + delta < -128 || offset + delta > 127) {
+		    break;
+		}
+		Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+		if (!isNew) {
+		    offset = TclGetInt1AtPtr(currentInstPtr + 1);
+		    break;
+		}
+		offset += delta;
+		switch (*(currentInstPtr + offset)) {
+		case INST_NOP:
+		    delta = InstLength(INST_NOP);
+		    continue;
+		case INST_JUMP1:
+		    delta = TclGetInt1AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		case INST_JUMP4:
+		    delta = TclGetInt4AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		}
+		break;
+	    }
+	    Tcl_DeleteHashTable(&jumps);
+	    TclStoreInt1AtPtr(offset, currentInstPtr + 1);
+	    continue;
+
+	case INST_JUMP4:
+	case INST_JUMP_TRUE4:
+	case INST_JUMP_FALSE4:
+	    Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
+	    Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew);
+	    for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) {
+		Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+		if (!isNew) {
+		    offset = TclGetInt4AtPtr(currentInstPtr + 1);
+		    break;
+		}
+		switch (*(currentInstPtr + offset)) {
+		case INST_NOP:
+		    offset += InstLength(INST_NOP);
+		    continue;
+		case INST_JUMP1:
+		    offset += TclGetInt1AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		case INST_JUMP4:
+		    offset += TclGetInt4AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		}
+		break;
+	    }
+	    Tcl_DeleteHashTable(&jumps);
+	    TclStoreInt4AtPtr(offset, currentInstPtr + 1);
+	    continue;
+	}
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOptimizeBytecode --
+ *
+ *	A very simple peephole optimizer for bytecode.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOptimizeBytecode(
+    void *envPtr)
+{
+    ConvertZeroEffectToNOP(envPtr);
+    AdvanceJumps(envPtr);
+    TrimUnreachable(envPtr);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 600307e..b032449 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -14,20 +14,20 @@
  */
 
 #include "tclInt.h"
+#if defined(_WIN32) || defined(__CYGWIN__)
+    MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
+#endif
 
 /*
  * The panicProc variable contains a pointer to an application specific panic
  * procedure.
  */
 
-static Tcl_PanicProc *panicProc = NULL;
-
-/*
- * The platformPanicProc variable contains a pointer to a platform specific
- * panic procedure, if any. (TclpPanic may be NULL via a macro.)
- */
-
-static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
+#if defined(__CYGWIN__)
+static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
+#else
+static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -47,8 +47,16 @@ static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
 
 void
 Tcl_SetPanicProc(
-    Tcl_PanicProc *proc)
+    TCL_NORETURN1 Tcl_PanicProc *proc)
 {
+#if defined(_WIN32)
+    /* tclWinDebugPanic only installs if there is no panicProc yet. */
+    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#elif defined(__CYGWIN__)
+    if (proc == NULL)
+	panicProc = tclWinDebugPanic;
+    else
+#endif
     panicProc = proc;
 }
 
@@ -70,13 +78,13 @@ Tcl_SetPanicProc(
 
 void
 Tcl_PanicVA(
-    CONST char *format,		/* Format string, suitable for passing to
+    const char *format,		/* Format string, suitable for passing to
 				 * fprintf. */
     va_list argList)		/* Variable argument list. */
 {
-    char *arg1, *arg2, *arg3, *arg4;	/* Additional arguments (variable in
-					 * number) to pass to fprintf. */
-    char *arg5, *arg6, *arg7, *arg8;
+    char *arg1, *arg2, *arg3;	/* Additional arguments (variable in number)
+				 * to pass to fprintf. */
+    char *arg4, *arg5, *arg6, *arg7, *arg8;
 
     arg1 = va_arg(argList, char *);
     arg2 = va_arg(argList, char *);
@@ -88,17 +96,32 @@ Tcl_PanicVA(
     arg8 = va_arg(argList, char *);
 
     if (panicProc != NULL) {
-	(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);
+	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
     } else {
-	(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
-		arg7, arg8);
-	(void) fprintf(stderr, "\n");
-	(void) fflush(stderr);
+	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
+		arg8);
+	fprintf(stderr, "\n");
+	fflush(stderr);
+#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
     }
 }
 
@@ -118,10 +141,17 @@ Tcl_PanicVA(
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
+/* ARGSUSED */
+
+/*
+ * The following comment is here so that Coverity's static analizer knows that
+ * a Tcl_Panic() call can never return and avoids lots of false positives.
+ */
+
+/* coverity[+kill] */
 void
 Tcl_Panic(
-    CONST char *format,
+    const char *format,
     ...)
 {
     va_list argList;
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 6f989d9..ce87fb0 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -14,6 +14,8 @@
  */
 
 #include "tclInt.h"
+#include "tclParse.h"
+#include <assert.h>
 
 /*
  * The following table provides parsing information about each possible 8-bit
@@ -41,18 +43,7 @@
  * TYPE_BRACE -		Character is a curly brace (either left or right).
  */
 
-#define TYPE_NORMAL		0
-#define TYPE_SPACE		0x1
-#define TYPE_COMMAND_END	0x2
-#define TYPE_SUBS		0x4
-#define TYPE_QUOTE		0x8
-#define TYPE_CLOSE_PAREN	0x10
-#define TYPE_CLOSE_BRACK	0x20
-#define TYPE_BRACE		0x40
-
-#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-
-static const char charTypeTable[] = {
+const char tclCharTypeTable[] = {
     /*
      * Negative character values, from -128 to -1:
      */
@@ -182,13 +173,13 @@ static int		ParseWhiteSpace(const char *src, int numBytes,
  *
  * TclParseInit --
  *
- * 	Initialize the fields of a Tcl_Parse struct.
+ *	Initialize the fields of a Tcl_Parse struct.
  *
  * Results:
- * 	None.
+ *	None.
  *
  * Side effects:
- * 	The Tcl_Parse struct pointed to by parsePtr gets initialized.
+ *	The Tcl_Parse struct pointed to by parsePtr gets initialized.
  *
  *----------------------------------------------------------------------
  */
@@ -251,7 +242,7 @@ Tcl_ParseCommand(
 				 * command terminator. If zero, then close
 				 * bracket has no special meaning. */
     register Tcl_Parse *parsePtr)
-    				/* Structure to fill in with information about
+				/* Structure to fill in with information about
 				 * the parsed command; any previous
 				 * information in the structure is ignored. */
 {
@@ -268,7 +259,8 @@ Tcl_ParseCommand(
 
     if ((start == NULL) && (numBytes != 0)) {
 	if (interp != NULL) {
-	    Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't parse a NULL pointer", -1));
 	}
 	return TCL_ERROR;
     }
@@ -496,9 +488,10 @@ Tcl_ParseCommand(
 		     * tokens representing the expanded list.
 		     */
 
-		    CONST char *listStart;
+		    const char *listStart;
 		    int growthNeeded = wordIndex + 2*elemCount
 			    - parsePtr->numTokens;
+
 		    parsePtr->numWords += elemCount - 1;
 		    if (growthNeeded > 0) {
 			TclGrowParseTokenArray(parsePtr, growthNeeded);
@@ -577,14 +570,14 @@ Tcl_ParseCommand(
 	}
 	if (src[-1] == '"') {
 	    if (interp != NULL) {
-		Tcl_SetResult(interp, "extra characters after close-quote",
-			TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"extra characters after close-quote", -1));
 	    }
 	    parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
 	} else {
 	    if (interp != NULL) {
-		Tcl_SetResult(interp, "extra characters after close-brace",
-			TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"extra characters after close-brace", -1));
 	    }
 	    parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
 	}
@@ -713,7 +706,7 @@ ParseWhiteSpace(
 	    if (p[1] != '\n') {
 		break;
 	    }
-	    p+=2;
+	    p += 2;
 	    if (--numBytes == 0) {
 		*incompletePtr = 1;
 		break;
@@ -784,21 +777,21 @@ int
 TclParseHex(
     const char *src,		/* First character to parse. */
     int numBytes,		/* Max number of byes to scan */
-    Tcl_UniChar *resultPtr)	/* Points to storage provided by caller where
-				 * the Tcl_UniChar resulting from the
+    int *resultPtr)	/* Points to storage provided by caller where
+				 * the character resulting from the
 				 * conversion is to be written. */
 {
-    Tcl_UniChar result = 0;
+    int result = 0;
     register const char *p = src;
 
     while (numBytes--) {
 	unsigned char digit = UCHAR(*p);
 
-	if (!isxdigit(digit)) {
+	if (!isxdigit(digit) || (result > 0x10fff)) {
 	    break;
 	}
 
-	++p;
+	p++;
 	result <<= 4;
 
 	if (digit >= 'a') {
@@ -823,14 +816,14 @@ TclParseHex(
  *	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.
  *
  *----------------------------------------------------------------------
  */
@@ -848,7 +841,8 @@ TclParseBackslash(
 				 * written there. */
 {
     register const char *p = src+1;
-    Tcl_UniChar result;
+    Tcl_UniChar unichar;
+    int result;
     int count;
     char buf[TCL_UTF_MAX];
 
@@ -905,7 +899,7 @@ TclParseBackslash(
 	result = 0xb;
 	break;
     case 'x':
-	count += TclParseHex(p+1, numBytes-2, &result);
+	count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result);
 	if (count == 2) {
 	    /*
 	     * No hexadigits -> This is just "x".
@@ -928,6 +922,15 @@ TclParseBackslash(
 	    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 {
@@ -946,21 +949,21 @@ TclParseBackslash(
 	 */
 
 	if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) {	/* INTL: digit */
-	    result = (unsigned char)(*p - '0');
+	    result = *p - '0';
 	    p++;
 	    if ((numBytes == 2) || !isdigit(UCHAR(*p))	/* INTL: digit */
 		    || (UCHAR(*p) >= '8')) {
 		break;
 	    }
 	    count = 3;
-	    result = (unsigned char)((result << 3) + (*p - '0'));
+	    result = (result << 3) + (*p - '0');
 	    p++;
 	    if ((numBytes == 3) || !isdigit(UCHAR(*p))	/* INTL: digit */
-		    || (UCHAR(*p) >= '8')) {
+		    || (UCHAR(*p) >= '8') || (result >= 0x20)) {
 		break;
 	    }
 	    count = 4;
-	    result = (unsigned char)((result << 3) + (*p - '0'));
+	    result = UCHAR((result << 3) + (*p - '0'));
 	    break;
 	}
 
@@ -972,14 +975,15 @@ TclParseBackslash(
 	 */
 
 	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
-	    count = Tcl_UtfToUniChar(p, &result) + 1;	/* +1 for '\' */
+	    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, &result) + 1;
+	    count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
 	}
+	result = unichar;
 	break;
     }
 
@@ -987,7 +991,7 @@ TclParseBackslash(
     if (readPtr != NULL) {
 	*readPtr = count;
     }
-    return Tcl_UniCharToUtf((int) result, dst);
+    return Tcl_UniCharToUtf(result, dst);
 }
 
 /*
@@ -999,11 +1003,11 @@ TclParseBackslash(
  *	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.
  *
  *----------------------------------------------------------------------
  */
@@ -1156,7 +1160,7 @@ ParseTokens(
 	    }
 
 	    /*
-	     * This is a variable reference.  Call Tcl_ParseVarName to do all
+	     * This is a variable reference. Call Tcl_ParseVarName to do all
 	     * the dirty work of parsing the name.
 	     */
 
@@ -1180,18 +1184,17 @@ ParseTokens(
 	    }
 
 	    /*
-	     * Command substitution.  Call Tcl_ParseCommand recursively (and
+	     * Command substitution. Call Tcl_ParseCommand recursively (and
 	     * repeatedly) to parse the nested command(s), then throw away the
 	     * parse information.
 	     */
 
 	    src++;
 	    numBytes--;
-	    nestedPtr = (Tcl_Parse *)
-		    TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
+	    nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
 	    while (1) {
 		const char *curEnd;
-		
+
 		if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
 			nestedPtr) != TCL_OK) {
 		    parsePtr->errorType = nestedPtr->errorType;
@@ -1218,8 +1221,8 @@ ParseTokens(
 		}
 		if (numBytes == 0) {
 		    if (parsePtr->interp != NULL) {
-			Tcl_SetResult(parsePtr->interp,
-				"missing close-bracket", TCL_STATIC);
+			Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+				"missing close-bracket", -1));
 		    }
 		    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
 		    parsePtr->term = tokenPtr->start;
@@ -1337,7 +1340,7 @@ Tcl_FreeParse(
 				 * call to Tcl_ParseCommand. */
 {
     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
-	ckfree((char *) parsePtr->tokenPtr);
+	ckfree(parsePtr->tokenPtr);
 	parsePtr->tokenPtr = parsePtr->staticTokens;
     }
 }
@@ -1452,8 +1455,8 @@ Tcl_ParseVarName(
 	}
 	if (numBytes == 0) {
 	    if (parsePtr->interp != NULL) {
-		Tcl_SetResult(parsePtr->interp,
-			"missing close-brace for variable name", TCL_STATIC);
+		Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+			"missing close-brace for variable name", -1));
 	    }
 	    parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
 	    parsePtr->term = tokenPtr->start-1;
@@ -1510,8 +1513,8 @@ Tcl_ParseVarName(
 	    }
 	    if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
 		if (parsePtr->interp != NULL) {
-		    Tcl_SetResult(parsePtr->interp, "missing )",
-			    TCL_STATIC);
+		    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+			    "missing )", -1));
 		}
 		parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
 		parsePtr->term = src;
@@ -1576,8 +1579,7 @@ Tcl_ParseVar(
 {
     register Tcl_Obj *objPtr;
     int code;
-    Tcl_Parse *parsePtr = (Tcl_Parse *)
-	    TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
 
     if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
 	TclStackFree(interp, parsePtr);
@@ -1609,16 +1611,13 @@ Tcl_ParseVar(
      * 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
+     * Since TclSubstTokens above returned TCL_OK, we know that objPtr
+     * is shared.  It is in both the interp result and the value of the
+     * variable.  Returning the string relies on that to be true.
      */
 
-    if (!Tcl_IsShared(objPtr)) {
-	Tcl_IncrRefCount(objPtr);
-    }
+    assert( Tcl_IsShared(objPtr) );
+
     Tcl_ResetResult(interp);
     return TclGetString(objPtr);
 }
@@ -1661,7 +1660,7 @@ Tcl_ParseBraces(
 				 * the string consists of all bytes up to the
 				 * first null character. */
     register Tcl_Parse *parsePtr,
-    				/* Structure to fill in with information about
+				/* Structure to fill in with information about
 				 * the string. */
     int append,			/* Non-zero means append tokens to existing
 				 * information in parsePtr; zero means ignore
@@ -1788,7 +1787,8 @@ Tcl_ParseBraces(
 	goto error;
     }
 
-    Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
+    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+	    "missing close-brace", -1));
 
     /*
      * Guess if the problem is due to comments by searching the source string
@@ -1810,8 +1810,8 @@ Tcl_ParseBraces(
 		break;
 	    case '#' :
 		if (openBrace && TclIsSpaceProc(src[-1])) {
-		    Tcl_AppendResult(parsePtr->interp,
-			    ": possible unbalanced brace in comment", NULL);
+		    Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp),
+			    ": possible unbalanced brace in comment", -1);
 		    goto error;
 		}
 		break;
@@ -1862,7 +1862,7 @@ Tcl_ParseQuotedString(
 				 * the string consists of all bytes up to the
 				 * first null character. */
     register Tcl_Parse *parsePtr,
-    				/* Structure to fill in with information about
+				/* Structure to fill in with information about
 				 * the string. */
     int append,			/* Non-zero means append tokens to existing
 				 * information in parsePtr; zero means ignore
@@ -1890,7 +1890,8 @@ Tcl_ParseQuotedString(
     }
     if (*parsePtr->term != '"') {
 	if (parsePtr->interp != NULL) {
-	    Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
+	    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+		    "missing \"", -1));
 	}
 	parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
 	parsePtr->term = start;
@@ -1910,33 +1911,42 @@ Tcl_ParseQuotedString(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SubstObj --
+ * TclSubstParse --
  *
- *	This function performs the substitutions specified on the given string
- *	as described in the user documentation for the "subst" Tcl command.
+ *	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:
- *	A Tcl_Obj* containing the substituted string, or NULL to indicate that
- *	an error occurred.
+ *	None.
  *
  * Side effects:
- *	See the user documentation.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+void
+TclSubstParse(
+    Tcl_Interp *interp,
+    const char *bytes,
+    int numBytes,
+    int flags,
+    Tcl_Parse *parsePtr,
+    Tcl_InterpState *statePtr)
 {
-    int length, tokensLeft, code;
-    Tcl_Token *endTokenPtr;
-    Tcl_Obj *result, *errMsg = NULL;
-    const char *p = TclGetStringFromObj(objPtr, &length);
-    Tcl_Parse *parsePtr = (Tcl_Parse *)
-	    TclStackAlloc(interp, sizeof(Tcl_Parse));
+    int length = numBytes;
+    const char *p = bytes;
 
     TclParseInit(interp, p, length, parsePtr);
 
@@ -1948,12 +1958,11 @@ Tcl_SubstObj(
 
     if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) {
 	/*
-	 * There was a parse error. Save the error message for possible
-	 * reporting later.
+	 * There was a parse error. Save the interpreter state for possible
+	 * error reporting later.
 	 */
 
-	errMsg = Tcl_GetObjResult(interp);
-	Tcl_IncrRefCount(errMsg);
+	*statePtr = Tcl_SaveInterpState(interp, TCL_ERROR);
 
 	/*
 	 * We need to re-parse to get the portion of the string we can [subst]
@@ -2019,10 +2028,10 @@ Tcl_SubstObj(
 			parsePtr->tokenPtr + parsePtr->numTokens - 2;
 
 		if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
-		    Tcl_Panic("Tcl_SubstObj: programming error");
+		    Tcl_Panic("TclSubstParse: programming error");
 		}
 		if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
-		    Tcl_Panic("Tcl_SubstObj: programming error");
+		    Tcl_Panic("TclSubstParse: programming error");
 		}
 		parsePtr->numTokens -= 2;
 	    }
@@ -2051,7 +2060,7 @@ Tcl_SubstObj(
 
 		Tcl_Token *tokenPtr;
 		const char *lastTerm = parsePtr->term;
-		Tcl_Parse *nestedPtr = (Tcl_Parse *)
+		Tcl_Parse *nestedPtr =
 			TclStackAlloc(interp, sizeof(Tcl_Parse));
 
 		while (TCL_OK ==
@@ -2096,64 +2105,9 @@ Tcl_SubstObj(
 	    break;
 
 	default:
-	    Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
+	    Tcl_Panic("bad parse in TclSubstParse: %c", p[length]);
 	}
     }
-
-    /*
-     * Next, substitute the parsed tokens just as in normal Tcl evaluation.
-     */
-
-    endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
-    tokensLeft = parsePtr->numTokens;
-    code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
-	    &tokensLeft, 1, NULL, NULL);
-    if (code == TCL_OK) {
-	Tcl_FreeParse(parsePtr);
-	TclStackFree(interp, parsePtr);
-	if (errMsg != NULL) {
-	    Tcl_SetObjResult(interp, errMsg);
-	    Tcl_DecrRefCount(errMsg);
-	    return NULL;
-	}
-	return Tcl_GetObjResult(interp);
-    }
-
-    result = Tcl_NewObj();
-    while (1) {
-	switch (code) {
-	case TCL_ERROR:
-	    Tcl_FreeParse(parsePtr);
-	    TclStackFree(interp, parsePtr);
-	    Tcl_DecrRefCount(result);
-	    if (errMsg != NULL) {
-		Tcl_DecrRefCount(errMsg);
-	    }
-	    return NULL;
-	case TCL_BREAK:
-	    tokensLeft = 0;		/* Halt substitution */
-	default:
-	    Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
-	}
-
-	if (tokensLeft == 0) {
-	    Tcl_FreeParse(parsePtr);
-	    TclStackFree(interp, parsePtr);
-	    if (errMsg != NULL) {
-		if (code != TCL_BREAK) {
-		    Tcl_DecrRefCount(result);
-		    Tcl_SetObjResult(interp, errMsg);
-		    Tcl_DecrRefCount(errMsg);
-		    return NULL;
-		}
-		Tcl_DecrRefCount(errMsg);
-	    }
-	    return result;
-	}
-
-	code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
-		&tokensLeft, 1, NULL, NULL);
-    }
 }
 
 /*
@@ -2167,13 +2121,13 @@ Tcl_SubstObj(
  *	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.
+ *	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.
+ *	Can be anything, depending on the types of substitution done.
  *
  *----------------------------------------------------------------------
  */
@@ -2191,29 +2145,30 @@ TclSubstTokens(
 				 * integer representing the number of tokens
 				 * left to be substituted will be written */
     int line,			/* The line the script starts on. */
-    int*  clNextOuter,       /* Information about an outer context for */
-    CONST char* outerScript) /* continuation line data. This is set by
-			      * EvalEx() to properly handle [...]-nested
-			      * commands. The 'outerScript' refers to the
-			      * most-outer script containing the embedded
-			      * command, which is refered to by 'script'. The
-			      * 'clNextOuter' refers to the current entry in
-			      * the table of continuation lines in this
-			      * "master script", and the character offsets are
-			      * relative to the 'outerScript' as well.
-			      *
-			      * If outerScript == script, then this call is for
-			      * words in the outer-most script/command. See
-			      * Tcl_EvalEx() and TclEvalObjEx() for the places
-			      * generating arguments for which this is true.
-			      */
+    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 *clPosition = NULL;
+    Interp *iPtr = (Interp *) interp;
     int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
 
     /*
@@ -2230,24 +2185,24 @@ TclSubstTokens(
      * 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.
      */
 
-    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 = (int*) ckalloc (maxNumCL*sizeof(int));
+	maxNumCL = NUM_STATIC_POS;
+	clPosition = ckalloc(maxNumCL * sizeof(int));
     }
 
     adjust = 0;
@@ -2268,6 +2223,7 @@ TclSubstTokens(
 	    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
@@ -2283,10 +2239,11 @@ TclSubstTokens(
 	     * correction.
 	     */
 
-	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') &&
-		(tokenPtr->start[1] == '\n')) {
+	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
+		    && (tokenPtr->start[1] == '\n')) {
 		if (isLiteral) {
 		    int clPos;
+
 		    if (result == 0) {
 			clPos = 0;
 		    } else {
@@ -2295,19 +2252,18 @@ TclSubstTokens(
 
 		    if (numCL >= maxNumCL) {
 			maxNumCL *= 2;
-			clPosition = (int*) ckrealloc ((char*)clPosition,
-						       maxNumCL*sizeof(int));
+			clPosition = ckrealloc(clPosition,
+				maxNumCL * sizeof(int));
 		    }
 		    clPosition[numCL] = clPos;
-		    numCL ++;
+		    numCL++;
 		}
-		adjust ++;
+		adjust++;
 	    }
 	    break;
 
 	case TCL_TOKEN_COMMAND: {
-	    Interp *iPtr = (Interp *) interp;
-
+	    /* TIP #280: Transfer line information to nested command */
 	    iPtr->numLevels++;
 	    code = TclInterpReady(interp);
 	    if (code == TCL_OK) {
@@ -2316,21 +2272,27 @@ TclSubstTokens(
 		 */
 
 		int theline;
-		TclAdvanceContinuations (&line, &clNextOuter,
-					 tokenPtr->start - outerScript);
+
+		TclAdvanceContinuations(&line, &clNextOuter,
+			tokenPtr->start - outerScript);
 		theline = line + adjust;
-		/* TIP #280: Transfer line information to nested command */
 		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
 			0, theline, clNextOuter, outerScript);
+
+		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) {
+
+		if (inFile) {
 		    iPtr->evalFlags |= TCL_EVAL_FILE;
 		}
 	    }
 	    iPtr->numLevels--;
+	    TclResetCancellation(interp, 0);
 	    appendObj = Tcl_GetObjResult(interp);
 	    break;
 	}
@@ -2429,6 +2391,7 @@ TclSubstTokens(
     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
@@ -2447,7 +2410,7 @@ TclSubstTokens(
 	     */
 
 	    if (maxNumCL) {
-		ckfree ((char*) clPosition);
+		ckfree(clPosition);
 	    }
 	} else {
 	    Tcl_ResetResult(interp);
diff --git a/generic/tclParse.h b/generic/tclParse.h
new file mode 100644
index 0000000..20c609c
--- /dev/null
+++ b/generic/tclParse.h
@@ -0,0 +1,17 @@
+/*
+ * 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) (tclCharTypeTable+128)[(int)(c)]
+
+MODULE_SCOPE const char tclCharTypeTable[];
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 88e49b5..31ed68e 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -35,7 +35,7 @@ static int		MakePathFromNormalized(Tcl_Interp *interp,
  * internally.
  */
 
-static Tcl_ObjType tclFsPathType = {
+static const Tcl_ObjType tclFsPathType = {
     "path",				/* name */
     FreeFsPathInternalRep,		/* freeIntRepProc */
     DupFsPathInternalRep,		/* dupIntRepProc */
@@ -94,7 +94,7 @@ typedef struct FsPath {
 				 * generated during the correct filesystem
 				 * epoch. The epoch changes when
 				 * filesystem-mounts are changed. */
-    Tcl_Filesystem *fsPtr;	/* The Tcl_Filesystem that claims this path */
+    const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
 } FsPath;
 
 /*
@@ -231,7 +231,7 @@ TclFSNormalizeAbsolutePath(
 		    retVal = Tcl_NewStringObj(path, dirSep - path);
 		    Tcl_IncrRefCount(retVal);
 		}
-		(void) Tcl_GetStringFromObj(retVal, &curLen);
+		Tcl_GetStringFromObj(retVal, &curLen);
 		if (curLen == 0) {
 		    Tcl_AppendToObj(retVal, dirSep, 1);
 		}
@@ -243,7 +243,7 @@ TclFSNormalizeAbsolutePath(
 		continue;
 	    }
 	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
-		Tcl_Obj *link;
+		Tcl_Obj *linkObj;
 		int curLen;
 		char *linkStr;
 
@@ -257,12 +257,12 @@ TclFSNormalizeAbsolutePath(
 		    retVal = Tcl_NewStringObj(path, dirSep - path);
 		    Tcl_IncrRefCount(retVal);
 		}
-		(void) Tcl_GetStringFromObj(retVal, &curLen);
+		Tcl_GetStringFromObj(retVal, &curLen);
 		if (curLen == 0) {
 		    Tcl_AppendToObj(retVal, dirSep, 1);
 		}
 		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
-		    link = Tcl_FSLink(retVal, NULL, 0);
+		    linkObj = Tcl_FSLink(retVal, NULL, 0);
 
 		    /* Safety check in case driver caused sharing */
 		    if (Tcl_IsShared(retVal)) {
@@ -271,15 +271,16 @@ TclFSNormalizeAbsolutePath(
 			Tcl_IncrRefCount(retVal);
 		    }
 
-		    if (link != NULL) {
+		    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(link) == TCL_PATH_RELATIVE) {
+			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
@@ -300,8 +301,8 @@ TclFSNormalizeAbsolutePath(
 			     */
 
 			    Tcl_SetObjLength(retVal, curLen+1);
-			    Tcl_AppendObjToObj(retVal, link);
-			    TclDecrRefCount(link);
+			    Tcl_AppendObjToObj(retVal, linkObj);
+			    TclDecrRefCount(linkObj);
 			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
 			} else {
 			    /*
@@ -309,11 +310,11 @@ TclFSNormalizeAbsolutePath(
 			     */
 
 			    TclDecrRefCount(retVal);
-			    if (Tcl_IsShared(link)) {
-				retVal = Tcl_DuplicateObj(link);
-				TclDecrRefCount(link);
+			    if (Tcl_IsShared(linkObj)) {
+				retVal = Tcl_DuplicateObj(linkObj);
+				TclDecrRefCount(linkObj);
 			    } else {
-				retVal = link;
+				retVal = linkObj;
 			    }
 			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
 
@@ -336,8 +337,8 @@ TclFSNormalizeAbsolutePath(
 		    }
 
 		    /*
-		     * Either way, we now remove the last path element.
-		     * (but not the first character of the path)
+		     * Either way, we now remove the last path element (but
+		     * not the first character of the path).
 		     */
 
 		    while (--curLen >= 0) {
@@ -398,7 +399,7 @@ TclFSNormalizeAbsolutePath(
     }
 
     /*
-     * Ensure a windows drive like C:/ has a trailing separator
+     * Ensure a windows drive like C:/ has a trailing separator.
      */
 
     if (tclPlatform == TCL_PLATFORM_WINDOWS) {
@@ -493,7 +494,7 @@ Tcl_FSGetPathType(
 Tcl_PathType
 TclFSGetPathType(
     Tcl_Obj *pathPtr,
-    Tcl_Filesystem **filesystemPtrPtr,
+    const Tcl_Filesystem **filesystemPtrPtr,
     int *driveNameLengthPtr)
 {
     FsPath *fsPathPtr;
@@ -511,7 +512,7 @@ TclFSGetPathType(
 
     if (PATHFLAGS(pathPtr) == 0) {
 	/* The path is not absolute... */
-#ifdef __WIN32__
+#ifdef _WIN32
 	/* ... on Windows we must make another call to determine whether
 	 * it's relative or volumerelative [Bug 2571597]. */
 	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
@@ -827,44 +828,39 @@ Tcl_FSJoinPath(
 				 * reference count. */
     int elements)		/* Number of elements to use (-1 = all) */
 {
-    Tcl_Obj *res;
-    int i;
-    Tcl_Filesystem *fsPtr = NULL;
-
-    if (elements < 0) {
-	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
-	    return NULL;
-	}
-    } else {
-	/*
-	 * Just make sure it is a valid list.
-	 */
-
-	int listTest;
+    Tcl_Obj *copy, *res;
+    int objc;
+    Tcl_Obj **objv;
 
-	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
-	    return NULL;
-	}
+    if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
+	return NULL;
+    }
 
-	/*
-	 * Correct this if it is too large, otherwise we will waste our time
-	 * joining null elements to the path.
-	 */
+    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;
+}
 
-	if (elements > listTest) {
-	    elements = listTest;
-	}
-    }
+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++) {
-	Tcl_Obj *elt, *driveName = NULL;
 	int driveNameLength, strEltLen, length;
 	Tcl_PathType type;
 	char *strElt, *ptr;
-
-	Tcl_ListObjIndex(NULL, listObj, i, &elt);
+	Tcl_Obj *driveName = NULL;
+	Tcl_Obj *elt = objv[i];
 
 	/*
 	 * This is a special case where we can be much more efficient, where
@@ -873,19 +869,23 @@ Tcl_FSJoinPath(
 	 * 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.
+         *
+         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
+         * to be an absolute path. Added a check for that elt is absolute.
 	 */
 
-	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
-		&& !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
-	    Tcl_Obj *tail;
+	if ((i == (elements-2)) && (i == 0)
+                && (elt->typePtr == &tclFsPathType)
+		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
+                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
+            Tcl_Obj *tailObj = objv[i+1];
 
-	    Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
-	    type = TclGetPathType(tail, NULL, NULL, NULL);
+	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
 	    if (type == TCL_PATH_RELATIVE) {
 		const char *str;
 		int len;
 
-		str = Tcl_GetStringFromObj(tail, &len);
+		str = Tcl_GetStringFromObj(tailObj, &len);
 		if (len == 0) {
 		    /*
 		     * This happens if we try to handle the root volume '/'.
@@ -943,16 +943,16 @@ Tcl_FSJoinPath(
 		if (res != NULL) {
 		    TclDecrRefCount(res);
 		}
-		return tail;
+		return tailObj;
 	    } else {
-		const char *str = TclGetString(tail);
+		const char *str = TclGetString(tailObj);
 
 		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
 		    if (strchr(str, '\\') == NULL) {
 			if (res != NULL) {
 			    TclDecrRefCount(res);
 			}
-			return tail;
+			return tailObj;
 		    }
 		}
 	    }
@@ -1036,8 +1036,8 @@ Tcl_FSJoinPath(
 	    }
 
 	    /*
-	     * This element is just what we want to return already - no
-	     * further manipulation is requred.
+	     * This element is just what we want to return already; no further
+	     * manipulation is requred.
 	     */
 
 	    return elt;
@@ -1083,7 +1083,7 @@ Tcl_FSJoinPath(
 	    int needsSep = 0;
 
 	    if (fsPtr->filesystemSeparatorProc != NULL) {
-		Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
+		Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res);
 
 		if (sep != NULL) {
 		    separator = TclGetString(sep)[0];
@@ -1177,7 +1177,7 @@ Tcl_FSConvertToPathType(
 	FreeFsPathInternalRep(pathPtr);
     }
 
-    return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
+    return SetFsPathFromAny(interp, pathPtr);
 
     /*
      * We used to have more complex code here:
@@ -1313,7 +1313,7 @@ TclNewFSPathObj(
     }
 
     pathPtr = Tcl_NewObj();
-    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+    fsPathPtr = ckalloc(sizeof(FsPath));
 
     /*
      * Set up the path.
@@ -1336,41 +1336,41 @@ TclNewFSPathObj(
 
     /*
      * 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.
+     * 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;
-           }
-       }
+	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;
+	PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
     }
 
     return pathPtr;
@@ -1391,7 +1391,7 @@ AppendPath(
      * of no evidence that such a foolish thing exists.  This solution was
      * chosen so that "JoinPath" operations that pass through either path
      * intrep produce the same results; that is, bugward compatibility.  If
-     * we need to fix that bug here, it needs fixing in Tcl_FSJoinPath() too.
+     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
      */
     bytes = Tcl_GetStringFromObj(tail, &numBytes);
     if (numBytes == 0) {
@@ -1436,72 +1436,8 @@ TclFSMakePathRelative(
     if (pathPtr->typePtr == &tclFsPathType) {
 	FsPath *fsPathPtr = PATHOBJ(pathPtr);
 
-	if (PATHFLAGS(pathPtr) != 0
-		&& fsPathPtr->cwdPtr == cwdPtr) {
-	    pathPtr = fsPathPtr->normPathPtr;
-
-	    /* TODO: Determine how much, if any, of this forcing
-	     * the relative path tail into the "path" Tcl_ObjType
-	     * with a recorded cwdPtr context has any actual value.
-	     *
-	     * Nothing is getting cached.  Not normPathPtr, not nativePathPtr,
-	     * nor fsPtr, so storing the cwdPtr context against which such
-	     * cached values might later be validated appears to be of no
-	     * value.  Take that away, and all this code is just a mildly
-	     * optimized equivalent of a call to SetFsPathFromAny().  That
-	     * optimization may have some value, *if* these value in fact
-	     * get used as "path" values before used as something else.
-	     * If not, though, whatever cost we pay below to convert to
-	     * one of the "path" intreps is just a waste, it seems.  The
-	     * usual convention in the core is to delay ObjType conversion
-	     * until it is needed and demanded, and I don't see why this
-	     * section of code should be an exception to that.  Leaving it
-	     * in place for the rest of the 8.5.* releases just for sake
-	     * of stability.
-	     */
-
-	    /*
-	     * Free old representation.
-	     */
-
-	    if (pathPtr->typePtr != NULL) {
-		if (pathPtr->bytes == NULL) {
-		    if (pathPtr->typePtr->updateStringProc == NULL) {
-			if (interp != NULL) {
-			    Tcl_ResetResult(interp);
-			    Tcl_AppendResult(interp, "can't find object"
-				    "string representation", NULL);
-			}
-			return NULL;
-		    }
-		    pathPtr->typePtr->updateStringProc(pathPtr);
-		}
-		TclFreeIntRep(pathPtr);
-	    }
-
-	    /*
-	     * Now pathPtr is a string object.
-	     */
-
-	    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
-
-	    /*
-	     * Circular reference, by design.
-	     */
-
-	    fsPathPtr->translatedPathPtr = pathPtr;
-	    fsPathPtr->normPathPtr = NULL;
-	    fsPathPtr->cwdPtr = cwdPtr;
-	    Tcl_IncrRefCount(cwdPtr);
-	    fsPathPtr->nativePathPtr = NULL;
-	    fsPathPtr->fsPtr = NULL;
-	    fsPathPtr->filesystemEpoch = 0;
-
-	    SETPATHOBJ(pathPtr, fsPathPtr);
-	    PATHFLAGS(pathPtr) = 0;
-	    pathPtr->typePtr = &tclFsPathType;
-
-	    return pathPtr;
+	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
+	    return fsPathPtr->normPathPtr;
 	}
     }
 
@@ -1577,9 +1513,10 @@ MakePathFromNormalized(
 	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_SetObjResult(interp, Tcl_NewStringObj(
+			    "can't find object string representation", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
+			    NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -1588,7 +1525,7 @@ MakePathFromNormalized(
 	TclFreeIntRep(pathPtr);
     }
 
-    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+    fsPathPtr = ckalloc(sizeof(FsPath));
 
     /*
      * It's a pure normalized absolute path.
@@ -1641,7 +1578,7 @@ MakePathFromNormalized(
 
 Tcl_Obj *
 Tcl_FSNewNativePath(
-    Tcl_Filesystem *fromFilesystem,
+    const Tcl_Filesystem *fromFilesystem,
     ClientData clientData)
 {
     Tcl_Obj *pathPtr = NULL;
@@ -1670,7 +1607,7 @@ Tcl_FSNewNativePath(
 	TclFreeIntRep(pathPtr);
     }
 
-    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+    fsPathPtr = ckalloc(sizeof(FsPath));
 
     fsPathPtr->translatedPathPtr = NULL;
 
@@ -1738,7 +1675,7 @@ Tcl_FSGetTranslatedPath(
 	    }
 
 	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
-		    &(srcFsPathPtr->normPathPtr));
+		    &srcFsPathPtr->normPathPtr);
 	    srcFsPathPtr->translatedPathPtr = retObj;
 	    if (translatedCwdPtr->typePtr == &tclFsPathType) {
 		srcFsPathPtr->filesystemEpoch
@@ -1800,7 +1737,7 @@ Tcl_FSGetTranslatedStringPath(
     if (transPtr != NULL) {
 	int len;
 	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
-	char *result = (char *) ckalloc((unsigned) len+1);
+	char *result = ckalloc(len+1);
 
 	memcpy(result, orig, (size_t) len+1);
 	TclDecrRefCount(transPtr);
@@ -1880,25 +1817,25 @@ Tcl_FSGetNormalizedPath(
 
 	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] ...
+	     * If the "tail" part has components (like /../) that cause the
+	     * combined path to need more complete normalizing, call on the
+	     * more powerful routine to accomplish that so we avoid [Bug
+	     * 2385549] ...
 	     */
 
 	    Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
+
 	    Tcl_DecrRefCount(copy);
 	    copy = newCopy;
 	} else {
 	    /*
-	     * ... but in most cases where we join a trouble free tail
-	     * to a normalized head, we can more efficiently normalize the
-	     * combined path by passing over only the unnormalized tail
-	     * portion.  When this is sufficient, prior developers claim
-	     * this should be much faster.  We use 'cwdLen-1' so that we are
-	     * already pointing at the dir-separator that we know about.
-	     * The normalization code will actually start off directly
-	     * after that separator.
+	     * ... 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);
@@ -1911,11 +1848,11 @@ Tcl_FSGetNormalizedPath(
 
 	    /*
 	     * NOTE: here we are (dangerously?) assuming that origDir points
-	     * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType .  The
+	     * 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.
+	     * 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);
@@ -1957,7 +1894,7 @@ Tcl_FSGetNormalizedPath(
 		UpdateStringOfFsPath(pathPtr);
 	    }
 	    FreeFsPathInternalRep(pathPtr);
-	    if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
+	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
 		return NULL;
 	    }
 	    fsPathPtr = PATHOBJ(pathPtr);
@@ -2003,11 +1940,11 @@ Tcl_FSGetNormalizedPath(
 
 	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.
+	     * 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.
@@ -2040,7 +1977,7 @@ Tcl_FSGetNormalizedPath(
 		/*
 		 * We have a refCount on the cwd.
 		 */
-#ifdef __WIN32__
+#ifdef _WIN32
 	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
 		/*
 		 * Only Windows has volume-relative paths.
@@ -2053,7 +1990,7 @@ Tcl_FSGetNormalizedPath(
 		    return NULL;
 		}
 		pureNormalized = 0;
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 	    }
 	}
 
@@ -2070,8 +2007,12 @@ Tcl_FSGetNormalizedPath(
 	 */
 
 	if (pureNormalized) {
-	    if (!strcmp(TclGetString(fsPathPtr->normPathPtr),
-		    TclGetString(pathPtr))) {
+	    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.
 		 */
@@ -2126,7 +2067,7 @@ Tcl_FSGetNormalizedPath(
 ClientData
 Tcl_FSGetInternalRep(
     Tcl_Obj *pathPtr,
-    Tcl_Filesystem *fsPtr)
+    const Tcl_Filesystem *fsPtr)
 {
     FsPath *srcFsPathPtr;
 
@@ -2199,7 +2140,7 @@ Tcl_FSGetInternalRep(
 	    return NULL;
 	}
 
-	nativePathPtr = (*proc)(pathPtr);
+	nativePathPtr = proc(pathPtr);
 	srcFsPathPtr = PATHOBJ(pathPtr);
 	srcFsPathPtr->nativePathPtr = nativePathPtr;
     }
@@ -2228,7 +2169,7 @@ Tcl_FSGetInternalRep(
 int
 TclFSEnsureEpochOk(
     Tcl_Obj *pathPtr,
-    Tcl_Filesystem **fsPtrPtr)
+    const Tcl_Filesystem **fsPtrPtr)
 {
     FsPath *srcFsPathPtr;
 
@@ -2287,7 +2228,7 @@ TclFSEnsureEpochOk(
 void
 TclFSSetPathDetails(
     Tcl_Obj *pathPtr,
-    Tcl_Filesystem *fsPtr,
+    const Tcl_Filesystem *fsPtr,
     ClientData clientData)
 {
     FsPath *srcFsPathPtr;
@@ -2330,7 +2271,7 @@ Tcl_FSEqualPaths(
     Tcl_Obj *firstPtr,
     Tcl_Obj *secondPtr)
 {
-    char *firstStr, *secondStr;
+    const char *firstStr, *secondStr;
     int firstLen, secondLen, tempErrno;
 
     if (firstPtr == secondPtr) {
@@ -2340,9 +2281,9 @@ Tcl_FSEqualPaths(
     if (firstPtr == NULL || secondPtr == NULL) {
 	return 0;
     }
-    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
-    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
-    if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
+    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
+    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
+    if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
 	return 1;
     }
 
@@ -2360,9 +2301,9 @@ Tcl_FSEqualPaths(
 	return 0;
     }
 
-    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
-    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
-    return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0);
+    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
+    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
+    return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
 }
 
 /*
@@ -2420,7 +2361,6 @@ SetFsPathFromAny(
      */
 
     if (name[0] == '~') {
-	char *expandedUser;
 	Tcl_DString temp;
 	int split;
 	char separator = '/';
@@ -2453,9 +2393,11 @@ SetFsPathFromAny(
 	    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_SetObjResult(interp, Tcl_NewStringObj(
+			    "couldn't find HOME environment variable to"
+			    " expand path", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
+			    "HOMELESS", NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -2470,9 +2412,10 @@ SetFsPathFromAny(
 	    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_SetObjResult(interp, Tcl_ObjPrintf(
+			    "user \"%s\" doesn't exist", name+1));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
+			    NULL);
 		}
 		Tcl_DStringFree(&temp);
 		if (split != len) {
@@ -2485,8 +2428,7 @@ SetFsPathFromAny(
 	    }
 	}
 
-	expandedUser = Tcl_DStringValue(&temp);
-	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
+	transPtr = TclDStringToObj(&temp);
 
 	if (split != len) {
 	    /*
@@ -2516,27 +2458,17 @@ SetFsPathFromAny(
 		}
 		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_Obj *pair[2];
 
-		Tcl_IncrRefCount(transPtr);
-		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
-		TclDecrRefCount(transPtr);
-		transPtr = joined;
+		pair[0] = transPtr;
+		pair[1] = Tcl_NewStringObj(name+split+1, -1);
+		transPtr = TclJoinPath(2, pair);
+		Tcl_DecrRefCount(pair[0]);
+		Tcl_DecrRefCount(pair[1]);
 	    }
 	}
-	Tcl_DStringFree(&temp);
     } else {
-	/* Bug 3479689: protect 0-refcount pathPth from getting freed */
-	pathPtr->refCount++;
-	transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
-	pathPtr->refCount--;
+	transPtr = TclJoinPath(1, &pathPtr);
     }
 
     /*
@@ -2544,7 +2476,7 @@ SetFsPathFromAny(
      * slashes on Windows, and will not contain any ~user sequences.
      */
 
-    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+    fsPathPtr = ckalloc(sizeof(FsPath));
 
     fsPathPtr->translatedPathPtr = transPtr;
     if (transPtr != pathPtr) {
@@ -2595,12 +2527,12 @@ FreeFsPathInternalRep(
 		fsPathPtr->fsPtr->freeInternalRepProc;
 
 	if (freeProc != NULL) {
-	    (*freeProc)(fsPathPtr->nativePathPtr);
+	    freeProc(fsPathPtr->nativePathPtr);
 	    fsPathPtr->nativePathPtr = NULL;
 	}
     }
 
-    ckfree((char *) fsPathPtr);
+    ckfree(fsPathPtr);
     pathPtr->typePtr = NULL;
 }
 
@@ -2610,7 +2542,7 @@ DupFsPathInternalRep(
     Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
 {
     FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
-    FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
+    FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));
 
     SETPATHOBJ(copyPtr, copyFsPathPtr);
 
@@ -2648,7 +2580,7 @@ DupFsPathInternalRep(
 
 	if (dupProc != NULL) {
 	    copyFsPathPtr->nativePathPtr =
-		    (*dupProc)(srcFsPathPtr->nativePathPtr);
+		    dupProc(srcFsPathPtr->nativePathPtr);
 	} else {
 	    copyFsPathPtr->nativePathPtr = NULL;
 	}
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 698f85d..83fb818 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -32,8 +32,8 @@ TCL_DECLARE_MUTEX(pipeMutex)	/* Guard access to detList. */
  * Declarations for local functions defined in this file:
  */
 
-static TclFile		FileForRedirect(Tcl_Interp *interp, CONST char *spec,
-			    int atOk, CONST char *arg, CONST char *nextArg,
+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);
 
@@ -61,14 +61,14 @@ 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
+    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:
+    const char *arg,		/* Pointer to entire argument containing spec:
 				 * used for error reporting. */
-    CONST char *nextArg,	/* Next argument in argc/argv array, if needed
+    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
@@ -94,23 +94,27 @@ 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;
+	if (file == NULL) {
+	    Tcl_Obj *msg;
+
 	    Tcl_GetChannelError(chan, &msg);
 	    if (msg) {
-		Tcl_SetObjResult (interp, msg);
+		Tcl_SetObjResult(interp, msg);
 	    } else {
-		Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
-				 "\" wasn't opened for ",
-				 ((writing) ? "writing" : "reading"), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"channel \"%s\" wasn't opened for %s",
+			Tcl_GetChannelName(chan),
+			((writing) ? "writing" : "reading")));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			"BADCHAN", NULL);
 	    }
-            return NULL;
-        }
+	    return NULL;
+	}
 	*releasePtr = 1;
 	if (writing) {
 	    /*
@@ -118,10 +122,10 @@ FileForRedirect(
 	     * 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') {
@@ -138,18 +142,20 @@ FileForRedirect(
 	file = TclpOpenFile(name, flags);
 	Tcl_DStringFree(&nameString);
 	if (file == NULL) {
-	    Tcl_AppendResult(interp, "couldn't ",
-		    ((writing) ? "write" : "read"), " file \"", spec, "\": ",
-		    Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't %s file \"%s\": %s",
+		    (writing ? "write" : "read"), spec,
+		    Tcl_PosixError(interp)));
 	    return NULL;
 	}
-        *closePtr = 1;
+	*closePtr = 1;
     }
     return file;
 
   badLastArg:
-    Tcl_AppendResult(interp, "can't specify \"", arg,
-	    "\" as last word in command", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "can't specify \"%s\" as last word in command", arg));
+    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
     return NULL;
 }
 
@@ -182,7 +188,7 @@ Tcl_DetachPids(
 
     Tcl_MutexLock(&pipeMutex);
     for (i = 0; i < numPids; i++) {
-	detPtr = (Detached *) ckalloc(sizeof(Detached));
+	detPtr = ckalloc(sizeof(Detached));
 	detPtr->pid = pidPtr[i];
 	detPtr->nextPtr = detList;
 	detList = detPtr;
@@ -232,7 +238,7 @@ Tcl_ReapDetachedProcs(void)
 	} else {
 	    prevPtr->nextPtr = detPtr->nextPtr;
 	}
-	ckfree((char *) detPtr);
+	ckfree(detPtr);
 	detPtr = nextPtr;
     }
     Tcl_MutexUnlock(&pipeMutex);
@@ -272,8 +278,8 @@ TclCleanupChildren(
     int result = TCL_OK;
     int i, abnormalExit, anyErrorInfo;
     Tcl_Pid pid;
-    WAIT_STATUS_TYPE waitStatus;
-    CONST char *msg;
+    int waitStatus;
+    const char *msg;
     unsigned long resolvedPid;
 
     abnormalExit = 0;
@@ -285,24 +291,24 @@ TclCleanupChildren(
 	 */
 
 	resolvedPid = TclpGetPid(pidPtr[i]);
-        pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
+	pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0);
 	if (pid == (Tcl_Pid) -1) {
 	    result = TCL_ERROR;
-            if (interp != NULL) {
-                msg = Tcl_PosixError(interp);
-                if (errno == ECHILD) {
+	    if (interp != NULL) {
+		msg = Tcl_PosixError(interp);
+		if (errno == ECHILD) {
 		    /*
-                     * This changeup in message suggested by Mark Diekhans to
-                     * remind people that ECHILD errors can occur on some
-                     * systems if SIGCHLD isn't in its default state.
-                     */
-
-                    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_SetObjResult(interp, Tcl_ObjPrintf(
+			"error waiting for process to exit: %s", msg));
+	    }
 	    continue;
 	}
 
@@ -319,32 +325,32 @@ TclCleanupChildren(
 	    result = TCL_ERROR;
 	    sprintf(msg1, "%lu", resolvedPid);
 	    if (WIFEXITED(waitStatus)) {
-                if (interp != (Tcl_Interp *) NULL) {
-		    sprintf(msg2, "%lu",
-			    (unsigned long) WEXITSTATUS(waitStatus));
-                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
-                }
+		if (interp != NULL) {
+		    sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
+		    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
+		}
 		abnormalExit = 1;
 	    } else if (interp != NULL) {
-		CONST char *p;
+		const char *p;
 
 		if (WIFSIGNALED(waitStatus)) {
-                    p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
-                    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
-                            Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
-                            NULL);
-                    Tcl_AppendResult(interp, "child killed: ", p, "\n", NULL);
+		    p = Tcl_SignalMsg(WTERMSIG(waitStatus));
+		    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
+			    Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "child killed: %s\n", p));
 		} else if (WIFSTOPPED(waitStatus)) {
-                    p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
-                    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
-                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p,
-			    NULL);
-                    Tcl_AppendResult(interp, "child suspended: ", p, "\n",
-                            NULL);
+		    p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
+		    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
+			    Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "child suspended: %s\n", p));
 		} else {
-                    Tcl_AppendResult(interp,
-                            "child wait status didn't make sense\n", NULL);
-                }
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "child wait status didn't make sense\n", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			    "ODDWAITRESULT", msg1, NULL);
+		}
 	    }
 	}
     }
@@ -360,7 +366,7 @@ TclCleanupChildren(
 	 * Make sure we start at the beginning of the file.
 	 */
 
-        if (interp != NULL) {
+	if (interp != NULL) {
 	    int count;
 	    Tcl_Obj *objPtr;
 
@@ -371,8 +377,9 @@ TclCleanupChildren(
 		result = TCL_ERROR;
 		Tcl_DecrRefCount(objPtr);
 		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "error reading stderr output file: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"error reading stderr output file: %s",
+			Tcl_PosixError(interp)));
 	    } else if (count > 0) {
 		anyErrorInfo = 1;
 		Tcl_SetObjResult(interp, objPtr);
@@ -390,7 +397,8 @@ TclCleanupChildren(
      */
 
     if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
-	Tcl_AppendResult(interp, "child process exited abnormally", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"child process exited abnormally", -1));
     }
     return result;
 }
@@ -428,7 +436,7 @@ 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
+    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
@@ -464,7 +472,7 @@ TclCreatePipeline(
 				 * *pidPtr right now. */
     int cmdCount;		/* Count of number of distinct commands found
 				 * in argc/argv. */
-    CONST char *inputLiteral = NULL;
+    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
@@ -473,22 +481,22 @@ TclCreatePipeline(
 				 * first process in pipeline (specified via <
 				 * or <@). */
     int inputClose = 0;		/* If non-zero, then inputFile should be
-    				 * closed when cleaning up. */
+				 * 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
 				 * means use stdout. */
     int outputClose = 0;	/* If non-zero, then outputFile should be
-    				 * closed when cleaning up. */
+				 * closed when cleaning up. */
     int outputRelease = 0;
     TclFile errorFile = NULL;	/* Writable file for error output from all
 				 * commands in pipeline. NULL means use
 				 * stderr. */
     int errorClose = 0;		/* If non-zero, then errorFile should be
-    				 * closed when cleaning up. */
+				 * 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;
@@ -539,8 +547,10 @@ TclCreatePipeline(
 	    }
 	    if (*p == '\0') {
 		if ((i == (lastBar + 1)) || (i == (argc - 1))) {
-		    Tcl_SetResult(interp, "illegal use of | or |& in command",
-			    TCL_STATIC);
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "illegal use of | or |& in command", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			    "PIPESYNTAX", NULL);
 		    goto error;
 		}
 	    }
@@ -565,8 +575,11 @@ TclCreatePipeline(
 		if (*inputLiteral == '\0') {
 		    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_SetObjResult(interp, Tcl_ObjPrintf(
+				"can't specify \"%s\" as last word in command",
+				argv[i]));
+			Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+				"PIPESYNTAX", NULL);
 			goto error;
 		    }
 		    skip = 2;
@@ -673,8 +686,11 @@ TclCreatePipeline(
 		 */
 
 		if (i != argc-1) {
-		    Tcl_AppendResult(interp, "must specify \"", argv[i],
-			    "\" as last word in command", NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "must specify \"%s\" as last word in command",
+			    argv[i]));
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			    "PIPESYNTAX", NULL);
 		    goto error;
 		}
 		errorFile = outputFile;
@@ -691,9 +707,12 @@ 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) {
@@ -706,11 +725,14 @@ 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_SetObjResult(interp, Tcl_NewStringObj(
+		"illegal use of | or |& in command", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
+		NULL);
 	goto error;
     }
 
@@ -724,9 +746,9 @@ TclCreatePipeline(
 
 	    inputFile = TclpCreateTempFile(inputLiteral);
 	    if (inputFile == NULL) {
-		Tcl_AppendResult(interp,
-			"couldn't create input file for command: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't create input file for command: %s",
+			Tcl_PosixError(interp)));
 		goto error;
 	    }
 	    inputClose = 1;
@@ -737,9 +759,9 @@ TclCreatePipeline(
 	     */
 
 	    if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
-		Tcl_AppendResult(interp,
-			"couldn't create input pipe for command: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't create input pipe for command: %s",
+			Tcl_PosixError(interp)));
 		goto error;
 	    }
 	    inputClose = 1;
@@ -766,9 +788,9 @@ TclCreatePipeline(
 	     */
 
 	    if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
-		Tcl_AppendResult(interp,
-			"couldn't create output pipe for command: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't create output pipe for command: %s",
+			Tcl_PosixError(interp)));
 		goto error;
 	    }
 	    outputClose = 1;
@@ -806,9 +828,9 @@ TclCreatePipeline(
 
 	    errorFile = TclpCreateTempFile(NULL);
 	    if (errorFile == NULL) {
-		Tcl_AppendResult(interp,
-			"couldn't create error file for command: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't create error file for command: %s",
+			Tcl_PosixError(interp)));
 		goto error;
 	    }
 	    *errFilePtr = errorFile;
@@ -833,14 +855,14 @@ TclCreatePipeline(
      */
 
     Tcl_ReapDetachedProcs();
-    pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
+    pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));
 
     curInFile = inputFile;
 
     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.
@@ -879,8 +901,8 @@ TclCreatePipeline(
 	} else {
 	    argv[lastArg] = NULL;
 	    if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
-		Tcl_AppendResult(interp, "couldn't create pipe: ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't create pipe: %s", Tcl_PosixError(interp)));
 		goto error;
 	    }
 	}
@@ -986,7 +1008,7 @@ TclCreatePipeline(
 		Tcl_DetachPids(1, &pidPtr[i]);
 	    }
 	}
-	ckfree((char *) pidPtr);
+	ckfree(pidPtr);
     }
     numPids = -1;
     goto cleanup;
@@ -1027,9 +1049,9 @@ TclCreatePipeline(
 Tcl_Channel
 Tcl_OpenCommandChannel(
     Tcl_Interp *interp,		/* Interpreter for error reporting. Can NOT be
-                                 * NULL. */
+				 * NULL. */
     int argc,			/* How many arguments. */
-    CONST char **argv,		/* Array of arguments for command pipe. */
+    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. */
 {
@@ -1046,7 +1068,7 @@ Tcl_OpenCommandChannel(
     errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
 
     numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
-            outPipePtr, errFilePtr);
+	    outPipePtr, errFilePtr);
 
     if (numPids < 0) {
 	goto error;
@@ -1059,13 +1081,19 @@ Tcl_OpenCommandChannel(
 
     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_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't read output from command:"
+		    " standard output was redirected", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+		    "BADREDIRECT", NULL);
 	    goto error;
 	}
 	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
-	    Tcl_AppendResult(interp, "can't write input to command:"
-		    " standard input was redirected", NULL);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't write input to command:"
+		    " standard input was redirected", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+		    "BADREDIRECT", NULL);
 	    goto error;
 	}
     }
@@ -1073,9 +1101,10 @@ Tcl_OpenCommandChannel(
     channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
 	    numPids, pidPtr);
 
-    if (channel == (Tcl_Channel) NULL) {
-        Tcl_AppendResult(interp, "pipe for command could not be created",
-                NULL);
+    if (channel == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"pipe for command could not be created", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
 	goto error;
     }
     return channel;
@@ -1083,7 +1112,7 @@ Tcl_OpenCommandChannel(
   error:
     if (numPids > 0) {
 	Tcl_DetachPids(numPids, pidPtr);
-	ckfree((char *) pidPtr);
+	ckfree(pidPtr);
     }
     if (inPipe != NULL) {
 	TclpCloseFile(inPipe);
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 52f33c3..f6e8b20 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -46,7 +46,7 @@ typedef struct Package {
 				 * exist in this interpreter yet. */
     PkgAvail *availPtr;		/* First in list of all available versions of
 				 * this package. */
-    ClientData clientData;	/* Client data. */
+    const void *clientData;	/* Client data. */
 } Package;
 
 /*
@@ -71,7 +71,7 @@ static void		AddRequirementsToDString(Tcl_DString *dstring,
 static Package *	FindPackage(Tcl_Interp *interp, const char *name);
 static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
 			    int reqc, Tcl_Obj *const reqv[],
-			    ClientData *clientDataPtr);
+			    void *clientDataPtr);
 
 /*
  * Helper macros.
@@ -123,7 +123,7 @@ Tcl_PkgProvideEx(
 				 * available. */
     const char *name,		/* Name of package. */
     const char *version,	/* Version string for package. */
-    ClientData clientData)	/* clientdata for this package (normally used
+    const void *clientData)	/* clientdata for this package (normally used
 				 * for C callback function table) */
 {
     Package *pkgPtr;
@@ -155,8 +155,10 @@ Tcl_PkgProvideEx(
 	}
 	return TCL_OK;
     }
-    Tcl_AppendResult(interp, "conflicting versions provided for package \"",
-	    name, "\": ", pkgPtr->version, ", then ", version, NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "conflicting versions provided for package \"%s\": %s, then %s",
+	    name, pkgPtr->version, version));
+    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
     return TCL_ERROR;
 }
 
@@ -212,7 +214,7 @@ Tcl_PkgRequireEx(
     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
+    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. */
@@ -285,9 +287,10 @@ Tcl_PkgRequireEx(
 	 */
 
 	tclEmptyStringRep = &tclEmptyString;
-	Tcl_AppendResult(interp, "Cannot load package \"", name,
-		"\" in standalone executable: This package is not "
-		"compiled with stub support", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"Cannot load package \"%s\" in standalone executable:"
+		" This package is not compiled with stub support", name));
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
 	return NULL;
     }
 
@@ -323,7 +326,7 @@ Tcl_PkgRequireProc(
 				 * version. */
     Tcl_Obj *const reqv[],	/* 0 means to use the latest version
 				 * available. */
-    ClientData *clientDataPtr)
+    void *clientDataPtr)
 {
     const char *result =
 	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
@@ -344,7 +347,7 @@ PkgRequireCore(
 				 * version. */
     Tcl_Obj *const reqv[],	/* 0 means to use the latest version
 				 * available. */
-    ClientData *clientDataPtr)
+    void *clientDataPtr)
 {
     Interp *iPtr = (Interp *) interp;
     Package *pkgPtr;
@@ -378,10 +381,12 @@ PkgRequireCore(
 	 */
 
 	if (pkgPtr->clientData != NULL) {
-	    Tcl_AppendResult(interp, "circular package dependency: "
-		    "attempt to provide ", name, " ",
-		    (char *) pkgPtr->clientData, " requires ", name, NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "circular package dependency:"
+		    " attempt to provide %s %s requires %s",
+		    name, (char *) pkgPtr->clientData, name));
 	    AddRequirementsToResult(interp, reqc, reqv);
+	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
 	    return NULL;
 	}
 
@@ -428,7 +433,9 @@ PkgRequireCore(
 		}
 	    }
 
-	    /* 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. */
@@ -481,24 +488,26 @@ PkgRequireCore(
 	     * will still exist when the script completes.
 	     */
 
-	    const char *versionToProvide = bestPtr->version;
+	    char *versionToProvide = bestPtr->version;
 	    script = bestPtr->script;
 
-	    pkgPtr->clientData = (ClientData) versionToProvide;
-	    Tcl_Preserve((ClientData) script);
-	    Tcl_Preserve((ClientData) versionToProvide);
+	    pkgPtr->clientData = versionToProvide;
+	    Tcl_Preserve(script);
+	    Tcl_Preserve(versionToProvide);
 	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
-	    Tcl_Release((ClientData) script);
+	    Tcl_Release(script);
 
 	    pkgPtr = FindPackage(interp, name);
 	    if (code == TCL_OK) {
 		Tcl_ResetResult(interp);
 		if (pkgPtr->version == NULL) {
 		    code = TCL_ERROR;
-		    Tcl_AppendResult(interp, "attempt to provide package ",
-			    name, " ", versionToProvide,
-			    " failed: no version of package ", name,
-			    " provided", NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "attempt to provide package %s %s failed:"
+			    " no version of package %s provided",
+			    name, versionToProvide, name));
+		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
+			    NULL);
 		} else {
 		    char *pvi, *vi;
 
@@ -516,21 +525,24 @@ PkgRequireCore(
 			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_SetObjResult(interp, Tcl_ObjPrintf(
+				    "attempt to provide package %s %s failed:"
+				    " package %s %s provided instead",
+				    name, versionToProvide,
+				    name, pkgPtr->version));
+			    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
+				    "WRONGPROVIDE", NULL);
 			}
 		    }
 		}
 	    } 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_SetObjResult(interp, Tcl_ObjPrintf(
+			"attempt to provide package %s %s failed:"
+			" bad return code: %s",
+			name, versionToProvide, TclGetString(codePtr)));
+		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
 		TclDecrRefCount(codePtr);
 		code = TCL_ERROR;
 	    }
@@ -540,7 +552,7 @@ PkgRequireCore(
 			"\n    (\"package ifneeded %s %s\" script)",
 			name, versionToProvide));
 	    }
-	    Tcl_Release((ClientData) versionToProvide);
+	    Tcl_Release(versionToProvide);
 
 	    if (code != TCL_OK) {
 		/*
@@ -587,11 +599,9 @@ PkgRequireCore(
 	    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_DecrRefCount(codePtr);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad return code: %d", code));
+		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
 		code = TCL_ERROR;
 	    }
 	    if (code == TCL_ERROR) {
@@ -604,7 +614,9 @@ PkgRequireCore(
     }
 
     if (pkgPtr->version == NULL) {
-	Tcl_AppendResult(interp, "can't find package ", name, NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't find package %s", name));
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
 	AddRequirementsToResult(interp, reqc, reqv);
 	return NULL;
     }
@@ -614,26 +626,29 @@ PkgRequireCore(
      * provided version meets the current requirements.
      */
 
-    if (reqc == 0) {
-	satisfies = 1;
-    } else {
+    if (reqc != 0) {
 	CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
 	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
 
 	ckfree(pkgVersionI);
-    }
 
-    if (satisfies) {
-	if (clientDataPtr) {
-	    *clientDataPtr = pkgPtr->clientData;
+	if (!satisfies) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "version conflict for package \"%s\": have %s, need",
+		    name, pkgPtr->version));
+	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
+		    NULL);
+	    AddRequirementsToResult(interp, reqc, reqv);
+	    return NULL;
 	}
-	return pkgPtr->version;
     }
 
-    Tcl_AppendResult(interp, "version conflict for package \"", name,
-	    "\": have ", pkgPtr->version, ", need", NULL);
-    AddRequirementsToResult(interp, reqc, reqv);
-    return NULL;
+    if (clientDataPtr) {
+	const void **ptr = (const void **) clientDataPtr;
+
+	*ptr = pkgPtr->clientData;
+    }
+    return pkgPtr->version;
 }
 
 /*
@@ -682,7 +697,7 @@ Tcl_PkgPresentEx(
     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
+    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. */
@@ -713,10 +728,11 @@ Tcl_PkgPresentEx(
     }
 
     if (version != NULL) {
-	Tcl_AppendResult(interp, "package ", name, " ", version,
-		" is not present", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"package %s %s is not present", name, version));
     } else {
-	Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"package %s is not present", name));
     }
     Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
     return NULL;
@@ -747,7 +763,7 @@ Tcl_PackageObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    static const char *pkgOptions[] = {
+    static const char *const pkgOptions[] = {
 	"forget",  "ifneeded", "names",   "prefer",   "present",
 	"provide", "require",  "unknown", "vcompare", "versions",
 	"vsatisfies", NULL
@@ -765,10 +781,11 @@ Tcl_PackageObjCmd(
     Tcl_HashSearch search;
     Tcl_HashTable *tablePtr;
     const char *version;
-    char *argv2, *argv3, *argv4, *iva = NULL, *ivb = NULL;
+    const char *argv2, *argv3, *argv4;
+    char *iva = NULL, *ivb = NULL;
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
 
@@ -778,7 +795,7 @@ Tcl_PackageObjCmd(
     }
     switch ((enum pkgOptions) optionIndex) {
     case PKG_FORGET: {
-	char *keyString;
+	const char *keyString;
 
 	for (i = 2; i < objc; i++) {
 	    keyString = TclGetString(objv[i]);
@@ -794,11 +811,11 @@ Tcl_PackageObjCmd(
 	    while (pkgPtr->availPtr != NULL) {
 		availPtr = pkgPtr->availPtr;
 		pkgPtr->availPtr = availPtr->nextPtr;
-		Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
-		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
-		ckfree((char *) availPtr);
+		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
+		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+		ckfree(availPtr);
 	    }
-	    ckfree((char *) pkgPtr);
+	    ckfree(pkgPtr);
 	}
 	break;
     }
@@ -841,10 +858,11 @@ Tcl_PackageObjCmd(
 	    if (res == 0){
 		if (objc == 4) {
 		    ckfree(argv3i);
-		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+		    Tcl_SetObjResult(interp,
+			    Tcl_NewStringObj(availPtr->script, -1));
 		    return TCL_OK;
 		}
-		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
 		break;
 	    }
 	}
@@ -854,7 +872,7 @@ Tcl_PackageObjCmd(
 	    return TCL_OK;
 	}
 	if (availPtr == NULL) {
-	    availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
+	    availPtr = ckalloc(sizeof(PkgAvail));
 	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);
 
 	    if (prevPtr == NULL) {
@@ -873,18 +891,25 @@ Tcl_PackageObjCmd(
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
-	}
-	tablePtr = &iPtr->packageTable;
-	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
-		hPtr = Tcl_NextHashEntry(&search)) {
-	    pkgPtr = Tcl_GetHashValue(hPtr);
-	    if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
-		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
+	} 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));
+		}
 	    }
+	    Tcl_SetObjResult(interp, resultObj);
 	}
 	break;
     case PKG_PRESENT: {
 	const char *name;
+
 	if (objc < 3) {
 	    goto require;
 	}
@@ -939,7 +964,8 @@ Tcl_PackageObjCmd(
 	    if (hPtr != NULL) {
 		pkgPtr = Tcl_GetHashValue(hPtr);
 		if (pkgPtr->version != NULL) {
-		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
+		    Tcl_SetObjResult(interp,
+			    Tcl_NewStringObj(pkgPtr->version, -1));
 		}
 	    }
 	    return TCL_OK;
@@ -954,7 +980,7 @@ Tcl_PackageObjCmd(
 	if (objc < 3) {
 	requireSyntax:
 	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "?-exact? package ?requirement...?");
+		    "?-exact? package ?requirement ...?");
 	    return TCL_ERROR;
 	}
 
@@ -1001,7 +1027,8 @@ Tcl_PackageObjCmd(
 
 	if (objc == 2) {
 	    if (iPtr->packageUnknown != NULL) {
-		Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
+		Tcl_SetObjResult(interp,
+			Tcl_NewStringObj(iPtr->packageUnknown, -1));
 	    }
 	} else if (objc == 3) {
 	    if (iPtr->packageUnknown != NULL) {
@@ -1020,7 +1047,7 @@ Tcl_PackageObjCmd(
 	break;
     }
     case PKG_PREFER: {
-	static const char *pkgPreferOptions[] = {
+	static const char *const pkgPreferOptions[] = {
 	    "latest", "stable", NULL
 	};
 
@@ -1089,23 +1116,27 @@ Tcl_PackageObjCmd(
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "package");
 	    return TCL_ERROR;
-	}
-	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_AppendElement(interp, availPtr->version);
+	} 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));
+		}
 	    }
+	    Tcl_SetObjResult(interp, resultObj);
 	}
 	break;
     case PKG_VSATISFIES: {
 	char *argv2i = NULL;
 
 	if (objc < 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "version requirement requirement...");
+	    Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
 	    return TCL_ERROR;
 	}
 
@@ -1159,7 +1190,7 @@ FindPackage(
 
     hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
     if (isNew) {
-	pkgPtr = (Package *) ckalloc(sizeof(Package));
+	pkgPtr = ckalloc(sizeof(Package));
 	pkgPtr->version = NULL;
 	pkgPtr->availPtr = NULL;
 	pkgPtr->clientData = NULL;
@@ -1205,11 +1236,11 @@ TclFreePackageInfo(
 	while (pkgPtr->availPtr != NULL) {
 	    availPtr = pkgPtr->availPtr;
 	    pkgPtr->availPtr = availPtr->nextPtr;
-	    Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
-	    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
-	    ckfree((char *) availPtr);
+	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
+	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+	    ckfree(availPtr);
 	}
-	ckfree((char *) pkgPtr);
+	ckfree(pkgPtr);
     }
     Tcl_DeleteHashTable(&iPtr->packageTable);
     if (iPtr->packageUnknown != NULL) {
@@ -1331,8 +1362,9 @@ CheckVersionAndConvert(
 
   error:
     ckfree(ibuf);
-    Tcl_AppendResult(interp, "expected version number but got \"", string,
-	    "\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "expected version number but got \"%s\"", string));
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
     return TCL_ERROR;
 }
 
@@ -1593,8 +1625,9 @@ CheckRequirement(
 	 * More dashes found after the first. This is wrong.
 	 */
 
-	Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
-		string, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"expected versionMin-versionMax but got \"%s\"", string));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
 	return TCL_ERROR;
     }
 
@@ -1645,19 +1678,17 @@ AddRequirementsToResult(
     Tcl_Obj *const reqv[])	/* 0 means to use the latest version
 				 * available. */
 {
-    if (reqc > 0) {
-	int i;
+    Tcl_Obj *result = Tcl_GetObjResult(interp);
+    int i, length;
 
-	for (i = 0; i < reqc; i++) {
-	    int length;
-	    char *v = Tcl_GetStringFromObj(reqv[i], &length);
+    for (i = 0; i < reqc; i++) {
+	const 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);
-	    } else {
-		Tcl_AppendResult(interp, " ", v, NULL);
-	    }
+	if ((length & 0x1) && (v[length/2] == '-')
+		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
+	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
+	} else {
+	    Tcl_AppendPrintfToObj(result, " %s", v);
 	}
     }
 }
@@ -1686,15 +1717,15 @@ AddRequirementsToDString(
     Tcl_Obj *const reqv[])	/* 0 means to use the latest version
 				 * available. */
 {
-    if (reqc > 0) {
-	int i;
+    int i;
 
+    if (reqc > 0) {
 	for (i = 0; i < reqc; i++) {
-	    Tcl_DStringAppend(dsPtr, " ", 1);
-	    Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
+	    TclDStringAppendLiteral(dsPtr, " ");
+	    TclDStringAppendObj(dsPtr, reqv[i]);
 	}
     } else {
-	Tcl_DStringAppend(dsPtr, " 0-", -1);
+	TclDStringAppendLiteral(dsPtr, " 0-");
     }
 }
 
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index 840ebed..466d535 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -88,7 +88,7 @@
 #  define CFG_PROFILED		"0"
 #endif
 
-static Tcl_Config cfg[] = {
+static Tcl_Config const cfg[] = {
     {"debug",			CFG_DEBUG},
     {"threaded",		CFG_THREADED},
     {"profiled",		CFG_PROFILED},
@@ -120,7 +120,7 @@ static Tcl_Config cfg[] = {
 
 void
 TclInitEmbeddedConfigurationInformation(
-    Tcl_Interp* interp)		/* Interpreter the configuration command is
+    Tcl_Interp *interp)		/* Interpreter the configuration command is
 				 * registered in. */
 {
     Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING);
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index ef23c84..abc8ee8 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -22,6 +22,12 @@
 #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.
+ */
+
+/*
  * 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.
  */
@@ -44,87 +50,67 @@ extern "C" {
  * Exported function declarations:
  */
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
-#ifndef Tcl_WinUtfToTChar_TCL_DECLARED
-#define Tcl_WinUtfToTChar_TCL_DECLARED
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 /* 0 */
-EXTERN TCHAR *		Tcl_WinUtfToTChar(CONST char *str, int len,
+EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
 				Tcl_DString *dsPtr);
-#endif
-#ifndef Tcl_WinTCharToUtf_TCL_DECLARED
-#define Tcl_WinTCharToUtf_TCL_DECLARED
 /* 1 */
-EXTERN char *		Tcl_WinTCharToUtf(CONST TCHAR *str, int len,
+EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
 				Tcl_DString *dsPtr);
-#endif
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_MacOSXOpenBundleResources_TCL_DECLARED
-#define Tcl_MacOSXOpenBundleResources_TCL_DECLARED
 /* 0 */
 EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
-				CONST char *bundleName, int hasResourceFile,
+				const char *bundleName, int hasResourceFile,
 				int maxPathLen, char *libraryPath);
-#endif
-#ifndef Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
-#define Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
 /* 1 */
 EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
-				Tcl_Interp *interp, CONST char *bundleName,
-				CONST char *bundleVersion,
+				Tcl_Interp *interp, const char *bundleName,
+				const char *bundleVersion,
 				int hasResourceFile, int maxPathLen,
 				char *libraryPath);
-#endif
 #endif /* MACOSX */
 
 typedef struct TclPlatStubs {
     int magic;
-    struct TclPlatStubHooks *hooks;
+    void *hooks;
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* 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 */
+#if defined(_WIN32) || defined(__CYGWIN__) /* 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 */
+    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
+    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
 #endif /* MACOSX */
 } TclPlatStubs;
 
-extern TclPlatStubs *tclPlatStubsPtr;
+extern const TclPlatStubs *tclPlatStubsPtr;
 
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
 
 /*
  * Inline function declarations:
  */
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
-#ifndef Tcl_WinUtfToTChar
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 #define Tcl_WinUtfToTChar \
 	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
-#endif
-#ifndef Tcl_WinTCharToUtf
 #define Tcl_WinTCharToUtf \
 	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
-#endif
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef Tcl_MacOSXOpenBundleResources
 #define Tcl_MacOSXOpenBundleResources \
 	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
-#endif
-#ifndef Tcl_MacOSXOpenVersionedBundleResources
 #define Tcl_MacOSXOpenVersionedBundleResources \
 	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
-#endif
 #endif /* MACOSX */
 
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
 
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index a11b532..411eb27 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -31,7 +31,7 @@
  *----------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_ErrnoId(void)
 {
     switch (errno) {
@@ -74,6 +74,9 @@ Tcl_ErrnoId(void)
 #ifdef EBADMSG
     case EBADMSG: return "EBADMSG";
 #endif
+#ifdef ECANCELED
+    case ECANCELED: return "ECANCELED";
+#endif
 #ifdef EBADR
     case EBADR: return "EBADR";
 #endif
@@ -200,7 +203,7 @@ Tcl_ErrnoId(void)
 #ifdef ELIBEXEC
     case ELIBEXEC: return "ELIBEXEC";
 #endif
-#ifdef ELIBMAX
+#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
     case ELIBMAX: return "ELIBMAX";
 #endif
 #ifdef ELIBSCN
@@ -269,7 +272,7 @@ Tcl_ErrnoId(void)
 #ifdef ENOLCK
     case ENOLCK: return "ENOLCK";
 #endif
-#if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
+#ifdef ENOLINK
     case ENOLINK: return "ENOLINK";
 #endif
 #ifdef ENOMEM
@@ -284,7 +287,7 @@ Tcl_ErrnoId(void)
 #ifdef ENOPKG
     case ENOPKG: return "ENOPKG";
 #endif
-#if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
+#ifdef ENOPROTOOPT
     case ENOPROTOOPT: return "ENOPROTOOPT";
 #endif
 #ifdef ENOSPC
@@ -308,6 +311,9 @@ Tcl_ErrnoId(void)
 #ifdef ENOTCONN
     case ENOTCONN: return "ENOTCONN";
 #endif
+#ifdef ENOTRECOVERABLE
+    case ENOTRECOVERABLE: return "ENOTRECOVERABLE";
+#endif
 #ifdef ENOTDIR
     case ENOTDIR: return "ENOTDIR";
 #endif
@@ -335,9 +341,15 @@ Tcl_ErrnoId(void)
 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
     case EOPNOTSUPP: return "EOPNOTSUPP";
 #endif
+#ifdef EOTHER
+    case EOTHER: return "EOTHER";
+#endif
 #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
     case EOVERFLOW: return "EOVERFLOW";
 #endif
+#ifdef EOWNERDEAD
+    case EOWNERDEAD: return "EOWNERDEAD";
+#endif
 #ifdef EPERM
     case EPERM: return "EPERM";
 #endif
@@ -477,7 +489,7 @@ Tcl_ErrnoId(void)
  *----------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_ErrnoMsg(
      int err)			/* Error number (such as in errno variable). */
 {
@@ -492,13 +504,13 @@ Tcl_ErrnoMsg(
     case EADDRINUSE: return "address already in use";
 #endif
 #ifdef EADDRNOTAVAIL
-    case EADDRNOTAVAIL: return "can't assign requested address";
+    case EADDRNOTAVAIL: return "cannot assign requested address";
 #endif
 #ifdef EADV
     case EADV: return "advertise error";
 #endif
 #ifdef EAFNOSUPPORT
-    case EAFNOSUPPORT: return "address family not supported by protocol family";
+    case EAFNOSUPPORT: return "address family not supported by protocol";
 #endif
 #ifdef EAGAIN
     case EAGAIN: return "resource temporarily unavailable";
@@ -521,6 +533,9 @@ Tcl_ErrnoMsg(
 #ifdef EBADMSG
     case EBADMSG: return "not a data message";
 #endif
+#ifdef ECANCELED
+    case ECANCELED: return "operation canceled";
+#endif
 #ifdef EBADR
     case EBADR: return "bad request descriptor";
 #endif
@@ -639,15 +654,15 @@ Tcl_ErrnoMsg(
     case EL3RST: return "level 3 reset";
 #endif
 #ifdef ELIBACC
-    case ELIBACC: return "can not access a needed shared library";
+    case ELIBACC: return "cannot access a needed shared library";
 #endif
 #ifdef ELIBBAD
     case ELIBBAD: return "accessing a corrupted shared library";
 #endif
 #ifdef ELIBEXEC
-    case ELIBEXEC: return "can not exec a shared library directly";
+    case ELIBEXEC: return "cannot exec a shared library directly";
 #endif
-#ifdef ELIBMAX
+#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
     case ELIBMAX: return
 	    "attempting to link in more shared libraries than system limit";
 #endif
@@ -717,7 +732,7 @@ Tcl_ErrnoMsg(
 #ifdef ENOLCK
     case ENOLCK: return "no locks available";
 #endif
-#if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
+#ifdef ENOLINK
     case ENOLINK: return "link has been severed";
 #endif
 #ifdef ENOMEM
@@ -732,7 +747,7 @@ Tcl_ErrnoMsg(
 #ifdef ENOPKG
     case ENOPKG: return "package not installed";
 #endif
-#if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
+#ifdef ENOPROTOOPT
     case ENOPROTOOPT: return "bad protocol option";
 #endif
 #ifdef ENOSPC
@@ -756,6 +771,9 @@ Tcl_ErrnoMsg(
 #ifdef ENOTCONN
     case ENOTCONN: return "socket is not connected";
 #endif
+#ifdef ENOTRECOVERABLE
+    case ENOTRECOVERABLE: return "state not recoverable";
+#endif
 #ifdef ENOTDIR
     case ENOTDIR: return "not a directory";
 #endif
@@ -783,9 +801,15 @@ Tcl_ErrnoMsg(
 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
     case EOPNOTSUPP: return "operation not supported on socket";
 #endif
+#ifdef EOTHER
+    case EOTHER: return "other error";
+#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";
+#endif
 #ifdef EPERM
     case EPERM: return "not owner";
 #endif
@@ -847,7 +871,7 @@ Tcl_ErrnoMsg(
     case ERREMOTE: return "object is remote";
 #endif
 #ifdef ESHUTDOWN
-    case ESHUTDOWN: return "can't send after socket shutdown";
+    case ESHUTDOWN: return "cannot send after socket shutdown";
 #endif
 #ifdef ESOCKTNOSUPPORT
     case ESOCKTNOSUPPORT: return "socket type not supported";
@@ -874,7 +898,7 @@ Tcl_ErrnoMsg(
     case ETIMEDOUT: return "connection timed out";
 #endif
 #ifdef ETOOMANYREFS
-    case ETOOMANYREFS: return "too many references: can't splice";
+    case ETOOMANYREFS: return "too many references: cannot splice";
 #endif
 #ifdef ETXTBSY
     case ETXTBSY: return "text file or pseudo-device busy";
@@ -927,7 +951,7 @@ Tcl_ErrnoMsg(
  *----------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_SignalId(
      int sig)			/* Number of signal. */
 {
@@ -1061,7 +1085,7 @@ Tcl_SignalId(
  *----------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_SignalMsg(
      int sig)			/* Number of signal. */
 {
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index 0dc669c..cca13e8 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -89,10 +89,10 @@ TclFinalizePreserve(void)
 {
     Tcl_MutexLock(&preserveMutex);
     if (spaceAvl != 0) {
-        ckfree((char *) refArray);
-        refArray = NULL;
-        inUse = 0;
-        spaceAvl = 0;
+	ckfree(refArray);
+	refArray = NULL;
+	inUse = 0;
+	spaceAvl = 0;
     }
     Tcl_MutexUnlock(&preserveMutex);
 }
@@ -144,8 +144,7 @@ Tcl_Preserve(
 
     if (inUse == spaceAvl) {
 	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
-	refArray = (Reference *) ckrealloc((char *) refArray,
-		spaceAvl * sizeof(Reference));
+	refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference));
     }
 
     /*
@@ -225,9 +224,9 @@ Tcl_Release(
 	Tcl_MutexUnlock(&preserveMutex);
 	if (mustFree) {
 	    if (freeProc == TCL_DYNAMIC) {
-		ckfree((char *) clientData);
+		ckfree(clientData);
 	    } else {
-		(*freeProc)((char *) clientData);
+		freeProc(clientData);
 	    }
 	}
 	return;
@@ -238,7 +237,7 @@ Tcl_Release(
      * Reference not found. This is a bug in the caller.
      */
 
-    Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", PTR2UINT(clientData));
+    Tcl_Panic("Tcl_Release couldn't find reference for %p", clientData);
 }
 
 /*
@@ -278,13 +277,12 @@ Tcl_EventuallyFree(
 	    continue;
 	}
 	if (refPtr->mustFree) {
-	    Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x",
-		    PTR2UINT(clientData));
-        }
-        refPtr->mustFree = 1;
+	    Tcl_Panic("Tcl_EventuallyFree called twice for %p", clientData);
+	}
+	refPtr->mustFree = 1;
 	refPtr->freeProc = freeProc;
 	Tcl_MutexUnlock(&preserveMutex);
-        return;
+	return;
     }
     Tcl_MutexUnlock(&preserveMutex);
 
@@ -293,9 +291,9 @@ Tcl_EventuallyFree(
      */
 
     if (freeProc == TCL_DYNAMIC) {
-	ckfree((char *) clientData);
+	ckfree(clientData);
     } else {
-	(*freeProc)((char *)clientData);
+	freeProc(clientData);
     }
 }
 
@@ -329,9 +327,8 @@ TclHandleCreate(
 				 * be tracked for deletion. Must not be
 				 * NULL. */
 {
-    HandleStruct *handlePtr;
+    HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct));
 
-    handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
     handlePtr->ptr = ptr;
 #ifdef TCL_MEM_DEBUG
     handlePtr->ptr2 = ptr;
@@ -371,16 +368,16 @@ TclHandleFree(
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
+	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
     }
     if (handlePtr->ptr2 != handlePtr->ptr) {
-	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
     handlePtr->ptr = NULL;
     if (handlePtr->refCount == 0) {
-	ckfree((char *) handlePtr);
+	ckfree(handlePtr);
     }
 }
 
@@ -414,10 +411,10 @@ TclHandlePreserve(
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
+	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
     }
     if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
-	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
@@ -455,16 +452,15 @@ TclHandleRelease(
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
+	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
     }
     if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
-	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
-    handlePtr->refCount--;
-    if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
-	ckfree((char *) handlePtr);
+    if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
+	ckfree(handlePtr);
     }
 }
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index d58e8da..5c68e17 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -17,6 +17,16 @@
 #include "tclCompile.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 {
+    Command cmd;
+    ExtraFrameInfo efi;
+} ApplyExtraData;
+
+/*
  * Prototypes for static functions in this file
  */
 
@@ -27,29 +37,26 @@ 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);
+			    Namespace *nsPtr);
+static void		InitLocalCache(Proc *procPtr);
 static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 static void		ProcBodyFree(Tcl_Obj *objPtr);
-static int              ProcWrongNumArgs(Tcl_Interp *interp, int skip);
+static int		ProcWrongNumArgs(Tcl_Interp *interp, int skip);
 static void		MakeProcError(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
 static void		MakeLambdaError(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
 static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static int		ProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
-			    Tcl_Obj *bodyPtr, Namespace *nsPtr,
-			    CONST char *description, CONST char *procName,
-			    Proc **procPtrPtr);
+
+static Tcl_NRPostProc ApplyNR2;
+static Tcl_NRPostProc InterpProcNR2;
+static Tcl_NRPostProc Uplevel_Callback;
 
 /*
  * The ProcBodyObjType type
  */
 
-Tcl_ObjType tclProcBodyType = {
+const Tcl_ObjType tclProcBodyType = {
     "procbody",			/* name for this type */
     ProcBodyFree,		/* FreeInternalRep function */
     ProcBodyDup,		/* DupInternalRep function */
@@ -61,15 +68,14 @@ Tcl_ObjType tclProcBodyType = {
 };
 
 /*
- * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
- * encoding the type of level reference in ptr1 and the actual parsed out
- * offset in ptr2.
+ * The [upvar]/[uplevel] level reference type. Uses the longValue field
+ * to remember the integer value of a parsed #<integer> format.
  *
  * Uses the default behaviour throughout, and never disposes of the string
  * rep; it's just a cache type.
  */
 
-static Tcl_ObjType levelReferenceType = {
+static const Tcl_ObjType levelReferenceType = {
     "levelReference",
     NULL, NULL, NULL, NULL
 };
@@ -80,10 +86,10 @@ static Tcl_ObjType levelReferenceType = {
  *
  * 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.
+ * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
  */
 
-static Tcl_ObjType lambdaType = {
+const Tcl_ObjType tclLambdaType = {
     "lambdaExpr",		/* name */
     FreeLambdaInternalRep,	/* freeIntRepProc */
     DupLambdaInternalRep,	/* dupIntRepProc */
@@ -114,12 +120,12 @@ Tcl_ProcObjCmd(
     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. */
 {
     register Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
-    char *fullName;
-    CONST char *procName, *procArgs, *procBody;
+    const char *fullName;
+    const char *procName, *procArgs, *procBody;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
     Tcl_DString ds;
@@ -140,20 +146,25 @@ Tcl_ProcObjCmd(
 	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
 
     if (nsPtr == NULL) {
-	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
-		"\": unknown namespace", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create procedure \"%s\": unknown namespace",
+		fullName));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
     if (procName == NULL) {
-	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
-		"\": bad procedure name", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create procedure \"%s\": bad procedure name",
+		fullName));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create procedure \"%s\" in non-global namespace with"
+		" name starting with \":\"", procName));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
 
@@ -179,13 +190,12 @@ Tcl_ProcObjCmd(
     Tcl_DStringInit(&ds);
     if (nsPtr != iPtr->globalNsPtr) {
 	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-	Tcl_DStringAppend(&ds, "::", 2);
+	TclDStringAppendLiteral(&ds, "::");
     }
     Tcl_DStringAppend(&ds, procName, -1);
 
-    cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
-	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
-
+    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
+	    TclNRInterpProc, procPtr, TclProcDeleteProc);
     Tcl_DStringFree(&ds);
 
     /*
@@ -205,17 +215,15 @@ Tcl_ProcObjCmd(
      *
      * 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
+     * line array of the context, and the lambda code requires some special
      * processing. Find a way to factor the common elements into a single
      * function.
      */
 
     if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr;
+	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
 
-	contextPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
 	*contextPtr = *iPtr->cmdFramePtr;
-
 	if (contextPtr->type == TCL_LOCATION_BC) {
 	    /*
 	     * Retrieve source information from the bytecode, if possible. If
@@ -243,12 +251,12 @@ Tcl_ProcObjCmd(
 	    if (contextPtr->line
 		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
 		int isNew;
-		Tcl_HashEntry* hePtr;
-		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+		Tcl_HashEntry *hePtr;
+		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
 
 		cfPtr->level = -1;
 		cfPtr->type = contextPtr->type;
-		cfPtr->line = (int *) ckalloc(sizeof(int));
+		cfPtr->line = ckalloc(sizeof(int));
 		cfPtr->line[0] = contextPtr->line[3];
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;
@@ -257,34 +265,35 @@ Tcl_ProcObjCmd(
 		cfPtr->data.eval.path = contextPtr->data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
+		cfPtr->cmd = NULL;
+		cfPtr->len = 0;
 
-		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew);
+		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
+			procPtr, &isNew);
 		if (!isNew) {
 		    /*
-		     * Get the old command frame and release it.  See also
+		     * Get the old command frame and release it. See also
 		     * TclProcCleanupProc in this file. Currently it seems as
 		     * if only the procbodytest::proc command of the testsuite
 		     * is able to trigger this situation.
 		     */
 
-		    CmdFrame* cfOldPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
+		    CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);
 
 		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
 			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
 			cfOldPtr->data.eval.path = NULL;
 		    }
-		    ckfree((char *) cfOldPtr->line);
+		    ckfree(cfOldPtr->line);
 		    cfOldPtr->line = NULL;
-		    ckfree((char *) cfOldPtr);
+		    ckfree(cfOldPtr);
 		}
 		Tcl_SetHashValue(hePtr, cfPtr);
 	    }
 
 	    /*
-	     * 'contextPtr' is going out of scope; account for the reference that
-	     * it's holding to the path name.
+	     * 'contextPtr' is going out of scope; account for the reference
+	     * that it's holding to the path name.
 	     */
 
 	    Tcl_DecrRefCount(contextPtr->data.eval.path);
@@ -378,17 +387,17 @@ int
 TclCreateProc(
     Tcl_Interp *interp,		/* Interpreter containing proc. */
     Namespace *nsPtr,		/* Namespace containing this proc. */
-    CONST char *procName,	/* Unqualified name of 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;
+    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;
@@ -427,7 +436,7 @@ TclCreateProc(
 	 */
 
 	if (Tcl_IsShared(bodyPtr)) {
-	    Tcl_Obj* sharedBodyPtr = bodyPtr;
+	    Tcl_Obj *sharedBodyPtr = bodyPtr;
 
 	    bytes = TclGetStringFromObj(bodyPtr, &length);
 	    bodyPtr = Tcl_NewStringObj(bytes, length);
@@ -438,7 +447,7 @@ TclCreateProc(
 	     * not lost and applies to the new body as well.
 	     */
 
-	    TclContinuationsCopy (bodyPtr, sharedBodyPtr);
+	    TclContinuationsCopy(bodyPtr, sharedBodyPtr);
 	}
 
 	/*
@@ -449,7 +458,7 @@ TclCreateProc(
 
 	Tcl_IncrRefCount(bodyPtr);
 
-	procPtr = (Proc *) ckalloc(sizeof(Proc));
+	procPtr = ckalloc(sizeof(Proc));
 	procPtr->iPtr = iPtr;
 	procPtr->refCount = 1;
 	procPtr->bodyPtr = bodyPtr;
@@ -480,6 +489,8 @@ TclCreateProc(
 		    "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;
@@ -490,7 +501,7 @@ TclCreateProc(
 
     for (i = 0; i < numArgs; i++) {
 	int fieldCount, nameLength, valueLength;
-	CONST char **fieldValues;
+	const char **fieldValues;
 
 	/*
 	 * Now divide the specifier up into name and default.
@@ -502,15 +513,20 @@ TclCreateProc(
 	    goto procError;
 	}
 	if (fieldCount > 2) {
-	    ckfree((char *) fieldValues);
-	    Tcl_AppendResult(interp,
-		    "too many fields in argument specifier \"",
-		    argArray[i], "\"", NULL);
+	    ckfree(fieldValues);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "too many fields in argument specifier \"%s\"",
+		    argArray[i]));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+		    "FORMALARGUMENTFORMAT", NULL);
 	    goto procError;
 	}
 	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
-	    ckfree((char *) fieldValues);
-	    Tcl_AppendResult(interp, "argument with no name", NULL);
+	    ckfree(fieldValues);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "argument with no name", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+		    "FORMALARGUMENTFORMAT", NULL);
 	    goto procError;
 	}
 
@@ -528,23 +544,27 @@ TclCreateProc(
 	p = fieldValues[0];
 	while (*p != '\0') {
 	    if (*p == '(') {
-		CONST char *q = 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((char *) fieldValues);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "formal parameter \"%s\" is an array element",
+			    fieldValues[0]));
+		    ckfree(fieldValues);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			    "FORMALARGUMENTFORMAT", NULL);
 		    goto procError;
 		}
 	    } else if ((*p == ':') && (*(p+1) == ':')) {
-		Tcl_AppendResult(interp, "formal parameter \"",
-			fieldValues[0],
-			"\" is not a simple name", NULL);
-		ckfree((char *) fieldValues);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"formal parameter \"%s\" is not a simple name",
+			fieldValues[0]));
+		ckfree(fieldValues);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			"FORMALARGUMENTFORMAT", NULL);
 		goto procError;
 	    }
 	    p++;
@@ -571,7 +591,9 @@ TclCreateProc(
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			"procedure \"%s\": formal parameter %d is "
 			"inconsistent with precompiled body", procName, i));
-		ckfree((char *) fieldValues);
+		ckfree(fieldValues);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			"BYTECODELIES", NULL);
 		goto procError;
 	    }
 
@@ -581,7 +603,7 @@ TclCreateProc(
 
 	    if (localPtr->defValuePtr != NULL) {
 		int tmpLength;
-		char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
+		const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
 			&tmpLength);
 
 		if ((valueLength != tmpLength) ||
@@ -590,7 +612,9 @@ TclCreateProc(
 			    "procedure \"%s\": formal parameter \"%s\" has "
 			    "default value inconsistent with precompiled body",
 			    procName, fieldValues[0]));
-		    ckfree((char *) fieldValues);
+		    ckfree(fieldValues);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			    "BYTECODELIES", NULL);
 		    goto procError;
 		}
 	    }
@@ -608,9 +632,7 @@ TclCreateProc(
 	     * local variables for the argument.
 	     */
 
-	    localPtr = (CompiledLocal *) ckalloc((unsigned)
-		    (sizeof(CompiledLocal) - sizeof(localPtr->name)
-			    + nameLength + 1));
+	    localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1);
 	    if (procPtr->firstLocalPtr == NULL) {
 		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
 	    } else {
@@ -639,11 +661,11 @@ TclCreateProc(
 	    }
 	}
 
-	ckfree((char *) fieldValues);
+	ckfree(fieldValues);
     }
 
     *procPtrPtr = procPtr;
-    ckfree((char *) argArray);
+    ckfree(argArray);
     return TCL_OK;
 
   procError:
@@ -660,12 +682,12 @@ TclCreateProc(
 		Tcl_DecrRefCount(defPtr);
 	    }
 
-	    ckfree((char *) localPtr);
+	    ckfree(localPtr);
 	}
-	ckfree((char *) procPtr);
+	ckfree(procPtr);
     }
     if (argArray != NULL) {
-	ckfree((char *) argArray);
+	ckfree(argArray);
     }
     return TCL_ERROR;
 }
@@ -698,7 +720,7 @@ TclCreateProc(
 int
 TclGetFrame(
     Tcl_Interp *interp,		/* Interpreter in which to find frame. */
-    CONST char *name,		/* String describing frame. */
+    const char *name,		/* String describing frame. */
     CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
 				 * global frame indicated). */
 {
@@ -744,8 +766,8 @@ TclGetFrame(
     return result;
 
   levelError:
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
     return -1;
 }
 
@@ -761,7 +783,7 @@ TclGetFrame(
  * 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
+ *	returned if objPtr was either an int or an int 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
@@ -783,93 +805,71 @@ TclObjGetFrame(
 {
     register Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
-    CallFrame *framePtr;
-    CONST char *name = TclGetString(objPtr);
+    const char *name = NULL;
 
     /*
      * Parse object to figure out which level number to go to.
      */
 
-    result = 1;
+    result = 0;
     curLevel = iPtr->varFramePtr->level;
-    if (objPtr->typePtr == &levelReferenceType) {
-	if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr1)) {
-	    level = curLevel - PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
-	} else {
-	    level = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
-	}
-	if (level < 0) {
-	    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;
-	}
 
-	/*
-	 * Cache for future reference.
-	 *
-	 * TODO: Use the new ptrAndLongRep intrep
-	 */
-
-	TclFreeIntRep(objPtr);
-	objPtr->typePtr = &levelReferenceType;
-	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
-	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
-    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
-	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
-	    return -1;
-	}
-
-	/*
-	 * Cache for future reference.
-	 *
-	 * TODO: Use the new ptrAndLongRep intrep
-	 */
+    /*
+     * Check for integer first, since that has potential to spare us
+     * a generation of a stringrep.
+     */
 
-	TclFreeIntRep(objPtr);
-	objPtr->typePtr = &levelReferenceType;
-	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
-	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
+    if (objPtr == NULL) {
+	/* Do nothing */
+    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
+	    && (level >= 0)) {
 	level = curLevel - level;
+	result = 1;
+    } else if (objPtr->typePtr == &levelReferenceType) {
+	level = (int) objPtr->internalRep.longValue;
+	result = 1;
     } else {
-	/*
-	 * Don't cache as the object *isn't* a level reference.
-	 */
-
-	level = curLevel - 1;
-	result = 0;
+	name = TclGetString(objPtr);
+	if (name[0] == '#') {
+	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
+		TclFreeIntRep(objPtr);
+		objPtr->typePtr = &levelReferenceType;
+		objPtr->internalRep.longValue = level;
+		result = 1;
+	    } else {
+		result = -1;
+	    }
+	} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
+	    /*
+	     * If this were an integer, we'd have succeeded already.
+	     * Docs say we have to treat this as a 'bad level'  error.
+	     */
+	    result = -1;
+	}
     }
 
-    /*
-     * 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 (result == 0) {
+	level = curLevel - 1;
+	name = "1";
+    }
+    if (result != -1) {
+	if (level >= 0) {
+	    CallFrame *framePtr;
+	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+		    framePtr = framePtr->callerVarPtr) {
+		if (framePtr->level == level) {
+		    *framePtrPtr = framePtr;
+		    return result;
+		}
+	    }
+	}
+	if (name == NULL) {
+	    name = TclGetString(objPtr);
 	}
     }
-    if (framePtr == NULL) {
-	goto levelError;
-    }
-    *framePtrPtr = framePtr;
-    return result;
 
-  levelError:
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
     return -1;
 }
 
@@ -890,17 +890,52 @@ 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_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;
     int result;
     CallFrame *savedVarFramePtr, *framePtr;
+    Tcl_Obj *objPtr;
 
     if (objc < 2) {
     uplevelSyntax:
@@ -916,11 +951,11 @@ Tcl_UplevelObjCmd(
     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.
@@ -935,14 +970,12 @@ Tcl_UplevelObjCmd(
 
     if (objc == 1) {
 	/*
-	 * TIP #280. Make argument location available to eval'd script
+	 * TIP #280. Make actual argument location available to eval'd script
 	 */
 
-	CmdFrame* invoker = NULL;
-	int word          = 0;
+	TclArgumentGet(interp, objv[0], &invoker, &word);
+	objPtr = objv[0];
 
-	TclArgumentGet (interp, objv[0], &invoker, &word);
-	result = TclEvalObjEx(interp, objv[0], 0, invoker, word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -950,22 +983,12 @@ Tcl_UplevelObjCmd(
 	 * 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) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"uplevel\" body line %d)", interp->errorLine));
     }
 
-    /*
-     * Restore the variable frame, and return.
-     */
-
-    iPtr->varFramePtr = savedVarFramePtr;
-    return result;
+    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
+	    NULL);
+    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
 
 /*
@@ -994,10 +1017,9 @@ Tcl_UplevelObjCmd(
 Proc *
 TclFindProc(
     Interp *iPtr,		/* Interpreter in which to look. */
-    CONST char *procName)	/* Name of desired procedure. */
+    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);
@@ -1006,14 +1028,7 @@ TclFindProc(
     }
     cmdPtr = (Command *) cmd;
 
-    origCmd = TclGetOriginalCommand(cmd);
-    if (origCmd != NULL) {
-	cmdPtr = (Command *) origCmd;
-    }
-    if (cmdPtr->objProc != TclObjInterpProc) {
-	return NULL;
-    }
-    return (Proc *) cmdPtr->objClientData;
+    return TclIsProc(cmdPtr);
 }
 
 /*
@@ -1038,41 +1053,21 @@ Proc *
 TclIsProc(
     Command *cmdPtr)		/* Command to test. */
 {
-    Tcl_Command origCmd;
+    Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
 
-    origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
     if (origCmd != NULL) {
 	cmdPtr = (Command *) origCmd;
     }
-    if (cmdPtr->objProc == TclObjInterpProc) {
-	return (Proc *) cmdPtr->objClientData;
+    if (cmdPtr->deleteProc == TclProcDeleteProc) {
+	return cmdPtr->objClientData;
     }
-    return (Proc *) 0;
+    return NULL;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * InitArgsAndLocals --
- *
- *	This routine is invoked in order to initialize the arguments and other
- *	compiled locals table for a new call frame.
- *
- * Results:
- *	A standard Tcl result.
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
 static int
 ProcWrongNumArgs(
-    Tcl_Interp *interp, int skip)
+    Tcl_Interp *interp,
+    int skip)
 {
     CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
     register Proc *procPtr = framePtr->procPtr;
@@ -1086,18 +1081,16 @@ ProcWrongNumArgs(
      */
 
     numArgs = framePtr->procPtr->numArgs;
-    desiredObjs = (Tcl_Obj **) TclStackAlloc(interp,
+    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);
+	desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
 #endif /* AVOID_HACKS_FOR_ITCL */
     }
     Tcl_IncrRefCount(desiredObjs[0]);
@@ -1112,7 +1105,7 @@ ProcWrongNumArgs(
 	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
 	} else if (defPtr->flags & VAR_IS_ARGS) {
 	    numArgs--;
-	    final = "...";
+	    final = "?arg ...?";
 	    break;
 	} else {
 	    argObj = namePtr;
@@ -1142,7 +1135,6 @@ ProcWrongNumArgs(
  *	DEPRECATED: functionality has been inlined elsewhere; this function
  *	remains to insure binary compatibility with Itcl.
  *
-
  * Results:
  *	None.
  *
@@ -1152,6 +1144,7 @@ ProcWrongNumArgs(
  *
  *----------------------------------------------------------------------
  */
+
 void
 TclInitCompiledLocals(
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -1221,37 +1214,7 @@ InitResolvedLocals(
     }
 
     if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
-	/*
-	 * Initialize the array of local variables stored in the call frame.
-	 * Some variables may have special resolution rules. In that case, we
-	 * call their "resolver" procs to get our hands on the variable, and
-	 * we make the compiled local a link to the real variable.
-	 */
-
-    doInitResolvedLocals:
-	for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
-	    varPtr->flags = 0;
-	    varPtr->value.objPtr = NULL;
-
-	    /*
-	     * Now invoke the resolvers to determine the exact variables
-	     * that should be used.
-	     */
-
-	    resVarInfo = localPtr->resolveInfo;
-	    if (resVarInfo && resVarInfo->fetchProc) {
-		Var *resolvedVarPtr = (Var *)
-		    (*resVarInfo->fetchProc)(interp, resVarInfo);
-		if (resolvedVarPtr) {
-		    if (TclIsVarInHash(resolvedVarPtr)) {
-			VarHashRefCount(resolvedVarPtr)++;
-		    }
-		    varPtr->flags = VAR_LINK;
-		    varPtr->value.linkPtr = resolvedVarPtr;
-		}
-	    }
-	}
-	return;
+	goto doInitResolvedLocals;
     }
 
     /*
@@ -1265,7 +1228,7 @@ InitResolvedLocals(
 	    if (localPtr->resolveInfo->deleteProc) {
 		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
 	    } else {
-		ckfree((char *) localPtr->resolveInfo);
+		ckfree(localPtr->resolveInfo);
 	    }
 	    localPtr->resolveInfo = NULL;
 	}
@@ -1278,7 +1241,7 @@ InitResolvedLocals(
 	    int result;
 
 	    if (nsPtr->compiledVarResProc) {
-		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
+		result = nsPtr->compiledVarResProc(nsPtr->interp,
 			localPtr->name, localPtr->nameLength,
 			(Tcl_Namespace *) nsPtr, &vinfo);
 	    } else {
@@ -1287,7 +1250,7 @@ InitResolvedLocals(
 
 	    while ((result == TCL_CONTINUE) && resPtr) {
 		if (resPtr->compiledVarResProc) {
-		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+		    result = resPtr->compiledVarResProc(nsPtr->interp,
 			    localPtr->name, localPtr->nameLength,
 			    (Tcl_Namespace *) nsPtr, &vinfo);
 		}
@@ -1301,9 +1264,40 @@ InitResolvedLocals(
     }
     localPtr = firstLocalPtr;
     codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
-    goto doInitResolvedLocals;
-}
 
+    /*
+     * 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.
+     */
+
+  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,
@@ -1313,25 +1307,19 @@ TclFreeLocalCache(
     Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
 
     for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
-	Tcl_Obj *objPtr = *namePtrPtr;
-	/*
-	 * Note that this can be called with interp==NULL, on interp
-	 * deletion. In that case, the literal table and objects go away
-	 * on their own.
-	 */
+	register Tcl_Obj *objPtr = *namePtrPtr;
+
 	if (objPtr) {
-	    if (interp) {
-		TclReleaseLiteral(interp, objPtr);
-	    } else {
-		Tcl_DecrRefCount(objPtr);
-	    }
+	    /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
+	    TclReleaseLiteral(interp, objPtr);
 	}
     }
-    ckfree((char *) localCachePtr);
+    ckfree(localCachePtr);
 }
-
+
 static void
-InitLocalCache(Proc *procPtr)
+InitLocalCache(
+    Proc *procPtr)
 {
     Interp *iPtr = procPtr->iPtr;
     ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
@@ -1350,9 +1338,9 @@ InitLocalCache(Proc *procPtr)
      * for future calls.
      */
 
-    localCachePtr = (LocalCache *) ckalloc(sizeof(LocalCache)
-	    + (localCt-1)*sizeof(Tcl_Obj *)
-	    + numArgs*sizeof(Var));
+    localCachePtr = ckalloc(sizeof(LocalCache)
+	    + (localCt - 1) * sizeof(Tcl_Obj *)
+	    + numArgs * sizeof(Var));
 
     namePtr = &localCachePtr->varName0;
     varPtr = (Var *) (namePtr + localCt);
@@ -1374,12 +1362,32 @@ InitLocalCache(Proc *procPtr)
 	    i++;
 	}
 	namePtr++;
-	localPtr=localPtr->nextPtr;
+	localPtr = localPtr->nextPtr;
     }
     codePtr->localCachePtr = localCachePtr;
     localCachePtr->refCount = 1;
-    localCachePtr->numVars  = localCt;
+    localCachePtr->numVars = localCt;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitArgsAndLocals --
+ *
+ *	This routine is invoked in order to initialize the arguments and other
+ *	compiled locals table for a new call frame.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
 static int
 InitArgsAndLocals(
@@ -1418,7 +1426,7 @@ InitArgsAndLocals(
      * parameters.
      */
 
-    varPtr = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var)));
+    varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var)));
     framePtr->compiledLocals = varPtr;
     framePtr->numCompiledLocals = localCt;
 
@@ -1441,7 +1449,7 @@ InitArgsAndLocals(
 	}
     }
     imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
-    for (i = 0; i < imax; i++, varPtr++, defPtr++) {
+    for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
 	/*
 	 * "Normal" arguments; last formal is special, depends on it being
 	 * 'args'.
@@ -1453,21 +1461,20 @@ InitArgsAndLocals(
 	varPtr->value.objPtr = objPtr;
 	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
     }
-    for (; i < numArgs-1; i++, varPtr++, defPtr++) {
+    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->value.objPtr;
+	Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL;
 
-	if (objPtr) {
-	    varPtr->flags = 0;
-	    varPtr->value.objPtr = objPtr;
-	    Tcl_IncrRefCount(objPtr);	/* Local var reference. */
-	} else {
+	if (!objPtr) {
 	    goto incorrectArgs;
 	}
+	varPtr->flags = 0;
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);	/* Local var reference. */
     }
 
     /*
@@ -1475,9 +1482,8 @@ InitArgsAndLocals(
      * defPtr and varPtr point to the last argument to be initialized.
      */
 
-
     varPtr->flags = 0;
-    if (defPtr->flags & VAR_IS_ARGS) {
+    if (defPtr && defPtr->flags & VAR_IS_ARGS) {
 	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
 
 	varPtr->value.objPtr = listPtr;
@@ -1487,7 +1493,7 @@ InitArgsAndLocals(
 
 	varPtr->value.objPtr = objPtr;
 	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-    } else if ((argCt < numArgs) && (defPtr->value.objPtr != NULL)) {
+    } else if ((argCt < numArgs) && defPtr && defPtr->value.objPtr) {
 	Tcl_Obj *objPtr = defPtr->value.objPtr;
 
 	varPtr->value.objPtr = objPtr;
@@ -1504,7 +1510,8 @@ InitArgsAndLocals(
 
   correctArgs:
     if (numArgs < localCt) {
-	if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
+	if (!framePtr->nsPtr->compiledVarResProc
+		&& !((Interp *)interp)->resolverPtr) {
 	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
 	} else {
 	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
@@ -1513,20 +1520,24 @@ InitArgsAndLocals(
 
     return TCL_OK;
 
-
-    incorrectArgs:
     /*
      * Initialise all compiled locals to avoid problems at DeleteLocalVars.
      */
 
-    memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr)*sizeof(Var));
+  incorrectArgs:
+    if ((skip != 1) &&
+	    TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+    }
+    memset(varPtr, 0,
+	    ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
     return ProcWrongNumArgs(interp, skip);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * PushProcCallFrame --
+ * TclPushProcCallFrame --
  *
  *	Compiles a proc body if necessary, then pushes a CallFrame suitable
  *	for executing it.
@@ -1541,19 +1552,19 @@ InitArgsAndLocals(
  *----------------------------------------------------------------------
  */
 
-static int
-PushProcCallFrame(
-    ClientData clientData, 	/* Record describing procedure to be
+int
+TclPushProcCallFrame(
+    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. */
+    Tcl_Obj *const objv[],	/* Argument value objects. */
     int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
 				 * needs special rules for error msg */
 {
-    Proc *procPtr = (Proc *) clientData;
+    Proc *procPtr = clientData;
     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
     CallFrame *framePtr, **framePtrPtr;
     int result;
@@ -1580,7 +1591,7 @@ PushProcCallFrame(
 	 */
 
 	codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
- 	if (((Interp *) *codePtr->interpHandle != iPtr)
+	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != nsPtr)
 		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
@@ -1588,9 +1599,9 @@ PushProcCallFrame(
 	}
     } else {
     doCompilation:
-	result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+	result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
 		(isLambda ? "body of lambda term" : "body of proc"),
-		TclGetString(objv[isLambda]), &procPtr);
+		TclGetString(objv[isLambda]));
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -1605,12 +1616,9 @@ PushProcCallFrame(
      */
 
     framePtrPtr = &framePtr;
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+    (void) 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;
@@ -1638,28 +1646,44 @@ PushProcCallFrame(
 
 int
 TclObjInterpProc(
-    ClientData clientData, 	/* Record describing procedure to be
+    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. */
+    Tcl_Obj *const objv[])	/* Argument value objects. */
 {
-    int result;
+    /*
+     * Not used much in the core; external interface for iTcl
+     */
 
-    result = PushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0);
-    if (result == TCL_OK) {
-	return TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError);
-    } else {
+    return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
+}
+
+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 = TclPushProcCallFrame(clientData, interp, objc, objv,
+	    /*isLambda*/ 0);
+
+    if (result != TCL_OK) {
 	return TCL_ERROR;
     }
+    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclObjInterpProcCore --
+ * TclNRInterpProcCore --
  *
  *	When a Tcl procedure, lambda term or anything else that works like a
  *	procedure gets invoked during bytecode evaluation, this object-based
@@ -1675,23 +1699,29 @@ TclObjInterpProc(
  */
 
 int
-TclObjInterpProcCore(
+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
+    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) {
-	goto procDone;
+	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;
     }
 
 #if defined(TCL_COMPILE_DEBUG)
@@ -1715,25 +1745,42 @@ TclObjInterpProcCore(
 
 #ifdef USE_DTRACE
     if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
-	char *a[10];
-	int i = 0;
 	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+	const char *a[10];
+	int i;
 
-	while (i < 10) {
+	for (i = 0 ; i < 10 ; i++) {
 	    a[i] = (l < iPtr->varFramePtr->objc ?
-		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL); i++; l++;
+		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL);
+	    l++;
 	}
 	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
 		a[8], a[9]);
     }
     if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
 	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
-	char *a[4]; int i[2];
+	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]);
+	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;
+
+	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));
+    }
+    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));
+    }
 #endif /* USE_DTRACE */
 
     /*
@@ -1741,45 +1788,69 @@ TclObjInterpProcCore(
      */
 
     procPtr->refCount++;
-    iPtr->numLevels++;
+    codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
 
-    if (TclInterpReady(interp) == TCL_ERROR) {
-	result = TCL_ERROR;
-    } else {
-	register ByteCode *codePtr =
-		procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
+	    NULL, NULL);
+    return TclNRExecuteByteCode(interp, codePtr);
+}
 
-	codePtr->refCount++;
-#ifdef USE_DTRACE
-	if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
-	    int l;
+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];
 
-	    l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
-	    TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
-		    iPtr->varFramePtr->objc - l,
-		    (Tcl_Obj **)(iPtr->varFramePtr->objv + l));
-	}
-#endif /* USE_DTRACE */
-	result = TclExecuteByteCode(interp, codePtr);
-	if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
-	    TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
-	}
-	codePtr->refCount--;
-	if (codePtr->refCount <= 0) {
-	    TclCleanupByteCode(codePtr);
-	}
-    }
+    if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
+	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
 
-    iPtr->numLevels--;
-    procPtr->refCount--;
-    if (procPtr->refCount <= 0) {
+	TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
+		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
+    }
+    if (procPtr->refCount-- <= 1) {
 	TclProcCleanupProc(procPtr);
     }
 
     /*
-     * Process the result code.
+     * 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.
+     */
+
+    if (result != TCL_OK) {
+	goto process;
+    }
+
+    done:
+    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+	Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+	TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
+		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
+		TclGetString(r), r);
+    }
+
+    freePtr = iPtr->framePtr;
+    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
+    TclStackFree(interp, freePtr->compiledLocals);
+					/* Free compiledLocals. */
+    TclStackFree(interp, freePtr);	/* Free CallFrame. */
+    return result;
+
+    /*
+     * Process any non-TCL_OK result code.
      */
 
+    process:
     switch (result) {
     case TCL_RETURN:
 	/*
@@ -1796,10 +1867,10 @@ TclObjInterpProcCore(
 	 * transform to an error now.
 	 */
 
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "invoked \"",
-		((result == TCL_BREAK) ? "break" : "continue"),
-		"\" outside of a loop", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"invoked \"%s\" outside of a loop",
+		((result == TCL_BREAK) ? "break" : "continue")));
+	Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
 	result = TCL_ERROR;
 
 	/*
@@ -1813,48 +1884,9 @@ TclObjInterpProcCore(
 	 * function handed to us as an argument.
 	 */
 
-	(*errorProc)(interp, procNameObj);
-
-    default:
-	/*
-	 * Process other results (OK and non-standard) by doing nothing
-	 * special, skipping directly to the code afterwards that cleans up
-	 * associated memory.
-	 *
-	 * Non-standard results are processed by passing them through quickly.
-	 * This means they all work as exceptions, unwinding the stack quickly
-	 * and neatly. Who knows how well they are handled by third-party code
-	 * though...
-	 */
-
-	(void) 0;		/* do nothing */
-    }
-
-#ifdef USE_DTRACE
-    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
-	Tcl_Obj *r;
-
-	r = Tcl_GetObjResult(interp);
-	TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
-		TclGetString(r), r);
+	errorProc(interp, procNameObj);
     }
-#endif /* USE_DTRACE */
-
-  procDone:
-    /*
-     * 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.
-     */
-
-    freePtr = iPtr->framePtr;
-    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
-    TclStackFree(interp, freePtr->compiledLocals);
-					/* Free compiledLocals. */
-    TclStackFree(interp, freePtr);	/* Free CallFrame. */
-    return result;
+    goto done;
 }
 
 /*
@@ -1882,34 +1914,15 @@ 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.) */
+				 * but could be any code fragment compiled in
+				 * the context of this procedure.) */
     Namespace *nsPtr,		/* Namespace containing procedure. */
-    CONST char *description,	/* string describing this body of code. */
-    CONST char *procName)	/* Name of this procedure. */
-{
-    return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
-	    procName, NULL);
-}
-
-static int
-ProcCompileProc(
-    Tcl_Interp *interp,		/* Interpreter containing procedure. */
-    Proc *procPtr,		/* Data associated with procedure. */
-    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
- 				 * but could be any code fragment compiled in
- 				 * the context of this procedure.) */
-    Namespace *nsPtr,		/* Namespace containing procedure. */
-    CONST char *description,	/* string describing this body of code. */
-    CONST char *procName,	/* Name of this procedure. */
-    Proc **procPtrPtr)		/* Points to storage where a replacement
-				 * (Proc *) value may be written. */
+    const char *description,	/* string describing this body of code. */
+    const char *procName)	/* Name of this procedure. */
 {
     Interp *iPtr = (Interp *) interp;
-    int i;
     Tcl_CallFrame *framePtr;
     ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
-    CompiledLocal *localPtr;
 
     /*
      * If necessary, compile the procedure's body. The compiler will allocate
@@ -1926,35 +1939,37 @@ ProcCompileProc(
      */
 
     if (bodyPtr->typePtr == &tclByteCodeType) {
- 	if (((Interp *) *codePtr->interpHandle == iPtr)
+	if (((Interp *) *codePtr->interpHandle == iPtr)
 		&& (codePtr->compileEpoch == iPtr->compileEpoch)
 		&& (codePtr->nsPtr == nsPtr)
 		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
 	    return TCL_OK;
-	} else {
-	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-		if ((Interp *) *codePtr->interpHandle != iPtr) {
-		    Tcl_AppendResult(interp,
-			    "a precompiled script jumped interps", NULL);
-		    return TCL_ERROR;
-		}
-		codePtr->compileEpoch = iPtr->compileEpoch;
-		codePtr->nsPtr = nsPtr;
-	    } else {
-		bodyPtr->typePtr->freeIntRepProc(bodyPtr);
-		bodyPtr->typePtr = NULL;
+	}
+
+	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+	    if ((Interp *) *codePtr->interpHandle != iPtr) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"a precompiled script jumped interps", -1));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			"CROSSINTERPBYTECODE", NULL);
+		return TCL_ERROR;
 	    }
- 	}
+	    codePtr->compileEpoch = iPtr->compileEpoch;
+	    codePtr->nsPtr = nsPtr;
+	} else {
+	    TclFreeIntRep(bodyPtr);
+	}
     }
+
     if (bodyPtr->typePtr != &tclByteCodeType) {
 	Tcl_HashEntry *hePtr;
 
 #ifdef TCL_COMPILE_DEBUG
- 	if (tclTraceCompile >= 1) {
- 	    /*
- 	     * Display a line summarizing the top level command we are about
- 	     * to compile.
- 	     */
+	if (tclTraceCompile >= 1) {
+	    /*
+	     * Display a line summarizing the top level command we are about
+	     * to compile.
+	     */
 
 	    Tcl_Obj *message;
 
@@ -1962,85 +1977,57 @@ ProcCompileProc(
 	    Tcl_IncrRefCount(message);
 	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
 	    Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
- 	    fprintf(stdout, "%s\"\n", TclGetString(message));
+	    fprintf(stdout, "%s\"\n", TclGetString(message));
 	    Tcl_DecrRefCount(message);
- 	}
+	}
 #endif
 
- 	/*
- 	 * Plug the current procPtr into the interpreter and coerce the code
- 	 * body to byte codes. The interpreter needs to know which proc it's
- 	 * compiling so that it can access its list of compiled locals.
- 	 *
- 	 * 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 *newProc = (Proc *) ckalloc(sizeof(Proc));
-
-	    newProc->iPtr = procPtr->iPtr;
-	    newProc->refCount = 1;
-	    newProc->cmdPtr = procPtr->cmdPtr;
-	    token = (Tcl_Command) newProc->cmdPtr;
-	    newProc->bodyPtr = Tcl_DuplicateObj(bodyPtr);
-	    bodyPtr = newProc->bodyPtr;
-	    Tcl_IncrRefCount(bodyPtr);
-	    newProc->numArgs = procPtr->numArgs;
-
-	    newProc->numCompiledLocals = newProc->numArgs;
-	    newProc->firstLocalPtr = NULL;
-	    newProc->lastLocalPtr = NULL;
-	    localPtr = procPtr->firstLocalPtr;
-	    for (i=0; i<newProc->numArgs; i++, localPtr=localPtr->nextPtr) {
-		CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned)
-			(sizeof(CompiledLocal) - sizeof(localPtr->name)
-			+ localPtr->nameLength + 1));
-
-		if (newProc->firstLocalPtr == NULL) {
-		    newProc->firstLocalPtr = newProc->lastLocalPtr = copy;
-		} else {
-		    newProc->lastLocalPtr->nextPtr = copy;
-		    newProc->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);
-	    }
+	/*
+	 * 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.
+	 */
 
-	    /*
-	     * Reset the ClientData
-	     */
+	iPtr->compiledProcPtr = procPtr;
+
+	if (procPtr->numCompiledLocals > procPtr->numArgs) {
+	    CompiledLocal *clPtr = procPtr->firstLocalPtr;
+	    CompiledLocal *lastPtr = NULL;
+	    int i, numArgs = procPtr->numArgs;
 
-	    Tcl_GetCommandInfoFromToken(token, &info);
-	    if (info.objClientData == (ClientData) procPtr) {
-		info.objClientData = (ClientData) newProc;
+	    for (i = 0; i < numArgs; i++) {
+		lastPtr = clPtr;
+		clPtr = clPtr->nextPtr;
 	    }
-	    if (info.clientData == (ClientData) procPtr) {
-		info.clientData = (ClientData) newProc;
+
+	    if (lastPtr) {
+		lastPtr->nextPtr = NULL;
+	    } else {
+		procPtr->firstLocalPtr = NULL;
 	    }
-	    if (info.deleteData == (ClientData) procPtr) {
-		info.deleteData = (ClientData) newProc;
+	    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);
 	    }
-	    Tcl_SetCommandInfoFromToken(token, &info);
-
-	    procPtr->refCount--;
-	    *procPtrPtr = procPtr = newProc;
+	    procPtr->numCompiledLocals = procPtr->numArgs;
 	}
- 	iPtr->compiledProcPtr = procPtr;
 
- 	(void) TclPushStackFrame(interp, &framePtr,
-		(Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0);
+	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
+		/* isProcCallFrame */ 0);
 
 	/*
 	 * TIP #280: We get the invoking context from the cmdFrame which
@@ -2054,9 +2041,8 @@ ProcCompileProc(
 	 */
 
 	iPtr->invokeWord = 0;
-	iPtr->invokeCmdFramePtr =
-		(hePtr ? (CmdFrame *) Tcl_GetHashValue(hePtr) : NULL);
-	(void) tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
+	TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
 	iPtr->invokeCmdFramePtr = NULL;
 	TclPopStackFrame(interp);
     } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
@@ -2103,7 +2089,7 @@ MakeProcError(
     Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 	    "\n    (procedure \"%.*s%s\" line %d)",
 	    (overflow ? limit : nameLen), procName,
-	    (overflow ? "..." : ""), interp->errorLine));
+	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
 }
 
 /*
@@ -2130,10 +2116,9 @@ void
 TclProcDeleteProc(
     ClientData clientData)	/* Procedure to be deleted. */
 {
-    Proc *procPtr = (Proc *) clientData;
+    Proc *procPtr = clientData;
 
-    procPtr->refCount--;
-    if (procPtr->refCount <= 0) {
+    if (procPtr->refCount-- <= 1) {
 	TclProcCleanupProc(procPtr);
     }
 }
@@ -2176,9 +2161,9 @@ TclProcCleanupProc(
 	resVarInfo = localPtr->resolveInfo;
 	if (resVarInfo) {
 	    if (resVarInfo->deleteProc) {
-		(*resVarInfo->deleteProc)(resVarInfo);
+		resVarInfo->deleteProc(resVarInfo);
 	    } else {
-		ckfree((char *) resVarInfo);
+		ckfree(resVarInfo);
 	    }
 	}
 
@@ -2186,16 +2171,15 @@ TclProcCleanupProc(
 	    defPtr = localPtr->defValuePtr;
 	    Tcl_DecrRefCount(defPtr);
 	}
-	ckfree((char *) localPtr);
+	ckfree(localPtr);
 	localPtr = nextPtr;
     }
-    ckfree((char *) procPtr);
+    ckfree(procPtr);
 
     /*
      * 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. See also Tcl_ProcObjCmd(), when
-     * the same ProcPtr is overwritten with a new CmdFrame.
+     * procbody structures created by tbcload.
      */
 
     if (iPtr == NULL) {
@@ -2207,16 +2191,16 @@ TclProcCleanupProc(
 	return;
     }
 
-    cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
+    cfPtr = Tcl_GetHashValue(hePtr);
 
     if (cfPtr) {
 	if (cfPtr->type == TCL_LOCATION_SOURCE) {
 	    Tcl_DecrRefCount(cfPtr->data.eval.path);
 	    cfPtr->data.eval.path = NULL;
 	}
-	ckfree((char *) cfPtr->line);
+	ckfree(cfPtr->line);
 	cfPtr->line = NULL;
-	ckfree((char *) cfPtr);
+	ckfree(cfPtr);
     }
     Tcl_DeleteHashEntry(hePtr);
 }
@@ -2389,7 +2373,7 @@ ProcBodyFree(
 {
     Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
-    if (procPtr->refCount-- < 2) {
+    if (procPtr->refCount-- <= 1) {
 	TclProcCleanupProc(procPtr);
     }
 }
@@ -2421,7 +2405,7 @@ DupLambdaInternalRep(
 
     procPtr->refCount++;
     Tcl_IncrRefCount(nsObjPtr);
-    copyPtr->typePtr = &lambdaType;
+    copyPtr->typePtr = &tclLambdaType;
 }
 
 static void
@@ -2432,8 +2416,7 @@ FreeLambdaInternalRep(
     Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
     Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
 
-    procPtr->refCount--;
-    if (procPtr->refCount == 0) {
+    if (procPtr->refCount-- == 1) {
 	TclProcCleanupProc(procPtr);
     }
     TclDecrRefCount(nsObjPtr);
@@ -2446,8 +2429,8 @@ SetLambdaFromAny(
     register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     Interp *iPtr = (Interp *) interp;
-    char *name;
-    Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
+    const char *name;
+    Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
     int isNew, objc, result;
     CmdFrame *cfPtr = NULL;
     Proc *procPtr;
@@ -2458,15 +2441,15 @@ SetLambdaFromAny(
 
     /*
      * 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.
+     * length is not 2, then it cannot be converted to tclLambdaType.
      */
 
     result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
     if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
-	TclNewLiteralStringObj(errPtr, "can't interpret \"");
-	Tcl_AppendObjToObj(errPtr, objPtr);
-	Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
-	Tcl_SetObjResult(interp, errPtr);
+	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;
     }
 
@@ -2515,11 +2498,9 @@ SetLambdaFromAny(
      */
 
     if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr;
+	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
 
-	contextPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
 	*contextPtr = *iPtr->cmdFramePtr;
-
 	if (contextPtr->type == TCL_LOCATION_BC) {
 	    /*
 	     * Retrieve the source context from the bytecode. This call
@@ -2553,12 +2534,12 @@ SetLambdaFromAny(
 		 * location (line of 2nd list element).
 		 */
 
-		cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+		cfPtr = ckalloc(sizeof(CmdFrame));
 		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
 
 		cfPtr->level = -1;
 		cfPtr->type = contextPtr->type;
-		cfPtr->line = (int *) ckalloc(sizeof(int));
+		cfPtr->line = ckalloc(sizeof(int));
 		cfPtr->line[0] = buf[1];
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;
@@ -2567,8 +2548,8 @@ SetLambdaFromAny(
 		cfPtr->data.eval.path = contextPtr->data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
+		cfPtr->cmd = NULL;
+		cfPtr->len = 0;
 	    }
 
 	    /*
@@ -2580,7 +2561,7 @@ SetLambdaFromAny(
 	}
 	TclStackFree(interp, contextPtr);
     }
-    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr,
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
 	    &isNew), cfPtr);
 
     /*
@@ -2591,7 +2572,7 @@ SetLambdaFromAny(
     if (objc == 2) {
 	TclNewLiteralStringObj(nsObjPtr, "::");
     } else {
-	char *nsName = TclGetString(objv[2]);
+	const char *nsName = TclGetString(objv[2]);
 
 	if ((*nsName != ':') || (*(nsName+1) != ':')) {
 	    TclNewLiteralStringObj(nsObjPtr, "::");
@@ -2606,14 +2587,14 @@ SetLambdaFromAny(
     /*
      * 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.
+     * conversion to tclLambdaType.
      */
 
-    objPtr->typePtr->freeIntRepProc(objPtr);
+    TclFreeIntRep(objPtr);
 
     objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
     objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
-    objPtr->typePtr = &lambdaType;
+    objPtr->typePtr = &tclLambdaType;
     return TCL_OK;
 }
 
@@ -2639,37 +2620,51 @@ Tcl_ApplyObjCmd(
     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. */
+{
+    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. */
 {
     Interp *iPtr = (Interp *) interp;
     Proc *procPtr = NULL;
     Tcl_Obj *lambdaPtr, *nsObjPtr;
-    int result, isRootEnsemble;
-    Command cmd;
+    int result;
     Tcl_Namespace *nsPtr;
-    ExtraFrameInfo efi;
+    ApplyExtraData *extraPtr;
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?");
 	return TCL_ERROR;
     }
 
     /*
-     * Set lambdaPtr, convert it to lambdaType in the current interp if
+     * Set lambdaPtr, convert it to tclLambdaType in the current interp if
      * necessary.
      */
 
     lambdaPtr = objv[1];
-    if (lambdaPtr->typePtr == &lambdaType) {
+    if (lambdaPtr->typePtr == &tclLambdaType) {
 	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;
@@ -2691,25 +2686,6 @@ Tcl_ApplyObjCmd(
 	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
     }
 
-    memset(&cmd, 0, sizeof(Command));
-    procPtr->cmdPtr = &cmd;
-
-    /*
-     * TIP#280 (semi-)HACK!
-     *
-     * Using cmd.clientData to tell [info frame] how to render the
-     * 'lambdaPtr'. The InfoFrameCmd will detect this case by testing cmd.hPtr
-     * for NULL. This condition holds here because of the 'memset' above, and
-     * nowhere else (in the core). Regular commands always have a valid
-     * 'hPtr', and lambda's never.
-     */
-
-    efi.length = 1;
-    efi.fields[0].name = "lambda";
-    efi.fields[0].proc = NULL;
-    efi.fields[0].clientData = lambdaPtr;
-    cmd.clientData = &efi;
-
     /*
      * Find the namespace where this lambda should run, and push a call frame
      * for that namespace. Note that TclObjInterpProc() will pop it.
@@ -2718,31 +2694,47 @@ Tcl_ApplyObjCmd(
     nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
     result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
     if (result != TCL_OK) {
-	return result;
+	return TCL_ERROR;
     }
 
-    cmd.nsPtr = (Namespace *) nsPtr;
+    extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData));
+    memset(&extraPtr->cmd, 0, sizeof(Command));
+    procPtr->cmdPtr = &extraPtr->cmd;
+    extraPtr->cmd.nsPtr = (Namespace *) nsPtr;
 
-    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = objv;
-	iPtr->ensembleRewrite.numRemovedObjs = 1;
-	iPtr->ensembleRewrite.numInsertedObjs = 0;
-    } else {
-	iPtr->ensembleRewrite.numInsertedObjs -= 1;
-    }
+    /*
+     * 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.
+     */
 
-    result = PushProcCallFrame((ClientData) procPtr, interp, objc, objv, 1);
+    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;
+
+    result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
     if (result == TCL_OK) {
-	result = TclObjInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
+	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
+	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
     }
+    return result;
+}
 
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = NULL;
-	iPtr->ensembleRewrite.numRemovedObjs = 0;
-	iPtr->ensembleRewrite.numInsertedObjs = 0;
-    }
+static int
+ApplyNR2(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    ApplyExtraData *extraPtr = data[0];
 
+    TclStackFree(interp, extraPtr);
     return result;
 }
 
@@ -2778,131 +2770,42 @@ MakeLambdaError(
     Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 	    "\n    (lambda term \"%.*s%s\" line %d)",
 	    (overflow ? limit : nameLen), procName,
-	    (overflow ? "..." : ""), interp->errorLine));
+	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
 }
 
-
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_DisassembleObjCmd --
+ * TclGetCmdFrameForProcedure --
+ *
+ *	How to get the CmdFrame information for a procedure.
  *
- *	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.
+ * Results:
+ *	A pointer to the CmdFrame (only guaranteed to be valid until the next
+ *	Tcl command is processed or the interpreter's state is otherwise
+ *	modified) or a NULL if the information is not available.
+ *
+ * Side effects:
+ *	none.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_DisassembleObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
+CmdFrame *
+TclGetCmdFrameForProcedure(
+    Proc *procPtr)		/* The procedure whose cmd-frame is to be
+				 * looked up. */
 {
-    static const char *types[] = {
-	"lambda", "proc", "script", NULL
-    };
-    enum Types {
-	DISAS_LAMBDA, DISAS_PROC, DISAS_SCRIPT
-    };
-    int idx, result;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "type procName|lambdaTerm|script");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
-	return TCL_ERROR;
-    }
-
-    switch ((enum Types) idx) {
-    case DISAS_LAMBDA: {
-	Proc *procPtr = NULL;
-	Command cmd;
-	Tcl_Obj *nsObjPtr;
-	Tcl_Namespace *nsPtr;
-
-	/*
-	 * Compile (if uncompiled) and disassemble a lambda term.
-	 */
-
-	if (objv[2]->typePtr == &lambdaType) {
-	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
-	}
-	if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
-	    result = SetLambdaFromAny(interp, objv[2]);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
-	}
-
-	memset(&cmd, 0, sizeof(Command));
-	nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
-	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	cmd.nsPtr = (Namespace *) nsPtr;
-	procPtr->cmdPtr = &cmd;
-	result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	TclPopStackFrame(interp);
-	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
-		& TCL_BYTECODE_PRECOMPILED) {
-	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
-		    NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
-	break;
-    }
-    case DISAS_PROC: {
-	Proc *procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
-
-	if (procPtr == NULL) {
-	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
-		    "\" isn't a procedure", NULL);
-	    return TCL_ERROR;
-	}
+    Tcl_HashEntry *hePtr;
 
-	/*
-	 * Compile (if uncompiled) and disassemble a procedure.
-	 */
-
-	result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	TclPopStackFrame(interp);
-	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
-		& TCL_BYTECODE_PRECOMPILED) {
-	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
-		    NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
-	break;
+    if (procPtr == NULL || procPtr->iPtr == NULL) {
+	return NULL;
     }
-    case DISAS_SCRIPT:
-	/*
-	 * Compile and disassemble a script.
-	 */
-
-	if (objv[2]->typePtr != &tclByteCodeType) {
-	    if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){
-		return TCL_ERROR;
-	    }
-	}
-	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(objv[2]));
-	break;
+    hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr);
+    if (hePtr == NULL) {
+	return NULL;
     }
-    return TCL_OK;
+    return (CmdFrame *) Tcl_GetHashValue(hePtr);
 }
 
 /*
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index dac6aba..ea25d4b 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -53,8 +53,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.		 ***
  */
 
 /*
@@ -100,7 +100,7 @@ static int		SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  * compiled form of the regular expression.
  */
 
-Tcl_ObjType tclRegexpType = {
+const Tcl_ObjType tclRegexpType = {
     "regexp",				/* name */
     FreeRegexpInternalRep,		/* freeIntRepProc */
     DupRegexpInternalRep,		/* dupIntRepProc */
@@ -173,7 +173,7 @@ Tcl_RegExpExec(
 				 * that "^" won't match. */
 {
     int flags, result, numChars;
-    TclRegexp *regexp = (TclRegexp *)re;
+    TclRegexp *regexp = (TclRegexp *) re;
     Tcl_DString ds;
     const Tcl_UniChar *ustr;
 
@@ -391,9 +391,8 @@ Tcl_RegExpMatch(
     const char *text,		/* Text to search for pattern matches. */
     const char *pattern)	/* Regular expression to match against text. */
 {
-    Tcl_RegExp re;
+    Tcl_RegExp re = Tcl_RegExpCompile(interp, pattern);
 
-    re = Tcl_RegExpCompile(interp, pattern);
     if (re == NULL) {
 	return -1;
     }
@@ -436,7 +435,8 @@ Tcl_RegExpExecObj(
     Tcl_UniChar *udata;
     int length;
     int reflags = regexpPtr->flags;
-#define TCL_REG_GLOBOK_FLAGS (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)
+#define TCL_REG_GLOBOK_FLAGS \
+	(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)
 
     /*
      * Take advantage of the equivalent glob pattern, if one exists.
@@ -571,14 +571,14 @@ Tcl_GetRegExpFromObj(
 {
     int length;
     TclRegexp *regexpPtr;
-    char *pattern;
+    const char *pattern;
 
     /*
      * This is OK because we only actually interpret this value properly as a
      * TclRegexp* when the type is tclRegexpType.
      */
 
-    regexpPtr = (TclRegexp *) objPtr->internalRep.twoPtrValue.ptr1;
+    regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
 	pattern = TclGetStringFromObj(objPtr, &length);
@@ -601,7 +601,7 @@ Tcl_GetRegExpFromObj(
 	 */
 
 	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = (void *) regexpPtr;
+	objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
 	objPtr->typePtr = &tclRegexpType;
     }
     return (Tcl_RegExp) regexpPtr;
@@ -654,7 +654,7 @@ TclRegAbout(
 	{0,			NULL}
     };
     const struct infoname *inf;
-    Tcl_Obj *infoObj;
+    Tcl_Obj *infoObj, *resultObj;
 
     /*
      * The reset here guarantees that the interpreter result is empty and
@@ -670,7 +670,8 @@ TclRegAbout(
      * well and Tcl has other limits that constrain things as well...
      */
 
-    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+    resultObj = Tcl_NewObj();
+    Tcl_ListObjAppendElement(NULL, resultObj,
 	    Tcl_NewIntObj((int) regexpPtr->re.re_nsub));
 
     /*
@@ -684,7 +685,8 @@ TclRegAbout(
 		    Tcl_NewStringObj(inf->text, -1));
 	}
     }
-    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), infoObj);
+    Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
+    Tcl_SetObjResult(interp, resultObj);
 
     return 0;
 }
@@ -712,14 +714,14 @@ TclRegError(
     int status)			/* Status code to report. */
 {
     char buf[100];		/* ample in practice */
-    char cbuf[100];		/* lots in practice */
+    char cbuf[TCL_INTEGER_SPACE];
     size_t n;
     const char *p;
 
     Tcl_ResetResult(interp);
     n = TclReError(status, NULL, buf, sizeof(buf));
     p = (n > sizeof(buf)) ? "..." : "";
-    Tcl_AppendResult(interp, msg, buf, p, NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p));
 
     sprintf(cbuf, "%d", status);
     (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
@@ -747,13 +749,13 @@ static void
 FreeRegexpInternalRep(
     Tcl_Obj *objPtr)		/* Regexp object with internal rep to free. */
 {
-    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.twoPtrValue.ptr1;
+    TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
 
     /*
      * If this is the last reference to the regexp, free it.
      */
 
-    if (--(regexpRepPtr->refCount) <= 0) {
+    if (regexpRepPtr->refCount-- <= 1) {
 	FreeRegexp(regexpRepPtr);
     }
     objPtr->typePtr = NULL;
@@ -781,7 +783,7 @@ DupRegexpInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.twoPtrValue.ptr1;
+    TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
     regexpPtr->refCount++;
     copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
@@ -903,7 +905,7 @@ CompileRegexp(
      * This is a new expression, so compile it and add it to the cache.
      */
 
-    regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
+    regexpPtr = ckalloc(sizeof(TclRegexp));
     regexpPtr->objPtr = NULL;
     regexpPtr->string = NULL;
     regexpPtr->details.rm_extend.rm_so = -1;
@@ -930,7 +932,7 @@ CompileRegexp(
 	 * Clean up and report errors in the interpreter, if possible.
 	 */
 
-	ckfree((char *)regexpPtr);
+	ckfree(regexpPtr);
 	if (interp) {
 	    TclRegError(interp,
 		    "couldn't compile regular expression pattern: ", status);
@@ -944,11 +946,10 @@ CompileRegexp(
      * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
      */
 
-    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
-	regexpPtr->globObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&stringBuf),
-		Tcl_DStringLength(&stringBuf));
+    if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
+	    NULL) == TCL_OK) {
+	regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
 	Tcl_IncrRefCount(regexpPtr->globObjPtr);
-	Tcl_DStringFree(&stringBuf);
     } else {
 	regexpPtr->globObjPtr = NULL;
     }
@@ -958,8 +959,8 @@ CompileRegexp(
      * the entire pattern.
      */
 
-    regexpPtr->matches = (regmatch_t *) ckalloc(
-	    sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
+    regexpPtr->matches =
+	    ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
 
     /*
      * Initialize the refcount to one initially, since it is in the cache.
@@ -974,7 +975,8 @@ CompileRegexp(
 
     if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
 	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
-	if (--(oldRegexpPtr->refCount) <= 0) {
+
+	if (oldRegexpPtr->refCount-- <= 1) {
 	    FreeRegexp(oldRegexpPtr);
 	}
 	ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
@@ -984,8 +986,8 @@ CompileRegexp(
 	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
 	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
     }
-    tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
-    strcpy(tsdPtr->patterns[0], string);
+    tsdPtr->patterns[0] = ckalloc(length + 1);
+    memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
     tsdPtr->patLengths[0] = length;
     tsdPtr->regexps[0] = regexpPtr;
 
@@ -1017,9 +1019,9 @@ FreeRegexp(
 	TclDecrRefCount(regexpPtr->globObjPtr);
     }
     if (regexpPtr->matches) {
-	ckfree((char *) regexpPtr->matches);
+	ckfree(regexpPtr->matches);
     }
-    ckfree((char *) regexpPtr);
+    ckfree(regexpPtr);
 }
 
 /*
@@ -1048,16 +1050,18 @@ FinalizeRegexp(
 
     for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
 	regexpPtr = tsdPtr->regexps[i];
-	if (--(regexpPtr->refCount) <= 0) {
+	if (regexpPtr->refCount-- <= 1) {
 	    FreeRegexp(regexpPtr);
 	}
 	ckfree(tsdPtr->patterns[i]);
 	tsdPtr->patterns[i] = NULL;
     }
+
     /*
      * We may find ourselves reinitialized if another finalization routine
      * invokes regexps.
      */
+
     tsdPtr->initialized = 0;
 }
 
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index 8650776..3b2433e 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -28,7 +28,7 @@ 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
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index 8bb5e2b..974737e 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.c
@@ -55,7 +55,7 @@ void
 Tcl_AddInterpResolvers(
     Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
 				 * being modified. */
-    CONST char *name,		/* Name of this resolution scheme. */
+    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. */
@@ -65,6 +65,7 @@ Tcl_AddInterpResolvers(
 {
     Interp *iPtr = (Interp *) interp;
     ResolverScheme *resPtr;
+    unsigned len;
 
     /*
      * Since we're adding a new name resolution scheme, we must force all code
@@ -100,9 +101,10 @@ Tcl_AddInterpResolvers(
      * list, so that it overrides existing schemes.
      */
 
-    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
-    resPtr->name = (char *) ckalloc((unsigned)(strlen(name) + 1));
-    strcpy(resPtr->name, name);
+    resPtr = ckalloc(sizeof(ResolverScheme));
+    len = strlen(name) + 1;
+    resPtr->name = ckalloc(len);
+    memcpy(resPtr->name, name, len);
     resPtr->cmdResProc = cmdProc;
     resPtr->varResProc = varProc;
     resPtr->compiledVarResProc = compiledVarProc;
@@ -134,7 +136,7 @@ int
 Tcl_GetInterpResolvers(
     Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
 				 * being queried. */
-    CONST char *name,		/* Look for a scheme with this name. */
+    const char *name,		/* Look for a scheme with this name. */
     Tcl_ResolverInfo *resInfoPtr)
 				/* Returns pointers to the functions, if
 				 * found */
@@ -186,7 +188,7 @@ int
 Tcl_RemoveInterpResolvers(
     Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
 				 * being modified. */
-    CONST char *name)		/* Name of the scheme to be removed. */
+    const char *name)		/* Name of the scheme to be removed. */
 {
     Interp *iPtr = (Interp *) interp;
     ResolverScheme **prevPtrPtr, *resPtr;
@@ -224,7 +226,7 @@ Tcl_RemoveInterpResolvers(
 
 	*prevPtrPtr = resPtr->nextPtr;
 	ckfree(resPtr->name);
-	ckfree((char *) resPtr);
+	ckfree(resPtr);
 
 	return 1;
     }
@@ -260,11 +262,23 @@ BumpCmdRefEpochs(
 
     nsPtr->cmdRefEpoch++;
 
+#ifndef BREAK_NAMESPACE_COMPAT
     for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
 	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
-	Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
+	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);
+
+	    BumpCmdRefEpochs(childNsPtr);
+	}
+    }
+#endif
     TclInvalidateNsPath(nsPtr);
 }
 
@@ -280,8 +294,8 @@ BumpCmdRefEpochs(
  *
  *	Command resolution is handled by a function of the following type:
  *
- *	  typedef int (*Tcl_ResolveCmdProc)(Tcl_Interp *interp,
- *		  CONST char *name, Tcl_Namespace *context,
+ *	  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
@@ -295,8 +309,8 @@ BumpCmdRefEpochs(
  *	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,
+ *	  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
@@ -311,8 +325,8 @@ BumpCmdRefEpochs(
  *	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,
+ *	  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
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 7b58d44..9d0714c 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -17,7 +17,7 @@
 
 enum returnKeys {
     KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,
-    KEY_LEVEL,	KEY_OPTIONS,	KEY_LAST
+    KEY_LEVEL,	KEY_OPTIONS,	KEY_ERRORSTACK,	KEY_LAST
 };
 
 /*
@@ -44,6 +44,8 @@ typedef struct InterpState {
     Tcl_Obj *errorCode;
     Tcl_Obj *returnOpts;
     Tcl_Obj *objResult;
+    Tcl_Obj *errorStack;
+    int resetErrorStack;
 } InterpState;
 
 /*
@@ -72,14 +74,16 @@ Tcl_SaveInterpState(
     Tcl_Interp *interp,		/* Interpreter's state to be saved */
     int status)			/* status code for current operation */
 {
-    Interp *iPtr = (Interp *)interp;
-    InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState));
+    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);
     }
@@ -91,6 +95,9 @@ Tcl_SaveInterpState(
     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;
@@ -119,8 +126,8 @@ 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;
+    Interp *iPtr = (Interp *) interp;
+    InterpState *statePtr = (InterpState *) state;
     int status = statePtr->status;
 
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -128,6 +135,7 @@ Tcl_RestoreInterpState(
 
     iPtr->returnLevel = statePtr->returnLevel;
     iPtr->returnCode = statePtr->returnCode;
+    iPtr->resetErrorStack = statePtr->resetErrorStack;
     if (iPtr->errorInfo) {
 	Tcl_DecrRefCount(iPtr->errorInfo);
     }
@@ -142,6 +150,13 @@ Tcl_RestoreInterpState(
     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);
     }
@@ -175,7 +190,7 @@ void
 Tcl_DiscardInterpState(
     Tcl_InterpState state)	/* saved interpreter state */
 {
-    InterpState *statePtr = (InterpState *)state;
+    InterpState *statePtr = (InterpState *) state;
 
     if (statePtr->errorInfo) {
 	Tcl_DecrRefCount(statePtr->errorInfo);
@@ -186,8 +201,11 @@ Tcl_DiscardInterpState(
     if (statePtr->returnOpts) {
 	Tcl_DecrRefCount(statePtr->returnOpts);
     }
+    if (statePtr->errorStack) {
+	Tcl_DecrRefCount(statePtr->errorStack);
+    }
     Tcl_DecrRefCount(statePtr->objResult);
-    ckfree((char *) statePtr);
+    ckfree(statePtr);
 }
 
 /*
@@ -212,6 +230,7 @@ Tcl_DiscardInterpState(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_SaveResult
 void
 Tcl_SaveResult(
     Tcl_Interp *interp,		/* Interpreter to save. */
@@ -286,6 +305,7 @@ Tcl_SaveResult(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_RestoreResult
 void
 Tcl_RestoreResult(
     Tcl_Interp *interp,		/* Interpreter being restored. */
@@ -313,7 +333,7 @@ Tcl_RestoreResult(
 	 */
 
 	if (iPtr->appendResult != NULL) {
-	    ckfree((char *) iPtr->appendResult);
+	    ckfree(iPtr->appendResult);
 	}
 
 	iPtr->appendResult = statePtr->appendResult;
@@ -354,6 +374,7 @@ Tcl_RestoreResult(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_DiscardResult
 void
 Tcl_DiscardResult(
     Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
@@ -362,12 +383,10 @@ Tcl_DiscardResult(
 
     if (statePtr->result == statePtr->appendResult) {
 	ckfree(statePtr->appendResult);
+    } else if (statePtr->freeProc == TCL_DYNAMIC) {
+        ckfree(statePtr->result);
     } else if (statePtr->freeProc) {
-	if (statePtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(statePtr->result);
-	} else {
-	    (*statePtr->freeProc)(statePtr->result);
-	}
+        statePtr->freeProc(statePtr->result);
     }
 }
 
@@ -399,7 +418,6 @@ Tcl_SetResult(
 				 * a Tcl_FreeProc such as free. */
 {
     Interp *iPtr = (Interp *) interp;
-    int length;
     register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
     char *oldResult = iPtr->result;
 
@@ -408,17 +426,18 @@ Tcl_SetResult(
 	iPtr->result = iPtr->resultSpace;
 	iPtr->freeProc = 0;
     } else if (freeProc == TCL_VOLATILE) {
-	length = strlen(result);
+	int length = strlen(result);
+
 	if (length > TCL_RESULT_SIZE) {
-	    iPtr->result = (char *) ckalloc((unsigned) length+1);
+	    iPtr->result = ckalloc(length + 1);
 	    iPtr->freeProc = TCL_DYNAMIC;
 	} else {
 	    iPtr->result = iPtr->resultSpace;
 	    iPtr->freeProc = 0;
 	}
-	strcpy(iPtr->result, result);
+	memcpy(iPtr->result, result, (unsigned) length+1);
     } else {
-	iPtr->result = result;
+	iPtr->result = (char *) result;
 	iPtr->freeProc = freeProc;
     }
 
@@ -432,7 +451,7 @@ Tcl_SetResult(
 	if (oldFreeProc == TCL_DYNAMIC) {
 	    ckfree(oldResult);
 	} else {
-	    (*oldFreeProc)(oldResult);
+	    oldFreeProc(oldResult);
 	}
     }
 
@@ -460,7 +479,7 @@ Tcl_SetResult(
  *----------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_GetStringResult(
     register Tcl_Interp *interp)/* Interpreter whose result to return. */
 {
@@ -469,11 +488,13 @@ Tcl_GetStringResult(
      * result, then reset the object result.
      */
 
-    if (*(interp->result) == 0) {
+    Interp *iPtr = (Interp *) interp;
+
+    if (*(iPtr->result) == 0) {
 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
 		TCL_VOLATILE);
     }
-    return interp->result;
+    return iPtr->result;
 }
 
 /*
@@ -523,7 +544,7 @@ Tcl_SetObjResult(
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
 	} else {
-	    (*iPtr->freeProc)(iPtr->result);
+	    iPtr->freeProc(iPtr->result);
 	}
 	iPtr->freeProc = 0;
     }
@@ -565,7 +586,7 @@ Tcl_GetObjResult(
      * result, then reset the string result.
      */
 
-    if (*(iPtr->result) != 0) {
+    if (iPtr->result[0] != 0) {
 	ResetObjResult(iPtr);
 
 	objResultPtr = iPtr->objResultPtr;
@@ -576,12 +597,12 @@ Tcl_GetObjResult(
 	    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;
+	iPtr->result[0] = 0;
     }
     return iPtr->objResultPtr;
 }
@@ -628,14 +649,14 @@ Tcl_AppendResultVA(
      * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
      */
 
-#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
+#ifdef USE_INTERP_RESULT
     /*
      * Ensure that the interp->result is legal so old Tcl 7.* code still
      * works. There's still embarrasingly much of it about...
      */
 
     (void) Tcl_GetStringResult(interp);
-#endif /* USE_DIRECT_INTERP_RESULT_ACCESS */
+#endif /* USE_INTERP_RESULT */
 }
 
 /*
@@ -697,7 +718,7 @@ void
 Tcl_AppendElement(
     Tcl_Interp *interp,		/* Interpreter whose result is to be
 				 * extended. */
-    CONST char *element)	/* String to convert to list element and add
+    const char *element)	/* String to convert to list element and add
 				 * to result. */
 {
     Interp *iPtr = (Interp *) interp;
@@ -811,7 +832,7 @@ SetupAppendBuffer(
 	} else {
 	    totalSpace *= 2;
 	}
-	new = (char *) ckalloc((unsigned) totalSpace);
+	new = ckalloc(totalSpace);
 	strcpy(new, iPtr->result);
 	if (iPtr->appendResult != NULL) {
 	    ckfree(iPtr->appendResult);
@@ -858,7 +879,7 @@ Tcl_FreeResult(
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
 	} else {
-	    (*iPtr->freeProc)(iPtr->result);
+	    iPtr->freeProc(iPtr->result);
 	}
 	iPtr->freeProc = 0;
     }
@@ -896,7 +917,7 @@ Tcl_ResetResult(
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
 	} else {
-	    (*iPtr->freeProc)(iPtr->result);
+	    iPtr->freeProc(iPtr->result);
 	}
 	iPtr->freeProc = 0;
     }
@@ -920,6 +941,7 @@ Tcl_ResetResult(
 	Tcl_DecrRefCount(iPtr->errorInfo);
 	iPtr->errorInfo = NULL;
     }
+    iPtr->resetErrorStack = 1;
     iPtr->returnLevel = 1;
     iPtr->returnCode = TCL_OK;
     if (iPtr->returnOpts) {
@@ -962,13 +984,12 @@ ResetObjResult(
     } else {
 	if (objResultPtr->bytes != tclEmptyStringRep) {
 	    if (objResultPtr->bytes) {
-		ckfree((char *) objResultPtr->bytes);
+		ckfree(objResultPtr->bytes);
 	    }
 	    objResultPtr->bytes = tclEmptyStringRep;
 	    objResultPtr->length = 0;
 	}
 	TclFreeIntRep(objResultPtr);
-	objResultPtr->typePtr = NULL;
     }
 }
 
@@ -1005,6 +1026,7 @@ Tcl_SetErrorCodeVA(
 
     while (1) {
 	char *elem = va_arg(argList, char *);
+
 	if (elem == NULL) {
 	    break;
 	}
@@ -1083,6 +1105,43 @@ Tcl_SetObjErrorCode(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_GetErrorLine --
+ *
+ *      Returns the line number associated with the current error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_GetErrorLine
+int
+Tcl_GetErrorLine(
+    Tcl_Interp *interp)
+{
+    return ((Interp *) interp)->errorLine;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorLine --
+ *
+ *      Sets the line number associated with the current error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_SetErrorLine
+void
+Tcl_SetErrorLine(
+    Tcl_Interp *interp,
+    int value)
+{
+    ((Interp *) interp)->errorLine = value;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * GetKeys --
  *
  *	Returns a Tcl_Obj * array of the standard keys used in the return
@@ -1095,8 +1154,8 @@ Tcl_SetObjErrorCode(
  *	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.
+ *	First time called in a thread, creates the keys (allocating memory)
+ *	and arranges for their cleanup at thread exit.
  *
  *----------------------------------------------------------------------
  */
@@ -1119,6 +1178,7 @@ GetKeys(void)
 	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");
 
@@ -1130,7 +1190,7 @@ GetKeys(void)
 	 * ... and arrange for their clenaup.
 	 */
 
-	Tcl_CreateThreadExitHandler(ReleaseKeys, (ClientData) keys);
+	Tcl_CreateThreadExitHandler(ReleaseKeys, keys);
     }
     return keys;
 }
@@ -1147,7 +1207,7 @@ GetKeys(void)
  *	None.
  *
  * Side effects:
- * 	Frees memory.
+ *	Frees memory.
  *
  *----------------------------------------------------------------------
  */
@@ -1156,7 +1216,7 @@ static void
 ReleaseKeys(
     ClientData clientData)
 {
-    Tcl_Obj **keys = (Tcl_Obj **)clientData;
+    Tcl_Obj **keys = clientData;
     int i;
 
     for (i = KEY_CODE; i < KEY_LAST; i++) {
@@ -1180,7 +1240,7 @@ ReleaseKeys(
  *	Returns the return code the [return] command should return.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -1213,7 +1273,8 @@ TclProcessReturn(
 	    Tcl_DecrRefCount(iPtr->errorInfo);
 	    iPtr->errorInfo = NULL;
 	}
-	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr);
+	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
+                &valuePtr);
 	if (valuePtr != NULL) {
 	    int infoLen;
 
@@ -1224,14 +1285,50 @@ TclProcessReturn(
 		iPtr->flags |= ERR_ALREADY_LOGGED;
 	    }
 	}
-	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], &valuePtr);
+	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);
+	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE],
+                &valuePtr);
 	if (valuePtr != NULL) {
 	    TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
 	}
@@ -1255,12 +1352,12 @@ TclProcessReturn(
  *	Parses, checks, and stores the options to the [return] command.
  *
  * Results:
- *	Returns TCL_ERROR is any of the option values are invalid. Otherwise,
+ *	Returns TCL_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.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -1269,16 +1366,16 @@ int
 TclMergeReturnOptions(
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[],	/* Argument objects. */
+    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 */
+				 * options dictionary should be written. */
     int *codePtr,		/* If not NULL, points to space where the
-				 * -code value should be written */
+				 * -code value should be written. */
     int *levelPtr)		/* If not NULL, points to space where the
-				 * -level value should be written */
+				 * -level value should be written. */
 {
-    int code=TCL_OK;
+    int code = TCL_OK;
     int level = 1;
     Tcl_Obj *valuePtr;
     Tcl_Obj *returnOpts = Tcl_NewObj();
@@ -1286,12 +1383,12 @@ TclMergeReturnOptions(
 
     for (;  objc > 1;  objv += 2, objc -= 2) {
 	int optLen;
-	CONST char *opt = TclGetStringFromObj(objv[0], &optLen);
+	const char *opt = TclGetStringFromObj(objv[0], &optLen);
 	int compareLen;
-	CONST char *compare =
+	const char *compare =
 		TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
 
-	if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) {
+	if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) {
 	    Tcl_DictSearch search;
 	    int done = 0;
 	    Tcl_Obj *keyPtr;
@@ -1304,10 +1401,11 @@ TclMergeReturnOptions(
 		 * Value is not a legal dictionary.
 		 */
 
-		Tcl_ResetResult(interp);
-		Tcl_AppendResult(interp, "bad ", compare,
-			" value: expected dictionary but got \"",
-			TclGetString(objv[1]), "\"", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                        "bad %s value: expected dictionary but got \"%s\"",
+                        compare, TclGetString(objv[1])));
+		Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
+			NULL);
 		goto error;
 	    }
 
@@ -1333,27 +1431,11 @@ TclMergeReturnOptions(
      */
 
     Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
-    if ((valuePtr != NULL)
-	    && (TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &code))) {
-	static CONST char *returnCodes[] = {
-	    "ok", "error", "return", "break", "continue", NULL
-	};
-
-	if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
-		NULL, TCL_EXACT, &code)) {
-	    /*
-	     * Value is not a legal return code.
-	     */
-
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad completion code \"",
-		    TclGetString(valuePtr),
-		    "\": must be ok, error, return, break, "
-		    "continue, or an integer", NULL);
+    if (valuePtr != NULL) {
+	if (TclGetCompletionCodeFromObj(interp, valuePtr,
+                &code) == TCL_ERROR) {
 	    goto error;
 	}
-    }
-    if (valuePtr != NULL) {
 	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
     }
 
@@ -1369,10 +1451,10 @@ TclMergeReturnOptions(
 	     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+                    "bad -level value: expected non-negative integer but got"
+                    " \"%s\"", TclGetString(valuePtr)));
+	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL);
 	    goto error;
 	}
 	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
@@ -1390,12 +1472,48 @@ TclMergeReturnOptions(
 	    /*
 	     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+                    "bad -errorcode value: expected a list but got \"%s\"",
+                    TclGetString(valuePtr)));
+	    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_SetObjResult(interp, Tcl_ObjPrintf(
+                    "bad -errorstack value: expected a list but got \"%s\"",
+                    TclGetString(valuePtr)));
+	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
+                    NULL);
 	    goto error;
 	}
+        if (length % 2) {
+            /*
+             * Errorstack must always be an even-sized list
+             */
+
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "forbidden odd-sized list for -errorstack: \"%s\"",
+		    TclGetString(valuePtr)));
+	    Tcl_SetErrorCode(interp, "TCL", "RESULT",
+                    "ODDSIZEDLIST_ERRORSTACK", NULL);
+	    goto error;
+        }
     }
 
     /*
@@ -1474,7 +1592,8 @@ Tcl_GetReturnOptions(
     }
 
     if (result == TCL_ERROR) {
-	Tcl_AddObjErrorInfo(interp, "", -1);
+	Tcl_AddErrorInfo(interp, "");
+        Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
     }
     if (iPtr->errorCode) {
 	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
@@ -1490,6 +1609,31 @@ Tcl_GetReturnOptions(
 /*
  *-------------------------------------------------------------------------
  *
+ * 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();
+
+    Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
+    return options;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
  * Tcl_SetReturnOptions --
  *
  *	Accepts an interp and a dictionary of return options, and sets the
@@ -1518,9 +1662,9 @@ Tcl_SetReturnOptions(
     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_SetObjResult(interp, Tcl_ObjPrintf(
+                "expected dict but got \"%s\"", TclGetString(options)));
+	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL);
 	code = TCL_ERROR;
     } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
 	    &mergedOpts, &code, &level)) {
@@ -1536,7 +1680,7 @@ Tcl_SetReturnOptions(
 /*
  *-------------------------------------------------------------------------
  *
- * TclTransferResult --
+ * 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
@@ -1562,7 +1706,7 @@ Tcl_SetReturnOptions(
  */
 
 void
-TclTransferResult(
+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
@@ -1605,5 +1749,7 @@ TclTransferResult(
  * 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 229f3fa..3edb8be 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -43,10 +43,10 @@ typedef struct CharSet {
  * Declarations for functions used only in this file.
  */
 
-static char *		BuildCharSet(CharSet *cset, char *format);
+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, char *format,
+static int		ValidateFormat(Tcl_Interp *interp, const char *format,
 			    int numVars, int *totalVars);
 
 /*
@@ -67,14 +67,14 @@ static int		ValidateFormat(Tcl_Interp *interp, char *format,
  *----------------------------------------------------------------------
  */
 
-static char *
+static const char *
 BuildCharSet(
     CharSet *cset,
-    char *format)		/* Points to first char of set. */
+    const char *format)		/* Points to first char of set. */
 {
     Tcl_UniChar ch, start;
     int offset, nranges;
-    char *end;
+    const char *end;
 
     memset(cset, 0, sizeof(CharSet));
 
@@ -101,10 +101,9 @@ BuildCharSet(
 	end += Tcl_UtfToUniChar(end, &ch);
     }
 
-    cset->chars = (Tcl_UniChar *)
-	    ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+    cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
     if (nranges > 0) {
-	cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
+	cset->ranges = ckalloc(sizeof(struct Range) * nranges);
     } else {
 	cset->ranges = NULL;
     }
@@ -224,9 +223,9 @@ static void
 ReleaseCharSet(
     CharSet *cset)
 {
-    ckfree((char *)cset->chars);
+    ckfree(cset->chars);
     if (cset->ranges) {
-	ckfree((char *)cset->ranges);
+	ckfree(cset->ranges);
     }
 }
 
@@ -250,7 +249,7 @@ ReleaseCharSet(
 static int
 ValidateFormat(
     Tcl_Interp *interp,		/* Current interpreter. */
-    char *format,		/* The format string. */
+    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
@@ -260,8 +259,12 @@ ValidateFormat(
     char *end;
     Tcl_UniChar ch;
     int objIndex, xpgSize, nspace = numVars;
-    int *nassign = (int *) TclStackAlloc(interp, nspace * sizeof(int));
+    int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
     char buf[TCL_UTF_MAX+1];
+    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
+				 * these are messy operations because we do
+				 * not want to use the formatting engine;
+				 * we're inside there! */
 
     /*
      * Initialize an array that records the number of times a variable is
@@ -329,9 +332,10 @@ ValidateFormat(
 	gotSequential = 1;
 	if (gotXpg) {
 	mixedXPG:
-	    Tcl_SetResult(interp,
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "cannot mix \"%\" and \"%n$\" conversion specifiers",
-		    TCL_STATIC);
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
 	    goto error;
 	}
 
@@ -341,7 +345,7 @@ ValidateFormat(
 	 */
 
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    value = strtoul(format-1, &format, 10);	/* INTL: "C" locale. */
+	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */
 	    flags |= SCAN_WIDTH;
 	    format += Tcl_UtfToUniChar(format, &ch);
 	}
@@ -375,9 +379,10 @@ ValidateFormat(
 	switch (ch) {
 	case 'c':
 	    if (flags & SCAN_WIDTH) {
-		Tcl_SetResult(interp,
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"field width may not be specified in %c conversion",
-			TCL_STATIC);
+			-1));
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
 		goto error;
 	    }
 	    /*
@@ -388,9 +393,12 @@ ValidateFormat(
 	    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);
+		errorMsg = Tcl_NewStringObj(
+			"field size modifier may not be specified in %", -1);
+		Tcl_AppendToObj(errorMsg, buf, -1);
+		Tcl_AppendToObj(errorMsg, " conversion", -1);
+		Tcl_SetObjResult(interp, errorMsg);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
 		goto error;
 	    }
 	    /*
@@ -406,11 +414,13 @@ ValidateFormat(
 	case 'o':
 	case 'x':
 	case 'X':
+	case 'b':
 	    break;
 	case 'u':
 	    if (flags & SCAN_BIG) {
-		Tcl_SetResult(interp,
-			"unsigned bignum scans are invalid", TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"unsigned bignum scans are invalid", -1));
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
 		goto error;
 	    }
 	    break;
@@ -445,18 +455,19 @@ ValidateFormat(
 	    }
 	    break;
 	badSet:
-	    Tcl_SetResult(interp, "unmatched [ in format string",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "unmatched [ in format string", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
 	    goto error;
 	default:
-	    {
-		char buf[TCL_UTF_MAX+1];
-
-		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
-		Tcl_AppendResult(interp, "bad scan conversion character \"",
-			buf, "\"", NULL);
-		goto error;
-	    }
+	    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+	    errorMsg = Tcl_NewStringObj(
+		    "bad scan conversion character \"", -1);
+	    Tcl_AppendToObj(errorMsg, buf, -1);
+	    Tcl_AppendToObj(errorMsg, "\"", -1);
+	    Tcl_SetObjResult(interp, errorMsg);
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
+	    goto error;
 	}
 	if (!(flags & SCAN_SUPPRESS)) {
 	    if (objIndex >= nspace) {
@@ -472,7 +483,7 @@ ValidateFormat(
 		} else {
 		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
 		}
-		nassign = (int *) TclStackRealloc(interp, nassign,
+		nassign = TclStackRealloc(interp, nassign,
 			nspace * sizeof(int));
 		for (i = value; i < nspace; i++) {
 		    nassign[i] = 0;
@@ -499,9 +510,10 @@ ValidateFormat(
     }
     for (i = 0; i < numVars; i++) {
 	if (nassign[i] > 1) {
-	    Tcl_SetResult(interp,
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "variable is assigned by multiple \"%n$\" conversion specifiers",
-		    TCL_STATIC);
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
 	    goto error;
 	} else if (!xpgSize && (nassign[i] == 0)) {
 	    /*
@@ -509,9 +521,10 @@ ValidateFormat(
 	     * and/or numVars != 0), then too many vars were given
 	     */
 
-	    Tcl_SetResult(interp,
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "variable is not assigned by any conversion specifiers",
-		    TCL_STATIC);
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
 	    goto error;
 	}
     }
@@ -521,12 +534,14 @@ ValidateFormat(
 
   badIndex:
     if (gotXpg) {
-	Tcl_SetResult(interp, "\"%n$\" argument index out of range",
-		TCL_STATIC);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"\"%n$\" argument index out of range", -1));
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
     } else {
-	Tcl_SetResult(interp,
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"different numbers of variable names and field specifiers",
-		TCL_STATIC);
+		-1));
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
     }
 
   error:
@@ -554,16 +569,16 @@ ValidateFormat(
 	/* ARGSUSED */
 int
 Tcl_ScanObjCmd(
-    ClientData dummy,    	/* Not used. */
+    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. */
 {
-    char *format;
+    const char *format;
     int numVars, nconversions, totalVars = -1;
     int objIndex, offset, i, result, code;
     long value;
-    CONST char *string, *end, *baseString;
+    const char *string, *end, *baseString;
     char op = 0;
     int width, underflow = 0;
     Tcl_WideInt wideValue;
@@ -576,11 +591,11 @@ Tcl_ScanObjCmd(
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"string format ?varName varName ...?");
+		"string format ?varName ...?");
 	return TCL_ERROR;
     }
 
-    format = Tcl_GetStringFromObj(objv[2], NULL);
+    format = Tcl_GetString(objv[2]);
     numVars = objc-3;
 
     /*
@@ -596,13 +611,13 @@ Tcl_ScanObjCmd(
      */
 
     if (totalVars > 0) {
-	objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
+	objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
 	for (i = 0; i < totalVars; i++) {
 	    objs[i] = NULL;
 	}
     }
 
-    string = Tcl_GetStringFromObj(objv[1], NULL);
+    string = Tcl_GetString(objv[1]);
     baseString = string;
 
     /*
@@ -676,7 +691,7 @@ Tcl_ScanObjCmd(
 	 */
 
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    width = (int) strtoul(format-1, &format, 10);/* INTL: "C" locale. */
+	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
 	    format += Tcl_UtfToUniChar(format, &ch);
 	} else {
 	    width = 0;
@@ -712,6 +727,7 @@ Tcl_ScanObjCmd(
 	    if (!(flags & SCAN_SUPPRESS)) {
 		objPtr = Tcl_NewIntObj(string - baseString);
 		Tcl_IncrRefCount(objPtr);
+		CLANG_ASSERT(objs);
 		objs[objIndex++] = objPtr;
 	    }
 	    nconversions++;
@@ -734,6 +750,10 @@ Tcl_ScanObjCmd(
 	    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;
@@ -818,6 +838,7 @@ Tcl_ScanObjCmd(
 	    if (!(flags & SCAN_SUPPRESS)) {
 		objPtr = Tcl_NewStringObj(string, end-string);
 		Tcl_IncrRefCount(objPtr);
+		CLANG_ASSERT(objs);
 		objs[objIndex++] = objPtr;
 	    }
 	    string = end;
@@ -868,6 +889,7 @@ Tcl_ScanObjCmd(
 	    if (!(flags & SCAN_SUPPRESS)) {
 		objPtr = Tcl_NewIntObj((int)sch);
 		Tcl_IncrRefCount(objPtr);
+		CLANG_ASSERT(objs);
 		objs[objIndex++] = objPtr;
 	    }
 	    break;
@@ -972,6 +994,7 @@ Tcl_ScanObjCmd(
 		    }
 		}
 		Tcl_SetDoubleObj(objPtr, dvalue);
+		CLANG_ASSERT(objs);
 		objs[objIndex++] = objPtr;
 		string = end;
 	    }
@@ -993,9 +1016,14 @@ Tcl_ScanObjCmd(
 		continue;
 	    }
 	    result++;
-	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
-		Tcl_AppendResult(interp, "couldn't set variable \"",
-			TclGetString(objv[i+3]), "\"", NULL);
+
+	    /*
+	     * 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;
 	    }
 	    Tcl_DecrRefCount(objs[i]);
@@ -1021,7 +1049,7 @@ Tcl_ScanObjCmd(
 	}
     }
     if (objs != NULL) {
-	ckfree((char*) objs);
+	ckfree(objs);
     }
     if (code == TCL_OK) {
 	if (underflow && (nconversions == 0)) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index b89ce45..67b6482 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1,6 +1,4 @@
 /*
- *----------------------------------------------------------------------
- *
  * tclStrToD.c --
  *
  *	This file contains a collection of procedures for managing conversions
@@ -13,7 +11,6 @@
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *----------------------------------------------------------------------
  */
 
 #include "tclInt.h"
@@ -38,6 +35,11 @@
 #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
@@ -45,41 +47,65 @@
  * and ix86-isms are factored out here.
  */
 
-#if defined(__GNUC__) && defined(__i386)
-typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
-#define _FPU_GETCW(cw) __asm__ __volatile__ ("fnstcw %0" : "=m" (*&cw))
-#define _FPU_SETCW(cw) __asm__ __volatile__ ("fldcw %0" : : "m" (*&cw))
+#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
-#endif
+#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.
- *
- *
+/*
+ * Sun ProC needs sunmath for rounding control on x86 like gcc above.
  */
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
+#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.
+ * 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)
+#   define NAN_START	0x7ff4
+#   define NAN_MASK	(((Tcl_WideUInt) 1) << 50)
 #else
-#   define NAN_START 0x7ff8
-#   define NAN_MASK (((Tcl_WideUInt) 1) << 51)
+#   define NAN_START	0x7ff8
+#   define NAN_MASK	(((Tcl_WideUInt) 1) << 51)
 #endif
 
 /*
@@ -93,45 +119,44 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__)));
 #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
+/*
+ * 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)
+				 * 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. */
+#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 {
@@ -162,7 +187,7 @@ 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 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
@@ -184,10 +209,12 @@ static int n770_fp;		/* Flag is 1 on Nokia N770 floating point.
 				 * 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. */
+				 * 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. */
+/*
+ * 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,
@@ -196,7 +223,10 @@ static const mp_digit dpow5[13] = {
        244140625
 };
 
-/* Table of powers: pow5_13[n] = 5**(13*2**(n+1)) */
+/*
+ * 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[] = {
@@ -270,68 +300,74 @@ static double		MakeHighPrecisionDouble(int signum,
 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 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 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,
+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 *, 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, 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,
+			    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,
+			    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,
+			    int ilim, int ilim1, int *decpt,
+			    char **endPtr);
+static char *		StrictBignumConversion(Double *dPtr, int convType,
 			    Tcl_WideUInt bw, int b2,
 			    int s2, int s5, int k, int len,
-			    int ilim, int ilim1, int* decpt,
-			    char** endPtr);
-static double		BignumToBiasedFrExp(mp_int *big, int *machexp);
+			    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
 
 /*
  *----------------------------------------------------------------------
@@ -360,14 +396,17 @@ static Tcl_WideUInt	Nokia770Twiddle(Tcl_WideUInt w);
  *	- 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
+ *	- TCL_PARSE_BINARY_ONLY:	parse only in the binary format, whether
+ *		or not a prefix is present that would lead to binary parsing.
+ *		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,
+ *	- 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
+ *	- 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
@@ -461,38 +500,38 @@ TclParseNumber(
     } state = INITIAL;
     enum State acceptState = INITIAL;
 
-    int signum = 0;		/* Sign of the number being parsed */
+    int signum = 0;		/* Sign of the number being parsed. */
     Tcl_WideUInt significandWide = 0;
 				/* Significand of the number being parsed (if
-				 * no overflow) */
+				 * no overflow). */
     mp_int significandBig;	/* Significand of the number being parsed (if
-				 * it overflows significandWide) */
-    int significandOverflow = 0;/* Flag==1 iff significandBig is used */
+				 * 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' */
+				 * we've scanned forward to a '.' or 'e'. */
     mp_int octalSignificandBig;	/* Significand of octal number once
-				 * octalSignificandWide overflows */
+				 * octalSignificandWide overflows. */
     int octalSignificandOverflow = 0;
-				/* Flag==1 if octalSignificandBig is used */
+				/* Flag==1 if octalSignificandBig is used. */
     int numSigDigs = 0;		/* Number of significant digits in the decimal
-				 * significand */
+				 * 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 */
+				 * 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 */
+				 * 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 */
+				 * an acceptable number. */
     size_t acceptLen;		/* Number of characters following that
 				 * point. */
-    int status = TCL_OK;	/* Status to return to caller */
+    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 */
@@ -554,6 +593,8 @@ TclParseNumber(
 		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))) {
@@ -580,16 +621,16 @@ TclParseNumber(
 	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'.
+	     * 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') {
-		if (flags & TCL_PARSE_OCTAL_ONLY) {
+		if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) {
 		    goto endgame;
 		}
 		state = ZERO_X;
@@ -608,6 +649,9 @@ TclParseNumber(
 		state = ZERO_B;
 		break;
 	    }
+	    if (flags & TCL_PARSE_BINARY_ONLY) {
+		goto zerob;
+	    }
 	    if (c == 'o' || c == 'O') {
 		explicitOctal = 1;
 		state = ZERO_O;
@@ -793,6 +837,7 @@ TclParseNumber(
 	    acceptPoint = p;
 	    acceptLen = len;
 	case ZERO_B:
+	zerob:
 	    if (c == '0') {
 		numTrailZeros++;
 		state = BINARY;
@@ -1181,7 +1226,7 @@ TclParseNumber(
 
 	case OCTAL:
 	    /*
-	     * Returning an octal integer. Final scaling step
+	     * Returning an octal integer. Final scaling step.
 	     */
 
 	    shift = 3 * numTrailZeros;
@@ -1203,7 +1248,7 @@ TclParseNumber(
 	    if (!octalSignificandOverflow) {
 		if (octalSignificandWide >
 			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 		    if (octalSignificandWide <= (MOST_BITS + signum)) {
 			objPtr->typePtr = &tclWideIntType;
 			if (signum) {
@@ -1242,7 +1287,7 @@ TclParseNumber(
 	case DECIMAL:
 	    significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
 		    &significandWide, &significandBig, significandOverflow);
-	    if (!significandOverflow && (significandWide > MOST_BITS+signum)) {
+	    if (!significandOverflow && (significandWide > MOST_BITS+signum)){
 		significandOverflow = 1;
 		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
 	    }
@@ -1250,7 +1295,7 @@ TclParseNumber(
 	    if (!significandOverflow) {
 		if (significandWide >
 			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
 		    if (significandWide <= MOST_BITS+signum) {
 			objPtr->typePtr = &tclWideIntType;
 			if (signum) {
@@ -1298,16 +1343,16 @@ TclParseNumber(
 
 	    objPtr->typePtr = &tclDoubleType;
 	    if (exponentSignum) {
-		exponent = - exponent;
+		exponent = -exponent;
 	    }
 	    if (!significandOverflow) {
 		objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
 			signum, significandWide, numSigDigs,
-			(numTrailZeros + exponent - numDigitsAfterDp));
+			numTrailZeros + exponent - numDigitsAfterDp);
 	    } else {
 		objPtr->internalRep.doubleValue = MakeHighPrecisionDouble(
 			signum, &significandBig, numSigDigs,
-			(numTrailZeros + exponent - numDigitsAfterDp));
+			numTrailZeros + exponent - numDigitsAfterDp);
 	    }
 	    break;
 
@@ -1324,12 +1369,12 @@ TclParseNumber(
 #ifdef IEEE_FLOATING_POINT
 	case sNAN:
 	case sNANFINISH:
-	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
+	    objPtr->internalRep.doubleValue = MakeNaN(signum,significandWide);
 	    objPtr->typePtr = &tclDoubleType;
 	    break;
 #endif
 	case INITIAL:
-	    /* This case only to silence compiler warning */
+	    /* This case only to silence compiler warning. */
 	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
 	}
     }
@@ -1340,11 +1385,9 @@ TclParseNumber(
 
     if (status != TCL_OK) {
 	if (interp != NULL) {
-	    Tcl_Obj *msg;
+	    Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
+		    expected);
 
-	    TclNewLiteralStringObj(msg, "expected ");
-	    Tcl_AppendToObj(msg, expected, -1);
-	    Tcl_AppendToObj(msg, " but got \"", -1);
 	    Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
 	    Tcl_AppendToObj(msg, "\"", -1);
 	    if (state == BAD_OCTAL) {
@@ -1401,7 +1444,7 @@ AccumulateDecimalDigit(
     Tcl_WideUInt w;
 
     /*
-     * Try wide multiplication first
+     * Try wide multiplication first.
      */
 
     if (!bignumFlag) {
@@ -1414,10 +1457,10 @@ AccumulateDecimalDigit(
 	    *wideRepPtr = digit;
 	    return 0;
 	} else if (numZeros >= maxpow10_wide
-		  || w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) {
+		|| 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.
+	     * Wide multiplication will overflow.  Expand the number to a
+	     * bignum and fall through into the bignum case.
 	     */
 
 	    TclBNInitBignumFromWideUInt(bignumRepPtr, w);
@@ -1425,6 +1468,7 @@ AccumulateDecimalDigit(
 	    /*
 	     * Wide multiplication.
 	     */
+
 	    *wideRepPtr = w * pow10_wide[numZeros+1] + digit;
 	    return 0;
 	}
@@ -1492,12 +1536,12 @@ AccumulateDecimalDigit(
 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 */
+    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 */
+    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.
@@ -1507,15 +1551,7 @@ MakeLowPrecisionDouble(
      * ulp, so we need to change rounding mode to 53-bits.
      */
 
-#if defined(__GNUC__) && defined(__i386)
-    fpu_control_t roundTo53Bits = 0x027f;
-    fpu_control_t oldRoundingMode;
-    _FPU_GETCW(oldRoundingMode);
-    _FPU_SETCW(roundTo53Bits);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
-    ieee_flags("set","precision","double",NULL);
-#endif
+    TCL_IEEE_DOUBLE_ROUNDING;
 
     /*
      * Test for the easy cases.
@@ -1530,10 +1566,12 @@ MakeLowPrecisionDouble(
 		 * without special handling.
 		 */
 
-		retval = (double)(Tcl_WideInt)significand * pow10vals[exponent];
+		retval = (double)
+			((Tcl_WideInt)significand * pow10vals[exponent]);
 		goto returnValue;
 	    } else {
 		int diff = QUICK_MAX - numSigDigs;
+
 		if (exponent-diff <= mmaxpow) {
 		    /*
 		     * 10**exponent is not an exact integer, but
@@ -1542,8 +1580,8 @@ MakeLowPrecisionDouble(
 		     * with only one roundoff.
 		     */
 
-		    volatile double factor =
-			    (double)(Tcl_WideInt)significand * pow10vals[diff];
+		    volatile double factor = (double)
+			    ((Tcl_WideInt)significand * pow10vals[diff]);
 		    retval = factor * pow10vals[exponent-diff];
 		    goto returnValue;
 		}
@@ -1556,7 +1594,8 @@ MakeLowPrecisionDouble(
 		 * only one rounding.
 		 */
 
-		retval = (double)(Tcl_WideInt)significand / pow10vals[-exponent];
+		retval = (double)
+			((Tcl_WideInt)significand / pow10vals[-exponent]);
 		goto returnValue;
 	    }
 	}
@@ -1585,12 +1624,7 @@ MakeLowPrecisionDouble(
      * On gcc on x86, restore the floating point mode word.
      */
 
-#if defined(__GNUC__) && defined(__i386)
-    _FPU_SETCW(oldRoundingMode);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
-    ieee_flags("clear","precision",NULL,NULL);
-#endif
+    TCL_DEFAULT_DOUBLE_ROUNDING;
 
     return retval;
 }
@@ -1615,13 +1649,13 @@ MakeLowPrecisionDouble(
 
 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 */
+    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 */
+    int machexp;		/* Machine exponent of a power of 10. */
 
     /*
      * With gcc on x86, the floating point rounding mode is double-extended.
@@ -1631,15 +1665,7 @@ MakeHighPrecisionDouble(
      * ulp, so we need to change rounding mode to 53-bits.
      */
 
-#if defined(__GNUC__) && defined(__i386)
-    fpu_control_t roundTo53Bits = 0x027f;
-    fpu_control_t oldRoundingMode;
-    _FPU_GETCW(oldRoundingMode);
-    _FPU_SETCW(roundTo53Bits);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
-    ieee_flags("set","precision","double",NULL);
-#endif
+    TCL_IEEE_DOUBLE_ROUNDING;
 
     /*
      * Quick checks for over/underflow.
@@ -1670,9 +1696,9 @@ MakeHighPrecisionDouble(
 	goto returnValue;
     }
     retval = SafeLdExp(retval, machexp);
-    if (tiny == 0.0) {
-	tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);
-    }
+	if (tiny == 0.0) {
+	    tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);
+	}
     if (retval < tiny) {
 	retval = tiny;
     }
@@ -1698,12 +1724,8 @@ MakeHighPrecisionDouble(
      * On gcc on x86, restore the floating point mode word.
      */
 
-#if defined(__GNUC__) && defined(__i386)
-    _FPU_SETCW(oldRoundingMode);
-#endif
-#if defined(__sun) && defined(__i386) && !defined(__GNUC__)
-    ieee_flags("clear","precision",NULL,NULL);
-#endif
+    TCL_DEFAULT_DOUBLE_ROUNDING;
+
     return retval;
 }
 
@@ -1722,8 +1744,8 @@ MakeHighPrecisionDouble(
 #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 */
+    int signum,			/* Sign bit (1=negative, 0=nonnegative. */
+    Tcl_WideUInt tags)		/* Tag bits to put in the NaN. */
 {
     union {
 	Tcl_WideUInt iv;
@@ -1761,28 +1783,28 @@ MakeNaN(
 
 static double
 RefineApproximation(
-    double approxResult,	/* Approximate result of conversion */
-    mp_int *exactSignificand,	/* Integer significand */
-    int exponent)		/* Power of 10 to multiply by significand */
+    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 */
+    double significand;		/* Sigificand of the binary number. */
+    int binExponent;		/* Exponent of the binary number. */
     int msb;			/* Most significant bit position of an
-				 * intermediate result */
+				 * intermediate result. */
     int nDigits;		/* Number of mp_digit's in an intermediate
-				 * result */
+				 * result. */
     mp_int twoMv;		/* Approx binary value expressed as an exact
-				 * integer scaled by the multiplier 2M */
+				 * 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 */
+				 * 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 */
+				 * term. */
+    double quot;		/* Correction term. */
     double minincr;		/* Lower bound on the absolute value of the
 				 * correction term. */
     int roundToEven = 0;	/* Flag == TRUE if we need to invoke
@@ -1818,8 +1840,8 @@ RefineApproximation(
 	M5 = 0;
     } else {
 	M5 = -exponent;
-	if ((M5-1) > M2) {
-	    M2 = M5-1;
+	if (M5 - 1 > M2) {
+	    M2 = M5 - 1;
 	}
     }
 
@@ -1858,7 +1880,7 @@ RefineApproximation(
 
     mp_init_copy(&twoMd, exactSignificand);
     for (i=0; i<=8; ++i) {
-	if ((M5+exponent) & (1 << i)) {
+	if ((M5 + exponent) & (1 << i)) {
 	    mp_mul(&twoMd, pow5+i, &twoMd);
 	}
     }
@@ -1868,7 +1890,7 @@ RefineApproximation(
     /*
      * 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
+     * denominator by a factor of 2**binExponent-mantBits.
      */
 
     scale = binExponent - mantBits - 1;
@@ -1892,8 +1914,8 @@ RefineApproximation(
 	 * 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.
 	 */
-        mp_clear(&twoMd);
-        mp_clear(&twoMv);
+	mp_clear(&twoMd);
+	mp_clear(&twoMv);
 	return approxResult;
     case MP_EQ:
 	/*
@@ -1909,8 +1931,8 @@ RefineApproximation(
 	rteSignificand = frexp(approxResult, &rteExponent);
 	rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION);
 	if ((rteSigWide & 1) == 0) {
-            mp_clear(&twoMd);
-            mp_clear(&twoMv);
+	    mp_clear(&twoMd);
+	    mp_clear(&twoMv);
 	    return approxResult;
 	}
     }
@@ -1939,26 +1961,28 @@ RefineApproximation(
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * MultPow5 --
  *
  *	Multiply a bignum by a power of 5.
  *
  * Side effects:
- *	Stores base*5**n in result
+ *	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 */
+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;
+    mp_int *p = base;
     int n13 = n / 13;
     int r = n % 13;
+
     if (r != 0) {
 	mp_mul_d(p, dpow5[r], result);
 	p = result;
@@ -1976,14 +2000,14 @@ MulPow5(mp_int* base, 		/* Number to multiply */
 	mp_copy(p, result);
     }
 }
-
+
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * NormalizeRightward --
  *
- *	Shifts a number rightward until it is odd (that is, until the
- *	least significant bit is nonzero.
+ *	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.
@@ -1991,15 +2015,16 @@ MulPow5(mp_int* base, 		/* Number to multiply */
  * 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 */
+NormalizeRightward(
+    Tcl_WideUInt *wPtr)		/* INOUT: Number to shift. */
 {
     int rv = 0;
     Tcl_WideUInt w = *wPtr;
+
     if (!(w & (Tcl_WideUInt) 0xffffffff)) {
 	w >>= 32; rv += 32;
     }
@@ -2021,27 +2046,28 @@ NormalizeRightward(Tcl_WideUInt* wPtr)
     *wPtr = w;
     return rv;
 }
-
+
 /*
- *-----------------------------------------------------------------------------0
+ *----------------------------------------------------------------------
  *
  * RequiredPrecision --
  *
  *	Determines the number of bits needed to hold an intger.
  *
  * Results:
- *	Returns the position of the most significant bit (0 - 63).
- *	Returns 0 if the number is zero.
+ *	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 */
+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 {
@@ -2067,38 +2093,40 @@ RequiredPrecision(Tcl_WideUInt w)
     }
     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'.
+ *	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 */
+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 */
+    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 */
+    /*
+     * Extract exponent and significand.
+     */
 
     de = (d.w.word0 & EXP_MASK) >> EXP_SHIFT;
     z = d.q & SIG_MASK;
@@ -2114,24 +2142,25 @@ DoubleToExpAndSig(double dv,	/* Number to convert */
     }
     *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.
+ *	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 */
+TakeAbsoluteValue(
+    Double *d,			/* Number to replace with absolute value. */
+    int *sign)			/* Place to put the signum. */
 {
     if (d->w.word0 & SIGN_BIT) {
 	*sign = 1;
@@ -2140,32 +2169,33 @@ TakeAbsoluteValue(Double* d,	/* Number to replace with absolute value */
 	*sign = 0;
     }
 }
-
+
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * FormatInfAndNaN --
  *
  *	Bailout for formatting infinities and Not-A-Number.
  *
  * Results:
- *	Returns one of the strings 'Infinity' and 'NaN'.
+ *	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.
+ *	Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
+ *	NUL byte of the string if 'endPtr' is not NULL.
  *
- * The string returned must be freed by the caller using 'ckfree'.
- *
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
-inline static char*
-FormatInfAndNaN(Double* d,	/* Exceptional number to format */
-		int* decpt,	/* Decimal point to set to a bogus value */
-		char** endPtr)	/* Pointer to the end of the formatted data */
+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;
+    char *retval;
+
     *decpt = 9999;
     if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
 	retval = ckalloc(9);
@@ -2182,9 +2212,9 @@ FormatInfAndNaN(Double* d,	/* Exceptional number to format */
     }
     return retval;
 }
-
+
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * FormatZero --
  *
@@ -2197,14 +2227,16 @@ FormatInfAndNaN(Double* d,	/* Exceptional number to format */
  *	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 */
+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);
+    char *retval = ckalloc(2);
+
     strcpy(retval, "0");
     if (endPtr) {
 	*endPtr = retval+1;
@@ -2212,31 +2244,31 @@ FormatZero(int* decpt,		/* Location of the decimal point */
     *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.
+ *	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.
+ *	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 */
+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 i;			/* Log base 2 of the number. */
     int k;			/* Floor(Log base 10 of the number) */
-    double ds;			/* Mantissa of the number */
+    double ds;			/* Mantissa of the number. */
     Double d2;
 
     /*
@@ -2250,17 +2282,16 @@ ApproximateLog10(Tcl_WideUInt bw,
     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;
+	    + LOG10_3HALVES_PLUS_FUDGE + LOG10_2 * i;
     k = (int) ds;
     if (k > ds) {
 	--k;
     }
     return k;
 }
-
+
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * BetterLog10 --
  *
@@ -2268,24 +2299,27 @@ ApproximateLog10(Tcl_WideUInt bw,
  *	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.
+ *	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)
+ *	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 */
+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.
+     * 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--;
@@ -2296,40 +2330,41 @@ BetterLog10(double d,		/* Original number to format */
     }
     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.
+ *	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.
+ *	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 */
+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
+     * 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;
@@ -2339,9 +2374,10 @@ ComputeScale(int be,		/* Exponent part of number: d = bw * 2**be */
     }
 
     /*
-     * Scale numerator and denominator so that the output decimal number
-     * is the ratio of integers
+     * Scale numerator and denominator so that the output decimal number is
+     * the ratio of integers.
      */
+
     if (k >= 0) {
 	*b5 = 0;
 	*s5 = k;
@@ -2354,49 +2390,45 @@ ComputeScale(int be,		/* Exponent part of number: d = bw * 2**be */
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * SetPrecisionLimits --
  *
- *	Determines how many digits of significance should be computed
- *	(and, hence, how much memory need be allocated) for formatting a
- *	floating point number.
+ *	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 '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.
+ *	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. */
+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) {
+    switch (convType) {
     case TCL_DD_SHORTEST0:
     case TCL_DD_STEELE0:
 	*iLimPtr = *iLim1Ptr = -1;
@@ -2424,31 +2456,31 @@ SetPrecisionLimits(int convType,
 	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...
+ *	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.
+ *	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 */
+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) {
@@ -2463,27 +2495,28 @@ BumpUp(char* s,		    	/* Cursor pointing one past the end of the
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * AdjustRange --
  *
- *	Rescales a 'double' in preparation for formatting it using the
- *	'quick' double-to-string method.
+ *	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.
+ *	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)) */
+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 */
+				 * accumulated. */
+    double d = *dPtr;		/* Number to adjust. */
     double ds;
     int i, j, j1;
 
@@ -2493,6 +2526,7 @@ AdjustRange(double* dPtr,	/* INOUT: Number to adjust */
 	/*
 	 * The number must be reduced to bring it into range.
 	 */
+
 	ds = tens[k & 0xf];
 	j = k >> 4;
 	if (j & BLETCH) {
@@ -2511,8 +2545,9 @@ AdjustRange(double* dPtr,	/* INOUT: Number to adjust */
 	d /= ds;
     } else if ((j1 = -k) != 0) {
 	/*
-	 * The number must be increased to bring it into range
+	 * The number must be increased to bring it into range.
 	 */
+
 	d *= tens[j1 & 0xf];
 	i = 0;
 	for (j = j1>>4; j; j>>=1) {
@@ -2529,52 +2564,52 @@ AdjustRange(double* dPtr,	/* INOUT: Number to adjust */
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * 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.
+ *	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.
+ *	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 */
+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 */
+    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 */
+	/*
+	 * 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.
+	 * Truncate the conversion if the string of digits is within 1/2 ulp
+	 * of the actual value.
 	 */
 
 	if (d < eps) {
@@ -2588,7 +2623,7 @@ ShorteningQuickFormat(double d,	/* Number to convert */
 
 	/*
 	 * Bail out if the conversion fails to converge to a sufficiently
-	 * precise value
+	 * precise value.
 	 */
 
 	if (++i >= ilim) {
@@ -2605,40 +2640,44 @@ ShorteningQuickFormat(double d,	/* Number to convert */
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * StrictQuickFormat --
  *
- *	Convert a double precision number of a string of a precise number
- *	of digits, using the 'quick' double precision method.
+ *	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.
+ *	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 */
+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 */
+    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 */
+	/*
+	 * Extract a digit.
+	 */
+
 	digit = (int) d;
 	d -= digit;
 	if (d == 0.0) {
@@ -2647,9 +2686,10 @@ StrictQuickFormat(double d,	/* Number to convert */
 	*s++ = '0' + digit;
 
 	/*
-	 * When the given digit count is reached, handle trailing strings
-	 * of 0 and 9.
+	 * When the given digit count is reached, handle trailing strings of 0
+	 * and 9.
 	 */
+
 	if (i == ilim) {
 	    if (d > 0.5 + eps) {
 		*kPtr = k;
@@ -2666,14 +2706,17 @@ StrictQuickFormat(double d,	/* Number to convert */
 	    }
 	}
 
-	/* Advance to the next digit */
+	/*
+	 * Advance to the next digit.
+	 */
+
 	++i;
 	d *= 10.0;
     }
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * QuickConversion --
  *
@@ -2682,44 +2725,48 @@ StrictQuickFormat(double d,	/* Number to convert */
  *	therefore be used for the intermediate results.
  *
  * Results:
- *	Returns the converted string, or NULL if the bignum method must
- *	be used.
+ *	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:
+inline static char *
+QuickConversion(
+    double e,			/* Number to format. */
+    int k,			/* floor(log10(d)), approximately. */
+    int k_check,		/* 0 if k is exact, 1 if it may be too high */
+    int flags,			/* Flags passed to dtoa:
 				 *    TCL_DD_SHORTEN_FLAG */
-		int len,	/* Length of the return value */
-		int ilim,	/* Number of digits to store */
-		int ilim1,	/* Number of digits to store if we
-				 * musguessed k */
-		int* decpt,	/* OUTPUT: Location of the decimal point */
-		char** endPtr)	/* OUTPUT: Pointer to the terminal null byte */
+    int 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 */
+				 * 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)
+     * 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 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;
@@ -2731,15 +2778,16 @@ QuickConversion(double e,	/* Number to format */
     }
 
     /*
-     * Compute estimated roundoff error
+     * 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.
+     * Handle the peculiar case where the result has no significant digits.
      */
+
     retval = ckalloc(len + 1);
     if (ilim == 0) {
 	d -= 5.;
@@ -2756,7 +2804,9 @@ QuickConversion(double e,	/* Number to format */
 	}
     }
 
-    /* Format the digit string */
+    /*
+     * Format the digit string.
+     */
 
     if (flags & TCL_DD_SHORTEN_FLAG) {
 	end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
@@ -2775,106 +2825,99 @@ QuickConversion(double e,	/* Number to format */
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * 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.
+ *	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 */
+CastOutPowersOf2(
+    int *b2,			/* Power of 2 to multiply the significand. */
+    int *m2,			/* Power of 2 to multiply 1/2 ulp. */
+    int *s2)			/* Power of 2 to multiply the common
+				 * denominator. */
 {
     int i;
+
     if (*m2 > 0 && *s2 > 0) {	/* Find the smallest power of 2 in the
-				 * numerator */
-        if (*m2 < *s2) {	/* Find the lowest common denominatorr */
+				 * numerator. */
+	if (*m2 < *s2) {	/* Find the lowest common denominator. */
 	    i = *m2;
 	} else {
 	    i = *s2;
 	}
-	*b2 -= i;		/* Reduce to lowest terms */
+	*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.
+ *	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
+ *	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'.
+ *	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 */
+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 */
+    char *retval = ckalloc(len + 1);
+				/* Output buffer. */
     Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
-				/* Numerator of the fraction being converted */
+				/* 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 */
+				 * 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 */
+    /*
+     * Adjust if the logarithm was guessed wrong.
+     */
 
     if (b < S) {
 	b = 10 * b;
@@ -2883,12 +2926,16 @@ ShorteningInt64Conversion(Double* dPtr,
 	--k;
     }
 
-    /* Compute roundoff ranges */
+    /*
+     * Compute roundoff ranges.
+     */
 
     mplus = wuipow5[m5] << m2plus;
     mminus = wuipow5[m5] << m2minus;
 
-    /* Loop through the digits */
+    /*
+     * Loop through the digits.
+     */
 
     i = 1;
     for (;;) {
@@ -2902,17 +2949,15 @@ ShorteningInt64Conversion(Double* dPtr,
 	 * 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)) {
+
+	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
+	     * 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)) {
+
+	    if (2 * b > S || (2 * b == S && (digit & 1) != 0)) {
 		++digit;
 		if (digit == 10) {
 		    *s++ = '9';
@@ -2921,7 +2966,9 @@ ShorteningInt64Conversion(Double* dPtr,
 		}
 	    }
 
-	    /* Stash the current digit */
+	    /*
+	     * Stash the current digit.
+	     */
 
 	    *s++ = '0' + digit;
 	    break;
@@ -2931,10 +2978,9 @@ ShorteningInt64Conversion(Double* dPtr,
 	 * 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 (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);
@@ -2948,16 +2994,18 @@ ShorteningInt64Conversion(Double* dPtr,
 	/*
 	 * Have we converted all the requested digits?
 	 */
+
 	*s++ = '0' + digit;
 	if (i == ilim) {
-	    if (2*b > S
-		|| (2*b == S && (digit & 1) != 0)) {
+	    if (2*b > S || (2*b == S && (digit & 1) != 0)) {
 		s = BumpUp(s, retval, &k);
 	    }
 	    break;
 	}
 
-	/* Advance to the next digit */
+	/*
+	 * Advance to the next digit.
+	 */
 
 	b = 10 * b;
 	mplus = 10 * mplus;
@@ -2969,6 +3017,7 @@ ShorteningInt64Conversion(Double* dPtr,
      * Endgame - store the location of the decimal point and the end of the
      * string.
      */
+
     *s = '\0';
     *decpt = k;
     if (endPtr) {
@@ -2978,69 +3027,61 @@ ShorteningInt64Conversion(Double* dPtr,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * 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.
+ *	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
+ *	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'.
+ *	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 */
+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 */
+    char *retval = ckalloc(len + 1);
+				/* Output buffer. */
     Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
-				/* Numerator of the fraction being converted */
+				/* 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 */
+				 * 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 */
+    /*
+     * Adjust if the logarithm was guessed wrong.
+     */
 
     if (b < S) {
 	b = 10 * b;
@@ -3048,7 +3089,9 @@ StrictInt64Conversion(Double* dPtr,
 	--k;
     }
 
-    /* Loop through the digits */
+    /*
+     * Loop through the digits.
+     */
 
     i = 1;
     for (;;) {
@@ -3061,10 +3104,10 @@ StrictInt64Conversion(Double* dPtr,
 	/*
 	 * Have we converted all the requested digits?
 	 */
+
 	*s++ = '0' + digit;
 	if (i == ilim) {
-	    if (2*b > S
-		|| (2*b == S && (digit & 1) != 0)) {
+	    if (2*b > S || (2*b == S && (digit & 1) != 0)) {
 		s = BumpUp(s, retval, &k);
 	    } else {
 		while (*--s == '0') {
@@ -3075,7 +3118,9 @@ StrictInt64Conversion(Double* dPtr,
 	    break;
 	}
 
-	/* Advance to the next digit */
+	/*
+	 * Advance to the next digit.
+	 */
 
 	b = 10 * b;
 	++i;
@@ -3085,6 +3130,7 @@ StrictInt64Conversion(Double* dPtr,
      * Endgame - store the location of the decimal point and the end of the
      * string.
      */
+
     *s = '\0';
     *decpt = k;
     if (endPtr) {
@@ -3094,30 +3140,30 @@ StrictInt64Conversion(Double* dPtr,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * 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.
+ *	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.
+ *	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 */
+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));
+    static const mp_digit topbit = 1 << (DIGIT_BIT - 1);
+
     if (b->used < sd || (b->dp[sd-1] & topbit) == 0) {
 	return 0;
     }
@@ -3133,45 +3179,41 @@ ShouldBankerRoundUpPowD(mp_int* b,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * ShouldBankerRoundUpToNextPowD --
  *
- *	Tests whether bankers' rounding will round down in the
- *	"denominator is a power of 2**MP_DIGIT" case.
+ *	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 */
+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
+     * 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 */
+    if (temp->used <= sd) {	/* Too few digits to be > s */
 	return 0;
     }
     if (temp->used > sd+1 || temp->dp[sd] > 1) {
@@ -3179,81 +3221,70 @@ ShouldBankerRoundUpToNextPowD(mp_int* b,
 	return 1;
     }
     for (i = sd-1; i >= 0; --i) {
-				/* check for ==s */
+				/* Check for ==s */
 	if (temp->dp[i] != 0) {	/* > s */
 	    return 1;
 	}
     }
     if (convType == TCL_DD_STEELE0) {
-				/* biased rounding */
+				/* 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.
+ *	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
+ *	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'.
+ *	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 */
+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 */
+    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;
 
@@ -3267,7 +3298,9 @@ ShorteningBignumConversionPowD(Double* dPtr,
     MulPow5(&b, b5, &b);
     mp_mul_2d(&b, b2, &b);
 
-    /* Adjust if the logarithm was guessed wrong */
+    /*
+     * Adjust if the logarithm was guessed wrong.
+     */
 
     if (b.used <= sd) {
 	mp_mul_d(&b, 10, &b);
@@ -3289,8 +3322,10 @@ ShorteningBignumConversionPowD(Double* dPtr,
     }
     mp_init(&temp);
 
-    /* Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
-     * by mp_digit extraction */
+    /*
+     * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
+     * by mp_digit extraction.
+     */
 
     i = 0;
     for (;;) {
@@ -3310,14 +3345,13 @@ ShorteningBignumConversionPowD(Double* dPtr,
 	 */
 
 	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)) {
+	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
+	     * 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) {
@@ -3327,7 +3361,9 @@ ShorteningBignumConversionPowD(Double* dPtr,
 		}
 	    }
 
-	    /* Stash the last digit */
+	    /*
+	     * Stash the last digit.
+	     */
 
 	    *s++ = '0' + digit;
 	    break;
@@ -3338,9 +3374,8 @@ ShorteningBignumConversionPowD(Double* dPtr,
 	 * number?
 	 */
 
-	if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd,
-					   convType, dPtr->w.word1 & 1,
-					   &temp)) {
+	if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd, convType,
+		dPtr->w.word1 & 1, &temp)) {
 	    if (digit == 9) {
 		*s++ = '9';
 		s = BumpUp(s, retval, &k);
@@ -3354,6 +3389,7 @@ ShorteningBignumConversionPowD(Double* dPtr,
 	/*
 	 * Have we converted all the requested digits?
 	 */
+
 	*s++ = '0' + digit;
 	if (i == ilim) {
 	    if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
@@ -3362,7 +3398,9 @@ ShorteningBignumConversionPowD(Double* dPtr,
 	    break;
 	}
 
-	/* Advance to the next digit */
+	/*
+	 * Advance to the next digit.
+	 */
 
 	mp_mul_d(&b, 10, &b);
 	mp_mul_d(&mminus, 10, &mminus);
@@ -3376,6 +3414,7 @@ ShorteningBignumConversionPowD(Double* dPtr,
      * Endgame - store the location of the decimal point and the end of the
      * string.
      */
+
     if (m2plus > m2minus) {
 	mp_clear(&mplus);
     }
@@ -3389,62 +3428,52 @@ ShorteningBignumConversionPowD(Double* dPtr,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * 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.
+ *	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.
+ *	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'.
+ *	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 */
+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 */
+    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;
 
     /*
@@ -3455,7 +3484,9 @@ StrictBignumConversionPowD(Double* dPtr,
     MulPow5(&b, b5, &b);
     mp_mul_2d(&b, b2, &b);
 
-    /* Adjust if the logarithm was guessed wrong */
+    /*
+     * Adjust if the logarithm was guessed wrong.
+     */
 
     if (b.used <= sd) {
 	mp_mul_d(&b, 10, &b);
@@ -3466,7 +3497,7 @@ StrictBignumConversionPowD(Double* dPtr,
 
     /*
      * Loop through the digits. Do division and mod by s == 2**(sd*DIGIT_BIT)
-     * by mp_digit extraction
+     * by mp_digit extraction.
      */
 
     i = 1;
@@ -3478,26 +3509,29 @@ StrictBignumConversionPowD(Double* dPtr,
 	    if (b.used > sd+1 || digit >= 10) {
 		Tcl_Panic("wrong digit!");
 	    }
-	    --b.used; mp_clamp(&b);
+	    --b.used;
+	    mp_clamp(&b);
 	}
 
 	/*
 	 * Have we converted all the requested digits?
 	 */
+
 	*s++ = '0' + digit;
 	if (i == ilim) {
 	    if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
 		s = BumpUp(s, retval, &k);
-	    } else {
-		while (*--s == '0') {
-		    /* do nothing */
-		}
-		++s;
 	    }
+	    while (*--s == '0') {
+		/* do nothing */
+	    }
+	    ++s;
 	    break;
 	}
 
-	/* Advance to the next digit */
+	/*
+	 * Advance to the next digit.
+	 */
 
 	mp_mul_d(&b, 10, &b);
 	++i;
@@ -3507,6 +3541,7 @@ StrictBignumConversionPowD(Double* dPtr,
      * Endgame - store the location of the decimal point and the end of the
      * string.
      */
+
     mp_clear_multi(&b, &temp, NULL);
     *s = '\0';
     *decpt = k;
@@ -3517,7 +3552,7 @@ StrictBignumConversionPowD(Double* dPtr,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * ShouldBankerRoundUp --
  *
@@ -3527,17 +3562,18 @@ StrictBignumConversionPowD(Double* dPtr,
  * 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 */
+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;
@@ -3551,38 +3587,37 @@ ShouldBankerRoundUp(mp_int* twor,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * ShouldBankerRoundUpToNext --
  *
- *	Tests whether the remainder is great enough to force rounding
- *	to the next higher digit.
+ *	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
+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 */
+    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. */
+
+    /*
+     * 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) {
@@ -3602,7 +3637,7 @@ ShouldBankerRoundUpToNext(mp_int* b,
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * ShorteningBignumConversion --
  *
@@ -3613,49 +3648,38 @@ ShouldBankerRoundUpToNext(mp_int* b,
  *	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.
+ *	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 */
+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 */
+    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;
 
@@ -3670,8 +3694,7 @@ ShorteningBignumConversion(Double* dPtr,
     MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
 
     /*
-     * Handle the case where we guess the position of the decimal point
-     * wrong.
+     * Handle the case where we guess the position of the decimal point wrong.
      */
 
     if (mp_cmp_mag(&b, &S) == MP_LT) {
@@ -3681,7 +3704,9 @@ ShorteningBignumConversion(Double* dPtr,
 	--k;
     }
 
-    /* mminus = 2**m2minus * 5**m5 */
+    /*
+     * mminus = 2**m2minus * 5**m5
+     */
 
     mp_init_set_int(&mminus, minit);
     mp_mul_2d(&mminus, m2minus, &mminus);
@@ -3691,7 +3716,9 @@ ShorteningBignumConversion(Double* dPtr,
     }
     mp_init(&temp);
 
-    /* Loop through the digits */
+    /*
+     * Loop through the digits.
+     */
 
     mp_init(&dig);
     i = 1;
@@ -3708,10 +3735,8 @@ ShorteningBignumConversion(Double* dPtr,
 	 */
 
 	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)) {
+	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;
@@ -3726,12 +3751,12 @@ ShorteningBignumConversion(Double* dPtr,
 	}
 
 	/*
-	 * Does the current digit leave us with a remainder large enough
-	 * to commit to rounding up to the next higher digit?
+	 * 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)) {
+		dPtr->w.word1 & 1, &temp)) {
 	    ++digit;
 	    if (digit == 10) {
 		*s++ = '9';
@@ -3742,7 +3767,9 @@ ShorteningBignumConversion(Double* dPtr,
 	    break;
 	}
 
-	/* Have we converted all the requested digits? */
+	/*
+	 * Have we converted all the requested digits?
+	 */
 
 	*s++ = '0' + digit;
 	if (i == ilim) {
@@ -3753,11 +3780,15 @@ ShorteningBignumConversion(Double* dPtr,
 	    break;
 	}
 
-	/* Advance to the next digit */
+	/*
+	 * Advance to the next digit.
+	 */
 
 	if (s5 > 0) {
+	    /*
+	     * Can possibly shorten the denominator.
+	     */
 
-	    /* Can possibly shorten the denominator */
 	    mp_mul_2d(&b, 1, &b);
 	    mp_mul_2d(&mminus, 1, &mminus);
 	    if (m2plus > m2minus) {
@@ -3765,13 +3796,14 @@ ShorteningBignumConversion(Double* dPtr,
 	    }
 	    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.
+	     * IDEA: It might possibly be a win to fall back to int64_t
+	     *       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
@@ -3790,7 +3822,7 @@ ShorteningBignumConversion(Double* dPtr,
 	     * 10**40  14 trips
 	     * 10**41  15 trips
 	     * 10**42  16 trips
-	     * thereafter  no gain.
+	     * thereafter no gain.
 	     */
 	} else {
 	    mp_mul_d(&b, 10, &b);
@@ -3803,11 +3835,11 @@ ShorteningBignumConversion(Double* dPtr,
 	++i;
     }
 
-
     /*
      * Endgame - store the location of the decimal point and the end of the
      * string.
      */
+
     if (m2plus > m2minus) {
 	mp_clear(&mplus);
     }
@@ -3818,57 +3850,49 @@ ShorteningBignumConversion(Double* dPtr,
 	*endPtr = s;
     }
     return retval;
-
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * StrictBignumConversion --
  *
- *	Convert a floating point number to a fixed-length digit string
- *	using the multiprecision method.
+ *	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.
+ *	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 */
+inline static char *
+StrictBignumConversion(
+    Double *dPtr,		/* Original number being converted. */
+    int convType,		/* Conversion type. */
+    Tcl_WideUInt bw,		/* Integer significand and exponent. */
+    int b2,			/* Scale factor for the significand. */
+    int s2, int s5,		/* Scale factors for denominator. */
+    int k,			/* Guessed position of the decimal point. */
+    int len,			/* Size of the digit buffer to allocate. */
+    int ilim,			/* Number of digits to convert if b >= s */
+    int ilim1,			/* Number of digits to convert if b < s */
+    int *decpt,			/* OUTPUT: Position of the decimal point. */
+    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
 {
-    char* retval = ckalloc(len+1);
-				/* Buffer of digits to return */
-    char* s = retval;		/* Cursor in the return value */
-    mp_int b;			/* Numerator of the result */
-    mp_int S;			/* Denominator of the result */
-    mp_int dig;			/* Current digit of the result */
-    int digit;			/* Current digit of the result */
-    mp_int temp;		/* Work area */
-    int g;			/* Size of the current digit groun */
+    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;
 
     /*
@@ -3883,8 +3907,7 @@ StrictBignumConversion(Double* dPtr,
     MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
 
     /*
-     * Handle the case where we guess the position of the decimal point
-     * wrong.
+     * Handle the case where we guess the position of the decimal point wrong.
      */
 
     if (mp_cmp_mag(&b, &S) == MP_LT) {
@@ -3893,7 +3916,9 @@ StrictBignumConversion(Double* dPtr,
 	--k;
     }
 
-    /* Convert the leading digit */
+    /*
+     * Convert the leading digit.
+     */
 
     i = 0;
     mp_div(&b, &S, &dig, &b);
@@ -3902,7 +3927,9 @@ StrictBignumConversion(Double* dPtr,
     }
     digit = dig.dp[0];
 
-    /* Is a single digit all that was requested? */
+    /*
+     * Is a single digit all that was requested?
+     */
 
     *s++ = '0' + digit;
     if (++i >= ilim) {
@@ -3911,10 +3938,10 @@ StrictBignumConversion(Double* dPtr,
 	    s = BumpUp(s, retval, &k);
 	}
     } else {
-
 	for (;;) {
-
-	    /* Shift by a group of digits. */
+	    /*
+	     * Shift by a group of digits.
+	     */
 
 	    g = ilim - i;
 	    if (g > DIGIT_GROUP) {
@@ -3933,18 +3960,17 @@ StrictBignumConversion(Double* dPtr,
 	    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.
+	     * 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_t 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.
 	     */
 
-	    /* Extract the next group of digits */
-
 	    mp_div(&b, &S, &dig, &b);
 	    if (dig.used > 1) {
 		Tcl_Panic("wrong digit!");
@@ -3952,31 +3978,35 @@ StrictBignumConversion(Double* dPtr,
 	    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? */
+	    /*
+	     * Have we converted all the requested digits?
+	     */
 
 	    if (i == ilim) {
 		mp_mul_2d(&b, 1, &b);
 		if (ShouldBankerRoundUp(&b, &S, digit&1)) {
 		    s = BumpUp(s, retval, &k);
-		} else {
-		    while (*--s == '0') {
-			/* do nothing */
-		    }
-		    ++s;
 		}
-	    break;
+		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;
@@ -3984,117 +4014,118 @@ StrictBignumConversion(Double* dPtr,
 	*endPtr = s;
     }
     return retval;
-
 }
 
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * TclDoubleDigits --
  *
- *	Core of Tcl's conversion of double-precision floating point numbers
- *	to decimal.
+ *	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.
+ *	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
+ * 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.
+ *	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'
+ *	TCL_DD_STEELE - This value is not recommended and may be removed in
+ *		the future. It follows the conversion algorithm outlined in
+ *		"How to Print Floating-Point Numbers Accurately" by Guy
+ *		L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90,
+ *		pp. 112-126]. This rule has the effect of rendering 1e23 as
+ *		9.9999999999999999e22 - which is a 'better' approximation in
+ *		the sense that it will reconvert correctly even if a
+ *		subsequent input conversion is 'round up' or 'round down'
  *		rather than 'round to nearest', but is surprising otherwise.
- *	TCL_DD_E_FORMAT - This value is used to prepare numbers for %e
- *		format conversion (or for default floating->string if
- *		tcl_precision is not 0). It constructs a string of at most
- *		'ndigits' digits, choosing the one that is closest to the
- *		given number (and resolving ties with 'round to even').
- *		It is allowed to return fewer than 'ndigits' if the number
- *		converts exactly; if the TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG
- *		is supplied instead, it also returns fewer digits if the
- *		shorter string will still reconvert to the given input number.
- *		In any case, strings of trailing zeroes are suppressed.
- *	TCL_DD_F_FORMAT - This value is used to prepare numbers for %f
- *		format conversion. It requests that conversion proceed until
+ *	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.
+ *		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.
+ * (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 */
+
+char *
+TclDoubleDigits(
+    double dv,			/* Number to convert. */
+    int ndigits,		/* Number of digits requested. */
+    int flags,			/* Conversion flags. */
+    int *decpt,			/* OUTPUT: Position of the decimal point. */
+    int *sign,			/* OUTPUT: 1 if the result is negative. */
+    char **endPtr)		/* OUTPUT: If not NULL, receives a pointer to
+				 *	   one character beyond the end of the
+				 *	   returned string. */
 {
     int convType = (flags & TCL_DD_CONVERSION_TYPE_MASK);
-				/* Type of conversion being performed
-				 * TCL_DD_SHORTEST0
-				 * TCL_DD_STEELE0
-				 * TCL_DD_E_FORMAT
-				 * TCL_DD_F_FORMAT */
-    Double d;			/* Union for deconstructing doubles */
-    Tcl_WideUInt bw;		/* Integer significand */
+				/* 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 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 */
+				 * 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 */
+				 * 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 */
+    /*
+     * Put the input number into a union for bit-whacking.
+     */
 
     d.d = dv;
 
@@ -4113,10 +4144,10 @@ TclDoubleDigits(double dv,	/* Number to convert */
 
     /*
      * 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)).
+     * 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);
@@ -4126,58 +4157,57 @@ TclDoubleDigits(double dv,	/* Number to convert */
      *	  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.
+     *	  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.
+     *    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:
+     * 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.
+     *      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
+     * Try to do low-precision conversion in floating point rather than
+     * resorting to expensive multiprecision arithmetic.
      */
+
     if (ilim >= 0 && ilim <= QUICK_MAX && !(flags & TCL_DD_NO_QUICK)) {
-	if ((retval = QuickConversion(d.d, k, k_check, flags,
-				      i, ilim, ilim1,
-				      decpt, endPtr)) != NULL) {
+	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.
+     * 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) {
@@ -4187,10 +4217,10 @@ TclDoubleDigits(double dv,	/* Number to convert */
 	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.
+	 * 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 {
@@ -4201,14 +4231,16 @@ TclDoubleDigits(double dv,	/* Number to convert */
 
 	/*
 	 * Reduce the fractions to lowest terms, since the above calculation
-	 * may have left excess powers of 2 in numerator and denominator
+	 * 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;
@@ -4216,60 +4248,56 @@ TclDoubleDigits(double dv,	/* Number to convert */
 	    ++m2plus;
 	}
 
-	if (s5+1 < N_LOG2POW5
-	    && s2+1 + log2pow5[s5+1] <= 64) {
+	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]).
+	     * 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);
+	    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.
+	     * 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);
+		    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
+	     * 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);
-
+	    return ShorteningBignumConversion(&d, convType, bw, b2, m2plus,
+		    m2minus, s2, s5, k, len, ilim, ilim1, decpt, endPtr);
 	}
-
     } else {
-
-	/* Non-shortening conversion */
+	/*
+	 * Non-shortening conversion.
+	 */
 
 	int len = i;
 
-	/* Reduce numerator and denominator to lowest terms */
+	/*
+	 * Reduce numerator and denominator to lowest terms.
+	 */
 
 	if (b2 >= s2 && s2 > 0) {
 	    b2 -= s2; s2 = 0;
@@ -4277,48 +4305,46 @@ TclDoubleDigits(double dv,	/* Number to convert */
 	    s2 -= b2; b2 = 0;
 	}
 
-	if (s5+1 < N_LOG2POW5
-	    && s2+1 + log2pow5[s5+1] <= 64) {
+	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.
+	     * 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);
-
+	    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.
+	     * 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);
+		    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.
+	     * 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);
+
+	    return StrictBignumConversion(&d, convType, bw, b2, s2, s5, k,
+		    len, ilim, ilim1, decpt, endPtr);
 	}
     }
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -4346,14 +4372,12 @@ TclInitDoubleConversion(void)
     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;
 
@@ -4368,8 +4392,7 @@ TclInitDoubleConversion(void)
 
     maxpow10_wide = (int)
 	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
-    pow10_wide = (Tcl_WideUInt *)
-	    ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
+    pow10_wide = ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
     u = 1;
     for (i = 0; i < maxpow10_wide; ++i) {
 	pow10_wide[i] = u;
@@ -4378,8 +4401,8 @@ TclInitDoubleConversion(void)
     pow10_wide[i] = u;
 
     /*
-     * Determine how many bits of precision a double has, and how many
-     * decimal digits that represents.
+     * 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) {
@@ -4390,8 +4413,8 @@ TclInitDoubleConversion(void)
     d = 1.0;
 
     /*
-     * Initialize a table of powers of ten that can be exactly represented
-     * in a double.
+     * 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));
@@ -4476,10 +4499,13 @@ TclFinalizeDoubleConversion(void)
 {
     int i;
 
-    ckfree((char *) pow10_wide);
+    ckfree(pow10_wide);
     for (i=0; i<9; ++i) {
 	mp_clear(pow5 + i);
     }
+    for (i=0; i < 5; ++i) {
+	mp_clear(pow5_13 + i);
+    }
 }
 
 /*
@@ -4502,9 +4528,9 @@ TclFinalizeDoubleConversion(void)
 
 int
 Tcl_InitBignumFromDouble(
-    Tcl_Interp *interp,		/* For error message */
-    double d,			/* Number to convert */
-    mp_int *b)			/* Place to store the result */
+    Tcl_Interp *interp,		/* For error message. */
+    double d,			/* Number to convert. */
+    mp_int *b)			/* Place to store the result. */
 {
     double fract;
     int expt;
@@ -4558,7 +4584,7 @@ Tcl_InitBignumFromDouble(
 
 double
 TclBignumToDouble(
-    mp_int *a)			/* Integer to convert. */
+    const mp_int *a)			/* Integer to convert. */
 {
     mp_int b;
     int bits, shift, i, lsb;
@@ -4654,9 +4680,9 @@ TclBignumToDouble(
 	return -r;
     }
 }
-
+
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * TclCeil --
  *
@@ -4666,12 +4692,12 @@ TclBignumToDouble(
  * Results:
  *	Returns the floating point number.
  *
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 double
 TclCeil(
-    mp_int *a)			/* Integer to convert. */
+    const mp_int *a)			/* Integer to convert. */
 {
     double r = 0.0;
     mp_int b;
@@ -4711,24 +4737,24 @@ TclCeil(
     mp_clear(&b);
     return r;
 }
-
+
 /*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * TclFloor --
  *
- *	Computes the largest floating point number less than or equal to
- *	the mp_int argument.
+ *	Computes the largest floating point number less than or equal to the
+ *	mp_int argument.
  *
  * Results:
  *	Returns the floating point value.
  *
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 double
 TclFloor(
-    mp_int *a)			/* Integer to convert. */
+    const mp_int *a)			/* Integer to convert. */
 {
     double r = 0.0;
     mp_int b;
@@ -4784,8 +4810,8 @@ TclFloor(
 
 static double
 BignumToBiasedFrExp(
-    mp_int *a,			/* Integer to convert */
-    int *machexp)		/* Power of two */
+    const mp_int *a,		/* Integer to convert. */
+    int *machexp)		/* Power of two. */
 {
     mp_int b;
     int bits;
@@ -4849,8 +4875,8 @@ BignumToBiasedFrExp(
 
 static double
 Pow10TimesFrExp(
-    int exponent,	 	/* Power of 10 to multiply by */
-    double fraction,		/* Significand of multiplicand */
+    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. */
 {
@@ -4860,7 +4886,7 @@ Pow10TimesFrExp(
 
     if (exponent > 0) {
 	/*
-	 * Multiply by 10**exponent
+	 * Multiply by 10**exponent.
 	 */
 
 	retval = frexp(retval * pow10vals[exponent&0xf], &j);
@@ -4873,7 +4899,7 @@ Pow10TimesFrExp(
 	}
     } else if (exponent < 0) {
 	/*
-	 * Divide by 10**-exponent
+	 * Divide by 10**-exponent.
 	 */
 
 	retval = frexp(retval / pow10vals[(-exponent) & 0xf], &j);
@@ -4982,26 +5008,27 @@ TclFormatNaN(
  *
  * Nokia770Twiddle --
  *
- * 	Transpose the two words of a number for Nokia 770 floating
- *	point handling.
+ *	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 */
+    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.
+ *	Transpose the two words of a number for Nokia 770 floating point
+ *	handling.
  *
  *----------------------------------------------------------------------
  */
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 67e86c5..4e19750 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -36,6 +36,16 @@
 
 #include "tclInt.h"
 #include "tommath.h"
+#include "tclStringRep.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.
+ */
+
+#define COMPAT 0
 
 /*
  * Prototypes for functions defined later in this file:
@@ -53,8 +63,14 @@ 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		SetUnicodeObj(Tcl_Obj *objPtr,
@@ -67,71 +83,14 @@ static void		UpdateStringOfString(Tcl_Obj *objPtr);
  * functions that can be invoked by generic object code.
  */
 
-Tcl_ObjType tclStringType = {
+const 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!
- */
-
-typedef struct String {
-    int numChars;		/* The number of chars in the string. -1 means
-				 * this value has not been calculated. >= 0
-				 * means that there is a valid Unicode rep, or
-				 * that the number of UTF bytes == the number
-				 * of chars. */
-    size_t allocated;		/* The amount of space actually allocated for
-				 * the UTF string (minus 1 byte for the
-				 * termination char). */
-    size_t uallocated;		/* The amount of space actually allocated for
-				 * the Unicode string (minus 2 bytes for the
-				 * termination char). */
-    int hasUnicode;		/* Boolean determining whether the string has
-				 * a Unicode representation. */
-    Tcl_UniChar unicode[2];	/* The array of Unicode chars. The actual size
-				 * of this field depends on the 'uallocated'
-				 * field above. */
-} String;
-
-#define STRING_MAXCHARS \
-	(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) { \
-	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
-		STRING_MAXCHARS); \
-    }
-#define stringRealloc(ptr, numChars) \
-	(String *) ckrealloc((char *) ptr, \
-		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
-#define stringAttemptRealloc(ptr, numChars) \
-	(String *) attemptckrealloc((char *) ptr, \
-		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
-#define GET_STRING(objPtr) \
-	((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_STRING(objPtr, stringPtr) \
-	((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
-
+
 /*
  * TCL STRING GROWTH ALGORITHM
  *
@@ -140,8 +99,7 @@ typedef struct String {
  *
  *   Attempt to allocate 2 * (originalLength + appendLength)
  *   On failure:
- *	attempt to allocate originalLength + 2*appendLength +
- *			TCL_GROWTH_MIN_ALLOC
+ *	attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH
  *
  * This algorithm allows very good performance, as it rapidly increases the
  * memory allocated for a given string, which minimizes the number of
@@ -154,37 +112,93 @@ typedef struct String {
  * 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
+ * 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_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior.
+ * TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior.
  *
  * The growth algorithm can be tuned by adjusting the following parameters:
  *
- * TCL_GROWTH_MIN_ALLOC		Additional space, in bytes, to allocate when
+ * TCL_MIN_GROWTH		Additional space, in bytes, to allocate when
  *				the double allocation has failed. Default is
- *				1024 (1 kilobyte).
+ *				1024 (1 kilobyte).  See tclInt.h.
  */
 
-#ifndef TCL_GROWTH_MIN_ALLOC
-#define TCL_GROWTH_MIN_ALLOC	1024
+#ifndef TCL_MIN_UNICHAR_GROWTH
+#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
 #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
-     *  STRING_UALLOC(needed) > stringPtr->uallocated
-     *  needed < STRING_MAXCHARS
+    /*
+     * Pre-conditions:
+     *	objPtr->typePtr == &tclStringType
+     *	needed > stringPtr->maxChars
+     *	needed < STRING_MAXCHARS
      */
+
     String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
     int attempt;
 
-    if (stringPtr->uallocated > 0) {
-	/* Subsequent appends - apply the growth algorithm. */
+    if (stringPtr->maxChars > 0) {
+	/*
+	 * Subsequent appends - apply the growth algorithm.
+	 */
+
 	attempt = 2 * needed;
 	if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
 	    ptr = stringAttemptRealloc(stringPtr, attempt);
@@ -194,24 +208,28 @@ 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_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
+		    + TCL_MIN_UNICHAR_GROWTH;
 	    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->uallocated = STRING_UALLOC(attempt);
+    stringPtr->maxChars = attempt;
     SET_STRING(objPtr, stringPtr);
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -261,7 +279,7 @@ Tcl_NewStringObj(
 				 * negative, use bytes up to the first NUL
 				 * byte. */
 {
-    register Tcl_Obj *objPtr;
+    Tcl_Obj *objPtr;
 
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
@@ -314,7 +332,7 @@ Tcl_DbNewStringObj(
     int line)			/* Line number in the source file; used for
 				 * debugging. */
 {
-    register Tcl_Obj *objPtr;
+    Tcl_Obj *objPtr;
 
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
@@ -328,7 +346,7 @@ Tcl_Obj *
 Tcl_DbNewStringObj(
     const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the new object. */
-    register int length,	/* The number of bytes to copy from "bytes"
+    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. */
@@ -397,64 +415,50 @@ Tcl_GetCharLength(
 				 * of. */
 {
     String *stringPtr;
-
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
+    int numChars;
 
     /*
-     * If numChars is unknown, then calculate the number of characaters while
-     * populating the Unicode string.
+     * 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 (stringPtr->numChars == -1) {
-	register int i = objPtr->length;
-	register unsigned char *str = (unsigned char *) objPtr->bytes;
+    if (TclIsPureByteArray(objPtr)) {
+	int length;
 
-	/*
-	 * 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);
-	 *
-	 * TODO: Consider macro-izing this.
-	 */
+	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
+	return length;
+    }
 
-	while (i && (*str < 0xC0)) {
-	    i--;
-	    str++;
-	}
-	stringPtr->numChars = objPtr->length - i;
-	if (i) {
-	    stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
-		    + (objPtr->length - i), i);
-	}
+    /*
+     * OK, need to work with the object as a string.
+     */
 
-	if (stringPtr->numChars == objPtr->length) {
-	    /*
-	     * Since we've just calculated the number of chars, and all UTF
-	     * chars are 1-byte long, we don't need to store the unicode
-	     * string.
-	     */
+    SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
+    numChars = stringPtr->numChars;
 
-	    stringPtr->hasUnicode = 0;
-	} else {
-	    /*
-	     * Since we've just calucalated the number of chars, and not all
-	     * UTF chars are 1-byte long, go ahead and populate the unicode
-	     * string.
-	     */
+    /*
+     * If numChars is unknown, compute it.
+     */
 
-	    FillUnicodeRep(objPtr);
+    if (numChars == -1) {
+	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
+	stringPtr->numChars = numChars;
 
+#if COMPAT
+	if (numChars < objPtr->length) {
 	    /*
-	     * We need to fetch the pointer again because we have just
-	     * reallocated the structure to make room for the Unicode data.
+	     * 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.
 	     */
 
-	    stringPtr = GET_STRING(objPtr);
+	    FillUnicodeRep(objPtr);
 	}
+#endif
     }
-    return stringPtr->numChars;
+    return numChars;
 }
 
 /*
@@ -480,39 +484,42 @@ Tcl_GetUniChar(
 				 * 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 (stringPtr->numChars == -1) {
-	/*
-	 * We haven't yet calculated the length, so we don't have the Unicode
-	 * str. We need to know the number of chars before we can do indexing.
-	 */
+    if (TclIsPureByteArray(objPtr)) {
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
 
-	Tcl_GetCharLength(objPtr);
+	return (Tcl_UniChar) bytes[index];
+    }
 
-	/*
-	 * We need to fetch the pointer again because we may have just
-	 * reallocated the structure.
-	 */
+    /*
+     * OK, need to work with the object as a string.
+     */
+
+    SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
 
-	stringPtr = GET_STRING(objPtr);
-    }
     if (stringPtr->hasUnicode == 0) {
 	/*
-	 * All of the characters in the Utf string are 1 byte chars, so we
-	 * don't store the unicode char. We get the Utf string and convert the
-	 * index'th byte to a Unicode character.
+	 * If numChars is unknown, compute it.
 	 */
 
-	unichar = (Tcl_UniChar) objPtr->bytes[index];
-    } else {
-	unichar = stringPtr->unicode[index];
+	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);
     }
-    return unichar;
+    return stringPtr->unicode[index];
 }
 
 /*
@@ -539,30 +546,7 @@ Tcl_GetUnicode(
     Tcl_Obj *objPtr)		/* The object to find the unicode string
 				 * for. */
 {
-    String *stringPtr;
-
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
-
-    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
-	/*
-	 * 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;
+    return Tcl_GetUnicodeFromObj(objPtr, NULL);
 }
 
 /*
@@ -597,22 +581,8 @@ Tcl_GetUnicodeFromObj(
     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,49 +620,50 @@ Tcl_GetRange(
     Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
     String *stringPtr;
 
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
-
-    if (stringPtr->numChars == -1) {
-	/*
-	 * We haven't yet calculated the length, so we don't have the Unicode
-	 * str. We need to know the number of chars before we can do indexing.
-	 */
-
-	Tcl_GetCharLength(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 substring operation.
+     */
 
-	/*
-	 * We need to fetch the pointer again because we may have just
-	 * reallocated the structure.
-	 */
+    if (TclIsPureByteArray(objPtr)) {
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
 
-	stringPtr = GET_STRING(objPtr);
+	return Tcl_NewByteArrayObj(bytes+first, last-first+1);
     }
 
-    if (objPtr->bytes && (stringPtr->numChars == objPtr->length)) {
-	char *str = TclGetString(objPtr);
+    /*
+     * OK, need to work with the object as a string.
+     */
+
+    SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
 
+    if (stringPtr->hasUnicode == 0) {
 	/*
-	 * All of the characters in the Utf string are 1 byte chars, so we
-	 * don't store the unicode char. Create a new string object containing
-	 * the specified range of chars.
+	 * If numChars is unknown, compute it.
 	 */
 
-	newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
+	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 new string only has 1-byte chars, we can set it's
-	 * numChars field.
-	 */
+	    /*
+	     * Since we know the char length of the result, store it.
+	     */
 
-	SetStringFromAny(NULL, newObjPtr);
-	stringPtr = GET_STRING(newObjPtr);
-	stringPtr->numChars = last-first+1;
-    } else {
-	newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
-		last-first+1);
+	    SetStringFromAny(NULL, newObjPtr);
+	    stringPtr = GET_STRING(newObjPtr);
+	    stringPtr->numChars = newObjPtr->length;
+	    return newObjPtr;
+	}
+	FillUnicodeRep(objPtr);
+	stringPtr = GET_STRING(objPtr);
     }
-    return newObjPtr;
+
+    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
 }
 
 /*
@@ -718,10 +689,10 @@ Tcl_GetRange(
 
 void
 Tcl_SetStringObj(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
     const char *bytes,		/* Points to the first of the length bytes
 				 * used to initialize the object. */
-    register int length)	/* The number of bytes to copy from "bytes"
+    int length)			/* The number of bytes to copy from "bytes"
 				 * when initializing the object. If negative,
 				 * use bytes up to the first NUL byte.*/
 {
@@ -734,7 +705,6 @@ Tcl_SetStringObj(
      */
 
     TclFreeIntRep(objPtr);
-    objPtr->typePtr = NULL;
 
     /*
      * Free any old string rep, then set the string rep to a copy of the
@@ -773,9 +743,9 @@ Tcl_SetStringObj(
 
 void
 Tcl_SetObjLength(
-    register Tcl_Obj *objPtr,	/* Pointer to object. This object must not
+    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
 				 * currently be shared. */
-    register int length)	/* Number of bytes desired for string
+    int length)			/* Number of bytes desired for string
 				 * representation of object, not including
 				 * terminating null byte. */
 {
@@ -783,60 +753,42 @@ 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");
     }
-    SetStringFromAny(NULL, objPtr);
 
-    stringPtr = GET_STRING(objPtr);
+    if (objPtr->bytes && objPtr->length == length) {
+	return;
+    }
 
-    /*
-     * Check that we're not extending a pure unicode string.
-     */
+    SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
 
-    if ((size_t)length > stringPtr->allocated &&
-	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
+    if (objPtr->bytes != NULL) {
 	/*
-	 * Not enough space in current string. Reallocate the string space and
-	 * free the old string.
+	 * Change length of an existing string rep.
 	 */
-
-	if (objPtr->bytes != tclEmptyStringRep) {
-	    objPtr->bytes = ckrealloc((char *) objPtr->bytes,
-		    (unsigned) (length + 1));
-	} else {
-	    char *newBytes = ckalloc((unsigned) (length+1));
-
-	    if (objPtr->bytes != NULL && objPtr->length != 0) {
-		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
-		TclInvalidateStringRep(objPtr);
+	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);
 	    }
-	    objPtr->bytes = newBytes;
+	    stringPtr->allocated = length;
 	}
-	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 NUL-terminated.
-	     */
-
-	    objPtr->bytes[length] = 0;
-	}
+	objPtr->bytes[length] = 0;
 
 	/*
 	 * Invalidate the unicode data.
@@ -849,24 +801,25 @@ Tcl_SetObjLength(
 	 * Changing length of pure unicode string.
 	 */
 
-	size_t uallocated = STRING_UALLOC(length);
-
 	stringCheckLimits(length);
-	if (uallocated > stringPtr->uallocated) {
+	if (length > stringPtr->maxChars) {
 	    stringPtr = stringRealloc(stringPtr, length);
 	    SET_STRING(objPtr, stringPtr);
-	    stringPtr->uallocated = uallocated;
+	    stringPtr->maxChars = length;
 	}
-	stringPtr->numChars = length;
-	stringPtr->hasUnicode = (length > 0);
 
 	/*
-	 * Ensure the string is NUL-terminated.
+	 * Mark the new end of the unicode string
 	 */
 
+	stringPtr->numChars = length;
 	stringPtr->unicode[length] = 0;
-	stringPtr->allocated = 0;
-	objPtr->length = 0;
+	stringPtr->hasUnicode = 1;
+
+	/*
+	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
+	 * the string rep.
+	 */
     }
 }
 
@@ -895,9 +848,9 @@ Tcl_SetObjLength(
 
 int
 Tcl_AttemptSetObjLength(
-    register Tcl_Obj *objPtr,	/* Pointer to object. This object must not
+    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
 				 * currently be shared. */
-    register int length)	/* Number of bytes desired for string
+    int length)			/* Number of bytes desired for string
 				 * representation of object, not including
 				 * terminating null byte. */
 {
@@ -905,66 +858,47 @@ 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");
     }
-    SetStringFromAny(NULL, objPtr);
+    if (objPtr->bytes && objPtr->length == length) {
+	return 1;
+    }
 
+    SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
-    /*
-     * Check that we're not extending a pure unicode string.
-     */
-
-    if (length > (int) stringPtr->allocated &&
-	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
-	char *newBytes;
-
+    if (objPtr->bytes != NULL) {
 	/*
-	 * Not enough space in current string. Reallocate the string space and
-	 * free the old string.
+	 * Change length of an existing string rep.
 	 */
+	if (length > stringPtr->allocated) {
+	    /*
+	     * Need to enlarge the buffer.
+	     */
 
-	if (objPtr->bytes != tclEmptyStringRep) {
-	    newBytes = attemptckrealloc(objPtr->bytes,
-		    (unsigned)(length + 1));
-	    if (newBytes == NULL) {
-		return 0;
+	    char *newBytes;
+
+	    if (objPtr->bytes == tclEmptyStringRep) {
+		newBytes = attemptckalloc(length + 1);
+	    } else {
+		newBytes = attemptckrealloc(objPtr->bytes, length + 1);
 	    }
-	} else {
-	    newBytes = attemptckalloc((unsigned) (length + 1));
 	    if (newBytes == NULL) {
 		return 0;
 	    }
-	    if (objPtr->bytes != NULL && objPtr->length != 0) {
-		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
-		TclInvalidateStringRep(objPtr);
-	    }
+	    objPtr->bytes = newBytes;
+	    stringPtr->allocated = length;
 	}
-	objPtr->bytes = newBytes;
-	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;
-	}
+	objPtr->bytes[length] = 0;
 
 	/*
 	 * Invalidate the unicode data.
@@ -977,29 +911,30 @@ Tcl_AttemptSetObjLength(
 	 * Changing length of pure unicode string.
 	 */
 
-	size_t uallocated = STRING_UALLOC(length);
 	if (length > STRING_MAXCHARS) {
 	    return 0;
 	}
-
-	if (uallocated > stringPtr->uallocated) {
+	if (length > stringPtr->maxChars) {
 	    stringPtr = stringAttemptRealloc(stringPtr, length);
 	    if (stringPtr == NULL) {
 		return 0;
 	    }
 	    SET_STRING(objPtr, stringPtr);
-	    stringPtr->uallocated = uallocated;
+	    stringPtr->maxChars = length;
 	}
-	stringPtr->numChars = length;
-	stringPtr->hasUnicode = (length > 0);
 
 	/*
-	 * Ensure the string is NUL-terminated.
+	 * Mark the new end of the unicode string.
 	 */
 
 	stringPtr->unicode[length] = 0;
-	stringPtr->allocated = 0;
-	objPtr->length = 0;
+	stringPtr->numChars = length;
+	stringPtr->hasUnicode = 1;
+
+	/*
+	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
+	 * the string rep.
+	 */
     }
     return 1;
 }
@@ -1059,7 +994,6 @@ SetUnicodeObj(
 				 * string. */
 {
     String *stringPtr;
-    size_t uallocated;
 
     if (numChars < 0) {
 	numChars = UnicodeLength(unicode);
@@ -1070,19 +1004,18 @@ SetUnicodeObj(
      */
 
     stringCheckLimits(numChars);
-    uallocated = STRING_UALLOC(numChars);
-    stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
+    stringPtr = stringAlloc(numChars);
+    SET_STRING(objPtr, stringPtr);
+    objPtr->typePtr = &tclStringType;
 
-    stringPtr->numChars = numChars;
-    stringPtr->uallocated = uallocated;
-    stringPtr->hasUnicode = (numChars > 0);
-    stringPtr->allocated = 0;
-    memcpy(stringPtr->unicode, unicode, uallocated);
+    stringPtr->maxChars = numChars;
+    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
     stringPtr->unicode[numChars] = 0;
+    stringPtr->numChars = numChars;
+    stringPtr->hasUnicode = 1;
 
     TclInvalidateStringRep(objPtr);
-    objPtr->typePtr = &tclStringType;
-    SET_STRING(objPtr, stringPtr);
+    stringPtr->allocated = 0;
 }
 
 /*
@@ -1105,13 +1038,13 @@ SetUnicodeObj(
 
 void
 Tcl_AppendLimitedToObj(
-    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
     const char *bytes,		/* Points to the bytes to append to the
 				 * object. */
-    register int length,	/* The number of bytes available to be
+    int length,			/* The number of bytes available to be
 				 * appended from "bytes". If < 0, then all
 				 * bytes up to a NUL byte are available. */
-    register int limit,		/* The maximum number of bytes to append to
+    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
@@ -1124,8 +1057,6 @@ Tcl_AppendLimitedToObj(
 	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
     }
 
-    SetStringFromAny(NULL, objPtr);
-
     if (length < 0) {
 	length = (bytes ? strlen(bytes) : 0);
     }
@@ -1149,8 +1080,10 @@ Tcl_AppendLimitedToObj(
      * objPtr's string rep.
      */
 
+    SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
-    if (stringPtr->hasUnicode != 0) {
+
+    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
 	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
     } else {
 	AppendUtfToUtfRep(objPtr, bytes, toCopy);
@@ -1161,10 +1094,10 @@ Tcl_AppendLimitedToObj(
     }
 
     stringPtr = GET_STRING(objPtr);
-    if (stringPtr->hasUnicode != 0) {
-	AppendUtfToUnicodeRep(objPtr, ellipsis, -1);
+    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
+	AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
     } else {
-	AppendUtfToUtfRep(objPtr, ellipsis, -1);
+	AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
     }
 }
 
@@ -1187,10 +1120,10 @@ Tcl_AppendLimitedToObj(
 
 void
 Tcl_AppendToObj(
-    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
+    Tcl_Obj *objPtr,		/* Points to the object to append to. */
     const char *bytes,		/* Points to the bytes to append to the
 				 * object. */
-    register int length)	/* The number of bytes to append from "bytes".
+    int length)			/* The number of bytes to append from "bytes".
 				 * If < 0, then append all bytes up to NUL
 				 * byte. */
 {
@@ -1216,7 +1149,7 @@ Tcl_AppendToObj(
 
 void
 Tcl_AppendUnicodeToObj(
-    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
+    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". */
@@ -1240,7 +1173,11 @@ Tcl_AppendUnicodeToObj(
      * objPtr's string rep.
      */
 
-    if (stringPtr->hasUnicode != 0) {
+    if (stringPtr->hasUnicode
+#if COMPAT
+		&& stringPtr->numChars > 0
+#endif
+	    ) {
 	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
     } else {
 	AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -1273,35 +1210,93 @@ Tcl_AppendObjToObj(
     Tcl_Obj *appendObjPtr)	/* Object to append. */
 {
     String *stringPtr;
-    int length, numChars, allOneByteChars;
-    char *bytes;
+    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)) {
+
+	/*
+	 * You might expect the code here to be
+	 *
+	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
+	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
+	 *
+	 * and essentially all of the time that would be fine.  However,
+	 * it would run into trouble in the case where objPtr and
+	 * appendObjPtr point to the same thing.  That may never be a
+	 * good idea.  It seems to violate Copy On Write, and we don't
+	 * have any tests for the situation, since making any Tcl commands
+	 * that call Tcl_AppendObjToObj() do that appears impossible
+	 * (They honor Copy On Write!).  For the sake of extensions that
+	 * go off into that realm, though, here's a more complex approach
+	 * that can handle all the cases.
+	 */
+
+	/* Get lengths */
+	int lengthSrc;
+
+	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
+	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
+
+	/* Grow buffer enough for the append */
+	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
+
+	/* Reset objPtr back to the original value */
+	Tcl_SetByteArrayLength(objPtr, length);
+
+	/*
+	 * Now do the append knowing that buffer growth cannot cause
+	 * any trouble.
+	 */
+
+	TclAppendBytesToByteArray(objPtr,
+		Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
+	return;
+    }
+
+    /*
+     * Must append as strings.
+     */
 
     SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
 
     /*
      * If objPtr has a valid Unicode rep, then get a Unicode string from
      * appendObjPtr and append it.
      */
 
-    stringPtr = GET_STRING(objPtr);
-    if (stringPtr->hasUnicode != 0) {
+    if (stringPtr->hasUnicode
+#if COMPAT
+		&& stringPtr->numChars > 0
+#endif
+	    ) {
 	/*
 	 * If appendObjPtr is not of the "String" type, don't convert it.
 	 */
 
 	if (appendObjPtr->typePtr == &tclStringType) {
-	    stringPtr = GET_STRING(appendObjPtr);
-	    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
-		/*
-		 * If appendObjPtr is a string obj with no valid Unicode rep,
-		 * then fill its unicode rep.
-		 */
+	    Tcl_UniChar *unicode =
+		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
 
-		FillUnicodeRep(appendObjPtr);
-		stringPtr = GET_STRING(appendObjPtr);
-	    }
-	    AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
-		    stringPtr->numChars);
+	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
 	} else {
 	    bytes = TclGetStringFromObj(appendObjPtr, &length);
 	    AppendUtfToUnicodeRep(objPtr, bytes, length);
@@ -1317,21 +1312,20 @@ Tcl_AppendObjToObj(
 
     bytes = TclGetStringFromObj(appendObjPtr, &length);
 
-    allOneByteChars = 0;
     numChars = stringPtr->numChars;
     if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
-	stringPtr = GET_STRING(appendObjPtr);
-	if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
-	    numChars += stringPtr->numChars;
-	    allOneByteChars = 1;
-	}
+	String *appendStringPtr = GET_STRING(appendObjPtr);
+	appendNumChars = appendStringPtr->numChars;
     }
 
     AppendUtfToUtfRep(objPtr, bytes, length);
 
-    if (allOneByteChars) {
-	stringPtr = GET_STRING(objPtr);
-	stringPtr->numChars = numChars;
+    if (numChars >= 0 && appendNumChars >= 0
+#if COMPAT
+		&& appendNumChars == length
+#endif
+	    ) {
+	stringPtr->numChars = numChars + appendNumChars;
     }
 }
 
@@ -1382,23 +1376,27 @@ AppendUnicodeToUnicodeRep(
     numChars = stringPtr->numChars + appendNumChars;
     stringCheckLimits(numChars);
 
-    if (STRING_UALLOC(numChars) > stringPtr->uallocated) {
+    if (numChars > stringPtr->maxChars) {
+	int offset = -1;
+
 	/*
 	 * 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 (unicode && unicode >= stringPtr->unicode
-		&& unicode <= stringPtr->unicode
-		+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
+		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
 	    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;
 	}
@@ -1410,7 +1408,7 @@ AppendUnicodeToUnicodeRep(
      */
 
     if (unicode) {
-	memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
+	memmove(stringPtr->unicode + stringPtr->numChars, unicode,
 		appendNumChars * sizeof(Tcl_UniChar));
     }
     stringPtr->unicode[numChars] = 0;
@@ -1443,20 +1441,21 @@ AppendUnicodeToUtfRep(
     const Tcl_UniChar *unicode,	/* String to convert to UTF. */
     int numChars)		/* Number of chars of "unicode" to convert. */
 {
-    Tcl_DString dsPtr;
-    const char *bytes;
+    String *stringPtr = GET_STRING(objPtr);
 
-    if (numChars < 0) {
-	numChars = UnicodeLength(unicode);
-    }
-    if (numChars == 0) {
-	return;
+    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
+
+    if (stringPtr->numChars != -1) {
+	stringPtr->numChars += numChars;
     }
 
-    Tcl_DStringInit(&dsPtr);
-    bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
-    AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
-    Tcl_DStringFree(&dsPtr);
+#if COMPAT
+    /*
+     * Invalidate the unicode rep.
+     */
+
+    stringPtr->hasUnicode = 0;
+#endif
 }
 
 /*
@@ -1466,7 +1465,7 @@ AppendUnicodeToUtfRep(
  *
  *	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.
+ *	valid Unicode rep. numBytes must be non-negative.
  *
  * Results:
  *	None.
@@ -1483,25 +1482,16 @@ AppendUtfToUnicodeRep(
     const char *bytes,		/* String to convert to Unicode. */
     int numBytes)		/* Number of bytes of "bytes" to convert. */
 {
-    Tcl_DString dsPtr;
-    int numChars = numBytes;
-    Tcl_UniChar *unicode = NULL;
+    String *stringPtr;
 
-    if (numBytes < 0) {
-	numBytes = (bytes ? strlen(bytes) : 0);
-    }
     if (numBytes == 0) {
 	return;
     }
 
-    Tcl_DStringInit(&dsPtr);
-    if (bytes) {
-	numChars = Tcl_NumUtfChars(bytes, numBytes);
-	unicode = (Tcl_UniChar *) Tcl_UtfToUniCharDString(bytes, numBytes,
-		&dsPtr);
-    }
-    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
-    Tcl_DStringFree(&dsPtr);
+    ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
+    TclInvalidateStringRep(objPtr);
+    stringPtr = GET_STRING(objPtr);
+    stringPtr->allocated = 0;
 }
 
 /*
@@ -1511,6 +1501,7 @@ AppendUtfToUnicodeRep(
  *
  *	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.
  *
  * Results:
  *	None.
@@ -1530,9 +1521,6 @@ AppendUtfToUtfRep(
     String *stringPtr;
     int newLength, oldLength;
 
-    if (numBytes < 0) {
-	numBytes = (bytes ? strlen(bytes) : 0);
-    }
     if (numBytes == 0) {
 	return;
     }
@@ -1542,6 +1530,9 @@ AppendUtfToUtfRep(
      * trailing null.
      */
 
+    if (objPtr->bytes == NULL) {
+	objPtr->length = 0;
+    }
     oldLength = objPtr->length;
     newLength = numBytes + oldLength;
     if (newLength < 0) {
@@ -1549,40 +1540,32 @@ AppendUtfToUtfRep(
     }
 
     stringPtr = GET_STRING(objPtr);
-    if (newLength > (int) stringPtr->allocated) {
+    if (newLength > stringPtr->allocated) {
+	int offset = -1;
+
 	/*
 	 * 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 && bytes >= objPtr->bytes
 		&& bytes <= objPtr->bytes + objPtr->length) {
 	    offset = bytes - objPtr->bytes;
 	}
 
 	/*
-	 * 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.
+	 * TODO: consider passing flag=1: no overalloc on first append. This
+	 * would make test stringObj-8.1 fail.
 	 */
 
-	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);
+	GrowStringBuffer(objPtr, newLength, 0);
 
-	    Tcl_SetObjLength(objPtr, newLength + growth);
-	}
+	/*
+	 * Relocate bytes if needed; see above.
+	 */
 
-	/* Relocate bytes if needed; see above. */
-	if (offset >=0) {
+	if (offset >= 0) {
 	    bytes = objPtr->bytes + offset;
 	}
     }
@@ -1595,7 +1578,7 @@ AppendUtfToUtfRep(
     stringPtr->hasUnicode = 0;
 
     if (bytes) {
-	memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
+	memmove(objPtr->bytes + oldLength, bytes, numBytes);
     }
     objPtr->bytes[newLength] = 0;
     objPtr->length = newLength;
@@ -1624,130 +1607,18 @@ Tcl_AppendStringsToObjVA(
     Tcl_Obj *objPtr,		/* Points to the object to append to. */
     va_list argList)		/* Variable argument list. */
 {
-#define STATIC_LIST_SIZE 16
-    String *stringPtr;
-    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");
     }
 
-    SetStringFromAny(NULL, objPtr);
-
-    /*
-     * Force the existence of a string rep. so we avoid crashes operating
-     * on a pure unicode value.  [Bug 2597185]
-     */
-
-    (void) Tcl_GetStringFromObj(objPtr, &oldLength);
-
-    /*
-     * Figure out how much space is needed for all the strings, and expand the
-     * string representation if it isn't big enough. If no bytes would be
-     * appended, just return. Note that on some platforms (notably OS/390) the
-     * argList is an array so we need to use memcpy.
-     */
-
-    nargs = 0;
-    newLength = 0;
     while (1) {
-	string = va_arg(argList, char *);
-	if (string == NULL) {
-	    break;
-	}
-	if (nargs >= nargs_space) {
-	    /*
-	     * Expand the args buffer.
-	     */
+	const char *bytes = va_arg(argList, char *);
 
-	    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;
-    }
-
-    stringPtr = GET_STRING(objPtr);
-    if (oldLength + newLength > (int) stringPtr->allocated) {
-	/*
-	 * There isn't currently enough space in the string representation, so
-	 * allocate additional space. If the current string representation
-	 * isn't empty (i.e. it looks like we're doing a series of appends)
-	 * then try to allocate extra space to accomodate future growth: first
-	 * try to double the required memory; if that fails, try a more modest
-	 * allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the
-	 * top of this file for an explanation of this growth algorithm.
-	 * Otherwise, if the current string representation is empty, exactly
-	 * enough memory is allocated.
-	 */
-
-	if (oldLength == 0) {
-	    Tcl_SetObjLength(objPtr, newLength);
-	} else {
-	    attemptLength = 2 * (oldLength + newLength);
-	    if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
-		attemptLength = oldLength + (2 * newLength) +
-			TCL_GROWTH_MIN_ALLOC;
-		Tcl_SetObjLength(objPtr, attemptLength);
-	    }
-	}
-    }
-
-    /*
-     * Make a second pass through the arguments, appending all the strings to
-     * the object.
-     */
-
-    dst = objPtr->bytes + oldLength;
-    for (i = 0; i < nargs; ++i) {
-	string = args[i];
-	if (string == NULL) {
+	if (bytes == NULL) {
 	    break;
 	}
-	while (*string != 0) {
-	    *dst = *string;
-	    dst++;
-	    string++;
-	}
+	Tcl_AppendToObj(objPtr, bytes, -1);
     }
-
-    /*
-     * Add a null byte to terminate the string. However, be careful: it's
-     * possible that the object is totally empty (if it was empty originally
-     * and there was nothing to append). In this case dst is NULL; just leave
-     * everything alone.
-     */
-
-    if (dst != NULL) {
-	*dst = 0;
-    }
-    objPtr->length = oldLength + newLength;
-
-  done:
-    /*
-     * If we had to allocate a buffer from the heap, free it now.
-     */
-
-    if (args != static_list) {
-	ckfree((void *) args);
-    }
-#undef STATIC_LIST_SIZE
 }
 
 /*
@@ -1808,12 +1679,12 @@ Tcl_AppendFormatToObj(
     int objc,
     Tcl_Obj *const objv[])
 {
-    const char *span = format, *msg;
+    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 *badIndex[2] = {
+    static const char *const badIndex[2] = {
 	"not enough arguments for all format specifiers",
 	"\"%n$\" argument index out of range"
     };
@@ -1831,8 +1702,11 @@ Tcl_AppendFormatToObj(
 
     while (*format != '\0') {
 	char *end;
-	int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
-	int width, gotPrecision, precision, useShort, useWide, useBig;
+	int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
+	int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0;
+#ifndef TCL_WIDE_INT_IS_LONG
+	int useWide = 0;
+#endif
 	int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
 	Tcl_Obj *segment;
 	Tcl_UniChar ch;
@@ -1846,6 +1720,7 @@ Tcl_AppendFormatToObj(
 	if (numBytes) {
 	    if (numBytes > limit) {
 		msg = overflow;
+		errCode = "OVERFLOW";
 		goto errorMsg;
 	    }
 	    Tcl_AppendToObj(appendObj, span, numBytes);
@@ -1874,6 +1749,7 @@ Tcl_AppendFormatToObj(
 	newXpg = 0;
 	if (isdigit(UCHAR(ch))) {
 	    int position = strtoul(format, &end, 10);
+
 	    if (*end == '$') {
 		newXpg = 1;
 		objIndex = position - 1;
@@ -1884,18 +1760,21 @@ Tcl_AppendFormatToObj(
 	if (newXpg) {
 	    if (gotSequential) {
 		msg = mixedXPG;
+		errCode = "MIXEDSPECTYPES";
 		goto errorMsg;
 	    }
 	    gotXpg = 1;
 	} 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;
 	}
 
@@ -1903,7 +1782,6 @@ Tcl_AppendFormatToObj(
 	 * Step 2. Set of flags.
 	 */
 
-	gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
 	sawFlag = 1;
 	do {
 	    switch (ch) {
@@ -1943,6 +1821,7 @@ Tcl_AppendFormatToObj(
 	} else if (ch == '*') {
 	    if (objIndex >= objc - 1) {
 		msg = badIndex[gotXpg];
+		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
 		goto errorMsg;
 	    }
 	    if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
@@ -1958,6 +1837,7 @@ Tcl_AppendFormatToObj(
 	}
 	if (width > limit) {
 	    msg = overflow;
+	    errCode = "OVERFLOW";
 	    goto errorMsg;
 	}
 
@@ -1978,6 +1858,7 @@ Tcl_AppendFormatToObj(
 	} else if (ch == '*') {
 	    if (objIndex >= objc - 1) {
 		msg = badIndex[gotXpg];
+		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
 		goto errorMsg;
 	    }
 	    if (TclGetIntFromObj(interp, objv[objIndex], &precision)
@@ -2001,7 +1882,6 @@ Tcl_AppendFormatToObj(
 	 * Step 5. Length modifier.
 	 */
 
-	useShort = useWide = useBig = 0;
 	if (ch == 'h') {
 	    useShort = 1;
 	    format += step;
@@ -2013,8 +1893,8 @@ Tcl_AppendFormatToObj(
 		useBig = 1;
 		format += step;
 		step = Tcl_UtfToUniChar(format, &ch);
-	    } else {
 #ifndef TCL_WIDE_INT_IS_LONG
+	    } else {
 		useWide = 1;
 #endif
 	    }
@@ -2035,6 +1915,7 @@ Tcl_AppendFormatToObj(
 	switch (ch) {
 	case '\0':
 	    msg = "format string ended in middle of field specifier";
+	    errCode = "INCOMPLETE";
 	    goto errorMsg;
 	case 's':
 	    if (gotPrecision) {
@@ -2064,13 +1945,15 @@ Tcl_AppendFormatToObj(
 	case 'u':
 	    if (useBig) {
 		msg = "unsigned bignum format is invalid";
+		errCode = "BADUNSIGNED";
 		goto errorMsg;
 	    }
 	case 'd':
 	case 'o':
 	case 'x':
-	case 'X': {
-	    short int s = 0;	/* Silence compiler warning; only defined and
+	case 'X':
+	case 'b': {
+	    short s = 0;	/* Silence compiler warning; only defined and
 				 * used when useShort is true. */
 	    long l;
 	    Tcl_WideInt w;
@@ -2082,6 +1965,7 @@ Tcl_AppendFormatToObj(
 		    goto error;
 		}
 		isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+#ifndef TCL_WIDE_INT_IS_LONG
 	    } else if (useWide) {
 		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
 		    Tcl_Obj *objPtr;
@@ -2095,7 +1979,8 @@ Tcl_AppendFormatToObj(
 		    Tcl_GetWideIntFromObj(NULL, objPtr, &w);
 		    Tcl_DecrRefCount(objPtr);
 		}
-		isNegative = (w < (Tcl_WideInt)0);
+		isNegative = (w < (Tcl_WideInt) 0);
+#endif
 	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
 		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
 		    Tcl_Obj *objPtr;
@@ -2112,16 +1997,16 @@ Tcl_AppendFormatToObj(
 		    l = Tcl_WideAsLong(w);
 		}
 		if (useShort) {
-		    s = (short int) l;
-		    isNegative = (s < (short int)0);
+		    s = (short) l;
+		    isNegative = (s < (short) 0);
 		} else {
-		    isNegative = (l < (long)0);
+		    isNegative = (l < (long) 0);
 		}
 	    } else if (useShort) {
-		s = (short int) l;
-		isNegative = (s < (short int)0);
+		s = (short) l;
+		isNegative = (s < (short) 0);
 	    } else {
-		isNegative = (l < (long)0);
+		isNegative = (l < (long) 0);
 	    }
 
 	    segment = Tcl_NewObj();
@@ -2129,8 +2014,9 @@ Tcl_AppendFormatToObj(
 	    segmentLimit = INT_MAX;
 	    Tcl_IncrRefCount(segment);
 
-	    if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) {
-		Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1);
+	    if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
+		Tcl_AppendToObj(segment,
+			(isNegative ? "-" : gotPlus ? "+" : " "), 1);
 		segmentLimit -= 1;
 	    }
 
@@ -2146,6 +2032,10 @@ Tcl_AppendFormatToObj(
 		    Tcl_AppendToObj(segment, "0x", 2);
 		    segmentLimit -= 2;
 		    break;
+		case 'b':
+		    Tcl_AppendToObj(segment, "0b", 2);
+		    segmentLimit -= 2;
+		    break;
 		}
 	    }
 
@@ -2156,9 +2046,11 @@ Tcl_AppendFormatToObj(
 		const char *bytes;
 
 		if (useShort) {
-		    pure = Tcl_NewIntObj((int)(s));
+		    pure = Tcl_NewIntObj((int) s);
+#ifndef TCL_WIDE_INT_IS_LONG
 		} else if (useWide) {
 		    pure = Tcl_NewWideIntObj(w);
+#endif
 		} else if (useBig) {
 		    pure = Tcl_NewBignumObj(&big);
 		} else {
@@ -2185,7 +2077,7 @@ Tcl_AppendFormatToObj(
 
 		if (gotPrecision) {
 		    if (length < precision) {
-			segmentLimit -= (precision - length);
+			segmentLimit -= precision - length;
 		    }
 		    while (length < precision) {
 			Tcl_AppendToObj(segment, "0", 1);
@@ -2196,7 +2088,7 @@ Tcl_AppendFormatToObj(
 		if (gotZero) {
 		    length += Tcl_GetCharLength(segment);
 		    if (length < width) {
-			segmentLimit -= (width - length);
+			segmentLimit -= width - length;
 		    }
 		    while (length < width) {
 			Tcl_AppendToObj(segment, "0", 1);
@@ -2205,6 +2097,7 @@ Tcl_AppendFormatToObj(
 		}
 		if (toAppend > segmentLimit) {
 		    msg = overflow;
+		    errCode = "OVERFLOW";
 		    goto errorMsg;
 		}
 		Tcl_AppendToObj(segment, bytes, toAppend);
@@ -2215,29 +2108,32 @@ Tcl_AppendFormatToObj(
 	    case 'u':
 	    case 'o':
 	    case 'x':
-	    case 'X': {
-		Tcl_WideUInt bits = (Tcl_WideUInt)0;
-		Tcl_WideInt numDigits = (Tcl_WideInt)0;
-		int length, numBits = 4, base = 16;
-		int index = 0, shift = 0;
+	    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;
-		}
-		if (ch == 'o') {
+		} else if (ch == 'o') {
 		    base = 8;
 		    numBits = 3;
+		} else if (ch == 'b') {
+		    base = 2;
+		    numBits = 1;
 		}
 		if (useShort) {
-		    unsigned short int us = (unsigned short int) s;
+		    unsigned short us = (unsigned short) s;
 
 		    bits = (Tcl_WideUInt) us;
 		    while (us) {
 			numDigits++;
 			us /= base;
 		    }
+#ifndef TCL_WIDE_INT_IS_LONG
 		} else if (useWide) {
 		    Tcl_WideUInt uw = (Tcl_WideUInt) w;
 
@@ -2246,22 +2142,24 @@ Tcl_AppendFormatToObj(
 			numDigits++;
 			uw /= base;
 		    }
+#endif
 		} 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);
+			    (((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 int ul = (unsigned long int) l;
+		    unsigned long ul = (unsigned long) l;
 
 		    bits = (Tcl_WideUInt) ul;
 		    while (ul) {
@@ -2278,16 +2176,16 @@ Tcl_AppendFormatToObj(
 		    numDigits = 1;
 		}
 		pure = Tcl_NewObj();
-		Tcl_SetObjLength(pure, (int)numDigits);
+		Tcl_SetObjLength(pure, (int) numDigits);
 		bytes = TclGetString(pure);
-		toAppend = length = (int)numDigits;
+		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);
+			    bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
 			    shift += DIGIT_BIT;
 			}
 			shift -= numBits;
@@ -2305,7 +2203,7 @@ Tcl_AppendFormatToObj(
 		}
 		if (gotPrecision) {
 		    if (length < precision) {
-			segmentLimit -= (precision - length);
+			segmentLimit -= precision - length;
 		    }
 		    while (length < precision) {
 			Tcl_AppendToObj(segment, "0", 1);
@@ -2316,7 +2214,7 @@ Tcl_AppendFormatToObj(
 		if (gotZero) {
 		    length += Tcl_GetCharLength(segment);
 		    if (length < width) {
-			segmentLimit -= (width - length);
+			segmentLimit -= width - length;
 		    }
 		    while (length < width) {
 			Tcl_AppendToObj(segment, "0", 1);
@@ -2325,6 +2223,7 @@ Tcl_AppendFormatToObj(
 		}
 		if (toAppend > segmentLimit) {
 		    msg = overflow;
+		    errCode = "OVERFLOW";
 		    goto errorMsg;
 		}
 		Tcl_AppendObjToObj(segment, pure);
@@ -2377,7 +2276,8 @@ Tcl_AppendFormatToObj(
 		*p++ = '.';
 		p += sprintf(p, "%d", precision);
 		if (precision > INT_MAX - length) {
-		    msg=overflow;
+		    msg = overflow;
+		    errCode = "OVERFLOW";
 		    goto errorMsg;
 		}
 		length += precision;
@@ -2394,11 +2294,13 @@ Tcl_AppendFormatToObj(
 	    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;
 	    }
 	    break;
@@ -2407,6 +2309,7 @@ Tcl_AppendFormatToObj(
 	    if (interp != NULL) {
 		Tcl_SetObjResult(interp,
 			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
 	    }
 	    goto error;
 	}
@@ -2419,27 +2322,26 @@ Tcl_AppendFormatToObj(
 	}
 	}
 
-	if (width > 0) {
-	    if (numChars < 0) {
-		numChars = Tcl_GetCharLength(segment);
+	if (width>0 && numChars<0) {
+	    numChars = Tcl_GetCharLength(segment);
+	}
+	if (!gotMinus && width>0) {
+	    if (numChars < width) {
+		limit -= width - numChars;
 	    }
-	    if (!gotMinus) {
-		if (numChars < width) {
-		    limit -= (width - numChars);
-		}
-		while (numChars < width) {
-		    Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
-		    numChars++;
-		}
+	    while (numChars < width) {
+		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
+		numChars++;
 	    }
 	}
 
-	Tcl_GetStringFromObj(segment, &segmentNumBytes);
+	TclGetStringFromObj(segment, &segmentNumBytes);
 	if (segmentNumBytes > limit) {
 	    if (allocSegment) {
 		Tcl_DecrRefCount(segment);
 	    }
 	    msg = overflow;
+	    errCode = "OVERFLOW";
 	    goto errorMsg;
 	}
 	Tcl_AppendObjToObj(appendObj, segment);
@@ -2449,7 +2351,7 @@ Tcl_AppendFormatToObj(
 	}
 	if (width > 0) {
 	    if (numChars < width) {
-		limit -= (width - numChars);
+		limit -= width-numChars;
 	    }
 	    while (numChars < width) {
 		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
@@ -2462,6 +2364,7 @@ Tcl_AppendFormatToObj(
     if (numBytes) {
 	if (numBytes > limit) {
 	    msg = overflow;
+	    errCode = "OVERFLOW";
 	    goto errorMsg;
 	}
 	Tcl_AppendToObj(appendObj, span, numBytes);
@@ -2474,6 +2377,7 @@ Tcl_AppendFormatToObj(
   errorMsg:
     if (interp != NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
     }
   error:
     Tcl_SetObjLength(appendObj, originalLength);
@@ -2489,7 +2393,7 @@ Tcl_AppendFormatToObj(
  *	A refcount zero Tcl_Obj.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *---------------------------------------------------------------------------
  */
@@ -2503,6 +2407,7 @@ Tcl_Format(
 {
     int result;
     Tcl_Obj *objPtr = Tcl_NewObj();
+
     result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
     if (result != TCL_OK) {
 	Tcl_DecrRefCount(objPtr);
@@ -2532,7 +2437,6 @@ AppendPrintfToObjVA(
     int code, objc;
     Tcl_Obj **objv, *list = Tcl_NewObj();
     const char *p;
-    char *end;
 
     p = format;
     Tcl_IncrRefCount(list);
@@ -2549,7 +2453,6 @@ AppendPrintfToObjVA(
 	}
 	do {
 	    switch (*p) {
-
 	    case '\0':
 		seekingConversion = 0;
 		break;
@@ -2602,11 +2505,11 @@ AppendPrintfToObjVA(
 		case -1:
 		case 0:
 		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
-			    (long int)va_arg(argList, int)));
+			    (long) va_arg(argList, int)));
 		    break;
 		case 1:
 		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
-			    va_arg(argList, long int)));
+			    va_arg(argList, long)));
 		    break;
 		}
 		break;
@@ -2620,15 +2523,18 @@ AppendPrintfToObjVA(
 		seekingConversion = 0;
 		break;
 	    case '*':
-		lastNum = (int)va_arg(argList, int);
+		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':
+	    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++;
@@ -2664,7 +2570,7 @@ AppendPrintfToObjVA(
  *	A standard Tcl result.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *---------------------------------------------------------------------------
  */
@@ -2691,7 +2597,7 @@ Tcl_AppendPrintfToObj(
  *	A refcount zero Tcl_Obj.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *---------------------------------------------------------------------------
  */
@@ -2751,8 +2657,8 @@ TclGetStringStorage(
  *
  * 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.
+ *	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.
@@ -2760,68 +2666,124 @@ TclGetStringStorage(
  *---------------------------------------------------------------------------
  */
 
+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;
-    int numChars = Tcl_GetCharLength(objPtr);
-    int i = 0, lastCharIdx = numChars - 1;
-    char *bytes;
+    Tcl_UniChar ch;
+
+    if (TclIsPureByteArray(objPtr)) {
+	int numBytes;
+	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
 
-    if (numChars <= 1) {
+	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 *source = stringPtr->unicode;
+	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
+	Tcl_UniChar *src = from + stringPtr->numChars;
 
 	if (Tcl_IsShared(objPtr)) {
-	    Tcl_UniChar *dest, ch = 0;
+	    Tcl_UniChar *to;
 
 	    /*
 	     * Create a non-empty, pure unicode value, so we can coax
 	     * Tcl_SetObjLength into growing the unicode rep buffer.
 	     */
 
-	    Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1);
-	    Tcl_SetObjLength(resultPtr, numChars);
-	    dest = Tcl_GetUnicode(resultPtr);
-
-	    while (i < numChars) {
-		dest[i++] = source[lastCharIdx--];
+	    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;
 	    }
-	    return resultPtr;
 	}
+    }
+
+    if (objPtr->bytes) {
+	int numChars = stringPtr->numChars;
+	int numBytes = objPtr->length;
+	char *to, *from = objPtr->bytes;
 
-	while (i < lastCharIdx) {
-	    Tcl_UniChar tmp = source[lastCharIdx];
-	    source[lastCharIdx--] = source[i];
-	    source[i++] = tmp;
+	if (Tcl_IsShared(objPtr)) {
+	    objPtr = Tcl_NewObj();
+	    Tcl_SetObjLength(objPtr, numBytes);
 	}
-	TclInvalidateStringRep(objPtr);
-	stringPtr->allocated = 0;
-	return objPtr;
-    }
+	to = objPtr->bytes;
 
-    bytes = TclGetString(objPtr);
-    if (Tcl_IsShared(objPtr)) {
-	char *dest;
-	Tcl_Obj *resultPtr = Tcl_NewObj();
-	Tcl_SetObjLength(resultPtr, numChars);
-	dest = TclGetString(resultPtr);
-	while (i < numChars) {
-	    dest[i++] = bytes[lastCharIdx--];
+	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;
 	}
-	return resultPtr;
+	/* Pass 2. Reverse all the bytes. */
+	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
     }
 
-    while (i < lastCharIdx) {
-	char tmp = bytes[lastCharIdx];
-	bytes[lastCharIdx--] = bytes[i];
-	bytes[i++] = tmp;
-    }
     return objPtr;
 }
 
@@ -2847,35 +2809,47 @@ FillUnicodeRep(
     Tcl_Obj *objPtr)		/* The object in which to fill the unicode
 				 * rep. */
 {
-    String *stringPtr;
-    size_t uallocated;
-    char *srcEnd, *src = objPtr->bytes;
+    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)
+{
+    String *stringPtr = GET_STRING(objPtr);
+    int needed, numOrigChars = 0;
     Tcl_UniChar *dst;
 
-    stringPtr = GET_STRING(objPtr);
-    if (stringPtr->numChars == -1) {
-	stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
+    if (stringPtr->hasUnicode) {
+	numOrigChars = stringPtr->numChars;
+    }
+    if (numAppendChars == -1) {
+	TclNumUtfChars(numAppendChars, bytes, numBytes);
     }
-    stringPtr->hasUnicode = (stringPtr->numChars > 0);
+    needed = numOrigChars + numAppendChars;
+    stringCheckLimits(needed);
 
-    stringCheckLimits(stringPtr->numChars);
-    uallocated = STRING_UALLOC(stringPtr->numChars);
-    if (uallocated > stringPtr->uallocated) {
-	GrowUnicodeBuffer(objPtr, stringPtr->numChars);
+    if (needed > stringPtr->maxChars) {
+	GrowUnicodeBuffer(objPtr, needed);
 	stringPtr = GET_STRING(objPtr);
     }
 
-    /*
-     * Convert src to Unicode and store the coverted data in "unicode".
-     */
-
-    srcEnd = src + objPtr->length;
-    for (dst = stringPtr->unicode; src < srcEnd; dst++) {
-	src += TclUtfToUniChar(src, dst);
+    stringPtr->hasUnicode = 1;
+    if (bytes) {
+	stringPtr->numChars = needed;
+    } else {
+	numAppendChars = 0;
+    }
+    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
+	bytes += TclUtfToUniChar(bytes, dst);
     }
     *dst = 0;
-
-    SET_STRING(objPtr, stringPtr);
 }
 
 /*
@@ -2898,36 +2872,49 @@ FillUnicodeRep(
 
 static void
 DupStringInternalRep(
-    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
+    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
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
 				 * currently have an internal rep.*/
 {
     String *srcStringPtr = GET_STRING(srcPtr);
     String *copyStringPtr = NULL;
 
-    /*
-     * If the src obj is a string of 1-byte Utf chars, then copy the string
-     * rep of the source object and create an "empty" Unicode internal rep for
-     * the new object. Otherwise, copy Unicode internal rep, and invalidate
-     * the string rep of the new object.
-     */
+#if 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.
+	 */
 
-    if (srcStringPtr->hasUnicode == 0) {
-	copyStringPtr = (String *) ckalloc(sizeof(String));
-	copyStringPtr->uallocated = 0;
-    } else {
-	copyStringPtr = (String *) ckalloc(
-		STRING_SIZE(srcStringPtr->uallocated));
-	copyStringPtr->uallocated = srcStringPtr->uallocated;
+	return;
+    }
 
+    if (srcStringPtr->hasUnicode) {
+	int copyMaxChars;
+
+	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,
-		(size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
+		srcStringPtr->numChars * sizeof(Tcl_UniChar));
 	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
+    } else {
+	copyStringPtr = stringAlloc(0);
+	copyStringPtr->maxChars = 0;
+	copyStringPtr->unicode[0] = 0;
     }
-    copyStringPtr->numChars = srcStringPtr->numChars;
     copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-    copyStringPtr->allocated = srcStringPtr->allocated;
+    copyStringPtr->numChars = srcStringPtr->numChars;
 
     /*
      * Tricky point: the string value was copied by generic object management
@@ -2935,7 +2922,42 @@ DupStringInternalRep(
      * source object.
      */
 
-    copyStringPtr->allocated = copyPtr->length;
+    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.
+     */
+
+    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 */
 
     SET_STRING(copyPtr, copyStringPtr);
     copyPtr->typePtr = &tclStringType;
@@ -2961,43 +2983,29 @@ DupStringInternalRep(
 static int
 SetStringFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
+    Tcl_Obj *objPtr)		/* The object to convert. */
 {
-    /*
-     * The Unicode object is optimized for the case where each UTF char in a
-     * string is only one byte. In this case, we store the value of numChars,
-     * but we don't copy the bytes to the unicodeObj->unicode.
-     */
-
     if (objPtr->typePtr != &tclStringType) {
-	String *stringPtr;
+	String *stringPtr = stringAlloc(0);
 
-	if (objPtr->typePtr != NULL) {
-	    if (objPtr->bytes == NULL) {
-		objPtr->typePtr->updateStringProc(objPtr);
-	    }
-	    TclFreeIntRep(objPtr);
-	}
-	objPtr->typePtr = &tclStringType;
+	/*
+	 * Convert whatever we have into an untyped value. Just A String.
+	 */
+
+	(void) TclGetString(objPtr);
+	TclFreeIntRep(objPtr);
 
 	/*
-	 * Allocate enough space for the basic String structure.
+	 * Create a basic String intrep that just points to the UTF-8 string
+	 * already in place at objPtr->bytes.
 	 */
 
-	stringPtr = (String *) ckalloc(sizeof(String));
 	stringPtr->numChars = -1;
-	stringPtr->uallocated = 0;
+	stringPtr->allocated = objPtr->length;
+	stringPtr->maxChars = 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;
 }
@@ -3024,57 +3032,85 @@ static void
 UpdateStringOfString(
     Tcl_Obj *objPtr)		/* Object with string rep to update. */
 {
-    int i, size;
-    Tcl_UniChar *unicode;
-    char dummy[TCL_UTF_MAX];
-    char *dst;
-    String *stringPtr;
+    String *stringPtr = GET_STRING(objPtr);
 
-    stringPtr = GET_STRING(objPtr);
-    if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
-	if (stringPtr->numChars <= 0) {
-	    /*
-	     * If there is no Unicode rep, or the string has 0 chars, then set
-	     * the string rep to an empty string.
-	     */
+    /*
+     * This routine is only called when we need to generate the
+     * string rep objPtr->bytes because it does not exist -- it is NULL.
+     * In that circumstance, any lingering claim about the size of
+     * memory pointed to by that NULL pointer is clearly bogus, and
+     * needs a reset.
+     */
 
-	    objPtr->bytes = tclEmptyStringRep;
-	    objPtr->length = 0;
-	    return;
-	}
+    stringPtr->allocated = 0;
 
-	unicode = stringPtr->unicode;
+    if (stringPtr->numChars == 0) {
+	TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+    } else {
+	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
+		stringPtr->numChars);
+    }
+}
 
-	/*
-	 * Translate the Unicode string to UTF. "size" will hold the amount of
-	 * space the UTF string needs.
-	 */
+static int
+ExtendStringRepWithUnicode(
+    Tcl_Obj *objPtr,
+    const Tcl_UniChar *unicode,
+    int numChars)
+{
+    /*
+     * Pre-condition: this is the "string" Tcl_ObjType.
+     */
 
-	if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX
-	    && stringPtr->allocated >= stringPtr->numChars * (size_t)TCL_UTF_MAX) {
-	    goto copyBytes;
-	}
+    int i, origLength, size = 0;
+    char *dst, buf[TCL_UTF_MAX];
+    String *stringPtr = GET_STRING(objPtr);
 
-	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 (numChars < 0) {
+	numChars = UnicodeLength(unicode);
+    }
 
-	objPtr->bytes = (char *) ckalloc((unsigned) (size + 1));
-	objPtr->length = size;
-	stringPtr->allocated = size;
+    if (numChars == 0) {
+	return 0;
+    }
 
-    copyBytes:
-	dst = objPtr->bytes;
-	for (i = 0; i < stringPtr->numChars; i++) {
-	    dst += Tcl_UniCharToUtf(unicode[i], dst);
-	}
-	*dst = '\0';
+    if (objPtr->bytes == NULL) {
+	objPtr->length = 0;
     }
-    return;
+    size = origLength = objPtr->length;
+
+    /*
+     * Quick cheap check in case we have more than enough room.
+     */
+
+    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
+	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
+	goto copyBytes;
+    }
+
+    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);
+    }
+
+    /*
+     * Grow space if needed.
+     */
+
+    if (size > stringPtr->allocated) {
+	GrowStringBuffer(objPtr, size, 1);
+    }
+
+  copyBytes:
+    dst = objPtr->bytes + origLength;
+    for (i = 0; i < numChars; i++) {
+	dst += Tcl_UniCharToUtf((int) unicode[i], dst);
+    }
+    *dst = '\0';
+    objPtr->length = dst - objPtr->bytes;
+    return numChars;
 }
 
 /*
@@ -3098,7 +3134,7 @@ static void
 FreeStringInternalRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    ckfree((char *) GET_STRING(objPtr));
+    ckfree(GET_STRING(objPtr));
     objPtr->typePtr = NULL;
 }
 
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
new file mode 100644
index 0000000..227e6bc
--- /dev/null
+++ b/generic/tclStringRep.h
@@ -0,0 +1,97 @@
+/*
+ * tclStringRep.h --
+ *
+ *	This file contains the definition of the Unicode string internal
+ *	representation and macros to access 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.
+ *
+ * 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.
+ */
+
+/*
+ * The following structure is the internal rep for a String object. It keeps
+ * track of how much memory has been used and how much has been allocated for
+ * the Unicode and UTF string to enable growing and shrinking of the UTF and
+ * Unicode reps of the String object with fewer mallocs. To optimize string
+ * length and indexing operations, this structure also stores the number of
+ * characters (same of UTF and Unicode!) once that value has been computed.
+ *
+ * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
+ * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
+ * can be officially modified by altering the definition of Tcl_UniChar in
+ * tcl.h, but do not do that unless you are sure what you're doing!
+ */
+
+typedef struct String {
+    int numChars;		/* The number of chars in the string. -1 means
+				 * this value has not been calculated. >= 0
+				 * means that there is a valid Unicode rep, or
+				 * that the number of UTF bytes == the number
+				 * of chars. */
+    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. */
+} String;
+
+#define STRING_MAXCHARS \
+    (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
+#define STRING_SIZE(numChars) \
+    (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
+#define stringCheckLimits(numChars) \
+    do {								\
+	if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) {		\
+	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
+		      STRING_MAXCHARS);					\
+	}								\
+    } while (0)
+#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))
+#define stringAttemptRealloc(ptr, numChars) \
+    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+#define GET_STRING(objPtr) \
+    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define SET_STRING(objPtr, stringPtr) \
+    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h
new file mode 100644
index 0000000..030e4ec
--- /dev/null
+++ b/generic/tclStringTrim.h
@@ -0,0 +1,43 @@
+/*
+ * tclStringTrim.h --
+ *
+ *	This file contains the definition of what characters are to be trimmed
+ *	from a string by [string trim] by default. It's only needed by Tcl's
+ *	implementation; it does not form a public or private API at all.
+ *
+ * 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-2013 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_STRING_TRIM_H
+#define TCL_STRING_TRIM_H
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters. [TIP #413]
+ */
+
+MODULE_SCOPE const char tclDefaultTrimSet[];
+
+/*
+ * The whitespace trimming set used when [concat]enating. This is a subset of
+ * the above, and deliberately so.
+ */
+
+#define CONCAT_TRIM_SET " \f\v\r\t\n"
+
+#endif /* TCL_STRING_TRIM_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 6499bc2..5b7a1cd 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.
@@ -12,6 +12,12 @@
 #include "tclInt.h"
 #include "tommath.h"
 
+#ifdef __GNUC__
+#pragma GCC dependency "tcl.decls"
+#pragma GCC dependency "tclInt.decls"
+#pragma GCC dependency "tclTomMath.decls"
+#endif
+
 /*
  * Remove macros that will interfere with the definitions below.
  */
@@ -31,64 +37,66 @@
 #undef Tcl_ValidateAllMemory
 #undef Tcl_FindHashEntry
 #undef Tcl_CreateHashEntry
+#undef Tcl_Panic
+#undef Tcl_FindExecutable
 #undef TclpGetPid
 #undef TclSockMinimumBuffers
+#define TclBackgroundException Tcl_BackgroundException
+#undef Tcl_SetIntObj
+#undef TclpInetNtoa
 #undef TclWinGetServByName
 #undef TclWinGetSockOpt
 #undef TclWinSetSockOpt
-#define TclUnusedStubEntry NULL
-
-/*
- * 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__) /* 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
-int TclSockMinimumBuffersOld(sock, size)
-    int sock;
-    int size;
+#define TclSockMinimumBuffersOld sockMinimumBuffersOld
+static int TclSockMinimumBuffersOld(int sock, int size)
 {
     return TclSockMinimumBuffers(INT2PTR(sock), size);
 }
 #endif
 
-MODULE_SCOPE TclIntStubs tclIntStubs;
-MODULE_SCOPE TclIntPlatStubs tclIntPlatStubs;
-MODULE_SCOPE TclPlatStubs tclPlatStubs;
-MODULE_SCOPE TclStubs tclStubs;
-MODULE_SCOPE TclTomMathStubs tclTomMathStubs;
+#define TclSetStartupScriptPath setStartupScriptPath
+static void TclSetStartupScriptPath(Tcl_Obj *path)
+{
+    Tcl_SetStartupScript(path, NULL);
+}
+#define TclGetStartupScriptPath getStartupScriptPath
+static Tcl_Obj *TclGetStartupScriptPath(void)
+{
+    return Tcl_GetStartupScript(NULL);
+}
+#define TclSetStartupScriptFileName setStartupScriptFileName
+static void TclSetStartupScriptFileName(
+    const char *fileName)
+{
+    Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL);
+}
+#define TclGetStartupScriptFileName getStartupScriptFileName
+static const char *TclGetStartupScriptFileName(void)
+{
+    Tcl_Obj *path = Tcl_GetStartupScript(NULL);
+    if (path == NULL) {
+	return NULL;
+    }
+    return Tcl_GetString(path);
+}
 
 #if defined(_WIN32) || defined(__CYGWIN__)
 #undef TclWinNToHS
-unsigned short TclWinNToHS(unsigned short ns) {
+#define TclWinNToHS winNToHS
+static unsigned short TclWinNToHS(unsigned short ns) {
 	return ntohs(ns);
 }
 #endif
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   define TclUnixWaitForFile 0
 #   define TclUnixCopyFile 0
+#   define TclUnixOpenTemporaryFile 0
 #   define TclpReaddir 0
 #   define TclpIsAtty 0
 #elif defined(__CYGWIN__)
@@ -97,7 +105,6 @@ unsigned short TclWinNToHS(unsigned short ns) {
 #   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
 #   define TclWinFlushDirtyChannels doNothing
 #   define TclWinResetInterfaces doNothing
-#   define TclpGetTZName 0
 
 static Tcl_Encoding winTCharEncoding;
 
@@ -235,9 +242,8 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
 		    && (longValue <= (long)(UINT_MAX))) {
 	    *ptr = (int)longValue;
 	} else {
-	    Tcl_SetResult(interp,
-		    "integer value too large to represent as non-long integer",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "integer value too large to represent as non-long integer", -1));
 	    result = TCL_ERROR;
 	}
     }
@@ -252,9 +258,8 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
 		    && (longValue <= (long)(UINT_MAX))) {
 	    *ptr = (int)longValue;
 	} else {
-	    Tcl_SetResult(interp,
-		    "integer value too large to represent as non-long integer",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "integer value too large to represent as non-long integer", -1));
 	    result = TCL_ERROR;
 	}
     }
@@ -295,119 +300,122 @@ static int formatInt(char *buffer, int n){
  * 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. */
 
-TclIntStubs tclIntStubs = {
+static const TclIntStubs tclIntStubs = {
     TCL_STUB_MAGIC,
-    NULL,
-    NULL, /* 0 */
-    NULL, /* 1 */
-    NULL, /* 2 */
+    0,
+    0, /* 0 */
+    0, /* 1 */
+    0, /* 2 */
     TclAllocateFreeObjects, /* 3 */
-    NULL, /* 4 */
+    0, /* 4 */
     TclCleanupChildren, /* 5 */
     TclCleanupCommand, /* 6 */
     TclCopyAndCollapse, /* 7 */
-    TclCopyChannel, /* 8 */
+    TclCopyChannelOld, /* 8 */
     TclCreatePipeline, /* 9 */
     TclCreateProc, /* 10 */
     TclDeleteCompiledLocalVars, /* 11 */
     TclDeleteVars, /* 12 */
-    NULL, /* 13 */
+    0, /* 13 */
     TclDumpMemoryInfo, /* 14 */
-    NULL, /* 15 */
+    0, /* 15 */
     TclExprFloatError, /* 16 */
-    NULL, /* 17 */
-    NULL, /* 18 */
-    NULL, /* 19 */
-    NULL, /* 20 */
-    NULL, /* 21 */
+    0, /* 17 */
+    0, /* 18 */
+    0, /* 19 */
+    0, /* 20 */
+    0, /* 21 */
     TclFindElement, /* 22 */
     TclFindProc, /* 23 */
     TclFormatInt, /* 24 */
     TclFreePackageInfo, /* 25 */
-    NULL, /* 26 */
-    NULL, /* 27 */
+    0, /* 26 */
+    0, /* 27 */
     TclpGetDefaultStdChannel, /* 28 */
-    NULL, /* 29 */
-    NULL, /* 30 */
+    0, /* 29 */
+    0, /* 30 */
     TclGetExtension, /* 31 */
     TclGetFrame, /* 32 */
-    NULL, /* 33 */
+    0, /* 33 */
     TclGetIntForIndex, /* 34 */
-    NULL, /* 35 */
-    TclGetLong, /* 36 */
+    0, /* 35 */
+    0, /* 36 */
     TclGetLoadedPackages, /* 37 */
     TclGetNamespaceForQualName, /* 38 */
     TclGetObjInterpProc, /* 39 */
     TclGetOpenMode, /* 40 */
     TclGetOriginalCommand, /* 41 */
     TclpGetUserHome, /* 42 */
-    NULL, /* 43 */
+    0, /* 43 */
     TclGuessPackageName, /* 44 */
     TclHideUnsafeCommands, /* 45 */
     TclInExit, /* 46 */
-    NULL, /* 47 */
-    NULL, /* 48 */
-    NULL, /* 49 */
+    0, /* 47 */
+    0, /* 48 */
+    0, /* 49 */
     TclInitCompiledLocals, /* 50 */
     TclInterpInit, /* 51 */
-    NULL, /* 52 */
+    0, /* 52 */
     TclInvokeObjectCommand, /* 53 */
     TclInvokeStringCommand, /* 54 */
     TclIsProc, /* 55 */
-    NULL, /* 56 */
-    NULL, /* 57 */
+    0, /* 56 */
+    0, /* 57 */
     TclLookupVar, /* 58 */
-    NULL, /* 59 */
+    0, /* 59 */
     TclNeedSpace, /* 60 */
     TclNewProcBodyObj, /* 61 */
     TclObjCommandComplete, /* 62 */
     TclObjInterpProc, /* 63 */
     TclObjInvoke, /* 64 */
-    NULL, /* 65 */
-    NULL, /* 66 */
-    NULL, /* 67 */
-    NULL, /* 68 */
+    0, /* 65 */
+    0, /* 66 */
+    0, /* 67 */
+    0, /* 68 */
     TclpAlloc, /* 69 */
-    NULL, /* 70 */
-    NULL, /* 71 */
-    NULL, /* 72 */
-    NULL, /* 73 */
+    0, /* 70 */
+    0, /* 71 */
+    0, /* 72 */
+    0, /* 73 */
     TclpFree, /* 74 */
     TclpGetClicks, /* 75 */
     TclpGetSeconds, /* 76 */
     TclpGetTime, /* 77 */
-    TclpGetTimeZone, /* 78 */
-    NULL, /* 79 */
-    NULL, /* 80 */
+    0, /* 78 */
+    0, /* 79 */
+    0, /* 80 */
     TclpRealloc, /* 81 */
-    NULL, /* 82 */
-    NULL, /* 83 */
-    NULL, /* 84 */
-    NULL, /* 85 */
-    NULL, /* 86 */
-    NULL, /* 87 */
+    0, /* 82 */
+    0, /* 83 */
+    0, /* 84 */
+    0, /* 85 */
+    0, /* 86 */
+    0, /* 87 */
     TclPrecTraceProc, /* 88 */
     TclPreventAliasLoop, /* 89 */
-    NULL, /* 90 */
+    0, /* 90 */
     TclProcCleanupProc, /* 91 */
     TclProcCompileProc, /* 92 */
     TclProcDeleteProc, /* 93 */
-    NULL, /* 94 */
-    NULL, /* 95 */
+    0, /* 94 */
+    0, /* 95 */
     TclRenameCommand, /* 96 */
     TclResetShadowedCmdRefs, /* 97 */
     TclServiceIdle, /* 98 */
-    NULL, /* 99 */
-    NULL, /* 100 */
+    0, /* 99 */
+    0, /* 100 */
     TclSetPreInitScript, /* 101 */
     TclSetupEnv, /* 102 */
     TclSockGetPort, /* 103 */
     TclSockMinimumBuffersOld, /* 104 */
-    NULL, /* 105 */
-    NULL, /* 106 */
-    NULL, /* 107 */
+    0, /* 105 */
+    0, /* 106 */
+    0, /* 107 */
     TclTeardownNamespace, /* 108 */
     TclUpdateReturnInfo, /* 109 */
     TclSockMinimumBuffers, /* 110 */
@@ -434,13 +442,13 @@ TclIntStubs tclIntStubs = {
     Tcl_SetNamespaceResolvers, /* 131 */
     TclpHasSockets, /* 132 */
     TclpGetDate, /* 133 */
-    NULL, /* 134 */
-    NULL, /* 135 */
-    NULL, /* 136 */
-    NULL, /* 137 */
+    0, /* 134 */
+    0, /* 135 */
+    0, /* 136 */
+    0, /* 137 */
     TclGetEnv, /* 138 */
-    NULL, /* 139 */
-    NULL, /* 140 */
+    0, /* 139 */
+    0, /* 140 */
     TclpGetCwd, /* 141 */
     TclSetByteCodeFromAny, /* 142 */
     TclAddLiteralObj, /* 143 */
@@ -454,13 +462,13 @@ TclIntStubs tclIntStubs = {
     TclRegExpRangeUniChar, /* 151 */
     TclSetLibraryPath, /* 152 */
     TclGetLibraryPath, /* 153 */
-    NULL, /* 154 */
-    NULL, /* 155 */
+    0, /* 154 */
+    0, /* 155 */
     TclRegError, /* 156 */
     TclVarTraceExists, /* 157 */
     TclSetStartupScriptFileName, /* 158 */
     TclGetStartupScriptFileName, /* 159 */
-    NULL, /* 160 */
+    0, /* 160 */
     TclChannelTransform, /* 161 */
     TclChannelEventScriptInvoker, /* 162 */
     TclGetInstructionTable, /* 163 */
@@ -474,32 +482,32 @@ TclIntStubs tclIntStubs = {
     TclCheckExecutionTraces, /* 171 */
     TclInThreadExit, /* 172 */
     TclUniCharMatch, /* 173 */
-    NULL, /* 174 */
+    0, /* 174 */
     TclCallVarTraces, /* 175 */
     TclCleanupVar, /* 176 */
     TclVarErrMsg, /* 177 */
     Tcl_SetStartupScript, /* 178 */
     Tcl_GetStartupScript, /* 179 */
-    NULL, /* 180 */
-    NULL, /* 181 */
+    0, /* 180 */
+    0, /* 181 */
     TclpLocaltime, /* 182 */
     TclpGmtime, /* 183 */
-    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 */
+    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 */
-    NULL, /* 199 */
+    0, /* 199 */
     TclpObjRemoveDirectory, /* 200 */
     TclpObjCopyDirectory, /* 201 */
     TclpObjCreateDirectory, /* 202 */
@@ -509,9 +517,9 @@ TclIntStubs tclIntStubs = {
     TclpObjStat, /* 206 */
     TclpObjAccess, /* 207 */
     TclpOpenFileChannel, /* 208 */
-    NULL, /* 209 */
-    NULL, /* 210 */
-    NULL, /* 211 */
+    0, /* 209 */
+    0, /* 210 */
+    0, /* 211 */
     TclpFindExecutable, /* 212 */
     TclGetObjNameOfExecutable, /* 213 */
     TclSetObjNameOfExecutable, /* 214 */
@@ -519,16 +527,16 @@ TclIntStubs tclIntStubs = {
     TclStackFree, /* 216 */
     TclPushStackFrame, /* 217 */
     TclPopStackFrame, /* 218 */
-    NULL, /* 219 */
-    NULL, /* 220 */
-    NULL, /* 221 */
-    NULL, /* 222 */
-    NULL, /* 223 */
+    0, /* 219 */
+    0, /* 220 */
+    0, /* 221 */
+    0, /* 222 */
+    0, /* 223 */
     TclGetPlatform, /* 224 */
     TclTraceDictPath, /* 225 */
     TclObjBeingDeleted, /* 226 */
     TclSetNsPath, /* 227 */
-    TclObjInterpProcCore, /* 228 */
+    0, /* 228 */
     TclPtrMakeUpvar, /* 229 */
     TclObjLookupVar, /* 230 */
     TclGetNamespaceFromObj, /* 231 */
@@ -537,31 +545,33 @@ TclIntStubs tclIntStubs = {
     TclVarHashCreateVar, /* 234 */
     TclInitVarHashTable, /* 235 */
     TclBackgroundException, /* 236 */
-    NULL, /* 237 */
-    NULL, /* 238 */
-    NULL, /* 239 */
-    NULL, /* 240 */
-    NULL, /* 241 */
-    NULL, /* 242 */
+    TclResetCancellation, /* 237 */
+    TclNRInterpProc, /* 238 */
+    TclNRInterpProcCore, /* 239 */
+    TclNRRunCallbacks, /* 240 */
+    TclNREvalObjEx, /* 241 */
+    TclNREvalObjv, /* 242 */
     TclDbDumpActiveObjects, /* 243 */
-    NULL, /* 244 */
-    NULL, /* 245 */
-    NULL, /* 246 */
-    NULL, /* 247 */
-    NULL, /* 248 */
+    TclGetNamespaceChildTable, /* 244 */
+    TclGetNamespaceCommandTable, /* 245 */
+    TclInitRewriteEnsemble, /* 246 */
+    TclResetRewriteEnsemble, /* 247 */
+    TclCopyChannel, /* 248 */
     TclDoubleDigits, /* 249 */
+    TclSetSlaveCancelFlags, /* 250 */
+    TclRegisterLiteral, /* 251 */
 };
 
-TclIntPlatStubs tclIntPlatStubs = {
+static const TclIntPlatStubs tclIntPlatStubs = {
     TCL_STUB_MAGIC,
-    NULL,
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+    0,
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
     TclGetAndDetachPids, /* 0 */
     TclpCloseFile, /* 1 */
     TclpCreateCommandChannel, /* 2 */
     TclpCreatePipe, /* 3 */
     TclpCreateProcess, /* 4 */
-    NULL, /* 5 */
+    0, /* 5 */
     TclpMakeFile, /* 6 */
     TclpOpenFile, /* 7 */
     TclUnixWaitForFile, /* 8 */
@@ -571,23 +581,24 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclpGmtime_unix, /* 12 */
     TclpInetNtoa, /* 13 */
     TclUnixCopyFile, /* 14 */
-    NULL, /* 15 */
-    NULL, /* 16 */
-    NULL, /* 17 */
-    NULL, /* 18 */
-    NULL, /* 19 */
-    NULL, /* 20 */
-    NULL, /* 21 */
-    NULL, /* 22 */
-    NULL, /* 23 */
-    NULL, /* 24 */
-    NULL, /* 25 */
-    NULL, /* 26 */
-    NULL, /* 27 */
-    NULL, /* 28 */
+    0, /* 15 */
+    0, /* 16 */
+    0, /* 17 */
+    0, /* 18 */
+    0, /* 19 */
+    0, /* 20 */
+    0, /* 21 */
+    0, /* 22 */
+    0, /* 23 */
+    0, /* 24 */
+    0, /* 25 */
+    0, /* 26 */
+    0, /* 27 */
+    0, /* 28 */
     TclWinCPUID, /* 29 */
+    TclUnixOpenTemporaryFile, /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     TclWinConvertError, /* 0 */
     TclWinConvertWSAError, /* 1 */
     TclWinGetServByName, /* 2 */
@@ -611,13 +622,14 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclWinAddProcess, /* 20 */
     TclpInetNtoa, /* 21 */
     TclpCreateTempFile, /* 22 */
-    TclpGetTZName, /* 23 */
+    0, /* 23 */
     TclWinNoBackslash, /* 24 */
-    NULL, /* 25 */
+    0, /* 25 */
     TclWinSetInterfaces, /* 26 */
     TclWinFlushDirtyChannels, /* 27 */
     TclWinResetInterfaces, /* 28 */
     TclWinCPUID, /* 29 */
+    TclUnixOpenTemporaryFile, /* 30 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     TclGetAndDetachPids, /* 0 */
@@ -625,7 +637,7 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclpCreateCommandChannel, /* 2 */
     TclpCreatePipe, /* 3 */
     TclpCreateProcess, /* 4 */
-    NULL, /* 5 */
+    0, /* 5 */
     TclpMakeFile, /* 6 */
     TclpOpenFile, /* 7 */
     TclUnixWaitForFile, /* 8 */
@@ -640,23 +652,24 @@ TclIntPlatStubs tclIntPlatStubs = {
     TclMacOSXCopyFileAttributes, /* 17 */
     TclMacOSXMatchType, /* 18 */
     TclMacOSXNotifierAddRunLoopMode, /* 19 */
-    NULL, /* 20 */
-    NULL, /* 21 */
-    NULL, /* 22 */
-    NULL, /* 23 */
-    NULL, /* 24 */
-    NULL, /* 25 */
-    NULL, /* 26 */
-    NULL, /* 27 */
-    NULL, /* 28 */
+    0, /* 20 */
+    0, /* 21 */
+    0, /* 22 */
+    0, /* 23 */
+    0, /* 24 */
+    0, /* 25 */
+    0, /* 26 */
+    0, /* 27 */
+    0, /* 28 */
     TclWinCPUID, /* 29 */
+    TclUnixOpenTemporaryFile, /* 30 */
 #endif /* MACOSX */
 };
 
-TclPlatStubs tclPlatStubs = {
+static const TclPlatStubs tclPlatStubs = {
     TCL_STUB_MAGIC,
-    NULL,
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+    0,
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     Tcl_WinUtfToTChar, /* 0 */
     Tcl_WinTCharToUtf, /* 1 */
 #endif /* WIN */
@@ -666,9 +679,9 @@ TclPlatStubs tclPlatStubs = {
 #endif /* MACOSX */
 };
 
-TclTomMathStubs tclTomMathStubs = {
+const TclTomMathStubs tclTomMathStubs = {
     TCL_STUB_MAGIC,
-    NULL,
+    0,
     TclBN_epoch, /* 0 */
     TclBN_revision, /* 1 */
     TclBN_mp_add, /* 2 */
@@ -733,15 +746,18 @@ TclTomMathStubs tclTomMathStubs = {
     TclBN_mp_init_set_int, /* 61 */
     TclBN_mp_set_int, /* 62 */
     TclBN_mp_cnt_lsb, /* 63 */
+    TclBNInitBignumFromLong, /* 64 */
+    TclBNInitBignumFromWideInt, /* 65 */
+    TclBNInitBignumFromWideUInt, /* 66 */
 };
 
-static TclStubHooks tclStubHooks = {
+static const TclStubHooks tclStubHooks = {
     &tclPlatStubs,
     &tclIntStubs,
     &tclIntPlatStubs
 };
 
-TclStubs tclStubs = {
+const TclStubs tclStubs = {
     TCL_STUB_MAGIC,
     &tclStubHooks,
     Tcl_PkgProvideEx, /* 0 */
@@ -753,20 +769,20 @@ TclStubs tclStubs = {
     Tcl_DbCkalloc, /* 6 */
     Tcl_DbCkfree, /* 7 */
     Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
-    NULL, /* 9 */
+#if defined(_WIN32) /* WIN */
+    0, /* 9 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_DeleteFileHandler, /* 10 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
-    NULL, /* 10 */
+#if defined(_WIN32) /* WIN */
+    0, /* 10 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_DeleteFileHandler, /* 10 */
@@ -927,11 +943,11 @@ TclStubs tclStubs = {
     Tcl_GetMaster, /* 164 */
     Tcl_GetNameOfExecutable, /* 165 */
     Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_GetOpenFile, /* 167 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
-    NULL, /* 167 */
+#if defined(_WIN32) /* WIN */
+    0, /* 167 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_GetOpenFile, /* 167 */
@@ -956,7 +972,7 @@ TclStubs tclStubs = {
     Tcl_IsSafe, /* 185 */
     Tcl_JoinPath, /* 186 */
     Tcl_LinkVar, /* 187 */
-    NULL, /* 188 */
+    0, /* 188 */
     Tcl_MakeFileChannel, /* 189 */
     Tcl_MakeSafe, /* 190 */
     Tcl_MakeTcpClientChannel, /* 191 */
@@ -1053,7 +1069,7 @@ TclStubs tclStubs = {
     Tcl_UnstackChannel, /* 282 */
     Tcl_GetStackedChannel, /* 283 */
     Tcl_SetMainLoop, /* 284 */
-    NULL, /* 285 */
+    0, /* 285 */
     Tcl_AppendObjToObj, /* 286 */
     Tcl_CreateEncoding, /* 287 */
     Tcl_CreateThreadExitHandler, /* 288 */
@@ -1348,57 +1364,57 @@ TclStubs tclStubs = {
     Tcl_AppendFormatToObj, /* 577 */
     Tcl_ObjPrintf, /* 578 */
     Tcl_AppendPrintfToObj, /* 579 */
-    NULL, /* 580 */
-    NULL, /* 581 */
-    NULL, /* 582 */
-    NULL, /* 583 */
-    NULL, /* 584 */
-    NULL, /* 585 */
-    NULL, /* 586 */
-    NULL, /* 587 */
-    NULL, /* 588 */
-    NULL, /* 589 */
-    NULL, /* 590 */
-    NULL, /* 591 */
-    NULL, /* 592 */
-    NULL, /* 593 */
-    NULL, /* 594 */
-    NULL, /* 595 */
-    NULL, /* 596 */
-    NULL, /* 597 */
-    NULL, /* 598 */
-    NULL, /* 599 */
-    NULL, /* 600 */
-    NULL, /* 601 */
-    NULL, /* 602 */
-    NULL, /* 603 */
-    NULL, /* 604 */
-    NULL, /* 605 */
-    NULL, /* 606 */
-    NULL, /* 607 */
-    NULL, /* 608 */
-    NULL, /* 609 */
-    NULL, /* 610 */
-    NULL, /* 611 */
-    NULL, /* 612 */
-    NULL, /* 613 */
-    NULL, /* 614 */
-    NULL, /* 615 */
-    NULL, /* 616 */
-    NULL, /* 617 */
-    NULL, /* 618 */
-    NULL, /* 619 */
-    NULL, /* 620 */
-    NULL, /* 621 */
-    NULL, /* 622 */
-    NULL, /* 623 */
-    NULL, /* 624 */
-    NULL, /* 625 */
-    NULL, /* 626 */
-    NULL, /* 627 */
-    NULL, /* 628 */
-    NULL, /* 629 */
-    TclUnusedStubEntry, /* 630 */
+    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 */
+    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 31fc865..859cbf9 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -13,17 +13,24 @@
 
 #include "tclInt.h"
 
-TclStubs *tclStubsPtr = NULL;
-TclPlatStubs *tclPlatStubsPtr = NULL;
-TclIntStubs *tclIntStubsPtr = NULL;
-TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
-TclTomMathStubs* tclTomMathStubsPtr = NULL;
+MODULE_SCOPE const TclStubs *tclStubsPtr;
+MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
+MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
+MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
+
+const TclStubs *tclStubsPtr = NULL;
+const TclPlatStubs *tclPlatStubsPtr = NULL;
+const TclIntStubs *tclIntStubsPtr = NULL;
+const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
 
 /*
- * Use our own ISDIGIT to avoid linking to libc on windows
+ * Use our own isDigit to avoid linking to libc on windows
  */
 
-#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)
+static int isDigit(const int c)
+{
+    return (c >= '0' && c <= '9');
+}
 
 /*
  *----------------------------------------------------------------------
@@ -43,16 +50,16 @@ TclTomMathStubs* tclTomMathStubsPtr = NULL;
  *----------------------------------------------------------------------
  */
 #undef Tcl_InitStubs
-CONST char *
+MODULE_SCOPE const char *
 Tcl_InitStubs(
     Tcl_Interp *interp,
-    CONST char *version,
+    const char *version,
     int exact)
 {
     Interp *iPtr = (Interp *) interp;
-    CONST char *actualVersion = NULL;
+    const char *actualVersion = NULL;
     ClientData pkgData = NULL;
-    TclStubs *stubsPtr = iPtr->stubTable;
+    const TclStubs *stubsPtr = iPtr->stubTable;
 
     /*
      * We can't optimize this check by caching tclStubsPtr because that
@@ -71,20 +78,20 @@ Tcl_InitStubs(
 	return NULL;
     }
     if (exact) {
-	CONST char *p = version;
+	const char *p = version;
 	int count = 0;
 
 	while (*p) {
-	    count += !ISDIGIT(*p++);
+	    count += !isDigit(*p++);
 	}
 	if (count == 1) {
-	    CONST char *q = actualVersion;
+	    const char *q = actualVersion;
 
 	    p = version;
 	    while (*p && (*p == *q)) {
 		p++; q++;
 	    }
-	    if (*p || ISDIGIT(*q)) {
+	    if (*p || isDigit(*q)) {
 		/* Construct error message */
 		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
 		return NULL;
@@ -112,61 +119,6 @@ Tcl_InitStubs(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * TclTomMathInitStubs --
- *
- *	Initializes the Stubs table for Tcl's subset of libtommath
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * This procedure should not be called directly, but rather through
- * the TclTomMath_InitStubs macro, to insure that the Stubs table
- * matches the header files used in compilation.
- *
- *----------------------------------------------------------------------
- */
-
-#undef TclTomMathInitializeStubs
-
-CONST char*
-TclTomMathInitializeStubs(
-    Tcl_Interp* interp,		/* Tcl interpreter */
-    CONST char* version,	/* Tcl version needed */
-    int epoch,			/* Stubs table epoch from the header files */
-    int revision		/* Stubs table revision number from the
-				 * header files */
-) {
-    int exact = 0;
-    const char* packageName = "tcl::tommath";
-    const char* errMsg = NULL;
-    ClientData pkgClientData = NULL;
-    const char* actualVersion = 
-	tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
-    TclTomMathStubs* stubsPtr = (TclTomMathStubs*) pkgClientData;
-    if (actualVersion == NULL) {
-	return NULL;
-    }
-    if (pkgClientData == NULL) {
-	errMsg = "missing stub table pointer";
-    } else if ((stubsPtr->tclBN_epoch)() != epoch) {
-	errMsg = "epoch number mismatch";
-    } else if ((stubsPtr->tclBN_revision)() != revision) {
-	errMsg = "requires a later revision";
-    } else {
-	tclTomMathStubsPtr = stubsPtr;
-	return actualVersion;
-    }
-    tclStubsPtr->tcl_ResetResult(interp);
-    tclStubsPtr->tcl_AppendResult(interp, "error loading ", packageName,
-		     " (requested version ", version,
-		     ", actual version ", actualVersion,
-		     "): ", errMsg, NULL);
-    return NULL;
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c
new file mode 100644
index 0000000..0391502
--- /dev/null
+++ b/generic/tclStubLibTbl.c
@@ -0,0 +1,58 @@
+/*
+ * tclStubLibTbl.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.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitStubTable --
+ *
+ *	Initialize the stub table, using the structure pointed at
+ *	by the "version" argument.
+ *
+ * Results:
+ *	Outputs the value of the "version" argument.
+ *
+ * Side effects:
+ *	Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE const char *
+TclInitStubTable(
+	const char *version) /* points to the version field of a
+	                        TclStubInfoType structure variable. */
+{
+    tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
+
+    if (tclStubsPtr->hooks) {
+	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+    } else {
+	tclPlatStubsPtr = NULL;
+	tclIntStubsPtr = NULL;
+	tclIntPlatStubsPtr = NULL;
+    }
+
+    return version;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 1d92ff5..f2dbfc9 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -15,9 +15,12 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#define TCL_TEST
+#undef STATIC_BUILD
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
-
+#include "tclOO.h"
 #include <math.h>
 
 /*
@@ -40,6 +43,17 @@
  */
 
 /*
+ * 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.
  */
@@ -61,7 +75,7 @@ typedef struct TestAsyncHandler {
 				/* Next is list of handlers. */
 } TestAsyncHandler;
 
-TCL_DECLARE_MUTEX(asyncTestMutex);
+TCL_DECLARE_MUTEX(asyncTestMutex)
 
 static TestAsyncHandler *firstHandler = NULL;
 
@@ -141,7 +155,6 @@ static TestChannel *firstDetached;
  * Forward declarations for procedures defined later in this file:
  */
 
-int			Tcltest_Init(Tcl_Interp *interp);
 static int		AsyncHandlerProc(ClientData clientData,
 			    Tcl_Interp *interp, int code);
 #ifdef TCL_THREADS
@@ -159,11 +172,11 @@ static void		CmdTraceDeleteProc(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int level, char *command, Tcl_CmdProc *cmdProc,
 			    ClientData cmdClientData, int argc,
-			    char **argv);
+			    const char *argv[]);
 static void		CmdTraceProc(ClientData clientData,
 			    Tcl_Interp *interp, int level, char *command,
 			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
-			    int argc, char **argv);
+			    int argc, const char *argv[]);
 static int		CreatedCommandProc(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int argc, const char **argv);
@@ -188,8 +201,9 @@ static int		EncodingFromUtfProc(ClientData clientData,
 			    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 int		GetTimesObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static void		MainLoop(void);
 static int		NoopCmd(ClientData clientData,
 			    Tcl_Interp *interp, int argc, const char **argv);
@@ -204,38 +218,11 @@ static void		ObjTraceDeleteProc(ClientData clientData);
 static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
 static void		SpecialFree(char *blockPtr);
 static int		StaticInitProc(Tcl_Interp *interp);
-#undef USE_OBSOLETE_FS_HOOKS
-#ifdef USE_OBSOLETE_FS_HOOKS
-static int		TestaccessprocCmd(ClientData dummy,
-			    Tcl_Interp *interp, int argc, const char **argv);
-static int		TestopenfilechannelprocCmd(
-			    ClientData dummy, Tcl_Interp *interp, int argc,
-			    const char **argv);
-static int		TeststatprocCmd(ClientData dummy,
-			    Tcl_Interp *interp, int argc, const char **argv);
-static int		PretendTclpAccess(const char *path, int mode);
-static int		TestAccessProc1(const char *path, int mode);
-static int		TestAccessProc2(const char *path, int mode);
-static int		TestAccessProc3(const char *path, int mode);
-static Tcl_Channel	PretendTclpOpenFileChannel(
-			    Tcl_Interp *interp, const char *fileName,
-			    const char *modeString, int permissions);
-static Tcl_Channel	TestOpenFileChannelProc1(
-			    Tcl_Interp *interp, const char *fileName,
-			    const char *modeString, int permissions);
-static Tcl_Channel	TestOpenFileChannelProc2(
-			    Tcl_Interp *interp, const char *fileName,
-			    const char *modeString, int permissions);
-static Tcl_Channel	TestOpenFileChannelProc3(
-			    Tcl_Interp *interp, const char *fileName,
-			    const char *modeString, int permissions);
-static int		PretendTclpStat(const char *path, struct stat *buf);
-static int		TestStatProc1(const char *path, struct stat *buf);
-static int		TestStatProc2(const char *path, struct stat *buf);
-static int		TestStatProc3(const char *path, struct stat *buf);
-#endif
 static int		TestasyncCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestbytestringObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		TestcmdinfoCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestcmdtokenCmd(ClientData dummy,
@@ -325,6 +312,8 @@ 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		TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 static int		TestparserObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -340,7 +329,7 @@ static int		TestregexpObjCmd(ClientData dummy,
 static int		TestreturnObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-static void		TestregexpXflags(char *string,
+static void		TestregexpXflags(const char *string,
 			    int length, int *cflagsPtr, int *eflagsPtr);
 static int		TestsaveresultCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
@@ -384,106 +373,99 @@ static int		TestSimpleFilesystemObjCmd(
 static void		TestReport(const char *cmd, Tcl_Obj *arg1,
 			    Tcl_Obj *arg2);
 static Tcl_Obj *	TestReportGetNativePath(Tcl_Obj *pathPtr);
-static int		TestReportStat(Tcl_Obj *path, Tcl_StatBuf *buf);
-static int		TestReportAccess(Tcl_Obj *path, int mode);
-static Tcl_Channel	TestReportOpenFileChannel(
-			    Tcl_Interp *interp, Tcl_Obj *fileName,
-			    int mode, int permissions);
-static int		TestReportMatchInDirectory(Tcl_Interp *interp,
-			    Tcl_Obj *resultPtr, Tcl_Obj *dirPtr,
-			    const char *pattern, Tcl_GlobTypeData *types);
-static int		TestReportChdir(Tcl_Obj *dirName);
-static int		TestReportLstat(Tcl_Obj *path, Tcl_StatBuf *buf);
-static int		TestReportCopyFile(Tcl_Obj *src, Tcl_Obj *dst);
-static int		TestReportDeleteFile(Tcl_Obj *path);
-static int		TestReportRenameFile(Tcl_Obj *src, Tcl_Obj *dst);
-static int		TestReportCreateDirectory(Tcl_Obj *path);
-static int		TestReportCopyDirectory(Tcl_Obj *src,
-			    Tcl_Obj *dst, Tcl_Obj **errorPtr);
-static int		TestReportRemoveDirectory(Tcl_Obj *path,
-			    int recursive, Tcl_Obj **errorPtr);
-static int		TestReportLoadFile(Tcl_Interp *interp,
-			    Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr,
-			    Tcl_FSUnloadFileProc **unloadProcPtr);
-static Tcl_Obj *	TestReportLink(Tcl_Obj *path,
-			    Tcl_Obj *to, int linkType);
-static const char **	TestReportFileAttrStrings(
-			    Tcl_Obj *fileName, Tcl_Obj **objPtrRef);
-static int		TestReportFileAttrsGet(Tcl_Interp *interp,
-			    int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef);
-static int		TestReportFileAttrsSet(Tcl_Interp *interp,
-			    int index, Tcl_Obj *fileName, Tcl_Obj *objPtr);
-static int		TestReportUtime(Tcl_Obj *fileName,
-			    struct utimbuf *tval);
-static int		TestReportNormalizePath(Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr, int nextCheckpoint);
-static int		TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr);
-static void		TestReportFreeInternalRep(ClientData clientData);
-static ClientData	TestReportDupInternalRep(ClientData clientData);
-
-static int		SimpleStat(Tcl_Obj *path, Tcl_StatBuf *buf);
-static int		SimpleAccess(Tcl_Obj *path, int mode);
-static Tcl_Channel	SimpleOpenFileChannel(Tcl_Interp *interp,
-			    Tcl_Obj *fileName, int mode, int permissions);
-static Tcl_Obj *	SimpleListVolumes(void);
-static int		SimplePathInFilesystem(
-			    Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+static Tcl_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 int TestReportLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
+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 int		SimpleMatchInDirectory(
-			    Tcl_Interp *interp, Tcl_Obj *resultPtr,
-			    Tcl_Obj *dirPtr, const char *pattern,
-			    Tcl_GlobTypeData *types);
+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[]);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
-static int		TestcpuidCmd (ClientData dummy,
+
+static Tcl_NRPostProc	NREUnwind_callback;
+static int		TestNREUnwind(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[]);
+#if defined(HAVE_CPUID) || defined(_WIN32)
+static int		TestcpuidCmd(ClientData dummy,
 			    Tcl_Interp* interp, int objc,
-			    Tcl_Obj *CONST objv[]);
+			    Tcl_Obj *const objv[]);
 #endif
 
-static Tcl_Filesystem testReportingFilesystem = {
+static const 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,
-    (Tcl_FSLoadFileProc *) &TestReportLoadFile,
+    TestReportFileAttrStrings,
+    TestReportFileAttrsGet,
+    TestReportFileAttrsSet,
+    TestReportCreateDirectory,
+    TestReportRemoveDirectory,
+    TestReportDeleteFile,
+    TestReportCopyFile,
+    TestReportRenameFile,
+    TestReportCopyDirectory,
+    TestReportLstat,
+    (Tcl_FSLoadFileProc *) TestReportLoadFile,
     NULL /* cwd */,
-    &TestReportChdir
+    TestReportChdir
 };
 
-static Tcl_Filesystem simpleFilesystem = {
+static const 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
@@ -497,14 +479,14 @@ static Tcl_Filesystem simpleFilesystem = {
     NULL,
     NULL,
     NULL,
-    &SimpleStat,
-    &SimpleAccess,
-    &SimpleOpenFileChannel,
-    &SimpleMatchInDirectory,
+    SimpleStat,
+    SimpleAccess,
+    SimpleOpenFileChannel,
+    SimpleMatchInDirectory,
     NULL,
     /* We choose not to support symbolic links inside our vfs's */
     NULL,
-    &SimpleListVolumes,
+    SimpleListVolumes,
     NULL,
     NULL,
     NULL,
@@ -528,15 +510,6 @@ static Tcl_Filesystem simpleFilesystem = {
 
 
 /*
- * External (platform specific) initialization routine, these declarations
- * explicitly don't use EXTERN since this code does not get compiled into the
- * library:
- */
-
-extern int		TclplatformtestInit(Tcl_Interp *interp);
-extern int		TclThread_Init(Tcl_Interp *interp);
-
-/*
  *----------------------------------------------------------------------
  *
  * Tcltest_Init --
@@ -564,11 +537,20 @@ Tcltest_Init(
     Tcl_Obj *listPtr;
     Tcl_Obj **objv;
     int objc, index;
-    static const char *specialOptions[] = {
+    static const char *const specialOptions[] = {
 	"-appinitprocerror", "-appinitprocdeleteinterp",
 	"-appinitprocclosestderr", "-appinitprocsetrcfile", 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;
+    }
     /* TIP #268: Full patchlevel instead of just major.minor */
 
     if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
@@ -579,143 +561,150 @@ Tcltest_Init(
      * Create additional commands and math functions for testing Tcl.
      */
 
-    Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0, NULL);
-    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
+    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
-	    TestGetIndexFromObjStructObjCmd, (ClientData) 0, NULL);
-#ifdef USE_OBSOLETE_FS_HOOKS
-    Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
-	    NULL);
-    Tcl_CreateCommand(interp, "testopenfilechannelproc",
-    	    TestopenfilechannelprocCmd, (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
-	    NULL);
-#endif
-    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, NULL);
+	    TestGetIndexFromObjStructObjCmd, NULL, NULL);
+    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
-	    (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
+	    NULL, NULL);
+    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
 	    NULL);
-    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
+    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
 	    NULL);
     Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
-	    (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0, NULL);
+	    NULL, NULL);
+    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
+    Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
 			 NULL, NULL);
     Tcl_DStringInit(&dstring);
-    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
+    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,
 	    NULL);
-    Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0,
+    Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL,
 	    NULL);
     Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
-	    (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
+	    NULL, NULL);
+    Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL,
 	    NULL);
     Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testhashsystemhash",
-	    TestHashSystemHashCmd, (ClientData) 0, NULL);
+	    TestHashSystemHashCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testgetvarfullname",
-	    TestgetvarfullnameCmd, (ClientData) 0, NULL);
+	    TestgetvarfullnameCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
-	    (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, NULL);
-    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0,
+	    NULL, NULL);
+    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
 	    NULL);
-    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, NULL);
+    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
     Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
 	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
     Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
 	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
     Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
-	    TestsetobjerrorcodeCmd, (ClientData) 0, NULL);
+	    TestsetobjerrorcodeCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testnumutfchars",
-	    TestNumUtfCharsCmd, (ClientData) 0, NULL);
+	    TestNumUtfCharsCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testtranslatefilename",
-	    TesttranslatefilenameCmd, (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0, NULL);
+	    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, (ClientData) 0,
+    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
 	    NULL);
     Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
-	    (ClientData) NULL, NULL);
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
-	    (ClientData) NULL, NULL);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+	    NULL, NULL);
+#if defined(HAVE_CPUID) || defined(_WIN32)
     Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
 	    (ClientData) 0, NULL);
 #endif
     t3ArgTypes[0] = TCL_EITHER;
     t3ArgTypes[1] = TCL_EITHER;
     Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
-	    (ClientData) 0);
+	    NULL);
+
+    Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
+	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
+	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
+	    NULL, NULL);
 
+    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;
@@ -761,6 +750,35 @@ Tcltest_Init(
 
     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);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -790,7 +808,6 @@ TestasyncCmd(
     TestAsyncHandler *asyncPtr, *prevPtr;
     int id, code;
     static int nextId = 1;
-    char buf[TCL_INTEGER_SPACE];
 
     if (argc < 2) {
 	wrongNumArgs:
@@ -801,7 +818,7 @@ TestasyncCmd(
 	if (argc != 3) {
 	    goto wrongNumArgs;
 	}
-	asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler));
+	asyncPtr = ckalloc(sizeof(TestAsyncHandler));
 	asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
 	strcpy(asyncPtr->command, argv[2]);
         Tcl_MutexLock(&asyncTestMutex);
@@ -812,8 +829,7 @@ TestasyncCmd(
 	asyncPtr->nextPtr = firstHandler;
 	firstHandler = asyncPtr;
         Tcl_MutexUnlock(&asyncTestMutex);
-	TclFormatInt(buf, asyncPtr->id);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
     } else if (strcmp(argv[1], "delete") == 0) {
 	if (argc == 2) {
             Tcl_MutexLock(&asyncTestMutex);
@@ -822,7 +838,7 @@ TestasyncCmd(
 		firstHandler = asyncPtr->nextPtr;
 		Tcl_AsyncDelete(asyncPtr->handler);
 		ckfree(asyncPtr->command);
-		ckfree((char *) asyncPtr);
+		ckfree(asyncPtr);
 	    }
             Tcl_MutexUnlock(&asyncTestMutex);
 	    return TCL_OK;
@@ -846,7 +862,7 @@ TestasyncCmd(
 	    }
 	    Tcl_AsyncDelete(asyncPtr->handler);
 	    ckfree(asyncPtr->command);
-	    ckfree((char *) asyncPtr);
+	    ckfree(asyncPtr);
 	    break;
 	}
         Tcl_MutexUnlock(&asyncTestMutex);
@@ -858,7 +874,7 @@ TestasyncCmd(
 		|| (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) {
 	    return TCL_ERROR;
 	}
-        Tcl_MutexLock(&asyncTestMutex);
+	Tcl_MutexLock(&asyncTestMutex);
 	for (asyncPtr = firstHandler; asyncPtr != NULL;
 		asyncPtr = asyncPtr->nextPtr) {
 	    if (asyncPtr->id == id) {
@@ -866,8 +882,8 @@ TestasyncCmd(
 		break;
 	    }
 	}
-        Tcl_MutexUnlock(&asyncTestMutex);
-	Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
+	Tcl_MutexUnlock(&asyncTestMutex);
 	return code;
 #ifdef TCL_THREADS
     } else if (strcmp(argv[1], "marklater") == 0) {
@@ -883,7 +899,7 @@ TestasyncCmd(
 	    if (asyncPtr->id == id) {
 		Tcl_ThreadId threadID;
 		if (Tcl_CreateThread(&threadID, AsyncThreadProc,
-			(ClientData) INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
+			INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
 			TCL_THREAD_NOFLAGS) != TCL_OK) {
 		    Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
 		    Tcl_MutexUnlock(&asyncTestMutex);
@@ -939,14 +955,14 @@ AsyncHandlerProc(
     listArgv[3] = NULL;
     cmd = Tcl_Merge(3, listArgv);
     if (interp != NULL) {
-	code = Tcl_Eval(interp, cmd);
+	code = Tcl_EvalEx(interp, cmd, -1, 0);
     } else {
 	/*
 	 * this should not happen, but by definition of how async handlers are
 	 * invoked, it's possible.  Better error checking is needed here.
 	 */
     }
-    ckfree((char *)cmd);
+    ckfree(cmd);
     return code;
 }
 
@@ -1063,13 +1079,13 @@ TestcmdinfoCmd(
 	info.proc = CmdProc2;
 	info.clientData = (ClientData) "new_command_data";
 	info.objProc = NULL;
-	info.objClientData = (ClientData) NULL;
+	info.objClientData = NULL;
 	info.deleteProc = CmdDelProc2;
 	info.deleteData = (ClientData) "new_delete_data";
 	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
-	    Tcl_SetResult(interp, "0", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
 	} else {
-	    Tcl_SetResult(interp, "1", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
 	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -1221,9 +1237,8 @@ TestcmdtraceCmd(
 
     if (strcmp(argv[1], "tracetest") == 0) {
 	Tcl_DStringInit(&buffer);
-	cmdTrace = Tcl_CreateTrace(interp, 50000,
-		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
-	result = Tcl_Eval(interp, argv[2]);
+	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
+	result = Tcl_EvalEx(interp, argv[2], -1, 0);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1235,18 +1250,17 @@ TestcmdtraceCmd(
 	 * 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
-	 * TclExecuteByteCode.
+	 * TclNRExecuteByteCode.
 	 */
 
-	cmdTrace = Tcl_CreateTrace(interp, 50000,
-		(Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
-	Tcl_Eval(interp, argv[2]);
+	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
+	Tcl_EvalEx(interp, argv[2], -1, 0);
     } else if (strcmp(argv[1], "leveltest") == 0) {
 	Interp *iPtr = (Interp *) interp;
 	Tcl_DStringInit(&buffer);
-	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4,
-		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
-	result = Tcl_Eval(interp, argv[2]);
+	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
+		&buffer);
+	result = Tcl_EvalEx(interp, argv[2], -1, 0);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1276,10 +1290,8 @@ TestcmdtraceCmd(
 	Tcl_Trace t1, t2;
 
 	Tcl_DStringInit(&buffer);
-	t1 = Tcl_CreateTrace(interp, 1,
-		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
-	t2 = Tcl_CreateTrace(interp, 50000,
-		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
+	t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
+	t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
 	result = Tcl_Eval(interp, argv[2]);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -1309,7 +1321,7 @@ CmdTraceProc(
     ClientData cmdClientData,	/* Client data associated with command
 				 * procedure. */
     int argc,			/* Number of arguments. */
-    char **argv)		/* Argument strings. */
+    const char *argv[])		/* Argument strings. */
 {
     Tcl_DString *bufPtr = (Tcl_DString *) clientData;
     int i;
@@ -1334,11 +1346,11 @@ CmdTraceDeleteProc(
     ClientData cmdClientData,	/* Client data associated with command
 				 * procedure. */
     int argc,			/* Number of arguments. */
-    char **argv)		/* Argument strings. */
+    const char *argv[])		/* Argument strings. */
 {
     /*
      * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
-     * callback causes the for loop in TclExecuteByteCode that calls traces to
+     * callback causes the for loop in TclNRExecuteByteCode that calls traces to
      * reference freed memory.
      */
 
@@ -1416,12 +1428,12 @@ TestcreatecommandCmd(
     }
     if (strcmp(argv[1], "create") == 0) {
 	Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
-		CreatedCommandProc, (ClientData) NULL, NULL);
+		CreatedCommandProc, NULL, NULL);
     } else if (strcmp(argv[1], "delete") == 0) {
 	Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand");
     } else if (strcmp(argv[1], "create2") == 0) {
 	Tcl_CreateCommand(interp, "value:at:",
-		CreatedCommandProc2, (ClientData) NULL, NULL);
+		CreatedCommandProc2, NULL, NULL);
     } else if (strcmp(argv[1], "delete2") == 0) {
 	Tcl_DeleteCommand(interp, "value:at:");
     } else {
@@ -1578,9 +1590,9 @@ TestdelCmd(
 	return TCL_ERROR;
     }
 
-    dPtr = (DelCmd *) ckalloc(sizeof(DelCmd));
+    dPtr = ckalloc(sizeof(DelCmd));
     dPtr->interp = interp;
-    dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
+    dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1);
     strcpy(dPtr->deleteCmd, argv[3]);
 
     Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
@@ -1599,7 +1611,7 @@ DelCmdProc(
 
     Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
     ckfree(dPtr->deleteCmd);
-    ckfree((char *) dPtr);
+    ckfree(dPtr);
     return TCL_OK;
 }
 
@@ -1607,12 +1619,12 @@ static void
 DelDeleteProc(
     ClientData clientData)	/* String command to evaluate. */
 {
-    DelCmd *dPtr = (DelCmd *) clientData;
+    DelCmd *dPtr = clientData;
 
     Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
     Tcl_ResetResult(dPtr->interp);
     ckfree(dPtr->deleteCmd);
-    ckfree((char *) dPtr);
+    ckfree(dPtr);
 }
 
 /*
@@ -1814,13 +1826,13 @@ 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) {
-	    Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
-	    strcpy(interp->result, "This is a malloc-ed string");
+	    char *s = ckalloc(100);
+	    strcpy(s, "This is a malloc-ed string");
+	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
 	} else if (strcmp(argv[2], "special") == 0) {
-	    interp->result = (char *) ckalloc(100);
-	    interp->result += 4;
-	    interp->freeProc = SpecialFree;
-	    strcpy(interp->result, "This is a specially-allocated string");
+	    char *s = (char*)ckalloc(100) + 16;
+	    strcpy(s, "This is a specially-allocated string");
+	    Tcl_SetResult(interp, s, SpecialFree);
 	} else {
 	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
 		    "\": must be staticsmall, staticlarge, free, or special",
@@ -1829,13 +1841,11 @@ TestdstringCmd(
 	}
 	Tcl_DStringGetResult(interp, &dstring);
     } else if (strcmp(argv[1], "length") == 0) {
-	char buf[TCL_INTEGER_SPACE];
 
 	if (argc != 2) {
 	    goto wrongNumArgs;
 	}
-	TclFormatInt(buf, Tcl_DStringLength(&dstring));
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring)));
     } else if (strcmp(argv[1], "result") == 0) {
 	if (argc != 2) {
 	    goto wrongNumArgs;
@@ -1871,7 +1881,7 @@ TestdstringCmd(
 static void SpecialFree(blockPtr)
     char *blockPtr;			/* Block to free. */
 {
-    ckfree(blockPtr - 4);
+    ckfree(blockPtr - 16);
 }
 
 /*
@@ -1901,9 +1911,9 @@ TestencodingObjCmd(
 {
     Tcl_Encoding encoding;
     int index, length;
-    char *string;
+    const char *string;
     TclEncoding *encodingPtr;
-    static const char *optionStrings[] = {
+    static const char *const optionStrings[] = {
 	"create",	"delete",	NULL
     };
     enum options {
@@ -1922,15 +1932,15 @@ TestencodingObjCmd(
 	if (objc != 5) {
 	    return TCL_ERROR;
 	}
-	encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
+	encodingPtr = ckalloc(sizeof(TclEncoding));
 	encodingPtr->interp = interp;
 
 	string = Tcl_GetStringFromObj(objv[3], &length);
-	encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+	encodingPtr->toUtfCmd = ckalloc(length + 1);
 	memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
 
 	string = Tcl_GetStringFromObj(objv[4], &length);
-	encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+	encodingPtr->fromUtfCmd = ckalloc(length + 1);
 	memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
 
 	string = Tcl_GetStringFromObj(objv[2], &length);
@@ -1974,7 +1984,7 @@ EncodingToUtfProc(
     TclEncoding *encodingPtr;
 
     encodingPtr = (TclEncoding *) clientData;
-    Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd);
+    Tcl_EvalEx(encodingPtr->interp,encodingPtr->toUtfCmd,-1,TCL_EVAL_GLOBAL);
 
     len = strlen(Tcl_GetStringResult(encodingPtr->interp));
     if (len > dstLen) {
@@ -2006,7 +2016,7 @@ EncodingFromUtfProc(
     TclEncoding *encodingPtr;
 
     encodingPtr = (TclEncoding *) clientData;
-    Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd);
+    Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd,-1,TCL_EVAL_GLOBAL);
 
     len = strlen(Tcl_GetStringResult(encodingPtr->interp));
     if (len > dstLen) {
@@ -2025,12 +2035,11 @@ static void
 EncodingFreeProc(
     ClientData clientData)	/* ClientData associated with type. */
 {
-    TclEncoding *encodingPtr;
+    TclEncoding *encodingPtr = clientData;
 
-    encodingPtr = (TclEncoding *) clientData;
-    ckfree((char *) encodingPtr->toUtfCmd);
-    ckfree((char *) encodingPtr->fromUtfCmd);
-    ckfree((char *) encodingPtr);
+    ckfree(encodingPtr->toUtfCmd);
+    ckfree(encodingPtr->fromUtfCmd);
+    ckfree(encodingPtr);
 }
 
 /*
@@ -2058,11 +2067,11 @@ TestevalexObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int length, flags;
-    char *script;
+    const char *script;
 
     flags = 0;
     if (objc == 3) {
-	char *global = Tcl_GetStringFromObj(objv[2], &length);
+	const char *global = Tcl_GetStringFromObj(objv[2], &length);
 	if (strcmp(global, "global") != 0) {
 	    Tcl_AppendResult(interp, "bad value \"", global,
 		    "\": must be global", NULL);
@@ -2151,11 +2160,11 @@ TesteventObjCmd(
     int objc,			/* Parameter count */
     Tcl_Obj *const objv[])	/* Parameter vector */
 {
-    static const char *subcommands[] = { /* Possible subcommands */
+    static const char *const subcommands[] = { /* Possible subcommands */
 	"queue", "delete", NULL
     };
     int subCmdIndex;		/* Index of the chosen subcommand */
-    static const char *positions[] = { /* Possible queue positions */
+    static const char *const positions[] = { /* Possible queue positions */
 	"head", "tail", "mark", NULL
     };
     int posIndex;		/* Index of the chosen position */
@@ -2168,7 +2177,7 @@ TesteventObjCmd(
     TestEvent *ev;		/* Event to be queued */
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
 	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",
@@ -2185,7 +2194,7 @@ TesteventObjCmd(
 		"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	ev = (TestEvent *) ckalloc(sizeof(TestEvent));
+	ev = ckalloc(sizeof(TestEvent));
 	ev->header.proc = TesteventProc;
 	ev->header.nextPtr = NULL;
 	ev->interp = interp;
@@ -2286,17 +2295,17 @@ TesteventDeleteProc(
 				 * to remove */
 {
     TestEvent *ev;		/* Event to examine */
-    char *evNameStr;
+    const char *evNameStr;
     Tcl_Obj *targetName;	/* Name of the event(s) to delete */
-    char *targetNameStr;
+    const char *targetNameStr;
 
     if (event->proc != TesteventProc) {
 	return 0;
     }
     targetName = (Tcl_Obj *) clientData;
-    targetNameStr = (char *) Tcl_GetStringFromObj(targetName, NULL);
+    targetNameStr = (char *) Tcl_GetString(targetName);
     ev = (TestEvent *) event;
-    evNameStr = Tcl_GetStringFromObj(ev->tag, NULL);
+    evNameStr = Tcl_GetString(ev->tag);
     if (strcmp(evNameStr, targetNameStr) == 0) {
 	Tcl_DecrRefCount(ev->tag);
 	Tcl_DecrRefCount(ev->command);
@@ -2714,7 +2723,7 @@ TestgetplatformCmd(
     int argc,			/* Number of arguments. */
     const char **argv)		/* Argument strings. */
 {
-    static const char *platformStrings[] = { "unix", "mac", "windows" };
+    static const char *const platformStrings[] = { "unix", "mac", "windows" };
     TclPlatformType *platform;
 
     platform = TclGetPlatform();
@@ -3043,7 +3052,7 @@ TestlinkCmd(
 	    if (strcmp(argv[5], "-") == 0) {
 		stringVar = NULL;
 	    } else {
-		stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
+		stringVar = ckalloc(strlen(argv[5]) + 1);
 		strcpy(stringVar, argv[5]);
 	    }
 	}
@@ -3150,7 +3159,7 @@ TestlinkCmd(
 	    if (strcmp(argv[5], "-") == 0) {
 		stringVar = NULL;
 	    } else {
-		stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
+		stringVar = ckalloc(strlen(argv[5]) + 1);
 		strcpy(stringVar, argv[5]);
 	    }
 	    Tcl_UpdateLinkedVar(interp, "string");
@@ -3265,13 +3274,13 @@ TestlocaleCmd(
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
     int index;
-    char *locale;
+    const char *locale;
 
-    static const char *optionStrings[] = {
-    	"ctype", "numeric", "time", "collate", "monetary",
+    static const char *const 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
     };
@@ -3462,7 +3471,7 @@ CleanupTestSetassocdataTests(
     ClientData clientData,	/* Data to be released. */
     Tcl_Interp *interp)		/* Interpreter being deleted. */
 {
-    ckfree((char *) clientData);
+    ckfree(clientData);
 }
 
 /*
@@ -3489,7 +3498,7 @@ TestparserObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    char *script;
+    const char *script;
     int length, dummy;
     Tcl_Parse parse;
 
@@ -3545,7 +3554,7 @@ TestexprparserObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    char *script;
+    const char *script;
     int length, dummy;
     Tcl_Parse parse;
 
@@ -3733,7 +3742,7 @@ TestparsevarnameObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    char *script;
+    const char *script;
     int append, length, dummy;
     Tcl_Parse parse;
 
@@ -3801,10 +3810,10 @@ TestregexpObjCmd(
     int i, ii, indices, stringLength, match, about;
     int hasxflags, cflags, eflags;
     Tcl_RegExp regExpr;
-    char *string;
+    const char *string;
     Tcl_Obj *objPtr;
     Tcl_RegExpInfo info;
-    static const char *options[] = {
+    static const char *const options[] = {
 	"-indices",	"-nocase",	"-about",	"-expanded",
 	"-line",	"-linestop",	"-lineanchor",
 	"-xflags",
@@ -3824,7 +3833,7 @@ TestregexpObjCmd(
     hasxflags = 0;
 
     for (i = 1; i < objc; i++) {
-	char *name;
+	const char *name;
 	int index;
 
 	name = Tcl_GetString(objv[i]);
@@ -3869,7 +3878,7 @@ TestregexpObjCmd(
   endOfForLoop:
     if (objc - i < hasxflags + 2 - about) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+		"?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
 	return TCL_ERROR;
     }
     objc -= i;
@@ -3909,7 +3918,7 @@ TestregexpObjCmd(
 
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
 	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
-	    char *varName;
+	    const char *varName;
 	    const char *value;
 	    int start, end;
 	    char resinfo[TCL_INTEGER_SPACE * 2];
@@ -3924,7 +3933,7 @@ TestregexpObjCmd(
 		return TCL_ERROR;
 	    }
 	} else if (cflags & TCL_REG_CANMATCH) {
-	    char *varName;
+	    const char *varName;
 	    const char *value;
 	    char resinfo[TCL_INTEGER_SPACE * 2];
 
@@ -3993,10 +4002,8 @@ TestregexpObjCmd(
 			info.matches[ii].end - 1);
 	    }
 	}
-	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
+	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
 	if (valuePtr == NULL) {
-	    Tcl_AppendResult(interp, "couldn't set variable \"",
-		    Tcl_GetString(varPtr), "\"", NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -4028,7 +4035,7 @@ TestregexpObjCmd(
 
 static void
 TestregexpXflags(
-    char *string,		/* The string of flags. */
+    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 */
@@ -4161,7 +4168,7 @@ TestsetassocdataCmd(
 	return TCL_ERROR;
     }
 
-    buf = ckalloc((unsigned) strlen(argv[2]) + 1);
+    buf = ckalloc(strlen(argv[2]) + 1);
     strcpy(buf, argv[2]);
 
     /*
@@ -4266,8 +4273,8 @@ TeststaticpkgCmd(
     if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
 	return TCL_ERROR;
     }
-    Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
-	    (safe) ? StaticInitProc : NULL);
+    tclStubsPtr->tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
+	    StaticInitProc, (safe) ? StaticInitProc : NULL);
     return TCL_OK;
 }
 
@@ -4403,8 +4410,26 @@ TestseterrorcodeCmd(
 	Tcl_SetResult(interp, "too many args", TCL_STATIC);
 	return TCL_ERROR;
     }
-    Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
-	    argv[5], NULL);
+    switch (argc) {
+    case 1:
+	Tcl_SetErrorCode(interp, "NONE", NULL);
+	break;
+    case 2:
+	Tcl_SetErrorCode(interp, argv[1], NULL);
+	break;
+    case 3:
+	Tcl_SetErrorCode(interp, argv[1], argv[2], NULL);
+	break;
+    case 4:
+	Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL);
+	break;
+    case 5:
+	Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL);
+	break;
+    case 6:
+	Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
+		argv[5], NULL);
+    }
     return TCL_ERROR;
 }
 
@@ -4469,7 +4494,7 @@ TestfeventCmd(
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg ...?", NULL);
+		" option ?arg ...?", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "cmd") == 0) {
@@ -4479,7 +4504,7 @@ TestfeventCmd(
 	    return TCL_ERROR;
 	}
 	if (interp2 != NULL) {
-	    code = Tcl_GlobalEval(interp2, argv[2]);
+	    code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL);
 	    Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
 	    return code;
 	} else {
@@ -4535,7 +4560,7 @@ TestpanicCmd(
     int argc,			/* Number of arguments. */
     const char **argv)		/* Argument strings. */
 {
-    const char *argString;
+    char *argString;
 
     /*
      *  Put the arguments into a var args structure
@@ -4544,11 +4569,11 @@ TestpanicCmd(
 
     argString = Tcl_Merge(argc-1, argv+1);
     Tcl_Panic("%s", argString);
-    ckfree((char *)argString);
+    ckfree(argString);
 
     return TCL_OK;
 }
-
+
 static int
 TestfileCmd(
     ClientData dummy,		/* Not used. */
@@ -4558,7 +4583,7 @@ TestfileCmd(
 {
     int force, i, j, result;
     Tcl_Obj *error = NULL;
-    char *subcmd;
+    const char *subcmd;
 
     if (argc < 3) {
 	return TCL_ERROR;
@@ -4638,12 +4663,11 @@ TestgetvarfullnameCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    char *name, *arg;
+    const char *name, *arg;
     int flags = 0;
     Tcl_Namespace *namespacePtr;
     Tcl_CallFrame *framePtr;
     Tcl_Var variable;
-    int result;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name scope");
@@ -4671,11 +4695,8 @@ TestgetvarfullnameCmd(
 	if (namespacePtr == NULL) {
 	    return TCL_ERROR;
 	}
-	result = TclPushStackFrame(interp, &framePtr, namespacePtr,
+	(void) TclPushStackFrame(interp, &framePtr, namespacePtr,
 		/*isProcCallFrame*/ 0);
-	if (result != TCL_OK) {
-	    return result;
-	}
     }
 
     variable = Tcl_FindNamespaceVar(interp, name, NULL,
@@ -4694,7 +4715,7 @@ TestgetvarfullnameCmd(
 /*
  *----------------------------------------------------------------------
  *
- * GetTimesCmd --
+ * GetTimesObjCmd --
  *
  *	This procedure implements the "gettimes" command.  It is used for
  *	computing the time needed for various basic operations such as reading
@@ -4710,11 +4731,11 @@ TestgetvarfullnameCmd(
  */
 
 static int
-GetTimesCmd(
+GetTimesObjCmd(
     ClientData unused,		/* Unused. */
     Tcl_Interp *interp,		/* The current interpreter. */
-    int argc,			/* The number of arguments. */
-    const char **argv)		/* The argument strings. */
+    int notused1,			/* Number of arguments. */
+    Tcl_Obj *const notused2[])	/* The argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
     int i, n;
@@ -4728,8 +4749,8 @@ GetTimesCmd(
     fprintf(stderr, "alloc & free 100000 6 word items\n");
     Tcl_GetTime(&start);
     for (i = 0;  i < 100000;  i++) {
-	objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
-	ckfree((char *) objPtr);
+	objPtr = ckalloc(sizeof(Tcl_Obj));
+	ckfree(objPtr);
     }
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4737,10 +4758,10 @@ GetTimesCmd(
 
     /* alloc 5000 times */
     fprintf(stderr, "alloc 5000 6 word items\n");
-    objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
+    objv = ckalloc(5000 * sizeof(Tcl_Obj *));
     Tcl_GetTime(&start);
     for (i = 0;  i < 5000;  i++) {
-	objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
+	objv[i] = ckalloc(sizeof(Tcl_Obj));
     }
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4750,7 +4771,7 @@ GetTimesCmd(
     fprintf(stderr, "free 5000 6 word items\n");
     Tcl_GetTime(&start);
     for (i = 0;  i < 5000;  i++) {
-	ckfree((char *) objv[i]);
+	ckfree(objv[i]);
     }
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4776,7 +4797,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((char *) objv);
+    ckfree(objv);
 
     /* TclGetString 100000 times */
     fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
@@ -4928,6 +4949,42 @@ NoopObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestbytestringObjCmd --
+ *
+ *	This object-based procedure constructs a string which can
+ *	possibly contain invalid UTF-8 bytes.
+ *
+ * Results:
+ *	Returns the TCL_OK result code.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestbytestringObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
+{
+    int n;
+    const char *p;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
+	return TCL_ERROR;
+    }
+    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestsetCmd --
  *
  *	Implements the "testset{err,noerr}" cmds that are used when testing
@@ -5033,10 +5090,11 @@ TestsaveresultCmd(
     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 *optionStrings[] = {
+    static const char *const optionStrings[] = {
 	"append", "dynamic", "free", "object", "small", NULL
     };
     enum options {
@@ -5075,7 +5133,7 @@ TestsaveresultCmd(
 	break;
     }
     case RESULT_DYNAMIC:
-	Tcl_SetResult(interp, "dynamic result", TestsaveresultFree);
+	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
 	break;
     case RESULT_OBJECT:
 	objPtr = Tcl_NewStringObj("object result", -1);
@@ -5101,7 +5159,7 @@ TestsaveresultCmd(
 
     switch ((enum options) index) {
     case RESULT_DYNAMIC: {
-	int present = interp->freeProc == TestsaveresultFree;
+	int present = iPtr->freeProc == TestsaveresultFree;
 	int called = freeCount;
 
 	Tcl_AppendElement(interp, called ? "called" : "notCalled");
@@ -5140,201 +5198,6 @@ TestsaveresultFree(
 {
     freeCount++;
 }
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- *----------------------------------------------------------------------
- *
- * TeststatprocCmd  --
- *
- *	Implements the "testTclStatProc" cmd that is used to test the
- *	'TclStatInsertProc' & 'TclStatDeleteProc' C Apis.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TeststatprocCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
-{
-    TclStatProc_ *proc;
-    int retVal;
-
-    if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"",
-		argv[0], " option arg\"", 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_AppendResult(interp, "bad arg \"", argv[1], "\": "
-		"must be TclpStat, "
-		"TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
-	return TCL_ERROR;
-    }
-
-    if (strcmp(argv[1], "insert") == 0) {
-	if (proc == PretendTclpStat) {
-	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
-		   "must be "
-		   "TestStatProc1, TestStatProc2, or TestStatProc3", 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", NULL);
-	return TCL_ERROR;
-    }
-
-    if (retVal == TCL_ERROR) {
-	Tcl_AppendResult(interp, "\"", argv[2], "\": "
-		"could not be ", argv[1], "ed", NULL);
-    }
-
-    return retVal;
-}
-
-static int
-PretendTclpStat(
-    const char *path,
-    struct stat *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_STRUCT_STAT_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_STRUCT_STAT_ST_BLKSIZE
-	buf->st_blksize = realBuf.st_blksize;
-#   endif
-#   ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-	buf->st_blocks  = (blkcnt_t) realBuf.st_blocks;
-#   endif
-    }
-    return ret;
-#endif /* TCL_WIDE_INT_IS_LONG */
-}
-
-static int
-TestStatProc1(
-    const char *path,
-    struct stat *buf)
-{
-    memset(buf, 0, sizeof(struct stat));
-    buf->st_size = 1234;
-    return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestStatProc2(
-    const char *path,
-    struct stat *buf)
-{
-    memset(buf, 0, sizeof(struct stat));
-    buf->st_size = 2345;
-    return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestStatProc3(
-    const char *path,
-    struct stat *buf)
-{
-    memset(buf, 0, sizeof(struct stat));
-    buf->st_size = 3456;
-    return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
-}
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -5360,14 +5223,15 @@ TestmainthreadCmd(
     int argc,			/* Number of arguments. */
     const char **argv)		/* Argument strings. */
 {
-  if (argc == 1) {
-      Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
-      Tcl_SetObjResult(interp, idObj);
-      return TCL_OK;
-  } else {
-      Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
-      return TCL_ERROR;
-  }
+    if (argc == 1) {
+	Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
+
+	Tcl_SetObjResult(interp, idObj);
+	return TCL_OK;
+    } else {
+	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	return TCL_ERROR;
+    }
 }
 
 /*
@@ -5378,7 +5242,7 @@ TestmainthreadCmd(
  *	A main loop set by TestsetmainloopCmd below.
  *
  * Results:
- * 	None.
+ *	None.
  *
  * Side effects:
  *	Event handlers could do anything.
@@ -5452,309 +5316,6 @@ TestexitmainloopCmd(
   exitMainLoop = 1;
   return TCL_OK;
 }
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- *----------------------------------------------------------------------
- *
- * 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(
-    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\"", 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", 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"
-		   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", NULL);
-	return TCL_ERROR;
-    }
-
-    if (retVal == TCL_ERROR) {
-	Tcl_AppendResult(interp, "\"", argv[2], "\": "
-		"could not be ", argv[1], "ed", NULL);
-    }
-
-    return retVal;
-}
-
-static int
-PretendTclpAccess(
-    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(
-    const char *path,
-    int mode)
-{
-    return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestAccessProc2(
-    const char *path,
-    int mode)
-{
-    return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestAccessProc3(
-    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(
-    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\"", 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", 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", 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", NULL);
-	return TCL_ERROR;
-    }
-
-    if (retVal == TCL_ERROR) {
-	Tcl_AppendResult(interp, "\"", argv[2], "\": "
-		"could not be ", argv[1], "ed", NULL);
-    }
-
-    return retVal;
-}
-
-static Tcl_Channel
-PretendTclpOpenFileChannel(
-    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
-				 * NULL. */
-    const char *fileName,	/* Name of file to open. */
-    const char *modeString,	/* A list of POSIX open modes or
-				 * a string such as "rw". */
-    int permissions)		/* If the open involves creating a file, with
-				 * what modes to create it? */
-{
-    Tcl_Channel ret;
-    int mode, seekFlag;
-    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 != NULL) {
-		    Tcl_AppendResult(interp,
-			    "could not seek to end of file while opening \"",
-			    fileName, "\": ", Tcl_PosixError(interp), NULL);
-		}
-		Tcl_Close(NULL, ret);
-		return NULL;
-	    }
-	}
-    }
-    return ret;
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc1(
-    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
-				 * NULL. */
-    const char *fileName,	/* Name of file to open. */
-    const char *modeString,	/* A list of POSIX open modes or
-				 * a string such as "rw". */
-    int permissions)		/* If the open involves creating a file, with
-				 * what modes to create it? */
-{
-    const char *expectname = "testOpenFileChannel1%.fil";
-    Tcl_DString ds;
-
-    Tcl_DStringInit(&ds);
-    Tcl_JoinPath(1, &expectname, &ds);
-
-    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
-	Tcl_DStringFree(&ds);
-	return (PretendTclpOpenFileChannel(interp,
-		"__testOpenFileChannel1%__.fil",
-		modeString, permissions));
-    } else {
-	Tcl_DStringFree(&ds);
-	return NULL;
-    }
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc2(
-    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
-				 * NULL. */
-    const char *fileName,	/* Name of file to open. */
-    const char *modeString,	/* A list of POSIX open modes or
-				 * a string such as "rw". */
-    int permissions)		/* If the open involves creating a file, with
-				 * what modes to create it? */
-{
-    const char *expectname = "testOpenFileChannel2%.fil";
-    Tcl_DString ds;
-
-    Tcl_DStringInit(&ds);
-    Tcl_JoinPath(1, &expectname, &ds);
-
-    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
-	Tcl_DStringFree(&ds);
-	return (PretendTclpOpenFileChannel(interp,
-		"__testOpenFileChannel2%__.fil",
-		modeString, permissions));
-    } else {
-	Tcl_DStringFree(&ds);
-	return (NULL);
-    }
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc3(
-    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
-				 * NULL. */
-    const char *fileName,	/* Name of file to open. */
-    const char *modeString,	/* A list of POSIX open modes or a string such
-				 * as "rw". */
-    int permissions)		/* If the open involves creating a file, with
-				 * what modes to create it? */
-{
-    const char *expectname = "testOpenFileChannel3%.fil";
-    Tcl_DString ds;
-
-    Tcl_DStringInit(&ds);
-    Tcl_JoinPath(1, &expectname, &ds);
-
-    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
-	Tcl_DStringFree(&ds);
-	return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
-		modeString, permissions));
-    } else {
-	Tcl_DStringFree(&ds);
-	return (NULL);
-    }
-}
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -5820,7 +5381,7 @@ TestChannelCmd(
 		    *nextPtrPtr = curPtr->nextPtr;
 		    curPtr->nextPtr = NULL;
 		    chan = curPtr->chan;
-		    ckfree((char *) curPtr);
+		    ckfree(curPtr);
 		    break;
 		}
 	    }
@@ -5890,7 +5451,7 @@ TestChannelCmd(
 
 	/* Remember the channel in the pool of detached channels */
 
-	det = (TestChannel *) ckalloc(sizeof(TestChannel));
+	det = ckalloc(sizeof(TestChannel));
 	det->chan     = chan;
 	det->nextPtr  = firstDetached;
 	firstDetached = det;
@@ -6060,7 +5621,7 @@ TestChannelCmd(
 	    return TCL_ERROR;
 	}
 
-	TclFormatInt(buf, (long)(size_t)Tcl_GetChannelThread(chan));
+	TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
 	Tcl_AppendResult(interp, buf, NULL);
 	return TCL_OK;
     }
@@ -6288,8 +5849,7 @@ TestChannelEventCmd(
 	    return TCL_ERROR;
 	}
 
-	esPtr = (EventScriptRecord *) ckalloc((unsigned)
-		sizeof(EventScriptRecord));
+	esPtr = ckalloc(sizeof(EventScriptRecord));
 	esPtr->nextPtr = statePtr->scriptRecordPtr;
 	statePtr->scriptRecordPtr = esPtr;
 
@@ -6346,7 +5906,7 @@ TestChannelEventCmd(
 	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
 		TclChannelEventScriptInvoker, (ClientData) esPtr);
 	Tcl_DecrRefCount(esPtr->scriptPtr);
-	ckfree((char *) esPtr);
+	ckfree(esPtr);
 
 	return TCL_OK;
     }
@@ -6387,7 +5947,7 @@ TestChannelEventCmd(
 	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
 		    TclChannelEventScriptInvoker, (ClientData) esPtr);
 	    Tcl_DecrRefCount(esPtr->scriptPtr);
-	    ckfree((char *) esPtr);
+	    ckfree(esPtr);
 	}
 	statePtr->scriptRecordPtr = NULL;
 	return TCL_OK;
@@ -6463,7 +6023,7 @@ TestWrongNumArgsObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int i, length;
-    char *msg;
+    const char *msg;
 
     if (objc < 3) {
 	/*
@@ -6518,7 +6078,7 @@ TestGetIndexFromObjStructObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    const char *ary[] = {
+    const char *const ary[] = {
 	"a", "b", "c", "d", "e", "f", NULL, NULL
     };
     int idx,target;
@@ -6573,7 +6133,7 @@ TestFilesystemObjCmd(
     Tcl_Obj *const objv[])
 {
     int res, boolVal;
-    char *msg;
+    const char *msg;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
@@ -6589,7 +6149,7 @@ TestFilesystemObjCmd(
 	res = Tcl_FSUnregister(&testReportingFilesystem);
 	msg = (res == TCL_OK) ? "unregistered" : "failed";
     }
-    Tcl_SetResult(interp, msg, TCL_VOLATILE);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
     return res;
 }
 
@@ -6672,7 +6232,7 @@ TestReport(
 	 * API, but there you go. We should convert it to objects.
 	 */
 
-	Tcl_SavedResult savedResult;
+	Tcl_Obj *savedResult;
 	Tcl_DString ds;
 
 	Tcl_DStringInit(&ds);
@@ -6686,11 +6246,15 @@ TestReport(
 	    Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
 	}
 	Tcl_DStringEndSublist(&ds);
-	Tcl_SaveResult(interp, &savedResult);
+	savedResult = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(savedResult);
+	Tcl_SetObjResult(interp, Tcl_NewObj());
 	Tcl_Eval(interp, Tcl_DStringValue(&ds));
 	Tcl_DStringFree(&ds);
-	Tcl_RestoreResult(interp, &savedResult);
-   }
+	Tcl_ResetResult(interp);
+	Tcl_SetObjResult(interp, savedResult);
+	Tcl_DecrRefCount(savedResult);
+    }
 }
 
 static int
@@ -6855,7 +6419,7 @@ TestReportRemoveDirectory(
 	    errorPtr);
 }
 
-static const char **
+static const char *const *
 TestReportFileAttrStrings(
     Tcl_Obj *fileName,
     Tcl_Obj **objPtrRef)
@@ -6945,7 +6509,7 @@ TestSimpleFilesystemObjCmd(
     Tcl_Obj *const objv[])
 {
     int res, boolVal;
-    char *msg;
+    const char *msg;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
@@ -6961,7 +6525,7 @@ TestSimpleFilesystemObjCmd(
 	res = Tcl_FSUnregister(&simpleFilesystem);
 	msg = (res == TCL_OK) ? "unregistered" : "failed";
     }
-    Tcl_SetResult(interp, msg, TCL_VOLATILE);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
     return res;
 }
 
@@ -7116,7 +6680,7 @@ TestNumUtfCharsCmd(
     return TCL_OK;
 }
 
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
 /*
  *----------------------------------------------------------------------
  *
@@ -7183,7 +6747,7 @@ TestHashSystemHashCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
-    static Tcl_HashKeyType hkType = {
+    static const Tcl_HashKeyType hkType = {
 	TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
 	NULL, NULL, NULL, NULL
     };
@@ -7204,14 +6768,14 @@ TestHashSystemHashCmd(
     }
 
     for (i=0 ; i<limit ; i++) {
-	hPtr = Tcl_CreateHashEntry(&hash, (char *) INT2PTR(i), &isNew);
+	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, (ClientData) INT2PTR(i+42));
+	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
     }
 
     if (hash.numEntries != limit) {
@@ -7264,7 +6828,6 @@ TestgetintCmd(
 	return TCL_ERROR;
     } else {
 	int val, i, total=0;
-	char buf[TCL_INTEGER_SPACE];
 
 	for (i=1 ; i<argc ; i++) {
 	    if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
@@ -7272,12 +6835,93 @@ TestgetintCmd(
 	    }
 	    total += val;
 	}
-	TclFormatInt(buf, total);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
 	return TCL_OK;
     }
 }
 
+static int
+NREUnwind_callback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    int none;
+
+    if (data[0] == INT2PTR(-1)) {
+        Tcl_NRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1),
+                INT2PTR(-1), NULL);
+    } else if (data[1] == INT2PTR(-1)) {
+        Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
+                INT2PTR(-1), NULL);
+    } else if (data[2] == INT2PTR(-1)) {
+        Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1],
+                &none, NULL);
+    } else {
+        Tcl_Obj *idata[3];
+        idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0]));
+        idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0]));
+        idata[2] = Tcl_NewIntObj((int) ((char *) &none   - (char *) data[0]));
+        Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
+    }
+    return TCL_OK;
+}
+
+static int
+TestNREUnwind(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    /*
+     * Insure that callbacks effectively run at the proper level during the
+     * unwinding of the NRE stack.
+     */
+
+    Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
+            INT2PTR(-1), NULL);
+    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;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -7321,14 +6965,14 @@ TestconcatobjCmd(
     list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
     Tcl_ListObjLength(NULL, list1Ptr, &len);
     if (list1Ptr->bytes != NULL) {
-	ckfree((char *) list1Ptr->bytes);
+	ckfree(list1Ptr->bytes);
 	list1Ptr->bytes = NULL;
     }
 
     list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
     Tcl_ListObjLength(NULL, list2Ptr, &len);
     if (list2Ptr->bytes != NULL) {
-	ckfree((char *) list2Ptr->bytes);
+	ckfree(list2Ptr->bytes);
 	list2Ptr->bytes = NULL;
     }
 
@@ -7583,6 +7227,306 @@ TestconcatobjCmd(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * 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 *callerNsPtr = varFramePtr->nsPtr;
+    Tcl_Command resolvedCmdPtr = NULL;
+
+    /*
+     * Just do something special on a cmd literal "z" in two cases:
+     *  A)  when the caller is a proc "x", and the proc is either in "::" or in "::ns2".
+     *  B) the caller's namespace is "ctx1" or "ctx2"
+     */
+    if ( (name[0] == 'z') && (name[1] == '\0') ) {
+        Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0);
+
+        if (procPtr != NULL
+            && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr)
+                || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr)
+                )
+            ) {
+            /*
+             * Case A)
+             *
+             *    - The context, in which this resolver becomes active, is
+             *      determined by the name of the caller proc, which has to be
+             *      named "x".
+             *
+             *    - To determine the name of the caller proc, the proc is taken
+             *      from the topmost stack frame.
+             *
+             *    - Note that the context is NOT provided during byte-code
+             *      compilation (e.g. in TclProcCompileProc)
+             *
+             *   When these conditions hold, this function resolves the
+             *   passed-in cmd literal into a cmd "y", which is taken from the
+             *   the global namespace (for simplicity).
+             */
+
+            const char *callingCmdName =
+                Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);
+
+            if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) {
+                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
+            }
+        } else if (callerNsPtr != NULL) {
+            /*
+             * Case B)
+             *
+             *    - The context, in which this resolver becomes active, is
+             *      determined by the name of the parent namespace, which has
+             *      to be named "ctx1" or "ctx2".
+             *
+             *    - To determine the name of the parent namesace, it is taken
+             *      from the 2nd highest stack frame.
+             *
+             *    - Note that the context can be provided during byte-code
+             *      compilation (e.g. in TclProcCompileProc)
+             *
+             *   When these conditions hold, this function resolves the
+             *   passed-in cmd literal into a cmd "y" or "Y" depending on the
+             *   context. The resolved procs are taken from the the global
+             *   namespace (for simplicity).
+             */
+
+            CallFrame *parentFramePtr = varFramePtr->callerPtr;
+            char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";
+
+            if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
+                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
+                /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/
+
+            } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
+                resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY);
+                /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/
+            }
+        }
+
+        if (resolvedCmdPtr != NULL) {
+            *rPtr = resolvedCmdPtr;
+            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) || (objc > 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?");
+	return TCL_ERROR;
+    }
+    if (objc == 3) {
+	interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
+	if (interp == NULL) {
+	    Tcl_AppendResult(interp, "provided interpreter not found", NULL);
+	    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
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 4226d51..f7d2bae 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -14,27 +14,22 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
 #include "tommath.h"
+#include "tclStringRep.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:
  */
 
-static int		CheckIfVarUnset(Tcl_Interp *interp, int varIndex);
+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(int varIndex, Tcl_Obj *objPtr);
-int			TclObjTest_Init(Tcl_Interp *interp);
+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,
@@ -52,13 +47,27 @@ 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[]);
+
+#define VARPTR_KEY "TCLOBJTEST_VARPTR"
+#define NUMBER_OF_OBJECT_VARS 20
 
-typedef struct TestString {
-    int numChars;
-    size_t allocated;
-    size_t uallocated;
-    Tcl_UniChar unicode[2];
-} TestString;
+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);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -83,26 +92,37 @@ TclObjTest_Init(
     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,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
-	    (ClientData) 0, NULL);
-    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL);
+	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
-	    (ClientData) 0, NULL);
+	    NULL, NULL);
     return TCL_OK;
 }
 
@@ -131,20 +151,20 @@ TestbignumobjCmd(
     int objc,			/* Argument count */
     Tcl_Obj *const objv[])	/* Argument vector */
 {
-    const char * subcmds[] = {
+    const char *const subcmds[] = {
 	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
     };
     enum options {
 	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
 	BIGNUM_RADIXSIZE
     };
-
     int index, varIndex;
-    char* string;
+    const char *string;
     mp_int bignumValue, newValue;
+    Tcl_Obj **varPtr;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?...");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
@@ -155,6 +175,7 @@ TestbignumobjCmd(
     if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
+    varPtr = GetVarPtr(interp);
 
     switch (index) {
     case BIGNUM_SET:
@@ -186,7 +207,7 @@ TestbignumobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
 	}
 	break;
 
@@ -195,7 +216,7 @@ TestbignumobjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	break;
@@ -205,7 +226,7 @@ TestbignumobjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -224,7 +245,7 @@ TestbignumobjCmd(
 	if (!Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
 	}
 	break;
 
@@ -233,7 +254,7 @@ TestbignumobjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -252,7 +273,7 @@ TestbignumobjCmd(
 	if (!Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
 	}
 	break;
 
@@ -261,7 +282,7 @@ TestbignumobjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -271,7 +292,7 @@ TestbignumobjCmd(
 	if (!Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetIntObj(varPtr[varIndex], mp_iseven(&bignumValue));
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewIntObj(mp_iseven(&bignumValue)));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iseven(&bignumValue)));
 	}
 	mp_clear(&bignumValue);
 	break;
@@ -281,7 +302,7 @@ TestbignumobjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
@@ -294,7 +315,7 @@ TestbignumobjCmd(
 	if (!Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetIntObj(varPtr[varIndex], index);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewIntObj(index));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(index));
 	}
 	mp_clear(&bignumValue);
 	break;
@@ -330,7 +351,8 @@ TestbooleanobjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int varIndex, boolValue;
-    char *index, *subCmd;
+    const char *index, *subCmd;
+    Tcl_Obj **varPtr;
 
     if (objc < 3) {
 	wrongNumArgs:
@@ -343,6 +365,8 @@ TestbooleanobjCmd(
 	return TCL_ERROR;
     }
 
+    varPtr = GetVarPtr(interp);
+
     subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "set") == 0) {
 	if (objc != 4) {
@@ -363,14 +387,14 @@ TestbooleanobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
+	    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, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -378,7 +402,7 @@ TestbooleanobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
@@ -388,7 +412,7 @@ TestbooleanobjCmd(
 	if (!Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
@@ -428,7 +452,8 @@ TestdoubleobjCmd(
 {
     int varIndex;
     double doubleValue;
-    char *index, *subCmd, *string;
+    const char *index, *subCmd, *string;
+    Tcl_Obj **varPtr;
 
     if (objc < 3) {
 	wrongNumArgs:
@@ -436,6 +461,8 @@ TestdoubleobjCmd(
 	return TCL_ERROR;
     }
 
+    varPtr = GetVarPtr(interp);
+
     index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
@@ -462,14 +489,14 @@ TestdoubleobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "get") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -477,7 +504,7 @@ TestdoubleobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
@@ -485,26 +512,26 @@ 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(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
+	    SetVarToObj(varPtr, 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, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,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(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
@@ -543,14 +570,14 @@ TestindexobjCmd(
 {
     int allowAbbrev, index, index2, setError, i, result;
     const char **argv;
-    static const char *tablePtr[] = {"a", "b", "check", NULL};
+    static const char *const tablePtr[] = {"a", "b", "check", 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;
 
@@ -567,7 +594,7 @@ TestindexobjCmd(
 	}
 
 	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
-	indexRep = (struct IndexRep *) objv[1]->internalRep.twoPtrValue.ptr1;
+	indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
 	indexRep->index = index2;
 	result = Tcl_GetIndexFromObj(NULL, objv[1],
 		tablePtr, "token", 0, &index);
@@ -589,7 +616,7 @@ TestindexobjCmd(
 	return TCL_ERROR;
     }
 
-    argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
+    argv = ckalloc((objc-3) * sizeof(char *));
     for (i = 4; i < objc; i++) {
 	argv[i-4] = Tcl_GetString(objv[i]);
     }
@@ -602,18 +629,17 @@ TestindexobjCmd(
      * object, clear out the object's cached state.
      */
 
-    if ( objv[3]->typePtr != NULL
-	 && !strcmp( "index", objv[3]->typePtr->name ) ) {
-	indexRep = (struct IndexRep *) objv[3]->internalRep.twoPtrValue.ptr1;
-	if (indexRep->tablePtr == (VOID *) argv) {
-	    objv[3]->typePtr->freeIntRepProc(objv[3]);
-	    objv[3]->typePtr = NULL;
+    if (objv[3]->typePtr != NULL
+	    && !strcmp("index", objv[3]->typePtr->name)) {
+	indexRep = objv[3]->internalRep.twoPtrValue.ptr1;
+	if (indexRep->tablePtr == (void *) argv) {
+	    TclFreeIntRep(objv[3]);
 	}
     }
 
     result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
 	    argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
-    ckfree((char *) argv);
+    ckfree(argv);
     if (result == TCL_OK) {
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
     }
@@ -647,7 +673,8 @@ TestintobjCmd(
 {
     int intValue, varIndex, i;
     long longValue;
-    char *index, *subCmd, *string;
+    const char *index, *subCmd, *string;
+    Tcl_Obj **varPtr;
 
     if (objc < 3) {
 	wrongNumArgs:
@@ -655,6 +682,7 @@ TestintobjCmd(
 	return TCL_ERROR;
     }
 
+    varPtr = GetVarPtr(interp);
     index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
@@ -682,7 +710,7 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetIntObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
@@ -697,7 +725,7 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetIntObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
 	}
     } else if (strcmp(subCmd, "setlong") == 0) {
 	if (objc != 4) {
@@ -711,7 +739,7 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetLongObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "setmaxlong") == 0) {
@@ -722,25 +750,25 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
 	}
     } else if (strcmp(subCmd, "ismaxlong") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,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, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -748,7 +776,7 @@ TestintobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	string = Tcl_GetString(varPtr[varIndex]);
@@ -770,7 +798,7 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
 	}
 	if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -783,34 +811,34 @@ TestintobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,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(varIndex, Tcl_NewIntObj( (intValue * 10) ));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "div10") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,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(varIndex, Tcl_NewIntObj( (intValue / 10) ));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
@@ -864,11 +892,13 @@ TestlistobjCmd(
     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;
@@ -882,7 +912,7 @@ TestlistobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
 	} else {
-	    SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
 	break;
@@ -892,7 +922,7 @@ TestlistobjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -909,7 +939,7 @@ TestlistobjCmd(
 	    return TCL_ERROR;
 	}
 	if (Tcl_IsShared(varPtr[varIndex])) {
-	    SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	    SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	}
 	Tcl_ResetResult(interp);
 	return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
@@ -943,8 +973,9 @@ TestobjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int varIndex, destIndex, i;
-    char *index, *subCmd, *string;
-    Tcl_ObjType *targetType;
+    const char *index, *subCmd, *string;
+    const Tcl_ObjType *targetType;
+    Tcl_Obj **varPtr;
 
     if (objc < 2) {
 	wrongNumArgs:
@@ -952,23 +983,24 @@ TestobjCmd(
 	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, varIndex)) {
+	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)) {
 	    return TCL_ERROR;
 	}
 	string = Tcl_GetString(objv[3]);
-        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
-            return TCL_ERROR;
-        }
-        SetVarToObj(destIndex, varPtr[varIndex]);
+	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
 	Tcl_SetObjResult(interp, varPtr[destIndex]);
     } else if (strcmp(subCmd, "bug3598580") == 0) {
 	Tcl_Obj *listObjPtr, *elemObjPtr;
@@ -981,90 +1013,91 @@ TestobjCmd(
 	Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
 	Tcl_SetObjResult(interp, listObjPtr);
 	return TCL_OK;
-     } 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) {
+    } 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)) {
+	    return TCL_ERROR;
+	}
+	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;
-        }
+	    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, varIndex)) {
+	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)) {
 	    return TCL_ERROR;
 	}
 	string = Tcl_GetString(objv[3]);
-        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
-            return TCL_ERROR;
-        }
-        SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	SetVarToObj(varPtr, 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;
 	}
-	index = Tcl_GetString( objv[2] );
-	if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
+	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) {
 	    return TCL_ERROR;
 	}
-        if (CheckIfVarUnset(interp, varIndex)) {
+	if (CheckIfVarUnset(interp, varPtr,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(varIndex, Tcl_NewObj());
+	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());
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "objtype") == 0) {
 	const 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 {
@@ -1072,41 +1105,38 @@ TestobjCmd(
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
 	}
     } else if (strcmp(subCmd, "refcount") == 0) {
-	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)) {
+	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)) {
 	    return TCL_ERROR;
 	}
-	TclFormatInt(buf, varPtr[varIndex]->refCount);
-        Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
     } 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, varIndex)) {
+	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)) {
 	    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;
@@ -1146,14 +1176,15 @@ TeststringobjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int varIndex, option, i, length;
     Tcl_UniChar *unicode;
+    int varIndex, option, i, length;
 #define MAX_STRINGS 11
-    char *index, *string, *strings[MAX_STRINGS+1];
-    TestString *strPtr;
-    static const char *options[] = {
+    const char *index, *string, *strings[MAX_STRINGS+1];
+    String *strPtr;
+    Tcl_Obj **varPtr;
+    static const char *const options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
-	"set", "set2", "setlength", "ualloc", "getunicode",
+	"set", "set2", "setlength", "maxchars", "getunicode",
 	"appendself", "appendself2", NULL
     };
 
@@ -1163,6 +1194,7 @@ TeststringobjCmd(
 	return TCL_ERROR;
     }
 
+    varPtr = GetVarPtr(interp);
     index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
@@ -1181,7 +1213,7 @@ TeststringobjCmd(
 		return TCL_ERROR;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varIndex, Tcl_NewObj());
+		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
 	    }
 
 	    /*
@@ -1190,7 +1222,7 @@ TeststringobjCmd(
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
-		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 	    string = Tcl_GetString(objv[3]);
 	    Tcl_AppendToObj(varPtr[varIndex], string, length);
@@ -1201,7 +1233,7 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varIndex, Tcl_NewObj());
+		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
 	    }
 
 	    /*
@@ -1210,7 +1242,7 @@ TeststringobjCmd(
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
-		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 	    for (i = 3;  i < objc;  i++) {
 		strings[i-3] = Tcl_GetString(objv[i]);
@@ -1228,7 +1260,7 @@ TeststringobjCmd(
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
-	    if (CheckIfVarUnset(interp, varIndex)) {
+	    if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 		return TCL_ERROR;
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -1237,7 +1269,7 @@ TeststringobjCmd(
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
-	    if (CheckIfVarUnset(interp, varIndex)) {
+	    if (CheckIfVarUnset(interp, varPtr, varIndex)) {
 		return TCL_ERROR;
 	    }
 	    string = Tcl_GetString(varPtr[varIndex]);
@@ -1255,8 +1287,9 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] != NULL) {
-		strPtr = (TestString *)
-		    (varPtr[varIndex])->internalRep.twoPtrValue.ptr1;
+		Tcl_ConvertToType(NULL, varPtr[varIndex],
+			Tcl_GetObjType("string"));
+		strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
 		length = (int) strPtr->allocated;
 	    } else {
 		length = -1;
@@ -1282,7 +1315,7 @@ TeststringobjCmd(
 		    && !Tcl_IsShared(varPtr[varIndex])) {
 		Tcl_SetStringObj(varPtr[varIndex], string, length);
 	    } else {
-		SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
+		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
@@ -1290,7 +1323,7 @@ TeststringobjCmd(
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
-	    SetVarToObj(varIndex, objv[3]);
+	    SetVarToObj(varPtr, varIndex, objv[3]);
 	    break;
 	case 8:				/* setlength */
 	    if (objc != 4) {
@@ -1303,14 +1336,15 @@ TeststringobjCmd(
 		Tcl_SetObjLength(varPtr[varIndex], length);
 	    }
 	    break;
-	case 9:				/* ualloc */
+	case 9:				/* maxchars */
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] != NULL) {
-		strPtr = (TestString *)
-		    (varPtr[varIndex])->internalRep.twoPtrValue.ptr1;
-		length = (int) strPtr->uallocated;
+		Tcl_ConvertToType(NULL, varPtr[varIndex],
+			Tcl_GetObjType("string"));
+		strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+		length = strPtr->maxChars;
 	    } else {
 		length = -1;
 	    }
@@ -1327,7 +1361,7 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varIndex, Tcl_NewObj());
+		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
 	    }
 
 	    /*
@@ -1336,7 +1370,7 @@ TeststringobjCmd(
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
-		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 
 	    string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
@@ -1358,7 +1392,7 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varIndex, Tcl_NewObj());
+		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
 	    }
 
 	    /*
@@ -1367,7 +1401,7 @@ TeststringobjCmd(
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
-		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 
 	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
@@ -1410,6 +1444,7 @@ TeststringobjCmd(
 
 static void
 SetVarToObj(
+    Tcl_Obj **varPtr,
     int varIndex,		/* Designates the assignment variable. */
     Tcl_Obj *objPtr)		/* Points to object to assign to var. */
 {
@@ -1482,6 +1517,7 @@ GetVariableIndex(
 static int
 CheckIfVarUnset(
     Tcl_Interp *interp,		/* Interpreter for error reporting. */
+    Tcl_Obj ** varPtr,
     int varIndex)		/* Index of the test variable to check. */
 {
     if (varPtr[varIndex] == NULL) {
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 644179b..4d32c5a 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -11,6 +11,9 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
 
 /*
@@ -31,9 +34,8 @@ static const char procCommand[] = "proc";
  * 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;
@@ -43,24 +45,22 @@ typedef struct CmdTable
  */
 
 static int	ProcBodyTestProcObjCmd(ClientData dummy,
-			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
 static int	ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
 static int	RegisterCommand(Tcl_Interp* interp,
 			const char *namespace, const CmdTable *cmdTablePtr);
-int             Procbodytest_Init(Tcl_Interp * interp);
-int             Procbodytest_SafeInit(Tcl_Interp * interp);
 
 /*
  * List of commands to create when the package is loaded; must go after the
  * declarations of the enable command procedure.
  */
 
-static CONST CmdTable commands[] = {
+static const CmdTable commands[] = {
     { procCommand,	ProcBodyTestProcObjCmd,	1 },
     { 0, 0, 0 }
 };
 
-static CONST CmdTable safeCommands[] = {
+static const CmdTable safeCommands[] = {
     { procCommand,	ProcBodyTestProcObjCmd,	1 },
     { 0, 0, 0 }
 };
@@ -70,13 +70,13 @@ static CONST CmdTable safeCommands[] = {
  *
  * Procbodytest_Init --
  *
- *  This function initializes the "procbodytest" package.
+ *	This function initializes the "procbodytest" package.
  *
  * Results:
- *  A standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *  None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -84,7 +84,7 @@ static CONST CmdTable safeCommands[] = {
 int
 Procbodytest_Init(
     Tcl_Interp *interp)		/* the Tcl interpreter for which the package
-                                 * is initialized */
+				 * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 0);
 }
@@ -94,13 +94,13 @@ Procbodytest_Init(
  *
  * Procbodytest_SafeInit --
  *
- *  This function initializes the "procbodytest" package.
+ *	This function initializes the "procbodytest" package.
  *
  * Results:
- *  A standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *  None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -108,7 +108,7 @@ Procbodytest_Init(
 int
 Procbodytest_SafeInit(
     Tcl_Interp *interp)		/* the Tcl interpreter for which the package
-                                 * is initialized */
+				 * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 1);
 }
@@ -118,36 +118,38 @@ Procbodytest_SafeInit(
  *
  * RegisterCommand --
  *
- *  This function registers a command in the context of the given namespace.
+ *	This function registers a command in the context of the given
+ *	namespace.
  *
  * Results:
- *  A standard Tcl result.
+ *	A standard Tcl result.
  *
  * Side effects:
- *  None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-static int RegisterCommand(interp, namespace, cmdTablePtr)
-    Tcl_Interp* interp;		/* the Tcl interpreter for which the operation
+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
+    const char *namespace,		/* the namespace in which the command is
 				 * registered */
-    const CmdTable *cmdTablePtr;/* the command to register */
+    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_EvalEx(interp, buf, -1, 0) != TCL_OK) {
+	    return TCL_ERROR;
+	}
     }
 
     sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
     Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
-
     return TCL_OK;
 }
 
@@ -171,16 +173,16 @@ static int RegisterCommand(interp, namespace, cmdTablePtr)
 static int
 ProcBodyTestInitInternal(
     Tcl_Interp *interp,		/* the Tcl interpreter for which the package
-                                 * is initialized */
+				 * 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);
@@ -226,7 +228,7 @@ ProcBodyTestProcObjCmd(
     int objc,			/* argument count */
     Tcl_Obj *const objv[])	/* arguments */
 {
-    char *fullName;
+    const char *fullName;
     Tcl_Command procCmd;
     Command *cmdPtr;
     Proc *procPtr = NULL;
@@ -243,23 +245,23 @@ ProcBodyTestProcObjCmd(
      * Find the Command pointer to this procedure
      */
 
-    fullName = Tcl_GetStringFromObj(objv[3], NULL);
+    fullName = Tcl_GetString(objv[3]);
     procCmd = Tcl_FindCommand(interp, fullName, 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->objProc is TclObjInterpProc.
+     * If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
      */
 
-    if (cmdPtr->objProc != TclGetObjInterpProc()) {
-        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+    if (cmdPtr->objClientData != TclIsProc(cmdPtr)) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"command \"", fullName, "\" is not a Tcl procedure", NULL);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
@@ -268,10 +270,9 @@ ProcBodyTestProcObjCmd(
 
     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!", NULL);
+	return TCL_ERROR;
     }
 
     /*
@@ -280,10 +281,10 @@ ProcBodyTestProcObjCmd(
 
     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, "\"", NULL);
+	return TCL_ERROR;
     }
     Tcl_IncrRefCount(bodyObjPtr);
 
@@ -293,7 +294,7 @@ ProcBodyTestProcObjCmd(
     myobjv[3] = bodyObjPtr;
     myobjv[4] = NULL;
 
-    result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
+    result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
     Tcl_DecrRefCount(bodyObjPtr);
 
     return result;
diff --git a/generic/tclThread.c b/generic/tclThread.c
index d3cf4ba..198fa6a 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -5,6 +5,7 @@
  *	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.
@@ -82,21 +83,23 @@ Tcl_GetThreadData(
     /*
      * Initialize the key for this thread.
      */
-    result = TclpThreadDataKeyGet(keyPtr);
+
+    result = TclThreadStorageKeyGet(keyPtr);
 
     if (result == NULL) {
-	result = ckalloc((size_t) size);
+	result = ckalloc(size);
 	memset(result, 0, (size_t) size);
-	TclpThreadDataKeySet(keyPtr, result);
+	TclThreadStorageKeySet(keyPtr, result);
     }
 #else /* TCL_THREADS */
     if (*keyPtr == NULL) {
-	result = ckalloc((size_t) size);
-	memset(result, 0, (size_t) size);
-	*keyPtr = (Tcl_ThreadDataKey)result;
+	result = ckalloc(size);
+	memset(result, 0, (size_t)size);
+	*keyPtr = result;
 	RememberSyncObject(keyPtr, &keyRecord);
+    } else {
+	result = *keyPtr;
     }
-    result = * (void **) keyPtr;
 #endif /* TCL_THREADS */
     return result;
 }
@@ -120,17 +123,15 @@ Tcl_GetThreadData(
 
 void *
 TclThreadDataKeyGet(
-    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk, really
-				 * (pthread_key_t **) */
+    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk. */
+
 {
 #ifdef TCL_THREADS
-    return TclpThreadDataKeyGet(keyPtr);
+    return TclThreadStorageKeyGet(keyPtr);
 #else /* TCL_THREADS */
-    char *result = *(char **) keyPtr;
-    return result;
+    return *keyPtr;
 #endif /* TCL_THREADS */
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -178,14 +179,14 @@ RememberSyncObject(
 
     if (recPtr->num >= recPtr->max) {
 	recPtr->max += 8;
-	newList = (void **) ckalloc(recPtr->max * sizeof(char *));
+	newList = ckalloc(recPtr->max * sizeof(void *));
 	for (i=0,j=0 ; i<recPtr->num ; i++) {
 	    if (recPtr->list[i] != NULL) {
 		newList[j++] = recPtr->list[i];
 	    }
 	}
 	if (recPtr->list != NULL) {
-	    ckfree((char *) recPtr->list);
+	    ckfree(recPtr->list);
 	}
 	recPtr->list = newList;
 	recPtr->num = j;
@@ -352,11 +353,16 @@ Tcl_ConditionFinalize(
  */
 
 void
-TclFinalizeThreadData(void)
+TclFinalizeThreadData(int quick)
 {
-    TclpFinalizeThreadDataThread();
+    TclFinalizeThreadDataThread();
 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    TclFinalizeThreadAllocThread();
+    if (!quick) {
+	/*
+	 * Quick exit principle makes it useless to terminate allocators
+	 */
+	TclFinalizeThreadAllocThread();
+    }
 #endif
 }
 
@@ -398,15 +404,15 @@ TclFinalizeSynchronization(void)
     if (keyRecord.list != NULL) {
 	for (i=0 ; i<keyRecord.num ; i++) {
 	    keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
-	    blockPtr = (void *) *keyPtr;
+	    blockPtr = *keyPtr;
 	    ckfree(blockPtr);
 	}
-	ckfree((char *) keyRecord.list);
+	ckfree(keyRecord.list);
 	keyRecord.list = NULL;
     }
     keyRecord.max = 0;
     keyRecord.num = 0;
-    
+
 #ifdef TCL_THREADS
     /*
      * Call thread storage master cleanup.
@@ -421,7 +427,7 @@ TclFinalizeSynchronization(void)
 	}
     }
     if (mutexRecord.list != NULL) {
-	ckfree((char *) mutexRecord.list);
+	ckfree(mutexRecord.list);
 	mutexRecord.list = NULL;
     }
     mutexRecord.max = 0;
@@ -434,7 +440,7 @@ TclFinalizeSynchronization(void)
 	}
     }
     if (condRecord.list != NULL) {
-	ckfree((char *) condRecord.list);
+	ckfree(condRecord.list);
 	condRecord.list = NULL;
     }
     condRecord.max = 0;
@@ -497,7 +503,7 @@ void
 Tcl_ConditionWait(
     Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
     Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
-    Tcl_Time *timePtr)		/* Timeout on waiting period */
+    const Tcl_Time *timePtr) /* Timeout on waiting period */
 {
 }
 
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 106e908..2ee758e 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -35,7 +35,9 @@
  */
 
 #define NOBJALLOC	800
-#define NOBJHIGH	1200
+
+/* Actual definition moved to tclInt.h */
+#define NOBJHIGH	ALLOC_NOBJHIGH
 
 /*
  * The following union stores accounting information for each block including
@@ -82,6 +84,7 @@ typedef union Block {
 
 typedef struct Bucket {
     Block *firstPtr;		/* First block available */
+    Block *lastPtr;		/* End of block list */
     long numFree;		/* Number of blocks available */
 
     /* All fields below for accounting only */
@@ -95,7 +98,9 @@ typedef struct Bucket {
 
 /*
  * The following structure defines a cache of buckets and objs, of which there
- * will be (at most) one per thread.
+ * 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().
  */
 
 typedef struct Cache {
@@ -103,6 +108,7 @@ typedef struct Cache {
     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 */
+    Tcl_Obj *lastPtr;		/* Last object in this cache */
     int totalAssigned;		/* Total space assigned to thread */
     Bucket buckets[NBUCKETS];	/* The buckets for this thread */
 } Cache;
@@ -131,6 +137,7 @@ 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	PutObjs(Cache *fromPtr, int numMove);
 
 /*
  * Local variables defined in this file and initialized at startup.
@@ -141,6 +148,26 @@ 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
 
 /*
  *----------------------------------------------------------------------
@@ -193,10 +220,11 @@ GetCache(void)
 
     cachePtr = TclpGetAllocCache();
     if (cachePtr == NULL) {
-	cachePtr = calloc(1, sizeof(Cache));
+	cachePtr = TclpSysAlloc(sizeof(Cache), 0);
 	if (cachePtr == NULL) {
 	    Tcl_Panic("alloc: could not allocate new cache");
 	}
+        memset(cachePtr, 0, sizeof(Cache));
 	Tcl_MutexLock(listLockPtr);
 	cachePtr->nextPtr = firstCachePtr;
 	firstCachePtr = cachePtr;
@@ -246,9 +274,7 @@ TclFreeAllocCache(
      */
 
     if (cachePtr->numObjects > 0) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
-	Tcl_MutexUnlock(objLockPtr);
+	PutObjs(cachePtr, cachePtr->numObjects);
     }
 
     /*
@@ -263,7 +289,7 @@ TclFreeAllocCache(
     *nextPtrPtr = cachePtr->nextPtr;
     cachePtr->nextPtr = NULL;
     Tcl_MutexUnlock(listLockPtr);
-    free(cachePtr);
+    TclpSysFree(cachePtr);
 }
 
 /*
@@ -304,14 +330,11 @@ TclpAlloc(
     }
 #endif
 
-    cachePtr = TclpGetAllocCache();
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
+    GETCACHE(cachePtr);
 
     /*
      * Increment the requested size to include room for the Block structure.
-     * Call malloc() directly if the required amount is greater than the
+     * Call TclpSysAlloc() directly if the required amount is greater than the
      * largest block, otherwise pop the smallest block large enough,
      * allocating more blocks if necessary.
      */
@@ -319,24 +342,24 @@ TclpAlloc(
     blockPtr = NULL;
     size = reqSize + sizeof(Block);
 #if RCHECK
-    ++size;
+    size++;
 #endif
     if (size > MAXALLOC) {
 	bucket = NBUCKETS;
-	blockPtr = malloc(size);
+	blockPtr = TclpSysAlloc(size, 0);
 	if (blockPtr != NULL) {
 	    cachePtr->totalAssigned += reqSize;
 	}
     } else {
 	bucket = 0;
 	while (bucketInfo[bucket].blockSize < size) {
-	    ++bucket;
+	    bucket++;
 	}
 	if (cachePtr->buckets[bucket].numFree || 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].numFree--;
+	    cachePtr->buckets[bucket].numRemoves++;
 	    cachePtr->buckets[bucket].totalAssigned += reqSize;
 	}
     }
@@ -374,10 +397,7 @@ TclpFree(
 	return;
     }
 
-    cachePtr = TclpGetAllocCache();
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
+    GETCACHE(cachePtr);
 
     /*
      * Get the block back from the user pointer and call system free directly
@@ -389,15 +409,18 @@ TclpFree(
     bucket = blockPtr->sourceBucket;
     if (bucket == NBUCKETS) {
 	cachePtr->totalAssigned -= blockPtr->blockReqSize;
-	free(blockPtr);
+	TclpSysFree(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->buckets[bucket].numFree == 0) {
+	cachePtr->buckets[bucket].lastPtr = blockPtr;
+    }
+    cachePtr->buckets[bucket].numFree++;
+    cachePtr->buckets[bucket].numInserts++;
 
     if (cachePtr != sharedPtr &&
 	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
@@ -449,21 +472,18 @@ TclpRealloc(
     }
 #endif
 
-    cachePtr = TclpGetAllocCache();
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
+    GETCACHE(cachePtr);
 
     /*
      * 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.
+     * size would also require a system block, call TclpSysRealloc() directly.
      */
 
     blockPtr = Ptr2Block(ptr);
     size = reqSize + sizeof(Block);
 #if RCHECK
-    ++size;
+    size++;
 #endif
     bucket = blockPtr->sourceBucket;
     if (bucket != NBUCKETS) {
@@ -480,7 +500,7 @@ TclpRealloc(
     } else if (size > MAXALLOC) {
 	cachePtr->totalAssigned -= blockPtr->blockReqSize;
 	cachePtr->totalAssigned += reqSize;
-	blockPtr = realloc(blockPtr, size);
+	blockPtr = TclpSysRealloc(blockPtr, size);
 	if (blockPtr == NULL) {
 	    return NULL;
 	}
@@ -516,18 +536,20 @@ TclpRealloc(
  *	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
+ *
  *----------------------------------------------------------------------
  */
 
 Tcl_Obj *
 TclThreadAllocObj(void)
 {
-    register Cache *cachePtr = TclpGetAllocCache();
+    register Cache *cachePtr;
     register Tcl_Obj *objPtr;
 
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
+    GETCACHE(cachePtr);
 
     /*
      * Get this thread's obj list structure and move or allocate new objs if
@@ -550,15 +572,17 @@ TclThreadAllocObj(void)
 	    Tcl_Obj *newObjsPtr;
 
 	    cachePtr->numObjects = numMove = NOBJALLOC;
-	    newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
+	    newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
 	    if (newObjsPtr == NULL) {
 		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
 	    }
+	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
+	    objPtr = cachePtr->firstObjPtr;	/* NULL */
 	    while (--numMove >= 0) {
-		objPtr = &newObjsPtr[numMove];
-		objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
-		cachePtr->firstObjPtr = objPtr;
+		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
+		objPtr = newObjsPtr + numMove;
 	    }
+	    cachePtr->firstObjPtr = newObjsPtr;
 	}
     }
 
@@ -568,7 +592,7 @@ TclThreadAllocObj(void)
 
     objPtr = cachePtr->firstObjPtr;
     cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    --cachePtr->numObjects;
+    cachePtr->numObjects--;
     return objPtr;
 }
 
@@ -585,6 +609,10 @@ TclThreadAllocObj(void)
  * 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
+ *
  *----------------------------------------------------------------------
  */
 
@@ -592,11 +620,9 @@ void
 TclThreadFreeObj(
     Tcl_Obj *objPtr)
 {
-    Cache *cachePtr = TclpGetAllocCache();
+    Cache *cachePtr;
 
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
+    GETCACHE(cachePtr);
 
     /*
      * Get this thread's list and push on the free Tcl_Obj.
@@ -604,7 +630,10 @@ TclThreadFreeObj(
 
     objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
     cachePtr->firstObjPtr = objPtr;
-    ++cachePtr->numObjects;
+    if (cachePtr->numObjects == 0) {
+	cachePtr->lastPtr = objPtr;
+    }
+    cachePtr->numObjects++;
 
     /*
      * If the number of free objects has exceeded the high water mark, move
@@ -612,9 +641,7 @@ TclThreadFreeObj(
      */
 
     if (cachePtr->numObjects > NOBJHIGH) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
-	Tcl_MutexUnlock(objLockPtr);
+	PutObjs(cachePtr, NOBJALLOC);
     }
 }
 
@@ -712,13 +739,67 @@ MoveObjs(
      * just have to update the first and last.
      */
 
-    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
+    toPtr->lastPtr = objPtr;
+    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */
     toPtr->firstObjPtr = fromFirstObjPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * PutObjs --
+ *
+ *	Move Tcl_Obj's from thread cache to shared cache.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PutObjs(
+    Cache *fromPtr,
+    int numMove)
+{
+    int keep = fromPtr->numObjects - numMove;
+    Tcl_Obj *firstPtr, *lastPtr = NULL;
+
+    fromPtr->numObjects = keep;
+    firstPtr = fromPtr->firstObjPtr;
+    if (keep == 0) {
+	fromPtr->firstObjPtr = NULL;
+    } else {
+	do {
+	    lastPtr = firstPtr;
+	    firstPtr = firstPtr->internalRep.twoPtrValue.ptr1;
+	} while (--keep > 0);
+	lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
+    }
+
+    /*
+     * Move all objects as a block - they are already linked to each other, we
+     * just have to update the first and last.
+     */
+
+    Tcl_MutexLock(objLockPtr);
+    fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr;
+    sharedPtr->firstObjPtr = firstPtr;
+    if (sharedPtr->numObjects == 0) {
+	sharedPtr->lastPtr = fromPtr->lastPtr;
+    }
+    sharedPtr->numObjects += numMove;
+    Tcl_MutexUnlock(objLockPtr);
+
+    fromPtr->lastPtr = lastPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Block2Ptr, Ptr2Block --
  *
  *	Convert between internal blocks and user pointers.
@@ -793,17 +874,9 @@ LockBucket(
     Cache *cachePtr,
     int bucket)
 {
-#if 0
-    if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
-	Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-	++cachePtr->buckets[bucket].numWaits;
-	++sharedPtr->buckets[bucket].numWaits;
-    }
-#else
     Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-#endif
-    ++cachePtr->buckets[bucket].numLocks;
-    ++sharedPtr->buckets[bucket].numLocks;
+    cachePtr->buckets[bucket].numLocks++;
+    sharedPtr->buckets[bucket].numLocks++;
 }
 
 static void
@@ -836,20 +909,25 @@ PutBlocks(
     int bucket,
     int numMove)
 {
-    register Block *lastPtr, *firstPtr;
-    register int n = numMove;
-
     /*
-     * Before acquiring the lock, walk the block list to find the last block
-     * to be moved.
+     * We have numFree.  Want to shed numMove. So compute how many
+     * Blocks to keep.
      */
 
-    firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
-    while (--n > 0) {
-	lastPtr = lastPtr->nextBlock;
+    int keep = cachePtr->buckets[bucket].numFree - numMove;
+    Block *lastPtr = NULL, *firstPtr;
+
+    cachePtr->buckets[bucket].numFree = keep;
+    firstPtr = cachePtr->buckets[bucket].firstPtr;
+    if (keep == 0) {
+	cachePtr->buckets[bucket].firstPtr = NULL;
+    } else {
+	do {
+	    lastPtr = firstPtr;
+	    firstPtr = firstPtr->nextBlock;
+	} while (--keep > 0);
+	lastPtr->nextBlock = NULL;
     }
-    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
-    cachePtr->buckets[bucket].numFree -= numMove;
 
     /*
      * Aquire the lock and place the list of blocks at the front of the shared
@@ -857,10 +935,17 @@ PutBlocks(
      */
 
     LockBucket(cachePtr, bucket);
-    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
+    cachePtr->buckets[bucket].lastPtr->nextBlock
+	    = sharedPtr->buckets[bucket].firstPtr;
     sharedPtr->buckets[bucket].firstPtr = firstPtr;
+    if (sharedPtr->buckets[bucket].numFree == 0) {
+	sharedPtr->buckets[bucket].lastPtr
+		= cachePtr->buckets[bucket].lastPtr;
+    }
     sharedPtr->buckets[bucket].numFree += numMove;
     UnlockBucket(cachePtr, bucket);
+
+    cachePtr->buckets[bucket].lastPtr = lastPtr;
 }
 
 /*
@@ -907,6 +992,8 @@ GetBlocks(
 	    if (n >= sharedPtr->buckets[bucket].numFree) {
 		cachePtr->buckets[bucket].firstPtr =
 			sharedPtr->buckets[bucket].firstPtr;
+		cachePtr->buckets[bucket].lastPtr =
+			sharedPtr->buckets[bucket].lastPtr;
 		cachePtr->buckets[bucket].numFree =
 			sharedPtr->buckets[bucket].numFree;
 		sharedPtr->buckets[bucket].firstPtr = NULL;
@@ -920,6 +1007,7 @@ GetBlocks(
 		    blockPtr = blockPtr->nextBlock;
 		}
 		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
+		cachePtr->buckets[bucket].lastPtr = blockPtr;
 		blockPtr->nextBlock = NULL;
 	    }
 	}
@@ -942,7 +1030,7 @@ GetBlocks(
 		size = bucketInfo[n].blockSize;
 		blockPtr = cachePtr->buckets[n].firstPtr;
 		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
-		--cachePtr->buckets[n].numFree;
+		cachePtr->buckets[n].numFree--;
 		break;
 	    }
 	}
@@ -953,7 +1041,7 @@ GetBlocks(
 
 	if (blockPtr == NULL) {
 	    size = MAXALLOC;
-	    blockPtr = malloc(size);
+	    blockPtr = TclpSysAlloc(size, 0);
 	    if (blockPtr == NULL) {
 		return 0;
 	    }
@@ -971,6 +1059,7 @@ GetBlocks(
 		((char *) blockPtr + bucketInfo[bucket].blockSize);
 	    blockPtr = blockPtr->nextBlock;
 	}
+	cachePtr->buckets[bucket].lastPtr = blockPtr;
 	blockPtr->nextBlock = NULL;
     }
     return 1;
@@ -999,8 +1088,8 @@ TclFinalizeThreadAlloc(void)
     unsigned int i;
 
     for (i = 0; i < NBUCKETS; ++i) {
-        TclpFreeAllocMutex(bucketInfo[i].lockPtr);
-        bucketInfo[i].lockPtr = NULL;
+	TclpFreeAllocMutex(bucketInfo[i].lockPtr);
+	bucketInfo[i].lockPtr = NULL;
     }
 
     TclpFreeAllocMutex(objLockPtr);
@@ -1017,9 +1106,9 @@ TclFinalizeThreadAlloc(void)
  *
  * TclFinalizeThreadAllocThread --
  *
- *	This procedure is used to destroy single thread private resources used
- *	in this file. 
- * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *	This procedure is used to destroy single thread private resources
+ *	defined in this file. Called either during Tcl_FinalizeThread() or
+ *	Tcl_Finalize().
  *
  * Results:
  *	None.
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 3a905b5..5c70a62 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -14,7 +14,7 @@
 
 #include "tclInt.h"
 
-#ifdef WIN32
+#ifdef _WIN32
 
 /*
  * The information about each joinable thread is remembered in a structure as
@@ -52,7 +52,7 @@ typedef struct JoinableThread {
 
 TCL_DECLARE_MUTEX(joinMutex)
 
-static JoinableThread* firstThreadPtr;
+static JoinableThread *firstThreadPtr;
 
 /*
  *----------------------------------------------------------------------
@@ -201,7 +201,7 @@ TclJoinThread(
 
     Tcl_ConditionFinalize(&threadPtr->cond);
     Tcl_MutexFinalize(&threadPtr->threadMutex);
-    ckfree((char *) threadPtr);
+    ckfree(threadPtr);
 
     return TCL_OK;
 }
@@ -230,7 +230,7 @@ TclRememberJoinableThread(
 {
     JoinableThread *threadPtr;
 
-    threadPtr = (JoinableThread *) ckalloc(sizeof(JoinableThread));
+    threadPtr = ckalloc(sizeof(JoinableThread));
     threadPtr->id = id;
     threadPtr->done = 0;
     threadPtr->waitedUpon = 0;
@@ -305,7 +305,7 @@ TclSignalExitThread(
 
     Tcl_MutexUnlock(&threadPtr->threadMutex);
 }
-#endif /* WIN32 */
+#endif /* _WIN32 */
 
 /*
  * Local Variables:
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 1578b40..755a461 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -1,9 +1,11 @@
 /*
  * tclThreadStorage.c --
  *
- *	This file implements platform independent thread storage operations.
+ *	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.
@@ -11,145 +13,171 @@
 
 #include "tclInt.h"
 
-#if defined(TCL_THREADS)
+#ifdef TCL_THREADS
+#include <signal.h>
 
 /*
- * This is the thread storage cache array and it's accompanying mutex. The
- * elements are pairs of thread Id and an associated hash table pointer; the
- * hash table being pointed to contains the thread storage for it's associated
- * thread. The purpose of this cache is to minimize the number of hash table
- * lookups in the master thread storage hash table.
+ * 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.
  */
 
-static Tcl_Mutex threadStorageLock;
-
 /*
- * This is the struct used for a thread storage cache slot. It contains the
- * owning thread Id and the associated hash table pointer.
+ * The master collection of information about TSDs. This is shared across the
+ * whole process, and includes the mutex used to protect it.
  */
 
-typedef struct ThreadStorage {
-    Tcl_ThreadId id;		/* the owning thread id */
-    Tcl_HashTable *hashTablePtr;/* the hash table for the thread */
-} ThreadStorage;
+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 };
 
 /*
- * These are the prototypes for the custom hash table allocation functions
- * used by the thread storage subsystem.
+ * The type of the data held per thread in a system TSD.
  */
 
-static Tcl_HashEntry *	AllocThreadStorageEntry(Tcl_HashTable *tablePtr,
-			    void *keyPtr);
-static void		FreeThreadStorageEntry(Tcl_HashEntry *hPtr);
-static Tcl_HashTable *	ThreadStorageGetHashTable(Tcl_ThreadId id);
+typedef struct TSDTable {
+    ClientData *tablePtr;	/* The table of Tcl TSDs. */
+    sig_atomic_t allocated;	/* The size of the table in the current
+				 * thread. */
+} TSDTable;
 
 /*
- * This is the hash key type for thread storage. We MUST use this in
- * combination with the new hash key type flag TCL_HASH_KEY_SYSTEM_HASH
- * because these hash tables MAY be used by the threaded memory allocator.
+ * The actual type of Tcl_ThreadDataKey.
  */
 
-static Tcl_HashKeyType tclThreadStorageHashKeyType = {
-    TCL_HASH_KEY_TYPE_VERSION,		/* version */
-    TCL_HASH_KEY_SYSTEM_HASH | TCL_HASH_KEY_RANDOMIZE_HASH,
-				        /* flags */
-    NULL,				/* hashKeyProc */
-    NULL,				/* compareKeysProc */
-    AllocThreadStorageEntry,		/* allocEntryProc */
-    FreeThreadStorageEntry		/* freeEntryProc */
-};
+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;
 
 /*
- * This is an invalid thread value.
+ * Forward declarations of functions in this file.
  */
 
-#define STORAGE_INVALID_THREAD  (Tcl_ThreadId)0
-
-/*
- * This is the value for an invalid thread storage key.
- */
-
-#define STORAGE_INVALID_KEY	0
-
+static TSDTable *	TSDTableCreate(void);
+static void		TSDTableDelete(TSDTable *tsdTablePtr);
+static void		TSDTableGrow(TSDTable *tsdTablePtr,
+			    sig_atomic_t atLeast);
+
 /*
- * This is the first valid key for use by external callers. All the values
- * below this are RESERVED for future use.
+ * Allocator and deallocator for a TSDTable structure.
  */
 
-#define STORAGE_FIRST_KEY	1
+static TSDTable *
+TSDTableCreate(void)
+{
+    TSDTable *tsdTablePtr;
+    sig_atomic_t i;
 
-/*
- * This is the default number of thread storage cache slots. This define may
- * need to be fine tuned for maximum performance.
- */
+    tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0);
+    if (tsdTablePtr == NULL) {
+	Tcl_Panic("unable to allocate TSDTable");
+    }
 
-#define STORAGE_CACHE_SLOTS	97
+    tsdTablePtr->allocated = 8;
+    tsdTablePtr->tablePtr =
+	    TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
+    if (tsdTablePtr->tablePtr == NULL) {
+	Tcl_Panic("unable to allocate TSDTable");
+    }
 
-/*
- * This is the master thread storage hash table. It is keyed on thread Id and
- * contains values that are hash tables for each thread. The thread specific
- * hash tables contain the actual thread storage.
- */
+    for (i = 0; i < tsdTablePtr->allocated; ++i) {
+	tsdTablePtr->tablePtr[i] = NULL;
+    }
 
-static Tcl_HashTable threadStorageHashTable;
+    return tsdTablePtr;
+}
 
-/*
- * This is the next thread data key value to use. We increment this everytime
- * we "allocate" one. It is initially set to 1 in TclInitThreadStorage.
- */
+static void
+TSDTableDelete(
+    TSDTable *tsdTablePtr)
+{
+    sig_atomic_t i;
 
-static int nextThreadStorageKey = STORAGE_INVALID_KEY;
+    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.
+	     */
 
-/*
- * This is the master thread storage cache. Per Kevin Kenny's idea, this
- * prevents unnecessary lookups for threads that use a lot of thread storage.
- */
+	    ckfree(tsdTablePtr->tablePtr[i]);
+	}
+    }
 
-static volatile ThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];
+    TclpSysFree(tsdTablePtr->tablePtr);
+    TclpSysFree(tsdTablePtr);
+}
 
 /*
  *----------------------------------------------------------------------
  *
- * AllocThreadStorageEntry --
+ * TSDTableGrow --
  *
- *	Allocate space for a Tcl_HashEntry using TclpSysAlloc (not ckalloc).
- *	We do this because the threaded memory allocator MAY use the thread
- *	storage hash tables.
+ *	This procedure makes the passed TSDTable grow to fit the atLeast
+ *	value.
  *
  * Results:
- *	The return value is a pointer to the created entry.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	The table is enlarged.
  *
  *----------------------------------------------------------------------
  */
 
-static Tcl_HashEntry *
-AllocThreadStorageEntry(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key to store in the hash table entry. */
+static void
+TSDTableGrow(
+    TSDTable *tsdTablePtr,
+    sig_atomic_t atLeast)
 {
-    Tcl_HashEntry *hPtr;
+    sig_atomic_t newAllocated = tsdTablePtr->allocated * 2;
+    ClientData *newTablePtr;
+    sig_atomic_t i;
 
-    hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
-    hPtr->key.oneWordValue = keyPtr;
-    hPtr->clientData = NULL;
+    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;
+    }
 
-    return hPtr;
+    tsdTablePtr->allocated = newAllocated;
+    tsdTablePtr->tablePtr = newTablePtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * FreeThreadStorageEntry --
+ * TclThreadStorageKeyGet --
  *
- *	Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree). We do
- *	this because the threaded memory allocator MAY use the thread storage
- *	hash tables.
+ *    This procedure gets the value associated with the passed key.
  *
  * Results:
- *	None.
+ *	A pointer value associated with the Tcl_ThreadDataKey or NULL.
  *
  * Side effects:
  *	None.
@@ -157,339 +185,138 @@ AllocThreadStorageEntry(
  *----------------------------------------------------------------------
  */
 
-static void
-FreeThreadStorageEntry(
-    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
+void *
+TclThreadStorageKeyGet(
+    Tcl_ThreadDataKey *dataKeyPtr)
 {
-    TclpSysFree((char *) hPtr);
+    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;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ThreadStorageGetHashTable --
+ * TclThreadStorageKeySet --
  *
- *	This procedure returns a hash table pointer to be used for thread
- *	storage for the specified thread.
+ *	This procedure set an association of value with the key passed. The
+ *	associated value may be retrieved with TclThreadDataKeyGet().
  *
  * Results:
- *	A hash table pointer for the specified thread, or NULL if the hash
- *	table has not been created yet.
+ *	None.
  *
  * Side effects:
- *	May change an entry in the master thread storage cache to point to the
- *	specified thread and it's associated hash table.
- *
- * Thread safety:
- *	This function assumes that integer operations are safe (atomic)
- *	on all (currently) supported Tcl platforms.  Hence there are
- * 	places where shared integer arithmetic is done w/o protective locks.
+ *	The thread-specific table may be created or reallocated.
  *
  *----------------------------------------------------------------------
  */
 
-static Tcl_HashTable *
-ThreadStorageGetHashTable(
-    Tcl_ThreadId id)		/* Id of thread to get hash table for */
+void
+TclThreadStorageKeySet(
+    Tcl_ThreadDataKey *dataKeyPtr,
+    void *value)
 {
-    int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
-    Tcl_HashEntry *hPtr;
-    int isNew;
-    Tcl_HashTable *hashTablePtr;
+    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
+    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
+
+    if (tsdTablePtr == NULL) {
+	tsdTablePtr = TSDTableCreate();
+	TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
+    }
 
     /*
-     * It's important that we pick up the hash table pointer BEFORE comparing
-     * thread Id in case another thread is in the critical region changing
-     * things out from under you.
-     *
-     * Thread safety: threadStorageCache is accessed w/o locks in order to
-     * avoid serialization of all threads at this hot-spot. It is safe to
-     * do this here because (threadStorageCache[index].id != id) test below
-     * should be atomic on all (currently) supported platforms and there
-     * are no devastatig side effects of the test.
-     *
-     * Note Valgrind users: this place will show up as a race-condition in
-     * helgrind-tool output. To silence this warnings, define VALGRIND
-     * symbol at compilation time.
+     * 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 !defined(VALGRIND)
-    hashTablePtr = threadStorageCache[index].hashTablePtr;
-    if (threadStorageCache[index].id != id) {
-	Tcl_MutexLock(&threadStorageLock);
-#else
-    Tcl_MutexLock(&threadStorageLock);
-    hashTablePtr = threadStorageCache[index].hashTablePtr;
-    if (threadStorageCache[index].id != id) {
-#endif
-
-	/*
-	 * It's not in the cache, so we look it up...
-	 */
-
-	hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char *) id);
-
-	if (hPtr != NULL) {
-	    /*
-	     * We found it, extract the hash table pointer.
-	     */
-
-	    hashTablePtr = Tcl_GetHashValue(hPtr);
-	} else {
-	    /*
-	     * The thread specific hash table is not found.
-	     */
-
-	    hashTablePtr = NULL;
-	}
-
-	if (hashTablePtr == NULL) {
-	    hashTablePtr = (Tcl_HashTable *)
-		    TclpSysAlloc(sizeof(Tcl_HashTable), 0);
-
-	    if (hashTablePtr == NULL) {
-		Tcl_Panic("could not allocate thread specific hash table, "
-			"TclpSysAlloc failed from ThreadStorageGetHashTable!");
-	    }
-	    Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS,
-		    &tclThreadStorageHashKeyType);
-
+    if (keyPtr->offset == 0) {
+	Tcl_MutexLock(&tsdMaster.mutex);
+	if (keyPtr->offset == 0) {
 	    /*
-	     * Add new thread storage hash table to the master hash table.
+	     * The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
 	     */
 
-	    hPtr = Tcl_CreateHashEntry(&threadStorageHashTable, (char *) id,
-		    &isNew);
-
-	    if (hPtr == NULL) {
-		Tcl_Panic("Tcl_CreateHashEntry failed from "
-			"ThreadStorageGetHashTable!");
-	    }
-	    Tcl_SetHashValue(hPtr, hashTablePtr);
+	    keyPtr->offset = ++tsdMaster.counter;
 	}
-
-	/*
-	 * Now, we put it in the cache since it is highly likely it will be
-	 * needed again shortly.
-	 */
-
-	threadStorageCache[index].id = id;
-	threadStorageCache[index].hashTablePtr = hashTablePtr;
-#if !defined(VALGRIND)
-	Tcl_MutexUnlock(&threadStorageLock);
+	Tcl_MutexUnlock(&tsdMaster.mutex);
     }
-#else
-    }
-    Tcl_MutexUnlock(&threadStorageLock);
-#endif
-
-    return hashTablePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitThreadStorage --
- *
- *	Initializes the thread storage allocator.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	This procedure initializes the master hash table that maps thread ID
- *	onto the individual index tables that map thread data key to thread
- *	data. It also creates a cache that enables fast lookup of the thread
- *	data block array for a recently executing thread without using
- *	spinlocks.
- *
- * This procedure is called from an extremely early point in Tcl's
- * initialization. In particular, it may not use ckalloc/ckfree because they
- * may depend on thread-local storage (it uses TclpSysAlloc and TclpSysFree
- * instead). It may not depend on synchronization primitives - but no threads
- * other than the master thread have yet been launched.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInitThreadStorage(void)
-{
-    Tcl_InitCustomHashTable(&threadStorageHashTable, TCL_CUSTOM_TYPE_KEYS,
-	    &tclThreadStorageHashKeyType);
 
     /*
-     * We also initialize the cache.
+     * 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.
      */
 
-    memset((void*) &threadStorageCache, 0,
-	    sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
+    if (keyPtr->offset >= tsdTablePtr->allocated) {
+	TSDTableGrow(tsdTablePtr, keyPtr->offset);
+    }
 
     /*
-     * Now, we set the first value to be used for a thread data key.
+     * Set the value in the Tcl thread-local variable.
      */
 
-    nextThreadStorageKey = STORAGE_FIRST_KEY;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpThreadDataKeyGet --
- *
- *	This procedure returns a pointer to a block of thread local storage.
- *
- * Results:
- *	A thread-specific pointer to the data structure, or NULL if the memory
- *	has not been assigned to this key for this thread.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void *
-TclpThreadDataKeyGet(
-    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk, really
-				 * (int**) */
-{
-    Tcl_HashTable *hashTablePtr =
-	    ThreadStorageGetHashTable(Tcl_GetCurrentThread());
-    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(hashTablePtr, (char *) keyPtr);
-
-    if (hPtr == NULL) {
-	return NULL;
-    }
-    return Tcl_GetHashValue(hPtr);
+    tsdTablePtr->tablePtr[keyPtr->offset] = value;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpThreadDataKeySet --
+ * TclFinalizeThreadDataThread --
  *
- *	This procedure sets the pointer to a block of thread local storage.
+ *	This procedure finalizes the data for a single thread.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Sets up the thread so future calls to TclpThreadDataKeyGet with this
- *	key will return the data pointer.
+ *	The TSDTable is deleted/freed.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclpThreadDataKeySet(
-    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk, really
-				 * (pthread_key_t **) */
-    void *data)			/* Thread local storage */
+TclFinalizeThreadDataThread(void)
 {
-    Tcl_HashTable *hashTablePtr;
-    Tcl_HashEntry *hPtr;
-    int dummy;
-
-    hashTablePtr = ThreadStorageGetHashTable(Tcl_GetCurrentThread());
-    hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)keyPtr, &dummy);
+    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
 
-    Tcl_SetHashValue(hPtr, data);
+    if (tsdTablePtr != NULL) {
+	TSDTableDelete(tsdTablePtr);
+	TclpThreadSetMasterTSD(tsdMaster.key, NULL);
+    }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpFinalizeThreadDataThread --
+ * TclInitializeThreadStorage --
  *
- *	This procedure cleans up the thread storage hash table for the
- *	current thread.
+ *	This procedure initializes the TSD subsystem with per-platform code.
+ *	This should be called before any Tcl threads are created.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Frees all associated thread storage, all hash table entries for
- *	the thread's thread storage, and the hash table itself.
+ *	Allocates a system TSD.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclpFinalizeThreadDataThread(void)
+TclInitThreadStorage(void)
 {
-    Tcl_ThreadId id = Tcl_GetCurrentThread();
-				/* Id of the thread to finalize. */
-    int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
-    Tcl_HashEntry *hPtr;	/* Hash entry for current thread in master
-				 * table. */
-    Tcl_HashTable* hashTablePtr;/* Pointer to the hash table holding TSD
-				 * blocks for the current thread*/
-    Tcl_HashSearch search;	/* Search object to walk the TSD blocks in the
-				 * designated thread */
-    Tcl_HashEntry *hPtr2;	/* Hash entry for a TSD block in the
-				 * designated thread. */
-
-    Tcl_MutexLock(&threadStorageLock);
-    hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char*)id);
-    if (hPtr == NULL) {
-	hashTablePtr = NULL;
-    } else {
-	/*
-	 * We found it, extract the hash table pointer.
-	 */
-
-	hashTablePtr = Tcl_GetHashValue(hPtr);
-	Tcl_DeleteHashEntry(hPtr);
-
-	/*
-	 * Make sure cache entry for this thread is NULL.
-	 */
-
-	if (threadStorageCache[index].id == id) {
-	    /*
-	     * We do not step on another thread's cache entry. This is
-	     * especially important if we are creating and exiting a lot of
-	     * threads.
-	     */
-
-	    threadStorageCache[index].id = STORAGE_INVALID_THREAD;
-	    threadStorageCache[index].hashTablePtr = NULL;
-	}
-    }
-    Tcl_MutexUnlock(&threadStorageLock);
-
-    /*
-     * The thread's hash table has been extracted and removed from the master
-     * hash table. Now clean up the thread.
-     */
-
-    if (hashTablePtr != NULL) {
-	/*
-	 * Free all TSD
-	 */
-
-	for (hPtr2 = Tcl_FirstHashEntry(hashTablePtr, &search); hPtr2 != NULL;
-		hPtr2 = Tcl_NextHashEntry(&search)) {
-	    void *blockPtr = Tcl_GetHashValue(hPtr2);
-
-	    if (blockPtr != NULL) {
-		/*
-		 * The block itself was allocated in Tcl_GetThreadData using
-		 * ckalloc; use ckfree to dispose of it.
-		 */
-
-		ckfree(blockPtr);
-	    }
-	}
-
-	/*
-	 * Delete thread specific hash table and free the struct.
-	 */
-
-	Tcl_DeleteHashTable(hashTablePtr);
-	TclpSysFree((char *) hashTablePtr);
-    }
+    tsdMaster.key = TclpThreadCreateKey();
 }
 
 /*
@@ -497,15 +324,14 @@ TclpFinalizeThreadDataThread(void)
  *
  * TclFinalizeThreadStorage --
  *
- *	This procedure cleans up the master thread storage hash table, all
- *	thread specific hash tables, and the thread storage cache.
+ *	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:
- *	The master thread storage hash table and thread storage cache are
- *	reset to their initial (empty) state.
+ *	Releases the thread data key.
  *
  *----------------------------------------------------------------------
  */
@@ -513,60 +339,11 @@ TclpFinalizeThreadDataThread(void)
 void
 TclFinalizeThreadStorage(void)
 {
-    Tcl_HashSearch search;	/* We need to hit every thread with this
-				 * search. */
-    Tcl_HashEntry *hPtr;	/* Hash entry for current thread in master
-				 * table. */
-    Tcl_MutexLock(&threadStorageLock);
-
-    /*
-     * We are going to delete the hash table for every thread now. This hash
-     * table should be empty at this point, except for one entry for the
-     * current thread.
-     */
-
-    for (hPtr = Tcl_FirstHashEntry(&threadStorageHashTable, &search);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	Tcl_HashTable *hashTablePtr = Tcl_GetHashValue(hPtr);
-
-	if (hashTablePtr != NULL) {
-	    /*
-	     * Delete thread specific hash table for the thread in question
-	     * and free the struct.
-	     */
-
-	    Tcl_DeleteHashTable(hashTablePtr);
-	    TclpSysFree((char *)hashTablePtr);
-	}
-
-	/*
-	 * Delete thread specific entry from master hash table.
-	 */
-
-	Tcl_SetHashValue(hPtr, NULL);
-    }
-
-    Tcl_DeleteHashTable(&threadStorageHashTable);
-
-    /*
-     * Clear out the thread storage cache as well.
-     */
-
-    memset((void*) &threadStorageCache, 0,
-	    sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
-
-    /*
-     * Reset this to zero, it will be set to STORAGE_FIRST_KEY if the thread
-     * storage subsystem gets reinitialized
-     */
-
-    nextThreadStorageKey = STORAGE_INVALID_KEY;
-
-    Tcl_MutexUnlock(&threadStorageLock);
+    TclpThreadDeleteKey(tsdMaster.key);
+    tsdMaster.key = NULL;
 }
 
-#else /* !defined(TCL_THREADS) */
-
+#else /* !TCL_THREADS */
 /*
  * Stub functions for non-threaded builds
  */
@@ -577,7 +354,7 @@ TclInitThreadStorage(void)
 }
 
 void
-TclpFinalizeThreadDataThread(void)
+TclFinalizeThreadDataThread(void)
 {
 }
 
@@ -585,8 +362,7 @@ void
 TclFinalizeThreadStorage(void)
 {
 }
-
-#endif /* defined(TCL_THREADS) && defined(USE_THREAD_STORAGE) */
+#endif /* TCL_THREADS */
 
 /*
  * Local Variables:
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index f899779..fcf3880 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -7,15 +7,17 @@
  *	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.
  */
 
+#ifndef USE_TCL_STUBS
+#   define USE_TCL_STUBS
+#endif
 #include "tclInt.h"
 
-extern int	Tcltest_Init(Tcl_Interp *interp);
-
 #ifdef TCL_THREADS
 /*
  * Each thread has an single instance of the following structure. There is one
@@ -29,11 +31,13 @@ extern int	Tcltest_Init(Tcl_Interp *interp);
  */
 
 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;
 
@@ -42,22 +46,23 @@ static Tcl_ThreadDataKey dataKey;
  * protected by threadMutex.
  */
 
-static struct ThreadSpecificData *threadList;
+static ThreadSpecificData *threadList = NULL;
 
 /*
  * The following bit-values are legal for the "flags" field of the
  * ThreadSpecificData structure.
  */
-#define TP_Dying               0x001 /* This thread is being cancelled */
+
+#define TP_Dying		0x001 /* This thread is being canceled */
 
 /*
  * 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 TclCreateThread() C function.
+ * "thread create" Tcl command or the ThreadCreate() C function.
  */
 
 typedef struct ThreadCtrl {
-    const char *script;	/* The Tcl command this thread should
+    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
@@ -103,6 +108,7 @@ 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;
 
@@ -113,23 +119,18 @@ static char *errorProcString;
 
 TCL_DECLARE_MUTEX(threadMutex)
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-EXTERN int		TclThread_Init(Tcl_Interp *interp);
-EXTERN int		Tcl_ThreadObjCmd(ClientData clientData,
+static int		ThreadObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-EXTERN int		TclCreateThread(Tcl_Interp *interp, const char *script,
+static int		ThreadCreate(Tcl_Interp *interp, const char *script,
 			    int joinable);
-EXTERN int		TclThreadList(Tcl_Interp *interp);
-EXTERN int		TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
+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);
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
-
-Tcl_ThreadCreateType	NewTestThread(ClientData clientData);
+static Tcl_ThreadCreateType	NewTestThread(ClientData clientData);
 static void		ListRemove(ThreadSpecificData *tsdPtr);
 static void		ListUpdateInner(ThreadSpecificData *tsdPtr);
 static int		ThreadEventProc(Tcl_Event *evPtr, int mask);
@@ -138,6 +139,7 @@ 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);
 
 /*
  *----------------------------------------------------------------------
@@ -147,7 +149,7 @@ static void		ThreadExitProc(ClientData clientData);
  *	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.
@@ -159,9 +161,17 @@ int
 TclThread_Init(
     Tcl_Interp *interp)		/* The current Tcl interpreter */
 {
+    /*
+     * If the main thread Id has not been set, do it now.
+     */
 
-    Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd,
-	    (ClientData) NULL, NULL);
+    Tcl_MutexLock(&threadMutex);
+    if (mainThreadId == 0) {
+	mainThreadId = Tcl_GetCurrentThread();
+    }
+    Tcl_MutexUnlock(&threadMutex);
+
+    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
     return TCL_OK;
 }
 
@@ -169,15 +179,17 @@ TclThread_Init(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ThreadObjCmd --
+ * ThreadObjCmd --
  *
  *	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 id ?-async? script
+ *	thread send ?-async? id script
+ *	thread event
  *	thread exit
- *	thread info id
+ *	thread id ?-main?
  *	thread names
  *	thread wait
  *	thread errorproc proc
@@ -193,8 +205,8 @@ TclThread_Init(
  */
 
 	/* ARGSUSED */
-int
-Tcl_ThreadObjCmd(
+static int
+ThreadObjCmd(
     ClientData dummy,		/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
@@ -202,17 +214,19 @@ Tcl_ThreadObjCmd(
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     int option;
-    static const char *threadOptions[] = {
-	"create", "exit", "id", "join", "names",
-	"send", "wait", "errorproc", NULL
+    static const char *const threadOptions[] = {
+	"cancel", "create", "event", "exit", "id",
+	"join", "names", "send", "wait", "errorproc",
+	NULL
     };
     enum options {
-	THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
-	THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
+	THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT,
+	THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND,
+	THREAD_WAIT, THREAD_ERRORPROC
     };
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
@@ -233,6 +247,34 @@ Tcl_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;
@@ -252,9 +294,8 @@ Tcl_ThreadObjCmd(
 
 	    script = Tcl_GetStringFromObj(objv[2], &len);
 
-	    if ((len > 1) &&
-		    (script [0] == '-') && (script [1] == 'j') &&
-		    (0 == strncmp (script, "-joinable", (size_t) len))) {
+	    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 {
@@ -270,17 +311,14 @@ Tcl_ThreadObjCmd(
 	     */
 
 	    script = Tcl_GetStringFromObj(objv[2], &len);
-
-	    joinable = ((len > 1) &&
-		    (script [0] == '-') && (script [1] == 'j') &&
-		    (0 == strncmp(script, "-joinable", (size_t) 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;
 	}
-	return TclCreateThread(interp, script, joinable);
+	return ThreadCreate(interp, script, joinable);
     }
     case THREAD_EXIT:
 	if (objc > 2) {
@@ -291,8 +329,24 @@ Tcl_ThreadObjCmd(
 	Tcl_ExitThread(0);
 	return TCL_OK;
     case THREAD_ID:
-	if (objc == 2) {
-	    Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t) Tcl_GetCurrentThread());
+	if (objc == 2 || objc == 3) {
+	    Tcl_Obj *idObj;
+
+	    /*
+	     * Check if they want the main thread id or the current thread id.
+	     */
+
+	    if (objc == 2) {
+		idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
+	    } else if (objc == 3
+		    && strcmp("-main", Tcl_GetString(objv[2])) == 0) {
+		Tcl_MutexLock(&threadMutex);
+		idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)mainThreadId);
+		Tcl_MutexUnlock(&threadMutex);
+	    } else {
+		Tcl_WrongNumArgs(interp, 2, objv, NULL);
+		return TCL_ERROR;
+	    }
 
 	    Tcl_SetObjResult(interp, idObj);
 	    return TCL_OK;
@@ -312,11 +366,11 @@ Tcl_ThreadObjCmd(
 	    return TCL_ERROR;
 	}
 
-	result = Tcl_JoinThread ((Tcl_ThreadId)(size_t)id, &status);
+	result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
 	if (result == TCL_OK) {
-	    Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
 	} else {
-	    char buf [20];
+	    char buf[20];
 
 	    sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
 	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
@@ -328,7 +382,7 @@ Tcl_ThreadObjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
-	return TclThreadList(interp);
+	return ThreadList(interp);
     case THREAD_SEND: {
 	Tcl_WideInt id;
 	const char *script;
@@ -354,14 +408,23 @@ Tcl_ThreadObjCmd(
 	}
 	arg++;
 	script = Tcl_GetString(objv[arg]);
-	return TclThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
+	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.
 	 */
 
-	char *proc;
+	const char *proc;
 
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
@@ -373,15 +436,41 @@ Tcl_ThreadObjCmd(
 	    ckfree(errorProcString);
 	}
 	proc = Tcl_GetString(objv[2]);
-	errorProcString = ckalloc(strlen(proc)+1);
+	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;
+	}
 	while (1) {
+	    /*
+	     * 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.
+	     */
+
+	    if (Tcl_Canceled(interp,
+		    TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) {
+		break;
+	    }
 	    (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
 	}
+
+	/*
+	 * 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;
 }
@@ -389,7 +478,7 @@ Tcl_ThreadObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TclCreateThread --
+ * ThreadCreate --
  *
  *	This procedure is invoked to create a thread containing an interp to
  *	run a script. This returns after the thread has started executing.
@@ -404,8 +493,8 @@ Tcl_ThreadObjCmd(
  */
 
 	/* ARGSUSED */
-int
-TclCreateThread(
+static int
+ThreadCreate(
     Tcl_Interp *interp,		/* Current interpreter. */
     const char *script,		/* Script to execute */
     int joinable)		/* Flag, joinable thread or not */
@@ -423,7 +512,7 @@ TclCreateThread(
     if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
 	    TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
 	Tcl_MutexUnlock(&threadMutex);
-        Tcl_AppendResult(interp, "can't create a new thread", NULL);
+	Tcl_AppendResult(interp, "can't create a new thread", NULL);
 	return TCL_ERROR;
     }
 
@@ -470,18 +559,20 @@ Tcl_ThreadCreateType
 NewTestThread(
     ClientData clientData)
 {
-    ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
+    ThreadCtrl *ctrlPtr = 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);
-    result = TclThread_Init(tsdPtr->interp);
+    if (result != TCL_OK) {
+	ThreadErrorProc(tsdPtr->interp);
+    }
 
     /*
      * This is part of the test facility. Initialize _ALL_ test commands for
@@ -489,6 +580,9 @@ NewTestThread(
      */
 
     result = Tcltest_Init(tsdPtr->interp);
+    if (result != TCL_OK) {
+	ThreadErrorProc(tsdPtr->interp);
+    }
 
     /*
      * Update the list of threads.
@@ -502,10 +596,10 @@ NewTestThread(
      * eval'ing, for the case that we exit during evaluation
      */
 
-    threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
+    threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1);
     strcpy(threadEvalScript, ctrlPtr->script);
 
-    Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
+    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);
 
     /*
      * Notify the parent we are alive.
@@ -518,8 +612,8 @@ NewTestThread(
      * Run the script.
      */
 
-    Tcl_Preserve((ClientData) tsdPtr->interp);
-    result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
+    Tcl_Preserve(tsdPtr->interp);
+    result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0);
     if (result != TCL_OK) {
 	ThreadErrorProc(tsdPtr->interp);
     }
@@ -528,9 +622,9 @@ NewTestThread(
      * Clean up.
      */
 
-    ListRemove(tsdPtr);
-    Tcl_Release((ClientData) tsdPtr->interp);
     Tcl_DeleteInterp(tsdPtr->interp);
+    Tcl_Release(tsdPtr->interp);
+    ListRemove(tsdPtr);
     Tcl_ExitThread(result);
 
     TCL_THREAD_CREATE_RETURN;
@@ -560,6 +654,7 @@ ThreadErrorProc(
     const char *errorInfo, *argv[3];
     char *script;
     char buf[TCL_DOUBLE_SPACE+1];
+
     sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
 
     errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
@@ -575,7 +670,7 @@ ThreadErrorProc(
 	argv[1] = buf;
 	argv[2] = errorInfo;
 	script = Tcl_Merge(3, argv);
-	TclThreadSend(interp, errorThreadId, script, 0);
+	ThreadSend(interp, errorThreadId, script, 0);
 	ckfree(script);
     }
 }
@@ -648,13 +743,14 @@ ListRemove(
 	tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
     }
     tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
+    tsdPtr->interp = NULL;
     Tcl_MutexUnlock(&threadMutex);
 }
 
 /*
  *------------------------------------------------------------------------
  *
- * TclThreadList --
+ * ThreadList --
  *
  *    Return a list of threads running Tcl interpreters.
  *
@@ -666,8 +762,8 @@ ListRemove(
  *
  *------------------------------------------------------------------------
  */
-int
-TclThreadList(
+static int
+ThreadList(
     Tcl_Interp *interp)
 {
     ThreadSpecificData *tsdPtr;
@@ -687,7 +783,7 @@ TclThreadList(
 /*
  *------------------------------------------------------------------------
  *
- * TclThreadSend --
+ * ThreadSend --
  *
  *    Send a script to another thread.
  *
@@ -700,8 +796,8 @@ TclThreadList(
  *------------------------------------------------------------------------
  */
 
-int
-TclThreadSend(
+static int
+ThreadSend(
     Tcl_Interp *interp,		/* The current interpreter. */
     Tcl_ThreadId id,		/* Thread Id of other interpreter. */
     const char *script,		/* The script to evaluate. */
@@ -737,21 +833,21 @@ TclThreadSend(
      */
 
     if (threadId == Tcl_GetCurrentThread()) {
-        Tcl_MutexUnlock(&threadMutex);
-	return Tcl_GlobalEval(interp, script);
+	Tcl_MutexUnlock(&threadMutex);
+	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
     }
 
     /*
      * Create the event for its event queue.
      */
 
-    threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
+    threadEventPtr = ckalloc(sizeof(ThreadEvent));
     threadEventPtr->script = ckalloc(strlen(script) + 1);
     strcpy(threadEventPtr->script, script);
     if (!wait) {
 	resultPtr = threadEventPtr->resultPtr = NULL;
     } else {
-	resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
+	resultPtr = ckalloc(sizeof(ThreadEventResult));
 	threadEventPtr->resultPtr = resultPtr;
 
 	/*
@@ -784,7 +880,7 @@ TclThreadSend(
      */
 
     threadEventPtr->event.proc = ThreadEventProc;
-    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
+    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
 	    TCL_QUEUE_TAIL);
     Tcl_ThreadAlert(threadId);
 
@@ -799,7 +895,7 @@ TclThreadSend(
 
     Tcl_ResetResult(interp);
     while (resultPtr->result == NULL) {
-        Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
+	Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
     }
 
     /*
@@ -830,11 +926,12 @@ TclThreadSend(
 	    ckfree(resultPtr->errorInfo);
 	}
     }
-    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
+    Tcl_AppendResult(interp, resultPtr->result, NULL);
     Tcl_ConditionFinalize(&resultPtr->done);
     code = resultPtr->code;
 
-    ckfree((char *) resultPtr);
+    ckfree(resultPtr->result);
+    ckfree(resultPtr);
 
     return code;
 }
@@ -842,6 +939,62 @@ TclThreadSend(
 /*
  *------------------------------------------------------------------------
  *
+ * 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);
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
  * ThreadEventProc --
  *
  *    Handle the event in the target thread.
@@ -861,7 +1014,7 @@ ThreadEventProc(
     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;
@@ -873,13 +1026,11 @@ ThreadEventProc(
 	errorCode = "THREAD";
 	errorInfo = "";
     } else {
-	Tcl_Preserve((ClientData) interp);
+	Tcl_Preserve(interp);
 	Tcl_ResetResult(interp);
-	Tcl_CreateThreadExitHandler(ThreadFreeProc,
-		(ClientData) threadEventPtr->script);
-	code = Tcl_GlobalEval(interp, threadEventPtr->script);
-	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
-		(ClientData) threadEventPtr->script);
+	Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
+	code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL);
+	Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
 	if (code != TCL_OK) {
 	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
 	    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
@@ -906,7 +1057,7 @@ ThreadEventProc(
 	Tcl_MutexUnlock(&threadMutex);
     }
     if (interp != NULL) {
-	Tcl_Release((ClientData) interp);
+	Tcl_Release(interp);
     }
     return 1;
 }
@@ -934,7 +1085,7 @@ ThreadFreeProc(
     ClientData clientData)
 {
     if (clientData) {
-	ckfree((char *) clientData);
+	ckfree(clientData);
     }
 }
 
@@ -962,7 +1113,7 @@ ThreadDeleteEvent(
     ClientData clientData)	/* dummy */
 {
     if (eventPtr->proc == ThreadEventProc) {
-	ckfree((char *) ((ThreadEvent *) eventPtr)->script);
+	ckfree(((ThreadEvent *) eventPtr)->script);
 	return 1;
     }
 
@@ -996,17 +1147,22 @@ static void
 ThreadExitProc(
     ClientData clientData)
 {
-    char *threadEvalScript = (char *) clientData;
+    char *threadEvalScript = 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((char *) threadEvalScript);
+	ckfree(threadEvalScript);
 	threadEvalScript = NULL;
     }
-    Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
+    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);
 
     for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
 	nextPtr = resultPtr->nextPtr;
@@ -1026,7 +1182,7 @@ ThreadExitProc(
 	    }
 	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
 	    resultPtr->eventPtr->resultPtr = NULL;
-	    ckfree((char *) resultPtr);
+	    ckfree(resultPtr);
 	} else if (resultPtr->dstThreadId == self) {
 	    /*
 	     * Dang. The target is going away. Unblock the caller. The result
@@ -1036,7 +1192,7 @@ ThreadExitProc(
 
 	    const char *msg = "target thread died";
 
-	    resultPtr->result = ckalloc(strlen(msg)+1);
+	    resultPtr->result = ckalloc(strlen(msg) + 1);
 	    strcpy(resultPtr->result, msg);
 	    resultPtr->code = TCL_ERROR;
 	    Tcl_ConditionNotify(&resultPtr->done);
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 33838ec..c10986a 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -72,7 +72,7 @@ typedef struct AfterAssocData {
  */
 
 typedef struct IdleHandler {
-    Tcl_IdleProc (*proc);	/* Function to call. */
+    Tcl_IdleProc *proc;		/* Function to call. */
     ClientData clientData;	/* Value to pass to proc. */
     int generation;		/* Used to distinguish older handlers from
 				 * recently-created ones. */
@@ -127,6 +127,25 @@ static Tcl_ThreadDataKey dataKey;
     (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:
  */
@@ -163,8 +182,7 @@ static void		TimerSetupProc(ClientData clientData, int flags);
 static ThreadSpecificData *
 InitTimer(void)
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-	    TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -195,8 +213,7 @@ static void
 TimerExitProc(
     ClientData clientData)	/* Not used. */
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-	    TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
     if (tsdPtr != NULL) {
@@ -205,7 +222,7 @@ TimerExitProc(
 	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
 	while (timerHandlerPtr != NULL) {
 	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
-	    ckfree((char *) timerHandlerPtr);
+	    ckfree(timerHandlerPtr);
 	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
 	}
     }
@@ -278,16 +295,15 @@ TclCreateAbsoluteTimerHandler(
     ClientData clientData)
 {
     register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
-    ThreadSpecificData *tsdPtr;
+    ThreadSpecificData *tsdPtr = InitTimer();
 
-    tsdPtr = InitTimer();
-    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
+    timerHandlerPtr = ckalloc(sizeof(TimerHandler));
 
     /*
      * Fill in fields for the event.
      */
 
-    memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time));
+    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
     timerHandlerPtr->proc = proc;
     timerHandlerPtr->clientData = clientData;
     tsdPtr->lastTimerId++;
@@ -357,7 +373,7 @@ Tcl_DeleteTimerHandler(
 	} else {
 	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
 	}
-	ckfree((char *) timerHandlerPtr);
+	ckfree(timerHandlerPtr);
 	return;
     }
 }
@@ -396,7 +412,6 @@ 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.
@@ -473,7 +488,7 @@ TimerCheckProc(
 	if (blockTime.sec == 0 && blockTime.usec == 0 &&
 		!tsdPtr->timerPending) {
 	    tsdPtr->timerPending = 1;
-	    timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
+	    timerEvPtr = ckalloc(sizeof(Tcl_Event));
 	    timerEvPtr->proc = TimerHandlerEventProc;
 	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
 	}
@@ -574,9 +589,9 @@ TimerHandlerEventProc(
 	 * potential reentrancy problems.
 	 */
 
-	(*nextPtrPtr) = timerHandlerPtr->nextPtr;
-	(*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
-	ckfree((char *) timerHandlerPtr);
+	*nextPtrPtr = timerHandlerPtr->nextPtr;
+	timerHandlerPtr->proc(timerHandlerPtr->clientData);
+	ckfree(timerHandlerPtr);
     }
     TimerSetupProc(NULL, TCL_TIMER_EVENTS);
     return 1;
@@ -610,7 +625,7 @@ Tcl_DoWhenIdle(
     Tcl_Time blockTime;
     ThreadSpecificData *tsdPtr = InitTimer();
 
-    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
+    idlePtr = ckalloc(sizeof(IdleHandler));
     idlePtr->proc = proc;
     idlePtr->clientData = clientData;
     idlePtr->generation = tsdPtr->idleGeneration;
@@ -659,7 +674,7 @@ Tcl_CancelIdleCall(
 	while ((idlePtr->proc == proc)
 		&& (idlePtr->clientData == clientData)) {
 	    nextPtr = idlePtr->nextPtr;
-	    ckfree((char *) idlePtr);
+	    ckfree(idlePtr);
 	    idlePtr = nextPtr;
 	    if (prevPtr == NULL) {
 		tsdPtr->idleList = idlePtr;
@@ -733,8 +748,8 @@ TclServiceIdle(void)
 	if (tsdPtr->idleList == NULL) {
 	    tsdPtr->lastIdlePtr = NULL;
 	}
-	(*idlePtr->proc)(idlePtr->clientData);
-	ckfree((char *) idlePtr);
+	idlePtr->proc(idlePtr->clientData);
+	ckfree(idlePtr);
     }
     if (tsdPtr->idleList) {
 	blockTime.sec = 0;
@@ -767,23 +782,22 @@ Tcl_AfterObjCmd(
     ClientData clientData,	/* Unused */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *CONST objv[])	/* Argument objects. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_WideInt ms;		/* Number of milliseconds to wait */
+    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
     Tcl_Time wakeup;
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
     int index;
-    char buf[16 + TCL_INTEGER_SPACE];
-    static CONST char *afterSubCmds[] = {
+    static const char *const afterSubCmds[] = {
 	"cancel", "idle", "info", NULL
     };
     enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
     ThreadSpecificData *tsdPtr = InitTimer();
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
 
@@ -794,11 +808,10 @@ Tcl_AfterObjCmd(
 
     assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
     if (assocPtr == NULL) {
-	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
+	assocPtr = ckalloc(sizeof(AfterAssocData));
 	assocPtr->interp = interp;
 	assocPtr->firstAfterPtr = NULL;
-	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
-		(ClientData) assocPtr);
+	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
     }
 
     /*
@@ -806,23 +819,26 @@ Tcl_AfterObjCmd(
      */
 
     if (objv[1]->typePtr == &tclIntType
-#ifndef NO_WIDE_TYPE
-	|| objv[1]->typePtr == &tclWideIntType
+#ifndef TCL_WIDE_INT_IS_LONG
+	    || objv[1]->typePtr == &tclWideIntType
 #endif
-	|| objv[1]->typePtr == &tclBignumType
-	|| ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, 
-				 &index) != TCL_OK )) {
+	    || objv[1]->typePtr == &tclBignumType
+	    || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
+		    &index) != TCL_OK)) {
 	index = -1;
 	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
-	    Tcl_AppendResult(interp, "bad argument \"",
-			     Tcl_GetString(objv[1]),
-			     "\": must be cancel, idle, info, or an integer",
-			     NULL);
+            const char *arg = Tcl_GetString(objv[1]);
+
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "bad argument \"%s\": must be"
+                    " cancel, idle, info, or an integer", arg));
+            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
+                    arg, NULL);
 	    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.
      */
@@ -835,12 +851,12 @@ Tcl_AfterObjCmd(
 	if (objc == 2) {
 	    return AfterDelay(interp, ms);
 	}
-	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr = ckalloc(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);
 
@@ -863,8 +879,8 @@ Tcl_AfterObjCmd(
 	    wakeup.sec++;
 	    wakeup.usec -= 1000000;
 	}
-	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc,
-							(ClientData) afterPtr);
+	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
+		AfterProc, afterPtr);
 	afterPtr->nextPtr = assocPtr->firstAfterPtr;
 	assocPtr->firstAfterPtr = afterPtr;
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
@@ -872,7 +888,7 @@ Tcl_AfterObjCmd(
     }
     case AFTER_CANCEL: {
 	Tcl_Obj *commandPtr;
-	char *command, *tempCommand;
+	const char *command, *tempCommand;
 	int tempLength;
 
 	if (objc < 3) {
@@ -890,8 +906,7 @@ Tcl_AfterObjCmd(
 	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
 		    &tempLength);
 	    if ((length == tempLength)
-		    && (memcmp((void*) command, (void*) tempCommand,
-			    (unsigned) length) == 0)) {
+		    && !memcmp(command, tempCommand, (unsigned) length)) {
 		break;
 	    }
 	}
@@ -905,7 +920,7 @@ Tcl_AfterObjCmd(
 	    if (afterPtr->token != NULL) {
 		Tcl_DeleteTimerHandler(afterPtr->token);
 	    } else {
-		Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+		Tcl_CancelIdleCall(AfterProc, afterPtr);
 	    }
 	    FreeAfterPtr(afterPtr);
 	}
@@ -913,10 +928,10 @@ Tcl_AfterObjCmd(
     }
     case AFTER_IDLE:
 	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
 	    return TCL_ERROR;
 	}
-	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
+	afterPtr = ckalloc(sizeof(AfterInfo));
 	afterPtr->assocPtr = assocPtr;
 	if (objc == 3) {
 	    afterPtr->commandPtr = objv[2];
@@ -929,20 +944,21 @@ Tcl_AfterObjCmd(
 	afterPtr->token = NULL;
 	afterPtr->nextPtr = assocPtr->firstAfterPtr;
 	assocPtr->firstAfterPtr = afterPtr;
-	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
+	Tcl_DoWhenIdle(AfterProc, afterPtr);
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
 	break;
-    case AFTER_INFO: {
-	Tcl_Obj *resultListPtr;
-
+    case AFTER_INFO:
 	if (objc == 2) {
+            Tcl_Obj *resultObj = Tcl_NewObj();
+
 	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
 		    afterPtr = afterPtr->nextPtr) {
 		if (assocPtr->interp == interp) {
-		    sprintf(buf, "after#%d", afterPtr->id);
-		    Tcl_AppendElement(interp, buf);
+                    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+                            "after#%d", afterPtr->id));
 		}
 	    }
+            Tcl_SetObjResult(interp, resultObj);
 	    return TCL_OK;
 	}
 	if (objc != 3) {
@@ -951,17 +967,22 @@ Tcl_AfterObjCmd(
 	}
 	afterPtr = GetAfterEvent(assocPtr, objv[2]);
 	if (afterPtr == NULL) {
-	    Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]),
-		    "\" doesn't exist", NULL);
+            const char *eventStr = TclGetString(objv[2]);
+
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "event \"%s\" doesn't exist", eventStr));
+            Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
 	    return TCL_ERROR;
-	}
-	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);
+	} 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");
     }
@@ -978,7 +999,7 @@ Tcl_AfterObjCmd(
  *
  * Results:
  *	Standard Tcl result code (with error set if an error occurred due to a
- *	time limit being exceeded).
+ *	time limit being exceeded or being canceled).
  *
  * Side effects:
  *	May adjust the time limit granularity marker.
@@ -996,7 +1017,8 @@ AfterDelay(
     Tcl_Time endTime, now;
     Tcl_WideInt diff;
 
-    Tcl_GetTime(&endTime);
+    Tcl_GetTime(&now);
+    endTime = now;
     endTime.sec += (long)(ms/1000);
     endTime.usec += ((int)(ms%1000))*1000;
     if (endTime.usec >= 1000000) {
@@ -1005,25 +1027,37 @@ AfterDelay(
     }
 
     do {
-	Tcl_GetTime(&now);
+	if (Tcl_AsyncReady()) {
+	    if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	}
+	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)) {
+		&& TCL_TIME_BEFORE(iPtr->limit.time, now)) {
 	    iPtr->limit.granularityTicker = 0;
 	    if (Tcl_LimitCheck(interp) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	}
 	if (iPtr->limit.timeEvent == NULL
-	    || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
-	    diff = TCL_TIME_DIFF_MS(endTime, now);
+		|| 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 > 0) {
-		Tcl_Sleep((long)diff);
+	    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
@@ -1031,13 +1065,25 @@ AfterDelay(
 		diff = LONG_MAX;
 	    }
 #endif
+	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
+		diff = TCL_TIME_MAXIMUM_SLICE;
+	    }
 	    if (diff > 0) {
-		Tcl_Sleep((long)diff);
+		Tcl_Sleep((long) diff);
+	    }
+	    if (Tcl_AsyncReady()) {
+		if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
+	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+		return TCL_ERROR;
 	    }
 	    if (Tcl_LimitCheck(interp) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	}
+        Tcl_GetTime(&now);
     } while (TCL_TIME_BEFORE(now, endTime));
     return TCL_OK;
 }
@@ -1067,7 +1113,7 @@ GetAfterEvent(
 				 * this interpreter. */
     Tcl_Obj *commandPtr)
 {
-    char *cmdString;		/* Textual identifier for after event, such as
+    const char *cmdString;	/* Textual identifier for after event, such as
 				 * "after#6". */
     AfterInfo *afterPtr;
     int id;
@@ -1114,7 +1160,7 @@ static void
 AfterProc(
     ClientData clientData)	/* Describes command to execute. */
 {
-    AfterInfo *afterPtr = (AfterInfo *) clientData;
+    AfterInfo *afterPtr = clientData;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
     AfterInfo *prevPtr;
     int result;
@@ -1141,20 +1187,20 @@ AfterProc(
      */
 
     interp = assocPtr->interp;
-    Tcl_Preserve((ClientData) interp);
+    Tcl_Preserve(interp);
     result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
-	TclBackgroundException(interp, result);
+	Tcl_BackgroundException(interp, result);
     }
-    Tcl_Release((ClientData) interp);
+    Tcl_Release(interp);
 
     /*
      * Free the memory for the callback.
      */
 
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree((char *) afterPtr);
+    ckfree(afterPtr);
 }
 
 /*
@@ -1192,7 +1238,7 @@ FreeAfterPtr(
 	prevPtr->nextPtr = afterPtr->nextPtr;
     }
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree((char *) afterPtr);
+    ckfree(afterPtr);
 }
 
 /*
@@ -1219,7 +1265,7 @@ AfterCleanupProc(
 				 * interpreter. */
     Tcl_Interp *interp)		/* Interpreter that is being deleted. */
 {
-    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
+    AfterAssocData *assocPtr = clientData;
     AfterInfo *afterPtr;
 
     while (assocPtr->firstAfterPtr != NULL) {
@@ -1228,12 +1274,12 @@ AfterCleanupProc(
 	if (afterPtr->token != NULL) {
 	    Tcl_DeleteTimerHandler(afterPtr->token);
 	} else {
-	    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+	    Tcl_CancelIdleCall(AfterProc, afterPtr);
 	}
 	Tcl_DecrRefCount(afterPtr->commandPtr);
-	ckfree((char *) afterPtr);
+	ckfree(afterPtr);
     }
-    ckfree((char *) assocPtr);
+    ckfree(assocPtr);
 }
 
 /*
@@ -1241,5 +1287,7 @@ AfterCleanupProc(
  * 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
index ab39e83..610a031 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -1,9 +1,8 @@
 # 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
-#	'tclStubInit.c' files.
+#	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 'tclStubInit.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
@@ -19,196 +18,197 @@ library tcl
 
 interface tclTomMath
 # hooks {tclTomMathInt}
+scspec EXTERN
 
 # Declare each of the functions in the Tcl tommath interface
 
-declare 0 generic {
+declare 0 {
     int TclBN_epoch(void)
 }
-declare 1 generic {
+declare 1 {
     int TclBN_revision(void)
 }
 
-declare 2 generic {
+declare 2 {
     int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 3 generic {
+declare 3 {
     int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
 }
-declare 4 generic {
+declare 4 {
     int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 5 generic {
+declare 5 {
     void TclBN_mp_clamp(mp_int *a)
 }
-declare 6 generic {
+declare 6 {
     void TclBN_mp_clear(mp_int *a)
 }
-declare 7 generic {
+declare 7 {
     void TclBN_mp_clear_multi(mp_int *a, ...)
 }
-declare 8 generic {
-    int TclBN_mp_cmp(mp_int *a, mp_int *b)
+declare 8 {
+    int TclBN_mp_cmp(const mp_int *a, const mp_int *b)
 }
-declare 9 generic {
-    int TclBN_mp_cmp_d(mp_int *a, mp_digit b)
+declare 9 {
+    int TclBN_mp_cmp_d(const mp_int *a, mp_digit b)
 }
-declare 10 generic {
-    int TclBN_mp_cmp_mag(mp_int *a, mp_int *b)
+declare 10 {
+    int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b)
 }
-declare 11 generic {
-    int TclBN_mp_copy(mp_int *a, mp_int *b)
+declare 11 {
+    int TclBN_mp_copy(const mp_int *a, mp_int *b)
 }
-declare 12 generic {
-    int TclBN_mp_count_bits(mp_int *a)
+declare 12 {
+    int TclBN_mp_count_bits(const mp_int *a)
 }
-declare 13 generic {
+declare 13 {
     int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
 }
-declare 14 generic {
+declare 14 {
     int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
 }
-declare 15 generic {
+declare 15 {
     int TclBN_mp_div_2(mp_int *a, mp_int *q)
 }
-declare 16 generic {
-    int TclBN_mp_div_2d(mp_int *a, int b, mp_int *q, mp_int *r)
+declare 16 {
+    int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
 }
-declare 17 generic {
+declare 17 {
     int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
 }
-declare 18 generic {
+declare 18 {
     void TclBN_mp_exch(mp_int *a, mp_int *b)
 }
-declare 19 generic {
+declare 19 {
     int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
 }
-declare 20 generic {
+declare 20 {
     int TclBN_mp_grow(mp_int *a, int size)
 }
-declare 21 generic {
+declare 21 {
     int TclBN_mp_init(mp_int *a)
 }
-declare 22 generic {
+declare 22 {
     int TclBN_mp_init_copy(mp_int *a, mp_int *b)
 }
-declare 23 generic {
+declare 23 {
     int TclBN_mp_init_multi(mp_int *a, ...)
 }
-declare 24 generic {
+declare 24 {
     int TclBN_mp_init_set(mp_int *a, mp_digit b)
 }
-declare 25 generic {
+declare 25 {
     int TclBN_mp_init_size(mp_int *a, int size)
 }
-declare 26 generic {
+declare 26 {
     int TclBN_mp_lshd(mp_int *a, int shift)
 }
-declare 27 generic {
+declare 27 {
     int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
 }
-declare 28 generic {
-    int TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r)
+declare 28 {
+    int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r)
 }
-declare 29 generic {
+declare 29 {
     int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
 }
-declare 30 generic {
+declare 30 {
     int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
 }
-declare 31 generic {
+declare 31 {
     int TclBN_mp_mul_2(mp_int *a, mp_int *p)
 }
-declare 32 generic {
-    int TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p)
+declare 32 {
+    int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
 }
-declare 33 generic {
-    int TclBN_mp_neg(mp_int *a, mp_int *b)
+declare 33 {
+    int TclBN_mp_neg(const mp_int *a, mp_int *b)
 }
-declare 34 generic {
+declare 34 {
     int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 35 generic {
+declare 35 {
     int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
 }
-declare 36 generic {
+declare 36 {
     int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
 }
-declare 37 generic {
+declare 37 {
     void TclBN_mp_rshd(mp_int *a, int shift)
 }
-declare 38 generic {
+declare 38 {
     int TclBN_mp_shrink(mp_int *a)
 }
-declare 39 generic {
+declare 39 {
     void TclBN_mp_set(mp_int *a, mp_digit b)
 }
-declare 40 generic {
+declare 40 {
     int TclBN_mp_sqr(mp_int *a, mp_int *b)
 }
-declare 41 generic {
+declare 41 {
     int TclBN_mp_sqrt(mp_int *a, mp_int *b)
 }
-declare 42 generic {
+declare 42 {
     int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 43 generic {
+declare 43 {
     int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
 }
-declare 44 generic {
+declare 44 {
     int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
 }
-declare 45 generic {
+declare 45 {
     int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
 	    unsigned long *outlen)
 }
-declare 46 generic {
+declare 46 {
     int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
 }
-declare 47 generic {
+declare 47 {
     int TclBN_mp_unsigned_bin_size(mp_int *a)
 }
-declare 48 generic {
+declare 48 {
     int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 49 generic {
+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 generic {
+declare 50 {
     void TclBN_reverse(unsigned char *s, int len)
 }
-declare 51 generic {
+declare 51 {
     int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
 }
-declare 52 generic {
+declare 52 {
     int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
 }
-declare 53 generic {
+declare 53 {
     int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 54 generic {
+declare 54 {
     int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
 }
-declare 55 generic {
+declare 55 {
     int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 56 generic {
+declare 56 {
     int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
 }
-declare 57 generic {
+declare 57 {
     int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
 }
-declare 58 generic {
+declare 58 {
     int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
 }
-declare 59 generic {
+declare 59 {
     int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
 }
-declare 60 generic {
+declare 60 {
     int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
 }
 declare 61 {
@@ -218,5 +218,21 @@ declare 62 {
     int TclBN_mp_set_int(mp_int *a, unsigned long i)
 }
 declare 63 {
-    int TclBN_mp_cnt_lsb(mp_int *a)
+    int TclBN_mp_cnt_lsb(const mp_int *a)
 }
+
+# Formerly internal API to allow initialisation of bignums without knowing the
+# typedefs of how a bignum works internally.
+declare 64 {
+    void TclBNInitBignumFromLong(mp_int *bignum, long initVal)
+}
+declare 65 {
+    void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal)
+}
+declare 66 {
+    void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
+}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index 550dafa..41512f0 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -15,23 +15,19 @@
 #ifndef BN_H_
 #define BN_H_
 
-#include <tclTomMathDecls.h>
+#include "tclTomMathDecls.h"
 #ifndef MODULE_SCOPE
 #define MODULE_SCOPE extern
 #endif
 
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <limits.h>
+
 
 #ifndef MIN
-   #define MIN(x,y) ((x)<(y)?(x):(y))
+#   define MIN(x,y) ((x)<(y)?(x):(y))
 #endif
 
 #ifndef MAX
-   #define MAX(x,y) ((x)>(y)?(x):(y))
+#   define MAX(x,y) ((x)>(y)?(x):(y))
 #endif
 
 #ifdef __cplusplus
@@ -50,9 +46,9 @@ extern "C" {
 
 /* 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
+#   if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
+#	define MP_64BIT
+#   endif
 #endif
 
 /* some default configurations.
@@ -88,19 +84,19 @@ extern "C" {
 #endif
    typedef unsigned long      mp_word __attribute__ ((mode(TI)));
 
-   #define DIGIT_BIT          60
+#  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__) 
+#  if defined(_MSC_VER) || defined(__BORLANDC__)
       typedef unsigned __int64   ulong64;
       typedef signed __int64     long64;
-   #else
+#  else
       typedef unsigned long long ulong64;
       typedef signed long long   long64;
-   #endif
+#  endif
 #endif
 
 #ifndef MP_DIGIT_DECLARED
@@ -109,39 +105,39 @@ extern "C" {
 #endif
    typedef ulong64            mp_word;
 
-#ifdef MP_31BIT   
+#ifdef MP_31BIT
    /* this is an extension that uses 31-bit digits */
-   #define DIGIT_BIT          31
+#  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   
+#  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
+#  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
 #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 */
+#   define DIGIT_BIT     ((int)((CHAR_BIT * sizeof(mp_digit) - 1)))  /* bits per digit */
 #endif
 
 #define MP_DIGIT_BIT     DIGIT_BIT
@@ -184,11 +180,11 @@ MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
 
 /* 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   
+#  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) */
@@ -293,7 +289,7 @@ int mp_init_set_int (mp_int * a, unsigned long b);
 
 /* copy, b = a */
 /*
-int mp_copy(mp_int *a, mp_int *b);
+int mp_copy(const mp_int *a, mp_int *b);
 */
 
 /* inits and copies, a = b */
@@ -320,7 +316,7 @@ int mp_lshd(mp_int *a, int b);
 
 /* c = a / 2**b */
 /*
-int mp_div_2d(mp_int *a, int b, mp_int *c, mp_int *d);
+int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
 */
 
 /* b = a/2 */
@@ -330,7 +326,7 @@ int mp_div_2(mp_int *a, mp_int *b);
 
 /* c = a * 2**b */
 /*
-int mp_mul_2d(mp_int *a, int b, mp_int *c);
+int mp_mul_2d(const mp_int *a, int b, mp_int *c);
 */
 
 /* b = a*2 */
@@ -340,7 +336,7 @@ int mp_mul_2(mp_int *a, mp_int *b);
 
 /* c = a mod 2**d */
 /*
-int mp_mod_2d(mp_int *a, int b, mp_int *c);
+int mp_mod_2d(const mp_int *a, int b, mp_int *c);
 */
 
 /* computes a = 2**b */
@@ -350,7 +346,7 @@ 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);
+int mp_cnt_lsb(const mp_int *a);
 */
 
 /* I Love Earth! */
@@ -380,7 +376,7 @@ int mp_and(mp_int *a, mp_int *b, mp_int *c);
 
 /* b = -a */
 /*
-int mp_neg(mp_int *a, mp_int *b);
+int mp_neg(const mp_int *a, mp_int *b);
 */
 
 /* b = |a| */
@@ -390,12 +386,12 @@ int mp_abs(mp_int *a, mp_int *b);
 
 /* compare a to b */
 /*
-int mp_cmp(mp_int *a, mp_int *b);
+int mp_cmp(const mp_int *a, const mp_int *b);
 */
 
 /* compare |a| to |b| */
 /*
-int mp_cmp_mag(mp_int *a, mp_int *b);
+int mp_cmp_mag(const mp_int *a, const mp_int *b);
 */
 
 /* c = a + b */
@@ -432,7 +428,7 @@ int mp_mod(mp_int *a, mp_int *b, mp_int *c);
 
 /* compare against a single digit */
 /*
-int mp_cmp_d(mp_int *a, mp_digit b);
+int mp_cmp_d(const mp_int *a, mp_digit b);
 */
 
 /* c = a + b */
@@ -620,9 +616,9 @@ int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
 
 /* number of primes */
 #ifdef MP_8BIT
-   #define PRIME_SIZE      31
+#  define PRIME_SIZE      31
 #else
-   #define PRIME_SIZE      256
+#  define PRIME_SIZE      256
 #endif
 
 /* table of first PRIME_SIZE primes */
@@ -650,7 +646,7 @@ 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 
+ * such that Miller-Rabin gives a prob of failure lower than 2^-96
  */
 /*
 int mp_prime_rabin_miller_trials(int size);
@@ -677,7 +673,7 @@ 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 
+ * 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
@@ -690,7 +686,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
 /* 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
@@ -707,7 +703,7 @@ int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback
 
 /* ---> radix conversion <--- */
 /*
-int mp_count_bits(mp_int *a);
+int mp_count_bits(const mp_int *a);
 */
 
 /*
@@ -830,7 +826,7 @@ MODULE_SCOPE const char *mp_s_rmap;
 #endif
 
 #ifdef __cplusplus
-   }
+}
 #endif
 
 #endif
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 056ad85..2ce9d5a 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -142,339 +142,155 @@ extern "C" {
  * Exported function declarations:
  */
 
-#ifndef TclBN_epoch_TCL_DECLARED
-#define TclBN_epoch_TCL_DECLARED
 /* 0 */
 EXTERN int		TclBN_epoch(void);
-#endif
-#ifndef TclBN_revision_TCL_DECLARED
-#define TclBN_revision_TCL_DECLARED
 /* 1 */
 EXTERN int		TclBN_revision(void);
-#endif
-#ifndef TclBN_mp_add_TCL_DECLARED
-#define TclBN_mp_add_TCL_DECLARED
 /* 2 */
 EXTERN int		TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_mp_add_d_TCL_DECLARED
-#define TclBN_mp_add_d_TCL_DECLARED
 /* 3 */
 EXTERN int		TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
-#endif
-#ifndef TclBN_mp_and_TCL_DECLARED
-#define TclBN_mp_and_TCL_DECLARED
 /* 4 */
 EXTERN int		TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_mp_clamp_TCL_DECLARED
-#define TclBN_mp_clamp_TCL_DECLARED
 /* 5 */
 EXTERN void		TclBN_mp_clamp(mp_int *a);
-#endif
-#ifndef TclBN_mp_clear_TCL_DECLARED
-#define TclBN_mp_clear_TCL_DECLARED
 /* 6 */
 EXTERN void		TclBN_mp_clear(mp_int *a);
-#endif
-#ifndef TclBN_mp_clear_multi_TCL_DECLARED
-#define TclBN_mp_clear_multi_TCL_DECLARED
 /* 7 */
 EXTERN void		TclBN_mp_clear_multi(mp_int *a, ...);
-#endif
-#ifndef TclBN_mp_cmp_TCL_DECLARED
-#define TclBN_mp_cmp_TCL_DECLARED
 /* 8 */
-EXTERN int		TclBN_mp_cmp(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_cmp_d_TCL_DECLARED
-#define TclBN_mp_cmp_d_TCL_DECLARED
+EXTERN int		TclBN_mp_cmp(const mp_int *a, const mp_int *b);
 /* 9 */
-EXTERN int		TclBN_mp_cmp_d(mp_int *a, mp_digit b);
-#endif
-#ifndef TclBN_mp_cmp_mag_TCL_DECLARED
-#define TclBN_mp_cmp_mag_TCL_DECLARED
+EXTERN int		TclBN_mp_cmp_d(const mp_int *a, mp_digit b);
 /* 10 */
-EXTERN int		TclBN_mp_cmp_mag(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_copy_TCL_DECLARED
-#define TclBN_mp_copy_TCL_DECLARED
+EXTERN int		TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b);
 /* 11 */
-EXTERN int		TclBN_mp_copy(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_count_bits_TCL_DECLARED
-#define TclBN_mp_count_bits_TCL_DECLARED
+EXTERN int		TclBN_mp_copy(const mp_int *a, mp_int *b);
 /* 12 */
-EXTERN int		TclBN_mp_count_bits(mp_int *a);
-#endif
-#ifndef TclBN_mp_div_TCL_DECLARED
-#define TclBN_mp_div_TCL_DECLARED
+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);
-#endif
-#ifndef TclBN_mp_div_d_TCL_DECLARED
-#define TclBN_mp_div_d_TCL_DECLARED
 /* 14 */
 EXTERN int		TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
 				mp_digit *r);
-#endif
-#ifndef TclBN_mp_div_2_TCL_DECLARED
-#define TclBN_mp_div_2_TCL_DECLARED
 /* 15 */
 EXTERN int		TclBN_mp_div_2(mp_int *a, mp_int *q);
-#endif
-#ifndef TclBN_mp_div_2d_TCL_DECLARED
-#define TclBN_mp_div_2d_TCL_DECLARED
 /* 16 */
-EXTERN int		TclBN_mp_div_2d(mp_int *a, int b, mp_int *q,
+EXTERN int		TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
 				mp_int *r);
-#endif
-#ifndef TclBN_mp_div_3_TCL_DECLARED
-#define TclBN_mp_div_3_TCL_DECLARED
 /* 17 */
 EXTERN int		TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
-#endif
-#ifndef TclBN_mp_exch_TCL_DECLARED
-#define TclBN_mp_exch_TCL_DECLARED
 /* 18 */
 EXTERN void		TclBN_mp_exch(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_expt_d_TCL_DECLARED
-#define TclBN_mp_expt_d_TCL_DECLARED
 /* 19 */
 EXTERN int		TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
-#endif
-#ifndef TclBN_mp_grow_TCL_DECLARED
-#define TclBN_mp_grow_TCL_DECLARED
 /* 20 */
 EXTERN int		TclBN_mp_grow(mp_int *a, int size);
-#endif
-#ifndef TclBN_mp_init_TCL_DECLARED
-#define TclBN_mp_init_TCL_DECLARED
 /* 21 */
 EXTERN int		TclBN_mp_init(mp_int *a);
-#endif
-#ifndef TclBN_mp_init_copy_TCL_DECLARED
-#define TclBN_mp_init_copy_TCL_DECLARED
 /* 22 */
 EXTERN int		TclBN_mp_init_copy(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_init_multi_TCL_DECLARED
-#define TclBN_mp_init_multi_TCL_DECLARED
 /* 23 */
 EXTERN int		TclBN_mp_init_multi(mp_int *a, ...);
-#endif
-#ifndef TclBN_mp_init_set_TCL_DECLARED
-#define TclBN_mp_init_set_TCL_DECLARED
 /* 24 */
 EXTERN int		TclBN_mp_init_set(mp_int *a, mp_digit b);
-#endif
-#ifndef TclBN_mp_init_size_TCL_DECLARED
-#define TclBN_mp_init_size_TCL_DECLARED
 /* 25 */
 EXTERN int		TclBN_mp_init_size(mp_int *a, int size);
-#endif
-#ifndef TclBN_mp_lshd_TCL_DECLARED
-#define TclBN_mp_lshd_TCL_DECLARED
 /* 26 */
 EXTERN int		TclBN_mp_lshd(mp_int *a, int shift);
-#endif
-#ifndef TclBN_mp_mod_TCL_DECLARED
-#define TclBN_mp_mod_TCL_DECLARED
 /* 27 */
 EXTERN int		TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
-#endif
-#ifndef TclBN_mp_mod_2d_TCL_DECLARED
-#define TclBN_mp_mod_2d_TCL_DECLARED
 /* 28 */
-EXTERN int		TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r);
-#endif
-#ifndef TclBN_mp_mul_TCL_DECLARED
-#define TclBN_mp_mul_TCL_DECLARED
+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);
-#endif
-#ifndef TclBN_mp_mul_d_TCL_DECLARED
-#define TclBN_mp_mul_d_TCL_DECLARED
 /* 30 */
 EXTERN int		TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
-#endif
-#ifndef TclBN_mp_mul_2_TCL_DECLARED
-#define TclBN_mp_mul_2_TCL_DECLARED
 /* 31 */
 EXTERN int		TclBN_mp_mul_2(mp_int *a, mp_int *p);
-#endif
-#ifndef TclBN_mp_mul_2d_TCL_DECLARED
-#define TclBN_mp_mul_2d_TCL_DECLARED
 /* 32 */
-EXTERN int		TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p);
-#endif
-#ifndef TclBN_mp_neg_TCL_DECLARED
-#define TclBN_mp_neg_TCL_DECLARED
+EXTERN int		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
 /* 33 */
-EXTERN int		TclBN_mp_neg(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_or_TCL_DECLARED
-#define TclBN_mp_or_TCL_DECLARED
+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);
-#endif
-#ifndef TclBN_mp_radix_size_TCL_DECLARED
-#define TclBN_mp_radix_size_TCL_DECLARED
 /* 35 */
 EXTERN int		TclBN_mp_radix_size(mp_int *a, int radix, int *size);
-#endif
-#ifndef TclBN_mp_read_radix_TCL_DECLARED
-#define TclBN_mp_read_radix_TCL_DECLARED
 /* 36 */
-EXTERN int		TclBN_mp_read_radix(mp_int *a, CONST char *str,
+EXTERN int		TclBN_mp_read_radix(mp_int *a, const char *str,
 				int radix);
-#endif
-#ifndef TclBN_mp_rshd_TCL_DECLARED
-#define TclBN_mp_rshd_TCL_DECLARED
 /* 37 */
 EXTERN void		TclBN_mp_rshd(mp_int *a, int shift);
-#endif
-#ifndef TclBN_mp_shrink_TCL_DECLARED
-#define TclBN_mp_shrink_TCL_DECLARED
 /* 38 */
 EXTERN int		TclBN_mp_shrink(mp_int *a);
-#endif
-#ifndef TclBN_mp_set_TCL_DECLARED
-#define TclBN_mp_set_TCL_DECLARED
 /* 39 */
 EXTERN void		TclBN_mp_set(mp_int *a, mp_digit b);
-#endif
-#ifndef TclBN_mp_sqr_TCL_DECLARED
-#define TclBN_mp_sqr_TCL_DECLARED
 /* 40 */
 EXTERN int		TclBN_mp_sqr(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_sqrt_TCL_DECLARED
-#define TclBN_mp_sqrt_TCL_DECLARED
 /* 41 */
 EXTERN int		TclBN_mp_sqrt(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_sub_TCL_DECLARED
-#define TclBN_mp_sub_TCL_DECLARED
 /* 42 */
 EXTERN int		TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_mp_sub_d_TCL_DECLARED
-#define TclBN_mp_sub_d_TCL_DECLARED
 /* 43 */
 EXTERN int		TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
-#endif
-#ifndef TclBN_mp_to_unsigned_bin_TCL_DECLARED
-#define TclBN_mp_to_unsigned_bin_TCL_DECLARED
 /* 44 */
 EXTERN int		TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
-#endif
-#ifndef TclBN_mp_to_unsigned_bin_n_TCL_DECLARED
-#define TclBN_mp_to_unsigned_bin_n_TCL_DECLARED
 /* 45 */
 EXTERN int		TclBN_mp_to_unsigned_bin_n(mp_int *a,
 				unsigned char *b, unsigned long *outlen);
-#endif
-#ifndef TclBN_mp_toradix_n_TCL_DECLARED
-#define TclBN_mp_toradix_n_TCL_DECLARED
 /* 46 */
 EXTERN int		TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
 				int maxlen);
-#endif
-#ifndef TclBN_mp_unsigned_bin_size_TCL_DECLARED
-#define TclBN_mp_unsigned_bin_size_TCL_DECLARED
 /* 47 */
 EXTERN int		TclBN_mp_unsigned_bin_size(mp_int *a);
-#endif
-#ifndef TclBN_mp_xor_TCL_DECLARED
-#define TclBN_mp_xor_TCL_DECLARED
 /* 48 */
 EXTERN int		TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_mp_zero_TCL_DECLARED
-#define TclBN_mp_zero_TCL_DECLARED
 /* 49 */
 EXTERN void		TclBN_mp_zero(mp_int *a);
-#endif
-#ifndef TclBN_reverse_TCL_DECLARED
-#define TclBN_reverse_TCL_DECLARED
 /* 50 */
 EXTERN void		TclBN_reverse(unsigned char *s, int len);
-#endif
-#ifndef TclBN_fast_s_mp_mul_digs_TCL_DECLARED
-#define TclBN_fast_s_mp_mul_digs_TCL_DECLARED
 /* 51 */
 EXTERN int		TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
 				mp_int *c, int digs);
-#endif
-#ifndef TclBN_fast_s_mp_sqr_TCL_DECLARED
-#define TclBN_fast_s_mp_sqr_TCL_DECLARED
 /* 52 */
 EXTERN int		TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_karatsuba_mul_TCL_DECLARED
-#define TclBN_mp_karatsuba_mul_TCL_DECLARED
 /* 53 */
 EXTERN int		TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
 				mp_int *c);
-#endif
-#ifndef TclBN_mp_karatsuba_sqr_TCL_DECLARED
-#define TclBN_mp_karatsuba_sqr_TCL_DECLARED
 /* 54 */
 EXTERN int		TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_mp_toom_mul_TCL_DECLARED
-#define TclBN_mp_toom_mul_TCL_DECLARED
 /* 55 */
 EXTERN int		TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_mp_toom_sqr_TCL_DECLARED
-#define TclBN_mp_toom_sqr_TCL_DECLARED
 /* 56 */
 EXTERN int		TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_s_mp_add_TCL_DECLARED
-#define TclBN_s_mp_add_TCL_DECLARED
 /* 57 */
 EXTERN int		TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_s_mp_mul_digs_TCL_DECLARED
-#define TclBN_s_mp_mul_digs_TCL_DECLARED
 /* 58 */
 EXTERN int		TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
 				int digs);
-#endif
-#ifndef TclBN_s_mp_sqr_TCL_DECLARED
-#define TclBN_s_mp_sqr_TCL_DECLARED
 /* 59 */
 EXTERN int		TclBN_s_mp_sqr(mp_int *a, mp_int *b);
-#endif
-#ifndef TclBN_s_mp_sub_TCL_DECLARED
-#define TclBN_s_mp_sub_TCL_DECLARED
 /* 60 */
 EXTERN int		TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
-#endif
-#ifndef TclBN_mp_init_set_int_TCL_DECLARED
-#define TclBN_mp_init_set_int_TCL_DECLARED
 /* 61 */
 EXTERN int		TclBN_mp_init_set_int(mp_int *a, unsigned long i);
-#endif
-#ifndef TclBN_mp_set_int_TCL_DECLARED
-#define TclBN_mp_set_int_TCL_DECLARED
 /* 62 */
 EXTERN int		TclBN_mp_set_int(mp_int *a, unsigned long i);
-#endif
-#ifndef TclBN_mp_cnt_lsb_TCL_DECLARED
-#define TclBN_mp_cnt_lsb_TCL_DECLARED
 /* 63 */
-EXTERN int		TclBN_mp_cnt_lsb(mp_int *a);
-#endif
+EXTERN int		TclBN_mp_cnt_lsb(const mp_int *a);
+/* 64 */
+EXTERN void		TclBNInitBignumFromLong(mp_int *bignum, long initVal);
+/* 65 */
+EXTERN void		TclBNInitBignumFromWideInt(mp_int *bignum,
+				Tcl_WideInt initVal);
+/* 66 */
+EXTERN void		TclBNInitBignumFromWideUInt(mp_int *bignum,
+				Tcl_WideUInt initVal);
 
 typedef struct TclTomMathStubs {
     int magic;
-    struct TclTomMathStubHooks *hooks;
+    void *hooks;
 
     int (*tclBN_epoch) (void); /* 0 */
     int (*tclBN_revision) (void); /* 1 */
@@ -484,15 +300,15 @@ typedef struct TclTomMathStubs {
     void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
     void (*tclBN_mp_clear) (mp_int *a); /* 6 */
     void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
-    int (*tclBN_mp_cmp) (mp_int *a, mp_int *b); /* 8 */
-    int (*tclBN_mp_cmp_d) (mp_int *a, mp_digit b); /* 9 */
-    int (*tclBN_mp_cmp_mag) (mp_int *a, mp_int *b); /* 10 */
-    int (*tclBN_mp_copy) (mp_int *a, mp_int *b); /* 11 */
-    int (*tclBN_mp_count_bits) (mp_int *a); /* 12 */
+    int (*tclBN_mp_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) (mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
+    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 */
@@ -504,15 +320,15 @@ typedef struct TclTomMathStubs {
     int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
     int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
     int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
-    int (*tclBN_mp_mod_2d) (mp_int *a, int b, mp_int *r); /* 28 */
+    int (*tclBN_mp_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) (mp_int *a, int d, mp_int *p); /* 32 */
-    int (*tclBN_mp_neg) (mp_int *a, mp_int *b); /* 33 */
+    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 */
+    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 */
@@ -539,279 +355,160 @@ typedef struct TclTomMathStubs {
     int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
     int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
     int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
-    int (*tclBN_mp_cnt_lsb) (mp_int *a); /* 63 */
+    int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
+    void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
+    void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
+    void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
 } TclTomMathStubs;
 
-extern TclTomMathStubs *tclTomMathStubsPtr;
+extern const TclTomMathStubs *tclTomMathStubsPtr;
 
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+#if defined(USE_TCL_STUBS)
 
 /*
  * Inline function declarations:
  */
 
-#ifndef TclBN_epoch
 #define TclBN_epoch \
 	(tclTomMathStubsPtr->tclBN_epoch) /* 0 */
-#endif
-#ifndef TclBN_revision
 #define TclBN_revision \
 	(tclTomMathStubsPtr->tclBN_revision) /* 1 */
-#endif
-#ifndef TclBN_mp_add
 #define TclBN_mp_add \
 	(tclTomMathStubsPtr->tclBN_mp_add) /* 2 */
-#endif
-#ifndef TclBN_mp_add_d
 #define TclBN_mp_add_d \
 	(tclTomMathStubsPtr->tclBN_mp_add_d) /* 3 */
-#endif
-#ifndef TclBN_mp_and
 #define TclBN_mp_and \
 	(tclTomMathStubsPtr->tclBN_mp_and) /* 4 */
-#endif
-#ifndef TclBN_mp_clamp
 #define TclBN_mp_clamp \
 	(tclTomMathStubsPtr->tclBN_mp_clamp) /* 5 */
-#endif
-#ifndef TclBN_mp_clear
 #define TclBN_mp_clear \
 	(tclTomMathStubsPtr->tclBN_mp_clear) /* 6 */
-#endif
-#ifndef TclBN_mp_clear_multi
 #define TclBN_mp_clear_multi \
 	(tclTomMathStubsPtr->tclBN_mp_clear_multi) /* 7 */
-#endif
-#ifndef TclBN_mp_cmp
 #define TclBN_mp_cmp \
 	(tclTomMathStubsPtr->tclBN_mp_cmp) /* 8 */
-#endif
-#ifndef TclBN_mp_cmp_d
 #define TclBN_mp_cmp_d \
 	(tclTomMathStubsPtr->tclBN_mp_cmp_d) /* 9 */
-#endif
-#ifndef TclBN_mp_cmp_mag
 #define TclBN_mp_cmp_mag \
 	(tclTomMathStubsPtr->tclBN_mp_cmp_mag) /* 10 */
-#endif
-#ifndef TclBN_mp_copy
 #define TclBN_mp_copy \
 	(tclTomMathStubsPtr->tclBN_mp_copy) /* 11 */
-#endif
-#ifndef TclBN_mp_count_bits
 #define TclBN_mp_count_bits \
 	(tclTomMathStubsPtr->tclBN_mp_count_bits) /* 12 */
-#endif
-#ifndef TclBN_mp_div
 #define TclBN_mp_div \
 	(tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
-#endif
-#ifndef TclBN_mp_div_d
 #define TclBN_mp_div_d \
 	(tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
-#endif
-#ifndef TclBN_mp_div_2
 #define TclBN_mp_div_2 \
 	(tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
-#endif
-#ifndef TclBN_mp_div_2d
 #define TclBN_mp_div_2d \
 	(tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
-#endif
-#ifndef TclBN_mp_div_3
 #define TclBN_mp_div_3 \
 	(tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */
-#endif
-#ifndef TclBN_mp_exch
 #define TclBN_mp_exch \
 	(tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
-#endif
-#ifndef TclBN_mp_expt_d
 #define TclBN_mp_expt_d \
 	(tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */
-#endif
-#ifndef TclBN_mp_grow
 #define TclBN_mp_grow \
 	(tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
-#endif
-#ifndef TclBN_mp_init
 #define TclBN_mp_init \
 	(tclTomMathStubsPtr->tclBN_mp_init) /* 21 */
-#endif
-#ifndef TclBN_mp_init_copy
 #define TclBN_mp_init_copy \
 	(tclTomMathStubsPtr->tclBN_mp_init_copy) /* 22 */
-#endif
-#ifndef TclBN_mp_init_multi
 #define TclBN_mp_init_multi \
 	(tclTomMathStubsPtr->tclBN_mp_init_multi) /* 23 */
-#endif
-#ifndef TclBN_mp_init_set
 #define TclBN_mp_init_set \
 	(tclTomMathStubsPtr->tclBN_mp_init_set) /* 24 */
-#endif
-#ifndef TclBN_mp_init_size
 #define TclBN_mp_init_size \
 	(tclTomMathStubsPtr->tclBN_mp_init_size) /* 25 */
-#endif
-#ifndef TclBN_mp_lshd
 #define TclBN_mp_lshd \
 	(tclTomMathStubsPtr->tclBN_mp_lshd) /* 26 */
-#endif
-#ifndef TclBN_mp_mod
 #define TclBN_mp_mod \
 	(tclTomMathStubsPtr->tclBN_mp_mod) /* 27 */
-#endif
-#ifndef TclBN_mp_mod_2d
 #define TclBN_mp_mod_2d \
 	(tclTomMathStubsPtr->tclBN_mp_mod_2d) /* 28 */
-#endif
-#ifndef TclBN_mp_mul
 #define TclBN_mp_mul \
 	(tclTomMathStubsPtr->tclBN_mp_mul) /* 29 */
-#endif
-#ifndef TclBN_mp_mul_d
 #define TclBN_mp_mul_d \
 	(tclTomMathStubsPtr->tclBN_mp_mul_d) /* 30 */
-#endif
-#ifndef TclBN_mp_mul_2
 #define TclBN_mp_mul_2 \
 	(tclTomMathStubsPtr->tclBN_mp_mul_2) /* 31 */
-#endif
-#ifndef TclBN_mp_mul_2d
 #define TclBN_mp_mul_2d \
 	(tclTomMathStubsPtr->tclBN_mp_mul_2d) /* 32 */
-#endif
-#ifndef TclBN_mp_neg
 #define TclBN_mp_neg \
 	(tclTomMathStubsPtr->tclBN_mp_neg) /* 33 */
-#endif
-#ifndef TclBN_mp_or
 #define TclBN_mp_or \
 	(tclTomMathStubsPtr->tclBN_mp_or) /* 34 */
-#endif
-#ifndef TclBN_mp_radix_size
 #define TclBN_mp_radix_size \
 	(tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
-#endif
-#ifndef TclBN_mp_read_radix
 #define TclBN_mp_read_radix \
 	(tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
-#endif
-#ifndef TclBN_mp_rshd
 #define TclBN_mp_rshd \
 	(tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
-#endif
-#ifndef TclBN_mp_shrink
 #define TclBN_mp_shrink \
 	(tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
-#endif
-#ifndef TclBN_mp_set
 #define TclBN_mp_set \
 	(tclTomMathStubsPtr->tclBN_mp_set) /* 39 */
-#endif
-#ifndef TclBN_mp_sqr
 #define TclBN_mp_sqr \
 	(tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */
-#endif
-#ifndef TclBN_mp_sqrt
 #define TclBN_mp_sqrt \
 	(tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
-#endif
-#ifndef TclBN_mp_sub
 #define TclBN_mp_sub \
 	(tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
-#endif
-#ifndef TclBN_mp_sub_d
 #define TclBN_mp_sub_d \
 	(tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */
-#endif
-#ifndef TclBN_mp_to_unsigned_bin
 #define TclBN_mp_to_unsigned_bin \
 	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */
-#endif
-#ifndef TclBN_mp_to_unsigned_bin_n
 #define TclBN_mp_to_unsigned_bin_n \
 	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */
-#endif
-#ifndef TclBN_mp_toradix_n
 #define TclBN_mp_toradix_n \
 	(tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */
-#endif
-#ifndef TclBN_mp_unsigned_bin_size
 #define TclBN_mp_unsigned_bin_size \
 	(tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */
-#endif
-#ifndef TclBN_mp_xor
 #define TclBN_mp_xor \
 	(tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
-#endif
-#ifndef TclBN_mp_zero
 #define TclBN_mp_zero \
 	(tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */
-#endif
-#ifndef TclBN_reverse
 #define TclBN_reverse \
 	(tclTomMathStubsPtr->tclBN_reverse) /* 50 */
-#endif
-#ifndef TclBN_fast_s_mp_mul_digs
 #define TclBN_fast_s_mp_mul_digs \
 	(tclTomMathStubsPtr->tclBN_fast_s_mp_mul_digs) /* 51 */
-#endif
-#ifndef TclBN_fast_s_mp_sqr
 #define TclBN_fast_s_mp_sqr \
 	(tclTomMathStubsPtr->tclBN_fast_s_mp_sqr) /* 52 */
-#endif
-#ifndef TclBN_mp_karatsuba_mul
 #define TclBN_mp_karatsuba_mul \
 	(tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */
-#endif
-#ifndef TclBN_mp_karatsuba_sqr
 #define TclBN_mp_karatsuba_sqr \
 	(tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */
-#endif
-#ifndef TclBN_mp_toom_mul
 #define TclBN_mp_toom_mul \
 	(tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */
-#endif
-#ifndef TclBN_mp_toom_sqr
 #define TclBN_mp_toom_sqr \
 	(tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */
-#endif
-#ifndef TclBN_s_mp_add
 #define TclBN_s_mp_add \
 	(tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */
-#endif
-#ifndef TclBN_s_mp_mul_digs
 #define TclBN_s_mp_mul_digs \
 	(tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */
-#endif
-#ifndef TclBN_s_mp_sqr
 #define TclBN_s_mp_sqr \
 	(tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */
-#endif
-#ifndef TclBN_s_mp_sub
 #define TclBN_s_mp_sub \
 	(tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */
-#endif
-#ifndef TclBN_mp_init_set_int
 #define TclBN_mp_init_set_int \
 	(tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */
-#endif
-#ifndef TclBN_mp_set_int
 #define TclBN_mp_set_int \
 	(tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
-#endif
-#ifndef TclBN_mp_cnt_lsb
 #define TclBN_mp_cnt_lsb \
 	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
-#endif
+#define TclBNInitBignumFromLong \
+	(tclTomMathStubsPtr->tclBNInitBignumFromLong) /* 64 */
+#define TclBNInitBignumFromWideInt \
+	(tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */
+#define TclBNInitBignumFromWideUInt \
+	(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
 
-#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+#endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
 
diff --git a/generic/tclTomMathInt.h b/generic/tclTomMathInt.h
index 1b9eb64..831f13f 100644
--- a/generic/tclTomMathInt.h
+++ b/generic/tclTomMathInt.h
@@ -1,2 +1,3 @@
+#include "tclInt.h"
 #include "tclTomMath.h"
 #include "tommath_class.h"
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 89c1132..48db8c3 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -14,9 +14,8 @@
 
 #include "tclInt.h"
 #include "tommath.h"
-#include <limits.h>
 
-extern TclTomMathStubs tclTomMathStubs;
+MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
 
 /*
  *----------------------------------------------------------------------
@@ -38,12 +37,12 @@ extern TclTomMathStubs tclTomMathStubs;
 
 int
 TclTommath_Init(
-    Tcl_Interp* interp		/* Tcl interpreter */
-) {
+    Tcl_Interp *interp)		/* Tcl interpreter */
+{
     /* TIP #268: Full patchlevel instead of just major.minor */
 
     if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
-			 (ClientData)&tclTomMathStubs) != TCL_OK) {
+	    &tclTomMathStubs) != TCL_OK) {
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -162,7 +161,7 @@ extern void
 TclBNFree(
     void *p)
 {
-    ckfree((char *) p);
+    ckree((char *) p);
 }
 #endif
 
@@ -189,7 +188,7 @@ TclBNInitBignumFromLong(
 {
     int status;
     unsigned long v;
-    mp_digit* p;
+    mp_digit *p;
 
     /*
      * Allocate enough memory to hold the largest possible long
diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c
new file mode 100644
index 0000000..324f2a3
--- /dev/null
+++ b/generic/tclTomMathStubLib.c
@@ -0,0 +1,79 @@
+/*
+ * 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.
+ */
+
+#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;
+    TclTomMathStubs *stubsPtr = NULL;
+    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+	    packageName, version, exact, &stubsPtr);
+
+    if (actualVersion == NULL) {
+	return NULL;
+    }
+    if (stubsPtr == NULL) {
+	errMsg = "missing stub table pointer";
+    } else if(stubsPtr->tclBN_epoch() != epoch) {
+	errMsg = "epoch number mismatch";
+    } else if(stubsPtr->tclBN_revision() != revision) {
+	errMsg = "requires a later revision";
+    } else {
+	tclTomMathStubsPtr = stubsPtr;
+	return actualVersion;
+    }
+    tclStubsPtr->tcl_ResetResult(interp);
+    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+	    " (requested version ", version, ", actual version ",
+	    actualVersion, "): ", errMsg, NULL);
+    return NULL;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 2e1b241..4e74c54 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -22,11 +22,11 @@ typedef struct {
     int flags;			/* Operations for which Tcl command is to be
 				 * invoked. */
     size_t length;		/* Number of non-NUL chars. in command. */
-    char command[4];		/* Space for Tcl command to invoke. Actual
+    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 4
-				 * bytes. */
+				 * structure, so that it can be larger than 1
+				 * byte. */
 } TraceVarInfo;
 
 typedef struct {
@@ -56,11 +56,11 @@ typedef struct {
 				 * 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
+    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 4
-				 * bytes. */
+				 * structure, so that it can be larger than 1
+				 * byte. */
 } TraceCommandInfo;
 
 /*
@@ -107,7 +107,7 @@ static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;
  * add to the list of supported trace types.
  */
 
-static const char *traceTypeOptions[] = {
+static const char *const traceTypeOptions[] = {
     "execution", "command", "variable", NULL
 };
 static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
@@ -147,6 +147,21 @@ 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_VarTraceInfo2((interp), (name), NULL, \
+	    0, TraceVarProc, (clientData))) != NULL)
+
+#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
+    (clientData) = NULL; \
+    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
+	    TraceCommandProc, clientData)) != NULL)
 
 /*
  *----------------------------------------------------------------------
@@ -176,9 +191,10 @@ Tcl_TraceObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int optionIndex;
-    char *name, *flagOps, *p;
+    const char *name;
+    const char *flagOps, *p;
     /* Main sub commands to 'trace' */
-    static const char *traceOptions[] = {
+    static const char *const traceOptions[] = {
 	"add", "info", "remove",
 #ifndef TCL_REMOVE_OBSOLETE_TRACES
 	"variable", "vdelete", "vinfo",
@@ -194,12 +210,12 @@ Tcl_TraceObjCmd(
     };
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	return TCL_ERROR;
     }
 
-    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
-		"option", 0, &optionIndex) != TCL_OK) {
+    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
+	    &optionIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
     switch ((enum traceOptions) optionIndex) {
@@ -214,14 +230,14 @@ Tcl_TraceObjCmd(
 	int typeIndex;
 
 	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
+	    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);
+	return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
     }
     case TRACE_INFO: {
 	/*
@@ -244,7 +260,7 @@ Tcl_TraceObjCmd(
 		0, &typeIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+	return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
 	break;
     }
 
@@ -288,9 +304,9 @@ Tcl_TraceObjCmd(
 	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);
+	    code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv);
 	} else {
-	    code = (traceSubCmds[2])(interp, TRACE_REMOVE, objc+1, copyObjv);
+	    code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
 	}
 	Tcl_DecrRefCount(opsList);
 	return code;
@@ -305,32 +321,29 @@ Tcl_TraceObjCmd(
 	    return TCL_ERROR;
 	}
 	resultListPtr = Tcl_NewObj();
-	clientData = 0;
 	name = Tcl_GetString(objv[2]);
-	while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
-		TraceVarProc, clientData)) != 0) {
-
-	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+	FOREACH_VAR_TRACE(interp, name, clientData) {
+	    TraceVarInfo *tvarPtr = clientData;
+	    char *q = ops;
 
 	    pairObjPtr = Tcl_NewListObj(0, NULL);
-	    p = ops;
 	    if (tvarPtr->flags & TCL_TRACE_READS) {
-		*p = 'r';
-		p++;
+		*q = 'r';
+		q++;
 	    }
 	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
-		*p = 'w';
-		p++;
+		*q = 'w';
+		q++;
 	    }
 	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-		*p = 'u';
-		p++;
+		*q = 'u';
+		q++;
 	    }
 	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
-		*p = 'a';
-		p++;
+		*q = 'a';
+		q++;
 	    }
-	    *p = '\0';
+	    *q = '\0';
 
 	    /*
 	     * Build a pair (2-item list) with the ops string as the first obj
@@ -353,8 +366,10 @@ Tcl_TraceObjCmd(
     return TCL_OK;
 
   badVarOps:
-    Tcl_AppendResult(interp, "bad operations \"", flagOps,
-	    "\": should be one or more of rwua", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "bad operations \"%s\": should be one or more of rwua",
+	    flagOps));
+    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
     return TCL_ERROR;
 }
 
@@ -385,12 +400,12 @@ TraceExecutionObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int commandLength, index;
-    char *name, *command;
+    const char *name, *command;
     size_t length;
     enum traceOptions {
 	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
     };
-    static const char *opStrings[] = {
+    static const char *const opStrings[] = {
 	"enter", "leave", "enterstep", "leavestep", NULL
     };
     enum operations {
@@ -420,9 +435,11 @@ TraceExecutionObjCmd(
 	    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_SetObjResult(interp, Tcl_NewStringObj(
+		    "bad operation list \"\": must be one or more of"
+		    " enter, leave, enterstep, or leavestep", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
+		    NULL);
 	    return TCL_ERROR;
 	}
 	for (i = 0; i < listLen; i++) {
@@ -448,11 +465,9 @@ TraceExecutionObjCmd(
 	command = Tcl_GetStringFromObj(objv[5], &commandLength);
 	length = (size_t) commandLength;
 	if ((enum traceOptions) optionIndex == TRACE_ADD) {
-	    TraceCommandInfo *tcmdPtr;
+	    TraceCommandInfo *tcmdPtr = ckalloc(
+		    TclOffset(TraceCommandInfo, command) + 1 + length);
 
-	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
-		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
-			    + length + 1));
 	    tcmdPtr->flags = flags;
 	    tcmdPtr->stepTrace = NULL;
 	    tcmdPtr->startLevel = 0;
@@ -467,8 +482,8 @@ TraceExecutionObjCmd(
 	    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);
+		    tcmdPtr) != TCL_OK) {
+		ckfree(tcmdPtr);
 		return TCL_ERROR;
 	    }
 	} else {
@@ -478,21 +493,19 @@ TraceExecutionObjCmd(
 	     * first one that matches.
 	     */
 
-	    TraceCommandInfo *tcmdPtr;
-	    ClientData clientData = NULL;
-	    name = Tcl_GetString(objv[3]);
+	    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;
 	    }
 
-	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-		    TraceCommandProc, clientData)) != NULL) {
-		tcmdPtr = (TraceCommandInfo *) clientData;
+	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
+		TraceCommandInfo *tcmdPtr = clientData;
 
 		/*
 		 * In checking the 'flags' field we must remove any extraneous
@@ -521,7 +534,7 @@ TraceExecutionObjCmd(
 			Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 			tcmdPtr->stepTrace = NULL;
 			if (tcmdPtr->startCmd != NULL) {
-			    ckfree((char *) tcmdPtr->startCmd);
+			    ckfree(tcmdPtr->startCmd);
 			}
 		    }
 		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -531,8 +544,8 @@ TraceExecutionObjCmd(
 
 			tcmdPtr->flags = 0;
 		    }
-		    if ((--tcmdPtr->refCount) <= 0) {
-			ckfree((char *) tcmdPtr);
+		    if (tcmdPtr->refCount-- <= 1) {
+			ckfree(tcmdPtr);
 		    }
 		    break;
 		}
@@ -542,14 +555,13 @@ TraceExecutionObjCmd(
     }
     case TRACE_INFO: {
 	ClientData clientData;
-	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	Tcl_Obj *resultListPtr;
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 3, objv, "name");
 	    return TCL_ERROR;
 	}
 
-	clientData = NULL;
 	name = Tcl_GetString(objv[3]);
 
 	/*
@@ -561,11 +573,10 @@ TraceExecutionObjCmd(
 	}
 
 	resultListPtr = Tcl_NewListObj(0, NULL);
-	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-		TraceCommandProc, clientData)) != NULL) {
+	FOREACH_COMMAND_TRACE(interp, name, clientData) {
 	    int numOps = 0;
-	    Tcl_Obj *opObj;
-	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
+	    TraceCommandInfo *tcmdPtr = clientData;
 
 	    /*
 	     * Build a list with the ops list as the first obj element and the
@@ -639,10 +650,10 @@ TraceCommandObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int commandLength, index;
-    char *name, *command;
+    const char *name, *command;
     size_t length;
     enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static const char *opStrings[] = { "delete", "rename", NULL };
+    static const char *const opStrings[] = { "delete", "rename", NULL };
     enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
 
     switch ((enum traceOptions) optionIndex) {
@@ -667,8 +678,11 @@ TraceCommandObjCmd(
 	    return result;
 	}
 	if (listLen == 0) {
-	    Tcl_SetResult(interp, "bad operation list \"\": must be "
-		    "one or more of delete or rename", TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "bad operation list \"\": must be one or more of"
+		    " delete or rename", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
+		    NULL);
 	    return TCL_ERROR;
 	}
 
@@ -690,11 +704,9 @@ TraceCommandObjCmd(
 	command = Tcl_GetStringFromObj(objv[5], &commandLength);
 	length = (size_t) commandLength;
 	if ((enum traceOptions) optionIndex == TRACE_ADD) {
-	    TraceCommandInfo *tcmdPtr;
+	    TraceCommandInfo *tcmdPtr = ckalloc(
+		    TclOffset(TraceCommandInfo, command) + 1 + length);
 
-	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
-		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
-			    + length + 1));
 	    tcmdPtr->flags = flags;
 	    tcmdPtr->stepTrace = NULL;
 	    tcmdPtr->startLevel = 0;
@@ -705,8 +717,8 @@ TraceCommandObjCmd(
 	    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);
+		    tcmdPtr) != TCL_OK) {
+		ckfree(tcmdPtr);
 		return TCL_ERROR;
 	    }
 	} else {
@@ -716,30 +728,28 @@ TraceCommandObjCmd(
 	     * first one that matches.
 	     */
 
-	    TraceCommandInfo *tcmdPtr;
-	    ClientData clientData = NULL;
-	    name = Tcl_GetString(objv[3]);
+	    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;
 	    }
 
-	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-		    TraceCommandProc, clientData)) != NULL) {
-		tcmdPtr = (TraceCommandInfo *) clientData;
-		if ((tcmdPtr->length == length)
-			&& (tcmdPtr->flags == flags)
+	    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((char *) tcmdPtr);
+		    if (tcmdPtr->refCount-- <= 1) {
+			ckfree(tcmdPtr);
 		    }
 		    break;
 		}
@@ -749,30 +759,27 @@ TraceCommandObjCmd(
     }
     case TRACE_INFO: {
 	ClientData clientData;
-	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	Tcl_Obj *resultListPtr;
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 3, objv, "name");
 	    return TCL_ERROR;
 	}
 
-	clientData = NULL;
-	name = Tcl_GetString(objv[3]);
-
 	/*
 	 * First ensure the name given is valid.
 	 */
 
+	name = Tcl_GetString(objv[3]);
 	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
 	    return TCL_ERROR;
 	}
 
 	resultListPtr = Tcl_NewListObj(0, NULL);
-	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
-		TraceCommandProc, clientData)) != NULL) {
+	FOREACH_COMMAND_TRACE(interp, name, clientData) {
 	    int numOps = 0;
-	    Tcl_Obj *opObj;
-	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
+	    TraceCommandInfo *tcmdPtr = clientData;
 
 	    /*
 	     * Build a list with the ops list as the first obj element and the
@@ -837,10 +844,11 @@ TraceVariableObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int commandLength, index;
-    char *name, *command;
+    const char *name, *command;
     size_t length;
+    ClientData clientData;
     enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static const char *opStrings[] = {
+    static const char *const opStrings[] = {
 	"array", "read", "unset", "write", NULL
     };
     enum operations {
@@ -869,8 +877,11 @@ TraceVariableObjCmd(
 	    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_SetObjResult(interp, Tcl_NewStringObj(
+		    "bad operation list \"\": must be one or more of"
+		    " array, read, unset, or write", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
+		    NULL);
 	    return TCL_ERROR;
 	}
 	for (i = 0; i < listLen ; i++) {
@@ -896,11 +907,10 @@ TraceVariableObjCmd(
 	command = Tcl_GetStringFromObj(objv[5], &commandLength);
 	length = (size_t) commandLength;
 	if ((enum traceOptions) optionIndex == TRACE_ADD) {
-	    CombinedTraceVarInfo *ctvarPtr;
+	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
+		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
+		    + 1 + length);
 
-	    ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)
-		    (sizeof(CombinedTraceVarInfo) + length + 1
-		    - sizeof(ctvarPtr->traceCmdInfo.command)));
 	    ctvarPtr->traceCmdInfo.flags = flags;
 	    if (objv[0] == NULL) {
 		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
@@ -909,12 +919,12 @@ TraceVariableObjCmd(
 	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
 	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
 	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
-	    ctvarPtr->traceInfo.clientData = (ClientData)
-		    &ctvarPtr->traceCmdInfo;
+	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
 	    ctvarPtr->traceInfo.flags = flags;
 	    name = Tcl_GetString(objv[3]);
-	    if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) {
-		ckfree((char *) ctvarPtr);
+	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
+		    != TCL_OK) {
+		ckfree(ctvarPtr);
 		return TCL_ERROR;
 	    }
 	} else {
@@ -924,12 +934,10 @@ TraceVariableObjCmd(
 	     * 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;
+	    FOREACH_VAR_TRACE(interp, name, clientData) {
+		TraceVarInfo *tvarPtr = clientData;
+
 		if ((tvarPtr->length == length)
 			&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
 			&& (strncmp(command, tvarPtr->command,
@@ -944,8 +952,7 @@ TraceVariableObjCmd(
 	break;
     }
     case TRACE_INFO: {
-	ClientData clientData;
-	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	Tcl_Obj *resultListPtr;
 
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 3, objv, "name");
@@ -953,12 +960,10 @@ TraceVariableObjCmd(
 	}
 
 	resultListPtr = Tcl_NewObj();
-	clientData = 0;
 	name = Tcl_GetString(objv[3]);
-	while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
-		clientData)) != 0) {
-	    Tcl_Obj *opObj;
-	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+	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
@@ -968,20 +973,20 @@ TraceVariableObjCmd(
 
 	    elemObjPtr = Tcl_NewListObj(0, NULL);
 	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
-		TclNewLiteralStringObj(opObj, "array");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+		TclNewLiteralStringObj(opObjPtr, "array");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
 	    }
 	    if (tvarPtr->flags & TCL_TRACE_READS) {
-		TclNewLiteralStringObj(opObj, "read");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+		TclNewLiteralStringObj(opObjPtr, "read");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
 	    }
 	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
-		TclNewLiteralStringObj(opObj, "write");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+		TclNewLiteralStringObj(opObjPtr, "write");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
 	    }
 	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-		TclNewLiteralStringObj(opObj, "unset");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
+		TclNewLiteralStringObj(opObjPtr, "unset");
+		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
 	    }
 	    eachTraceObjPtr = Tcl_NewListObj(0, NULL);
 	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
@@ -1113,7 +1118,7 @@ Tcl_TraceCommand(
      * Set up trace information.
      */
 
-    tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
+    tracePtr = ckalloc(sizeof(CommandTrace));
     tracePtr->traceProc = proc;
     tracePtr->clientData = clientData;
     tracePtr->flags = flags &
@@ -1125,7 +1130,7 @@ Tcl_TraceCommand(
 	/*
 	 * 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++;
@@ -1133,7 +1138,7 @@ Tcl_TraceCommand(
 	cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
     }
 
-    
+
     return TCL_OK;
 }
 
@@ -1218,8 +1223,8 @@ Tcl_UntraceCommand(
     }
     tracePtr->flags = 0;
 
-    if ((--tracePtr->refCount) <= 0) {
-	ckfree((char *) tracePtr);
+    if (tracePtr->refCount-- <= 1) {
+	ckfree(tracePtr);
     }
 
     if (hasExecTraces) {
@@ -1240,7 +1245,7 @@ Tcl_UntraceCommand(
         /*
 	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
 	 */
-	
+
 	if (cmdPtr->compileProc != NULL) {
 	    Interp *iPtr = (Interp *) interp;
 	    iPtr->compileEpoch++;
@@ -1278,7 +1283,7 @@ TraceCommandProc(
     int flags)			/* OR-ed bits giving operation and other
 				 * information. */
 {
-    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    TraceCommandInfo *tcmdPtr = clientData;
     int code;
     Tcl_DString cmd;
 
@@ -1296,9 +1301,9 @@ TraceCommandProc(
 	Tcl_DStringAppendElement(&cmd, oldName);
 	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
 	if (flags & TCL_TRACE_RENAME) {
-	    Tcl_DStringAppend(&cmd, " rename", 7);
+	    TclDStringAppendLiteral(&cmd, " rename");
 	} else if (flags & TCL_TRACE_DELETE) {
-	    Tcl_DStringAppend(&cmd, " delete", 7);
+	    TclDStringAppendLiteral(&cmd, " delete");
 	}
 
 	/*
@@ -1317,7 +1322,7 @@ TraceCommandProc(
 		Tcl_DStringLength(&cmd), 0);
 	if (code != TCL_OK) {
 	    /* We ignore errors in these traced commands */
-	    /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
+	    /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/
 	}
 	Tcl_DStringFree(&cmd);
     }
@@ -1335,7 +1340,7 @@ TraceCommandProc(
 	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 	    tcmdPtr->stepTrace = NULL;
 	    if (tcmdPtr->startCmd != NULL) {
-		ckfree((char *) tcmdPtr->startCmd);
+		ckfree(tcmdPtr->startCmd);
 	    }
 	}
 	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
@@ -1374,11 +1379,11 @@ TraceCommandProc(
 	state = Tcl_SaveInterpState(interp, TCL_OK);
 	Tcl_UntraceCommand(interp, oldName, untraceFlags,
 		TraceCommandProc, clientData);
-	(void) Tcl_RestoreInterpState(interp, state);
+	Tcl_RestoreInterpState(interp, state);
 	tcmdPtr->refCount--;
     }
-    if ((--tcmdPtr->refCount) <= 0) {
-	ckfree((char *) tcmdPtr);
+    if (tcmdPtr->refCount-- <= 1) {
+	ckfree(tcmdPtr);
     }
 }
 
@@ -1458,8 +1463,7 @@ TclCheckExecutionTraces(
 	    active.nextTracePtr = tracePtr->nextPtr;
 	}
 	if (tracePtr->traceProc == TraceCommandProc) {
-	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
-		    tracePtr->clientData;
+	    TraceCommandInfo *tcmdPtr = tracePtr->clientData;
 
 	    if (tcmdPtr->flags != 0) {
 		tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
@@ -1468,10 +1472,10 @@ TclCheckExecutionTraces(
 		if (state == NULL) {
 		    state = Tcl_SaveInterpState(interp, code);
 		}
-		traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp,
-			curLevel, command, (Tcl_Command) cmdPtr, objc, objv);
-		if ((--tcmdPtr->refCount) <= 0) {
-		    ckfree((char *) tcmdPtr);
+		traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
+			command, (Tcl_Command) cmdPtr, objc, objv);
+		if (tcmdPtr->refCount-- <= 1) {
+		    ckfree(tcmdPtr);
 		}
 	    }
 	}
@@ -1488,7 +1492,7 @@ TclCheckExecutionTraces(
 	}
     }
 
-    return(traceCode);
+    return traceCode;
 }
 
 /*
@@ -1586,7 +1590,7 @@ TclCheckInterpTraces(
 	     * it.
 	     */
 
-	    Tcl_Preserve((ClientData) tracePtr);
+	    Tcl_Preserve(tracePtr);
 	    tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
 	    if (state == NULL) {
 		state = Tcl_SaveInterpState(interp, code);
@@ -1600,15 +1604,14 @@ TclCheckInterpTraces(
 
 		if (tracePtr->flags & traceFlags) {
 		    if (tracePtr->proc == TraceExecutionProc) {
-			TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
-				tracePtr->clientData;
+			TraceCommandInfo *tcmdPtr = tracePtr->clientData;
 
 			tcmdPtr->curFlags = traceFlags;
 			tcmdPtr->curCode = code;
 		    }
-		    traceCode = (tracePtr->proc)(tracePtr->clientData,
-			    interp, curLevel, command, (Tcl_Command) cmdPtr,
-			    objc, objv);
+		    traceCode = tracePtr->proc(tracePtr->clientData, interp,
+			    curLevel, command, (Tcl_Command) cmdPtr, objc,
+			    objv);
 		}
 	    } else {
 		/*
@@ -1626,19 +1629,19 @@ TclCheckInterpTraces(
 		}
 	    }
 	    tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
-	    Tcl_Release((ClientData) tracePtr);
+	    Tcl_Release(tracePtr);
 	}
     }
     iPtr->activeInterpTracePtr = active.nextPtr;
     if (state) {
 	if (traceCode == TCL_OK) {
-	    (void) Tcl_RestoreInterpState(interp, state);
+	    Tcl_RestoreInterpState(interp, state);
 	} else {
 	    Tcl_DiscardInterpState(state);
 	}
     }
 
-    return(traceCode);
+    return traceCode;
 }
 
 /*
@@ -1680,7 +1683,7 @@ CallTraceFunction(
      * Copy the command characters into a new string.
      */
 
-    commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1));
+    commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1);
     memcpy(commandCopy, command, (size_t) numChars);
     commandCopy[numChars] = '\0';
 
@@ -1688,7 +1691,7 @@ CallTraceFunction(
      * Call the trace function then free allocated storage.
      */
 
-    traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp *) iPtr,
+    traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr,
 	    iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
 
     TclStackFree(interp, commandCopy);
@@ -1716,10 +1719,10 @@ static void
 CommandObjTraceDeleted(
     ClientData clientData)
 {
-    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    TraceCommandInfo *tcmdPtr = clientData;
 
-    if ((--tcmdPtr->refCount) <= 0) {
-	ckfree((char *) tcmdPtr);
+    if (tcmdPtr->refCount-- <= 1) {
+	ckfree(tcmdPtr);
     }
 }
 
@@ -1760,7 +1763,7 @@ TraceExecutionProc(
 {
     int call = 0;
     Interp *iPtr = (Interp *) interp;
-    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    TraceCommandInfo *tcmdPtr = clientData;
     int flags = tcmdPtr->curFlags;
     int code = tcmdPtr->curCode;
     int traceCode = TCL_OK;
@@ -1802,7 +1805,7 @@ TraceExecutionProc(
 	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
 	    tcmdPtr->stepTrace = NULL;
 	    if (tcmdPtr->startCmd != NULL) {
-		ckfree((char *) tcmdPtr->startCmd);
+		ckfree(tcmdPtr->startCmd);
 	    }
 	}
 
@@ -1811,8 +1814,7 @@ TraceExecutionProc(
 	 */
 
 	if (call) {
-	    Tcl_DString cmd;
-	    Tcl_DString sub;
+	    Tcl_DString cmd, sub;
 	    int i, saveInterpFlags;
 
 	    Tcl_DStringInit(&cmd);
@@ -1841,7 +1843,7 @@ TraceExecutionProc(
 		}
 	    } else if (flags & TCL_TRACE_LEAVE_EXEC) {
 		Tcl_Obj *resultCode;
-		char *resultCodeStr;
+		const char *resultCodeStr;
 
 		/*
 		 * Append result code.
@@ -1887,7 +1889,8 @@ TraceExecutionProc(
 	     * interpreter.
 	     */
 
-	    traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+	    traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+		    Tcl_DStringLength(&cmd), 0);
 	    tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
 
 	    /*
@@ -1921,8 +1924,7 @@ TraceExecutionProc(
 	    tcmdPtr->refCount++;
 	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
 		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
-		   TraceExecutionProc, (ClientData)tcmdPtr,
-		   CommandObjTraceDeleted);
+		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
 	}
     }
     if (flags & TCL_TRACE_DESTROYED) {
@@ -1935,8 +1937,8 @@ TraceExecutionProc(
 	}
     }
     if (call) {
-	if ((--tcmdPtr->refCount) <= 0) {
-	    ckfree((char *) tcmdPtr);
+	if (tcmdPtr->refCount-- <= 1) {
+	    ckfree(tcmdPtr);
 	}
     }
     return traceCode;
@@ -1971,10 +1973,11 @@ TraceVarProc(
     int flags)			/* OR-ed bits giving operation and other
 				 * information. */
 {
-    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+    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]
@@ -1999,24 +2002,24 @@ TraceVarProc(
 #ifndef TCL_REMOVE_OBSOLETE_TRACES
 	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
 		if (flags & TCL_TRACE_ARRAY) {
-		    Tcl_DStringAppend(&cmd, " a", 2);
+		    TclDStringAppendLiteral(&cmd, " a");
 		} else if (flags & TCL_TRACE_READS) {
-		    Tcl_DStringAppend(&cmd, " r", 2);
+		    TclDStringAppendLiteral(&cmd, " r");
 		} else if (flags & TCL_TRACE_WRITES) {
-		    Tcl_DStringAppend(&cmd, " w", 2);
+		    TclDStringAppendLiteral(&cmd, " w");
 		} else if (flags & TCL_TRACE_UNSETS) {
-		    Tcl_DStringAppend(&cmd, " u", 2);
+		    TclDStringAppendLiteral(&cmd, " u");
 		}
 	    } else {
 #endif
 		if (flags & TCL_TRACE_ARRAY) {
-		    Tcl_DStringAppend(&cmd, " array", 6);
+		    TclDStringAppendLiteral(&cmd, " array");
 		} else if (flags & TCL_TRACE_READS) {
-		    Tcl_DStringAppend(&cmd, " read", 5);
+		    TclDStringAppendLiteral(&cmd, " read");
 		} else if (flags & TCL_TRACE_WRITES) {
-		    Tcl_DStringAppend(&cmd, " write", 6);
+		    TclDStringAppendLiteral(&cmd, " write");
 		} else if (flags & TCL_TRACE_UNSETS) {
-		    Tcl_DStringAppend(&cmd, " unset", 6);
+		    TclDStringAppendLiteral(&cmd, " unset");
 		}
 #ifndef TCL_REMOVE_OBSOLETE_TRACES
 	    }
@@ -2036,10 +2039,23 @@ TraceVarProc(
 		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;
 	    }
@@ -2149,7 +2165,7 @@ Tcl_CreateObjTrace(
 	iPtr->tracesForbiddingInline++;
     }
 
-    tracePtr = (Trace *) ckalloc(sizeof(Trace));
+    tracePtr = ckalloc(sizeof(Trace));
     tracePtr->level = level;
     tracePtr->proc = proc;
     tracePtr->clientData = clientData;
@@ -2212,13 +2228,12 @@ Tcl_CreateTrace(
 				 * command. */
     ClientData clientData)	/* Arbitrary value word to pass to proc. */
 {
-    StringTraceData *data = (StringTraceData *)
-	    ckalloc(sizeof(StringTraceData));
+    StringTraceData *data = ckalloc(sizeof(StringTraceData));
 
     data->clientData = clientData;
     data->proc = proc;
     return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
-	    (ClientData) data, StringTraceDeleteProc);
+	    data, StringTraceDeleteProc);
 }
 
 /*
@@ -2247,7 +2262,7 @@ StringTraceProc(
     int objc,
     Tcl_Obj *const *objv)
 {
-    StringTraceData *data = (StringTraceData *) clientData;
+    StringTraceData *data = clientData;
     Command *cmdPtr = (Command *) commandInfo;
     const char **argv;		/* Args to pass to string trace proc */
     int i;
@@ -2270,7 +2285,7 @@ StringTraceProc(
      * either command or argv.
      */
 
-    (data->proc)(data->clientData, interp, level, (char *) command,
+    data->proc(data->clientData, interp, level, (char *) command,
 	    cmdPtr->proc, cmdPtr->clientData, objc, argv);
     TclStackFree(interp, (void *) argv);
 
@@ -2297,7 +2312,7 @@ static void
 StringTraceDeleteProc(
     ClientData clientData)
 {
-    ckfree((char *) clientData);
+    ckfree(clientData);
 }
 
 /*
@@ -2325,7 +2340,7 @@ Tcl_DeleteTrace(
 {
     Interp *iPtr = (Interp *) interp;
     Trace *prevPtr, *tracePtr = (Trace *) trace;
-    register Trace **tracePtr2 = &(iPtr->tracePtr);
+    register Trace **tracePtr2 = &iPtr->tracePtr;
     ActiveInterpTrace *activePtr;
 
     /*
@@ -2334,14 +2349,14 @@ Tcl_DeleteTrace(
      */
 
     prevPtr = NULL;
-    while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
+    while (*tracePtr2 != NULL && *tracePtr2 != tracePtr) {
 	prevPtr = *tracePtr2;
-	tracePtr2 = &((*tracePtr2)->nextPtr);
+	tracePtr2 = &prevPtr->nextPtr;
     }
     if (*tracePtr2 == NULL) {
 	return;
     }
-    (*tracePtr2) = (*tracePtr2)->nextPtr;
+    *tracePtr2 = (*tracePtr2)->nextPtr;
 
     /*
      * The code below makes it possible to delete traces while traces are
@@ -2380,7 +2395,7 @@ Tcl_DeleteTrace(
      */
 
     if (tracePtr->delProc != NULL) {
-	(tracePtr->delProc)(tracePtr->clientData);
+	tracePtr->delProc(tracePtr->clientData);
     }
 
     /*
@@ -2413,8 +2428,7 @@ TclVarTraceExists(
     Tcl_Interp *interp,		/* The interpreter */
     const char *varName)	/* The variable name */
 {
-    Var *varPtr;
-    Var *arrayPtr;
+    Var *varPtr, *arrayPtr;
 
     /*
      * The choice of "create" flag values is delicate here, and matches the
@@ -2434,7 +2448,7 @@ TclVarTraceExists(
 
     if ((varPtr->flags & VAR_TRACED_READ)
 	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
-	TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
+	TclCallVarTraces((Interp *) interp, arrayPtr, varPtr, varName, NULL,
 		TCL_TRACE_READS, /* leaveErrMsg */ 0);
     }
 
@@ -2493,11 +2507,14 @@ TclObjCallVarTraces(
 				 * variable, or -1. Only used when part1Ptr is
 				 * NULL. */
 {
-    char *part1, *part2;
+    const char *part1, *part2;
 
     if (!part1Ptr) {
 	part1Ptr = localName(iPtr->varFramePtr, index);
     }
+    if (!part1Ptr) {
+	Tcl_Panic("Cannot trace a variable with no name");
+    }
     part1 = TclGetString(part1Ptr);
     part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
 
@@ -2571,7 +2588,7 @@ TclCallVarTraces(
 		    char *newPart1;
 
 		    Tcl_DStringInit(&nameCopy);
-		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
+		    Tcl_DStringAppend(&nameCopy, part1, p-part1);
 		    newPart1 = Tcl_DStringValue(&nameCopy);
 		    newPart1[offset] = 0;
 		    part1 = newPart1;
@@ -2597,25 +2614,25 @@ TclCallVarTraces(
     result = NULL;
     active.nextPtr = iPtr->activeVarTracePtr;
     iPtr->activeVarTracePtr = &active;
-    Tcl_Preserve((ClientData) iPtr);
+    Tcl_Preserve(iPtr);
     if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
 	    && (arrayPtr->flags & traceflags)) {
 	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
 	active.varPtr = arrayPtr;
-	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
-	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
+	for (tracePtr = Tcl_GetHashValue(hPtr);
+		tracePtr != NULL; tracePtr = active.nextTracePtr) {
 	    active.nextTracePtr = tracePtr->nextPtr;
 	    if (!(tracePtr->flags & flags)) {
 		continue;
 	    }
-	    Tcl_Preserve((ClientData) tracePtr);
+	    Tcl_Preserve(tracePtr);
 	    if (state == NULL) {
-		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
+		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
 	    }
-	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
+	    if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) {
 		flags |= TCL_INTERP_DESTROYED;
 	    }
-	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+	    result = tracePtr->traceProc(tracePtr->clientData,
 		    (Tcl_Interp *) iPtr, part1, part2, flags);
 	    if (result != NULL) {
 		if (flags & TCL_TRACE_UNSETS) {
@@ -2629,7 +2646,7 @@ TclCallVarTraces(
 		    code = TCL_ERROR;
 		}
 	    }
-	    Tcl_Release((ClientData) tracePtr);
+	    Tcl_Release(tracePtr);
 	    if (code == TCL_ERROR) {
 		goto done;
 	    }
@@ -2646,20 +2663,20 @@ TclCallVarTraces(
     active.varPtr = varPtr;
     if (varPtr->flags & traceflags) {
 	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
-	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
-	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
+	for (tracePtr = Tcl_GetHashValue(hPtr);
+		tracePtr != NULL; tracePtr = active.nextTracePtr) {
 	    active.nextTracePtr = tracePtr->nextPtr;
 	    if (!(tracePtr->flags & flags)) {
 		continue;
 	    }
-	    Tcl_Preserve((ClientData) tracePtr);
+	    Tcl_Preserve(tracePtr);
 	    if (state == NULL) {
-		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
+		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
 	    }
-	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
+	    if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) {
 		flags |= TCL_INTERP_DESTROYED;
 	    }
-	    result = (*tracePtr->traceProc)(tracePtr->clientData,
+	    result = tracePtr->traceProc(tracePtr->clientData,
 		    (Tcl_Interp *) iPtr, part1, part2, flags);
 	    if (result != NULL) {
 		if (flags & TCL_TRACE_UNSETS) {
@@ -2673,7 +2690,7 @@ TclCallVarTraces(
 		    code = TCL_ERROR;
 		}
 	    }
-	    Tcl_Release((ClientData) tracePtr);
+	    Tcl_Release(tracePtr);
 	    if (code == TCL_ERROR) {
 		goto done;
 	    }
@@ -2709,7 +2726,8 @@ TclCallVarTraces(
 	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
 		Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result);
 	    } else {
-		Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC);
+		Tcl_SetObjResult((Tcl_Interp *)iPtr,
+			Tcl_NewStringObj(result, -1));
 	    }
 	    Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");
 
@@ -2726,12 +2744,12 @@ TclCallVarTraces(
 	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
 	    Tcl_DiscardInterpState(state);
 	} else {
-	    (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+	    Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
 	}
 	DisposeTraceResult(disposeFlags,result);
     } else if (state) {
 	if (code == TCL_OK) {
-	    code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
+	    code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
 	} else {
 	    Tcl_DiscardInterpState(state);
 	}
@@ -2748,7 +2766,7 @@ TclCallVarTraces(
 	VarHashRefCount(varPtr)--;
     }
     iPtr->activeVarTracePtr = active.nextPtr;
-    Tcl_Release((ClientData) iPtr);
+    Tcl_Release(iPtr);
     return code;
 }
 
@@ -2880,9 +2898,8 @@ Tcl_UntraceVar2(
 #endif
     flags &= flagMask;
 
-    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
-	    (char *) varPtr);
-    for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
+    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+    for (tracePtr = Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
 	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
 	if (tracePtr == NULL) {
 	    goto updateFlags;
@@ -2927,7 +2944,7 @@ Tcl_UntraceVar2(
 	prevPtr->nextPtr = nextPtr;
     }
     tracePtr->nextPtr = NULL;
-    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+    Tcl_EventuallyFree(tracePtr, TCL_DYNAMIC);
 
     for (tracePtr = nextPtr; tracePtr != NULL;
 	    tracePtr = tracePtr->nextPtr) {
@@ -3022,7 +3039,6 @@ Tcl_VarTraceInfo2(
 				 * call will return the first trace. */
 {
     Interp *iPtr = (Interp *) interp;
-    register VarTrace *tracePtr;
     Var *varPtr, *arrayPtr;
     Tcl_HashEntry *hPtr;
 
@@ -3037,14 +3053,13 @@ Tcl_VarTraceInfo2(
      * Find the relevant trace, if any, and return its clientData.
      */
 
-    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
-	    (char *) varPtr);
+    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
 
     if (hPtr) {
-	tracePtr = Tcl_GetHashValue(hPtr);
+	register VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
 
 	if (prevClientData != NULL) {
-	    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	    for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
 		if ((tracePtr->clientData == prevClientData)
 			&& (tracePtr->traceProc == proc)) {
 		    tracePtr = tracePtr->nextPtr;
@@ -3052,7 +3067,7 @@ Tcl_VarTraceInfo2(
 		}
 	    }
 	}
-	for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
+	for (; tracePtr != NULL ; tracePtr = tracePtr->nextPtr) {
 	    if (tracePtr->traceProc == proc) {
 		return tracePtr->clientData;
 	    }
@@ -3140,7 +3155,7 @@ Tcl_TraceVar2(
     register VarTrace *tracePtr;
     int result;
 
-    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+    tracePtr = ckalloc(sizeof(VarTrace));
     tracePtr->traceProc = proc;
     tracePtr->clientData = clientData;
     tracePtr->flags = flags;
@@ -3148,7 +3163,7 @@ Tcl_TraceVar2(
     result = TraceVarEx(interp, part1, part2, tracePtr);
 
     if (result != TCL_OK) {
-	ckfree((char *) tracePtr);
+	ckfree(tracePtr);
     }
     return result;
 }
@@ -3214,8 +3229,8 @@ TraceVarEx(
      * 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)) {
+    if ((tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC)
+	    && (tracePtr->flags & TCL_TRACE_RESULT_OBJECT)) {
 	Tcl_Panic("bad result flag combination");
     }
 
@@ -3230,13 +3245,13 @@ TraceVarEx(
 #endif
     tracePtr->flags = tracePtr->flags & flagMask;
 
-    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew);
+    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew);
     if (isNew) {
 	tracePtr->nextPtr = NULL;
     } else {
-	tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr);
+	tracePtr->nextPtr = Tcl_GetHashValue(hPtr);
     }
-    Tcl_SetHashValue(hPtr, (char *) tracePtr);
+    Tcl_SetHashValue(hPtr, tracePtr);
 
     /*
      * Mark the variable as traced so we know to call them.
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index 20fab8c..d8b317a 100644
--- a/generic/tclUniData.c
+++ b/generic/tclUniData.c
@@ -1607,4 +1607,8 @@ enum {
  * Unicode character tables.
  */
 
-#define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#if TCL_UTF_MAX > 3
+#   define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1fffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#else
+#   define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#endif
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index e5497a4..68119a4 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -59,7 +59,7 @@
  * 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,
@@ -73,16 +73,7 @@ static CONST unsigned char totalBytes[256] = {
 #else
     1,1,1,1,1,1,1,1,
 #endif
-#if TCL_UTF_MAX > 4
-    5,5,5,5,
-#else
-    1,1,1,1,
-#endif
-#if TCL_UTF_MAX > 5
-    6,6,6,6
-#else
-    1,1,1,1
-#endif
+    1,1,1,1,1,1,1,1
 };
 
 /*
@@ -111,25 +102,16 @@ INLINE static int
 UtfCount(
     int ch)			/* The Tcl_UniChar whose size is returned. */
 {
-    if ((ch > 0) && (ch < UNICODE_SELF)) {
+    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
 	return 1;
     }
     if (ch <= 0x7FF) {
 	return 2;
     }
-    if (ch <= 0xFFFF) {
-	return 3;
-    }
 #if TCL_UTF_MAX > 3
-    if (ch <= 0x1FFFFF) {
+    if (((unsigned)(ch - 0x10000) <= 0xfffff)) {
 	return 4;
     }
-    if (ch <= 0x3FFFFFF) {
-	return 5;
-    }
-    if (ch <= 0x7FFFFFFF) {
-	return 6;
-    }
 #endif
     return 3;
 }
@@ -161,7 +143,7 @@ Tcl_UniCharToUtf(
 				 * large enough to hold the UTF-8 character
 				 * (at most TCL_UTF_MAX bytes). */
 {
-    if ((ch > 0) && (ch < UNICODE_SELF)) {
+    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
 	buf[0] = (char) ch;
 	return 1;
     }
@@ -172,43 +154,43 @@ Tcl_UniCharToUtf(
 	    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);
-	    return 3;
+#if TCL_UTF_MAX == 4
+	    if ((ch & 0xF800) == 0xD800) {
+		if (ch & 0x0400) {
+		    /* Low surrogate */
+		    buf[3] = (char) ((ch | 0x80) & 0xBF);
+		    buf[2] |= (char) (((ch >> 6) | 0x80) & 0x8F);
+		    return 4;
+		} else {
+		    /* High surrogate */
+		    ch += 0x40;
+		    buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
+		    buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
+		    buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
+		    return 0;
+		}
+	    }
+#endif
+	    goto three;
 	}
 
 #if TCL_UTF_MAX > 3
-	if (ch <= 0x1FFFFF) {
+	if (ch <= 0x10FFFF) {
 	    buf[3] = (char) ((ch | 0x80) & 0xBF);
 	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
 	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
 	    buf[0] = (char) ((ch >> 18) | 0xF0);
 	    return 4;
 	}
-	if (ch <= 0x3FFFFFF) {
-	    buf[4] = (char) ((ch | 0x80) & 0xBF);
-	    buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
-	    buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
-	    buf[0] = (char) ((ch >> 24) | 0xF8);
-	    return 5;
-	}
-	if (ch <= 0x7FFFFFFF) {
-	    buf[5] = (char) ((ch | 0x80) & 0xBF);
-	    buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
-	    buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
-	    buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
-	    buf[0] = (char) ((ch >> 30) | 0xFC);
-	    return 6;
-	}
 #endif
     }
 
     ch = 0xFFFD;
-    goto three;
+three:
+    buf[2] = (char) ((ch | 0x80) & 0xBF);
+    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
+    buf[0] = (char) ((ch >> 12) | 0xE0);
+    return 3;
 }
 
 /*
@@ -231,13 +213,13 @@ Tcl_UniCharToUtf(
 
 char *
 Tcl_UniCharToUtfDString(
-    CONST Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
+    const Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
     int uniLength,		/* Length of Unicode string in Tcl_UniChars
 				 * (must be >= 0). */
     Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
 				 * to this previously initialized DString. */
 {
-    CONST Tcl_UniChar *w, *wEnd;
+    const Tcl_UniChar *w, *wEnd;
     char *p, *string;
     int oldLength;
 
@@ -289,7 +271,7 @@ Tcl_UniCharToUtfDString(
 
 int
 Tcl_UtfToUniChar(
-    register CONST char *src,	/* The UTF-8 string. */
+    register const char *src,	/* The UTF-8 string. */
     register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by
 				 * the UTF-8 string. */
 {
@@ -323,9 +305,6 @@ Tcl_UtfToUniChar(
 	 * A two-byte-character lead-byte not followed by trail-byte
 	 * represents itself.
 	 */
-
-	*chPtr = (Tcl_UniChar) byte;
-	return 1;
     } else if (byte < 0xF0) {
 	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
 	    /*
@@ -341,31 +320,23 @@ Tcl_UtfToUniChar(
 	 * A three-byte-character lead-byte not followed by two trail-bytes
 	 * represents itself.
 	 */
-
-	*chPtr = (Tcl_UniChar) byte;
-	return 1;
     }
 #if TCL_UTF_MAX > 3
-    {
-	int ch, total, trail;
-
-	total = totalBytes[byte];
-	trail = total - 1;
-	if (trail > 0) {
-	    ch = byte & (0x3F >> trail);
-	    do {
-		src++;
-		if ((*src & 0xC0) != 0x80) {
-		    *chPtr = byte;
-		    return 1;
-		}
-		ch <<= 6;
-		ch |= (*src & 0x3F);
-		trail--;
-	    } while (trail > 0);
-	    *chPtr = ch;
-	    return total;
+    else if (byte < 0xF8) {
+	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
+	    /*
+	     * Four-byte-character lead byte followed by three trail bytes.
+	     */
+
+	    *chPtr = (Tcl_UniChar) (((byte & 0x0E) << 18) | ((src[1] & 0x3F) << 12)
+		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
+	    return 4;
 	}
+
+	/*
+	 * A three-byte-character lead-byte not followed by two trail-bytes
+	 * represents itself.
+	 */
     }
 #endif
 
@@ -393,7 +364,7 @@ Tcl_UtfToUniChar(
 
 Tcl_UniChar *
 Tcl_UtfToUniCharDString(
-    CONST char *src,		/* UTF-8 string to convert to Unicode. */
+    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
@@ -401,7 +372,7 @@ Tcl_UtfToUniCharDString(
 				 * DString. */
 {
     Tcl_UniChar *w, *wString;
-    CONST char *p, *end;
+    const char *p, *end;
     int oldLength;
 
     if (length < 0) {
@@ -414,6 +385,7 @@ Tcl_UtfToUniCharDString(
      */
 
     oldLength = Tcl_DStringLength(dsPtr);
+/* TODO: fix overreach! */
     Tcl_DStringSetLength(dsPtr,
 	    (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
     wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
@@ -452,7 +424,7 @@ Tcl_UtfToUniCharDString(
 
 int
 Tcl_UtfCharComplete(
-    CONST char *src,		/* String to check if first few bytes contain
+    const char *src,		/* String to check if first few bytes contain
 				 * a complete UTF-8 character. */
     int length)			/* Length of above string in bytes. */
 {
@@ -482,7 +454,7 @@ Tcl_UtfCharComplete(
 
 int
 Tcl_NumUtfChars(
-    register CONST char *src,	/* The UTF-8 string to measure. */
+    register const char *src,	/* The UTF-8 string to measure. */
     int length)			/* The length of the string in bytes, or -1
 				 * for strlen(string). */
 {
@@ -540,9 +512,9 @@ Tcl_NumUtfChars(
  *---------------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_UtfFindFirst(
-    CONST char *src,		/* The UTF-8 string to be searched. */
+    const char *src,		/* The UTF-8 string to be searched. */
     int ch)			/* The Tcl_UniChar to search for. */
 {
     int len;
@@ -579,14 +551,14 @@ Tcl_UtfFindFirst(
  *---------------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_UtfFindLast(
-    CONST char *src,		/* The UTF-8 string to be searched. */
+    const char *src,		/* 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) {
@@ -621,9 +593,9 @@ Tcl_UtfFindLast(
  *---------------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_UtfNext(
-    CONST char *src)		/* The current location in the string. */
+    const char *src)		/* The current location in the string. */
 {
     Tcl_UniChar ch;
 
@@ -651,13 +623,13 @@ Tcl_UtfNext(
  *---------------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_UtfPrev(
-    CONST char *src,		/* The current location in the string. */
-    CONST char *start)		/* Pointer to the beginning of the string, to
+    const char *src,		/* The current location in the string. */
+    const char *start)		/* Pointer to the beginning of the string, to
 				 * avoid going backwards too far. */
 {
-    CONST char *look;
+    const char *look;
     int i, byte;
 
     src--;
@@ -700,10 +672,10 @@ Tcl_UtfPrev(
 
 Tcl_UniChar
 Tcl_UniCharAtIndex(
-    register CONST char *src,	/* The UTF-8 string to dereference. */
+    register const char *src,	/* The UTF-8 string to dereference. */
     register int index)		/* The position of the desired character. */
 {
-    Tcl_UniChar ch;
+    Tcl_UniChar ch = 0;
 
     while (index >= 0) {
 	index--;
@@ -729,9 +701,9 @@ Tcl_UniCharAtIndex(
  *---------------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_UtfAtIndex(
-    register CONST char *src,	/* The UTF-8 string. */
+    register const char *src,	/* The UTF-8 string. */
     register int index)		/* The position of the desired character. */
 {
     Tcl_UniChar ch;
@@ -771,7 +743,7 @@ Tcl_UtfAtIndex(
 
 int
 Tcl_UtfBackslash(
-    CONST char *src,		/* Points to the backslash character of a
+    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. */
@@ -983,8 +955,8 @@ Tcl_UtfToTitle(
 
 int
 TclpUtfNcmp2(
-    CONST char *cs,		/* UTF string to compare to ct. */
-    CONST char *ct,		/* UTF string cs is compared to. */
+    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. */
 {
     /*
@@ -1030,8 +1002,8 @@ TclpUtfNcmp2(
 
 int
 Tcl_UtfNcmp(
-    CONST char *cs,		/* UTF string to compare to ct. */
-    CONST char *ct,		/* UTF string cs is compared to. */
+    const char *cs,		/* UTF string to compare to ct. */
+    const char *ct,		/* UTF string cs is compared to. */
     unsigned long numChars)	/* Number of UTF chars to compare. */
 {
     Tcl_UniChar ch1, ch2;
@@ -1078,8 +1050,8 @@ Tcl_UtfNcmp(
 
 int
 Tcl_UtfNcasecmp(
-    CONST char *cs,		/* UTF string to compare to ct. */
-    CONST char *ct,		/* UTF string cs is compared to. */
+    const char *cs,		/* UTF string to compare to ct. */
+    const char *ct,		/* UTF string cs is compared to. */
     unsigned long numChars)	/* Number of UTF chars to compare. */
 {
     Tcl_UniChar ch1, ch2;
@@ -1122,8 +1094,8 @@ Tcl_UtfNcasecmp(
 
 int
 TclUtfCasecmp(
-    CONST char *cs,		/* UTF string to compare to ct. */
-    CONST char *ct)		/* UTF string cs is compared to. */
+    const char *cs,		/* UTF string to compare to ct. */
+    const char *ct)		/* UTF string cs is compared to. */
 {
     while (*cs && *ct) {
 	Tcl_UniChar ch1, ch2;
@@ -1252,7 +1224,7 @@ Tcl_UniCharToTitle(
 
 int
 Tcl_UniCharLen(
-    CONST Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
+    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
 {
     int len = 0;
 
@@ -1282,8 +1254,8 @@ 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. */
+    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
+    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     unsigned long numChars)	/* Number of unichars to compare. */
 {
 #ifdef WORDS_BIGENDIAN
@@ -1327,8 +1299,8 @@ 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. */
+    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
+    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     unsigned long numChars)	/* Number of unichars to compare. */
 {
     for ( ; numChars != 0; numChars--, ucs++, uct++) {
@@ -1364,6 +1336,11 @@ int
 Tcl_UniCharIsAlnum(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
 }
 
@@ -1387,6 +1364,11 @@ int
 Tcl_UniCharIsAlpha(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return ((ALPHA_BITS >> GetCategory(ch)) & 1);
 }
 
@@ -1410,6 +1392,18 @@ int
 Tcl_UniCharIsControl(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	ch &= 0x1fffff;
+	if ((ch == 0xe0001) || ((ch >= 0xe0020) && (ch <= 0xe007f))) {
+	    return 1;
+	}
+	if ((ch >= 0xf0000) && ((ch & 0xffff) <= 0xfffd)) {
+	    return 1;
+	}
+	return 0;
+    }
+#endif
     return ((CONTROL_BITS >> GetCategory(ch)) & 1);
 }
 
@@ -1433,6 +1427,11 @@ int
 Tcl_UniCharIsDigit(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
 }
 
@@ -1456,6 +1455,12 @@ int
 Tcl_UniCharIsGraph(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	ch &= 0x1fffff;
+	return (ch >= 0xe0100) && (ch <= 0xe01ef);
+    }
+#endif
     return ((GRAPH_BITS >> GetCategory(ch)) & 1);
 }
 
@@ -1479,6 +1484,11 @@ int
 Tcl_UniCharIsLower(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return (GetCategory(ch) == LOWERCASE_LETTER);
 }
 
@@ -1502,6 +1512,12 @@ int
 Tcl_UniCharIsPrint(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	ch &= 0x1fffff;
+	return (ch >= 0xe0100) && (ch <= 0xe01ef);
+    }
+#endif
     return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
 }
 
@@ -1525,6 +1541,11 @@ int
 Tcl_UniCharIsPunct(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return ((PUNCT_BITS >> GetCategory(ch)) & 1);
 }
 
@@ -1548,14 +1569,27 @@ int
 Tcl_UniCharIsSpace(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    /* Ignore upper 11 bits. */
+    ch &= 0x1fffff;
+#else
+    /* Ignore upper 16 bits. */
+    ch &= 0xffff;
+#endif
+
     /*
      * If the character is within the first 127 characters, just use the
      * standard C function, otherwise consult the Unicode table.
      */
 
-    if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
+    if (ch < 0x80) {
 	return TclIsSpaceProc((char) ch);
-    } else if ((Tcl_UniChar) ch == 0x180e || (Tcl_UniChar) ch == 0x202f) {
+#if TCL_UTF_MAX > 3
+    } else if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+#endif
+    } else if (ch == 0x0085 || ch == 0x180e || ch == 0x200b
+	    || ch == 0x202f || ch == 0x2060 || ch == 0xfeff) {
 	return 1;
     } else {
 	return ((SPACE_BITS >> GetCategory(ch)) & 1);
@@ -1582,6 +1616,11 @@ int
 Tcl_UniCharIsUpper(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return (GetCategory(ch) == UPPERCASE_LETTER);
 }
 
@@ -1605,6 +1644,11 @@ int
 Tcl_UniCharIsWordChar(
     int ch)			/* Unicode character to test. */
 {
+#if TCL_UTF_MAX > 3
+    if (UNICODE_OUT_OF_RANGE(ch)) {
+	return 0;
+    }
+#endif
     return ((WORD_BITS >> GetCategory(ch)) & 1);
 }
 
@@ -1633,8 +1677,8 @@ Tcl_UniCharIsWordChar(
 
 int
 Tcl_UniCharCaseMatch(
-    CONST Tcl_UniChar *uniStr,	/* Unicode String. */
-    CONST Tcl_UniChar *uniPattern,
+    const Tcl_UniChar *uniStr,	/* Unicode String. */
+    const Tcl_UniChar *uniPattern,
 				/* Pattern, which may contain special
 				 * characters. */
     int nocase)			/* 0 for case sensitive, 1 for insensitive */
@@ -1821,14 +1865,14 @@ Tcl_UniCharCaseMatch(
 
 int
 TclUniCharMatch(
-    CONST Tcl_UniChar *string,	/* Unicode String. */
+    const Tcl_UniChar *string,	/* Unicode String. */
     int strLen,			/* Length of String */
-    CONST Tcl_UniChar *pattern,	/* Pattern, which may contain special
+    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
 				 * characters. */
     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;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 34d4be2..553593c 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -13,7 +13,8 @@
  */
 
 #include "tclInt.h"
-#include <float.h>
+#include "tclParse.h"
+#include "tclStringTrim.h"
 #include <math.h>
 
 /*
@@ -26,9 +27,9 @@ static ProcessGlobalValue executableName = {
 };
 
 /*
- * 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:
+ * 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
@@ -40,11 +41,11 @@ static ProcessGlobalValue executableName = {
  *				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.
+ *				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
@@ -54,8 +55,8 @@ static ProcessGlobalValue executableName = {
  * 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_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
@@ -64,18 +65,18 @@ static ProcessGlobalValue executableName = {
  *			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
+ *			*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
+ *			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
+ * 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,
+ * 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
@@ -107,10 +108,14 @@ 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 int		SetEndOffsetFromAny(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+static void		UpdateStringOfEndOffset(Tcl_Obj *objPtr);
+static int		FindElement(Tcl_Interp *interp, const char *string,
+			    int stringLength, const char *typeStr,
+			    const char *typeCode, const char **elementPtr,
+			    const char **nextPtr, int *sizePtr,
+			    int *literalPtr);
 /*
  * 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
@@ -118,7 +123,7 @@ static void		UpdateStringOfEndOffset(Tcl_Obj* objPtr);
  * integer, so no memory management is required for it.
  */
 
-Tcl_ObjType tclEndOffsetType = {
+const Tcl_ObjType tclEndOffsetType = {
     "end-offset",			/* name */
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
@@ -129,17 +134,17 @@ Tcl_ObjType tclEndOffsetType = {
 /*
  *	*	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.
+ * 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.
+ * 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:
+ * The ASCII characters which can make up the whitespace between list elements
+ * are:
  *
  *	\u0009	\t	TAB
  *	\u000A	\n	NEWLINE
@@ -158,69 +163,68 @@ Tcl_ObjType tclEndOffsetType = {
  *	* 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.
+ *	* 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.
+ *	  separating whitespace, or a string terminator. It is just another
+ *	  character in a list element.
  *
- * The interpretation of a formatted substring as a list element follows
- * rules similar to the parsing of the words of a command in a Tcl script.
- * Backslash substitution plays a key role, and is defined exactly as it is
- * in command parsing.  The same routine, TclParseBackslash() is used in both
- * command parsing and list parsing.
+ * The interpretation of a formatted substring as a list element follows rules
+ * similar to the parsing of the words of a command in a Tcl script. Backslash
+ * substitution plays a key role, and is defined exactly as it is in command
+ * parsing. The same routine, TclParseBackslash() is used in both command
+ * parsing and list parsing.
  *
- * NOTE:  This means that if and when backslash substitution rules ever
- * change for command parsing, the interpretation of strings as lists also
- * changes.
+ * NOTE: This means that if and when backslash substitution rules ever change
+ * for command parsing, the interpretation of strings as lists also changes.
  *
  * Backslash substitution replaces an "escape sequence" of one or more
  * characters starting with
  *		\u005c	\	BACKSLASH
- * with a single character.  The one character escape sequence case happens
- * only when BACKSLASH is the last character in the string.  In all other
- * cases, the escape sequence is at least two characters long.
+ * with a single character. The one character escape sequence case happens only
+ * when BACKSLASH is the last character in the string. In all other cases, the
+ * escape sequence is at least two characters long.
  *
- * The formatted substrings are interpreted as element values according to
- * the following cases:
+ * 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.
+ *   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.
+ *   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
+ *   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,
@@ -231,20 +235,20 @@ Tcl_ObjType tclEndOffsetType = {
  *   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,
+ *   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().
+ * FindElement().
  *
- * 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.
+ * 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	*	*	*	*	*
  *
@@ -253,18 +257,18 @@ Tcl_ObjType tclEndOffsetType = {
  * 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:
+ * * 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.
+ *	  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
@@ -274,11 +278,10 @@ Tcl_ObjType tclEndOffsetType = {
  *		\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.
+ *	* 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:
@@ -289,10 +292,10 @@ Tcl_ObjType tclEndOffsetType = {
  *
  * * 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:
+ *   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:
@@ -301,54 +304,54 @@ Tcl_ObjType tclEndOffsetType = {
  *   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
+ * 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.
+ * 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:
+ * 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:
+ * 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.
+ * 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
@@ -366,15 +369,15 @@ Tcl_ObjType tclEndOffsetType = {
  *
  *	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.
+ *	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.
+ *	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.
@@ -384,9 +387,9 @@ Tcl_ObjType tclEndOffsetType = {
 
 int
 TclMaxListLength(
-    CONST char *bytes,
+    const char *bytes,
     int numBytes,
-    CONST char **endPtr)
+    const char **endPtr)
 {
     int count = 0;
 
@@ -395,16 +398,25 @@ TclMaxListLength(
 	goto done;
     }
 
-    /* No list element before leading white space */
+    /*
+     * No list element before leading white space.
+     */
+
     count += 1 - TclIsSpaceProc(*bytes);
 
-    /* Count white space runs as potential element separators */
+    /*
+     * Count white space runs as potential element separators.
+     */
+
     while (numBytes) {
 	if ((numBytes == -1) && (*bytes == '\0')) {
 	    break;
 	}
 	if (TclIsSpaceProc(*bytes)) {
-	    /* Space run started; bump count */
+	    /*
+	     * Space run started; bump count.
+	     */
+
 	    count++;
 	    do {
 		bytes++;
@@ -413,16 +425,22 @@ TclMaxListLength(
 	    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
 		break;
 	    }
-	    /* (*bytes) is non-space; return to counting state */
+
+	    /*
+	     * (*bytes) is non-space; return to counting state.
+	     */
 	}
 	bytes++;
 	numBytes -= (numBytes != -1);
     }
 
-    /* No list element following trailing white space */
+    /*
+     * No list element following trailing white space.
+     */
+
     count -= TclIsSpaceProc(bytes[-1]);
 
-    done:
+  done:
     if (endPtr) {
 	*endPtr = bytes;
     }
@@ -449,18 +467,18 @@ TclMaxListLength(
  *	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
+ *	*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.
+ *	to a boolean value indicating whether the substring returned as the
+ *	values of **elementPtr and *sizePtr is the literal value of a list
+ *	element. If not, a call to TclCopyAndCollapse() is needed to produce
+ *	the actual value of the list element. Note: this function does NOT
+ *	collapse backslash sequences, but uses *literalPtr to tell callers
+ *	when it is required for them to do so.
  *
  * Side effects:
  *	None.
@@ -473,13 +491,13 @@ 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
+    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
+    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
@@ -491,23 +509,84 @@ TclFindElement(
 				 * does not/does require a call to
 				 * TclCopyAndCollapse() by the caller. */
 {
-    CONST char *p = list;
-    CONST char *elemStart;	/* Points to first byte of first element. */
-    CONST char *limit;		/* Points just after list's last byte. */
+    return FindElement(interp, list, listLength, "list", "LIST", elementPtr,
+	    nextPtr, sizePtr, literalPtr);
+}
+
+int
+TclFindDictElement(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    const char *dict,		/* Points to the first byte of a string
+				 * containing a Tcl dictionary with zero or
+				 * more keys and values (possibly in
+				 * braces). */
+    int dictLength,		/* Number of bytes in the dict's string. */
+    const char **elementPtr,	/* Where to put address of first significant
+				 * character in the first element (i.e., key
+				 * or value) of dict. */
+    const char **nextPtr,	/* Fill in with location of character just
+				 * after all white space following end of
+				 * element (next arg or end of list). */
+    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 key or value and therefore
+				 * does not/does require a call to
+				 * TclCopyAndCollapse() by the caller. */
+{
+    return FindElement(interp, dict, dictLength, "dict", "DICTIONARY",
+	    elementPtr, nextPtr, sizePtr, literalPtr);
+}
+
+static int
+FindElement(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    const char *string,		/* Points to the first byte of a string
+				 * containing a Tcl list or dictionary with
+				 * zero or more elements (possibly in
+				 * braces). */
+    int stringLength,		/* Number of bytes in the string. */
+    const char *typeStr,	/* The name of the type of thing we are
+				 * parsing, for error messages. */
+    const char *typeCode,	/* The type code for thing we are parsing, for
+				 * error messages. */
+    const char **elementPtr,	/* Where to put address of first significant
+				 * character in first element. */
+    const char **nextPtr,	/* Fill in with location of character just
+				 * after all white space following end of
+				 * argument (next arg or end of list/dict). */
+    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/dict element and therefore
+				 * does not/does require a call to
+				 * TclCopyAndCollapse() by the caller. */
+{
+    const char *p = string;
+    const char *elemStart;	/* Points to first byte of first element. */
+    const char *limit;		/* Points just after list/dict'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.
+     * We treat embedded NULLs in the list/dict as bytes belonging to a list
+     * element (or dictionary key or value).
      */
 
-    limit = (list + listLength);
+    limit = (string + stringLength);
     while ((p < limit) && (TclIsSpaceProc(*p))) {
 	p++;
     }
@@ -568,8 +647,10 @@ TclFindElement(
 			p2++;
 		    }
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "list element in braces followed by \"%.*s\" "
-			    "instead of space", (int) (p2-p), p));
+			    "%s element in braces followed by \"%.*s\" "
+			    "instead of space", typeStr, (int) (p2-p), p));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
+			    NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -585,9 +666,10 @@ TclFindElement(
 		/*
 		 * 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.
+		 * substring we are parsing. A call to TclCopyAndCollapse() is
+		 * needed to produce the element value. Inform the caller.
 		 */
+
 		literal = 0;
 	    }
 	    TclParseBackslash(p, limit - p, &numChars, NULL);
@@ -634,8 +716,10 @@ TclFindElement(
 			p2++;
 		    }
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "list element in quotes followed by \"%.*s\" "
-			    "instead of space", (int) (p2-p), p));
+			    "%s element in quotes followed by \"%.*s\" "
+			    "instead of space", typeStr, (int) (p2-p), p));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
+			    NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -645,20 +729,24 @@ TclFindElement(
     }
 
     /*
-     * End of list: terminate element.
+     * End of list/dict: terminate element.
      */
 
     if (p == limit) {
 	if (openBraces != 0) {
 	    if (interp != NULL) {
-		Tcl_SetResult(interp, "unmatched open brace in list",
-			TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unmatched open brace in %s", typeStr));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
+			NULL);
 	    }
 	    return TCL_ERROR;
 	} else if (inQuotes) {
 	    if (interp != NULL) {
-		Tcl_SetResult(interp, "unmatched open quote in list",
-			TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unmatched open quote in %s", typeStr));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
+			NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -689,9 +777,9 @@ TclFindElement(
  *
  * Results:
  *	Count bytes get copied from src to dst. Along the way, backslash
- *	sequences are substituted in the copy.  After scanning count bytes
- *	from src, a null character is placed at the end of dst.  Returns
- *	the number of bytes that got written to dst.
+ *	sequences are substituted in the copy. After scanning count bytes from
+ *	src, a null character is placed at the end of dst. Returns the number
+ *	of bytes that got written to dst.
  *
  * Side effects:
  *	None.
@@ -702,13 +790,14 @@ TclFindElement(
 int
 TclCopyAndCollapse(
     int count,			/* Number of byte to copy from src. */
-    CONST char *src,		/* Copy from here... */
+    const char *src,		/* Copy from here... */
     char *dst)			/* ... to here. */
 {
     int newCount = 0;
 
     while (count > 0) {
 	char c = *src;
+
 	if (c == '\\') {
 	    int numRead;
 	    int backslashCount = TclParseBackslash(src, count, &numRead, dst);
@@ -761,50 +850,50 @@ 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. */
+    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
+    const char ***argvPtr)	/* Pointer to place to store pointer to array
 				 * of pointers to list elements. */
 {
-    CONST char **argv, *end, *element;
+    const char **argv, *end, *element;
     char *p;
     int length, size, i, result, elSize;
 
     /*
-     * 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.
+     * 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.
      */
 
     size = TclMaxListLength(list, -1, &end) + 1;
     length = end - list;
-    argv = (CONST char **) ckalloc((unsigned)
-	    ((size * sizeof(char *)) + length + 1));
+    argv = ckalloc((size * sizeof(char *)) + length + 1);
 
     for (i = 0, p = ((char *) argv) + size*sizeof(char *);
 	    *list != 0;  i++) {
-	CONST char *prevList = list;
+	const char *prevList = list;
 	int literal;
 
 	result = TclFindElement(interp, list, length, &element, &list,
 		&elSize, &literal);
 	length -= (list - prevList);
 	if (result != TCL_OK) {
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	    return result;
 	}
 	if (*element == 0) {
 	    break;
 	}
 	if (i >= size) {
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	    if (interp != NULL) {
-		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
-			TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"internal error in Tcl_SplitList", -1));
+		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
+			NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -835,9 +924,9 @@ Tcl_SplitList(
  *	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
+ *	The return value is an overestimate of the number of bytes that will
+ *	be needed by Tcl_ConvertElement to produce a valid list element from
+ *	src. The word at *flagPtr is filled in with a value needed by
  *	Tcl_ConvertElement when doing the actual conversion.
  *
  * Side effects:
@@ -848,7 +937,7 @@ Tcl_SplitList(
 
 int
 Tcl_ScanElement(
-    register CONST char *src,	/* String to convert to list element. */
+    register const char *src,	/* String to convert to list element. */
     register int *flagPtr)	/* Where to store information to guide
 				 * Tcl_ConvertCountedElement. */
 {
@@ -867,10 +956,10 @@ Tcl_ScanElement(
  *	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 bytes that will
+ *	be needed by Tcl_ConvertCountedElement to produce a valid list element
+ *	from src. The word at *flagPtr is filled in with a value needed by
+ *	Tcl_ConvertCountedElement when doing the actual conversion.
  *
  * Side effects:
  *	None.
@@ -880,7 +969,7 @@ Tcl_ScanElement(
 
 int
 Tcl_ScanCountedElement(
-    CONST char *src,		/* String to convert to Tcl list element. */
+    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. */
@@ -897,24 +986,24 @@ Tcl_ScanCountedElement(
  *
  * 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().
+ *	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
+ *	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.
+ *	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.
@@ -924,15 +1013,15 @@ Tcl_ScanCountedElement(
 
 int
 TclScanElement(
-    CONST char *src,		/* String to convert to Tcl list element. */
+    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;
+    const char *p = src;
     int nestingLevel = 0;	/* Brace nesting count */
     int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
-				   needs protection or escape. */
+				 * 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
@@ -944,10 +1033,13 @@ TclScanElement(
     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
+#endif /* COMPAT */
 
     if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
-	/* Empty string element must be brace quoted. */
+	/*
+	 * Empty string element must be brace quoted.
+	 */
+
 	*flagPtr = CONVERT_BRACE;
 	return 2;
     }
@@ -957,34 +1049,39 @@ TclScanElement(
 	 * Must escape or protect so leading character of value is not
 	 * misinterpreted as list element delimiting syntax.
 	 */
+
 	forbidNone = 1;
 #if COMPAT
 	preferBrace = 1;
-#endif
+#endif /* COMPAT */
     }
 
     while (length) {
+      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
 	switch (*p) {
-	case '{':
+	case '{':	/* TYPE_BRACE */
 #if COMPAT
 	    braceCount++;
-#endif
+#endif /* COMPAT */
 	    extra++;				/* Escape '{' => '\{' */
 	    nestingLevel++;
 	    break;
-	case '}':
+	case '}':	/* TYPE_BRACE */
 #if COMPAT
 	    braceCount++;
-#endif
+#endif /* COMPAT */
 	    extra++;				/* Escape '}' => '\}' */
 	    nestingLevel--;
 	    if (nestingLevel < 0) {
-		/* Unbalanced braces!  Cannot format with brace quoting. */
+		/*
+		 * Unbalanced braces!  Cannot format with brace quoting.
+		 */
+
 		requireEscape = 1;
 	    }
 	    break;
-	case ']':
-	case '"':
+	case ']':	/* TYPE_CLOSE_BRACK */
+	case '"':	/* TYPE_SPACE */
 #if COMPAT
 	    forbidNone = 1;
 	    extra++;		/* Escapes all just prepend a backslash */
@@ -992,32 +1089,39 @@ TclScanElement(
 	    break;
 #else
 	    /* FLOW THROUGH */
-#endif
-	case '[':
-	case '$':
-	case ';':
-	case ' ':
-	case '\f':
-	case '\n':
-	case '\r':
-	case '\t':
-	case '\v':
+#endif /* COMPAT */
+	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
+#endif /* COMPAT */
 	    break;
-	case '\\':
+	case '\\':	/* TYPE_SUBS */
 	    extra++;				/* Escape '\' => '\\' */
 	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
-		/* Final backslash. Cannot format with brace quoting. */
+		/*
+		 * Final backslash. Cannot format with brace quoting.
+		 */
+
 		requireEscape = 1;
 		break;
 	    }
 	    if (p[1] == '\n') {
 		extra++;	/* Escape newline => '\n', one byte longer */
-		/* Backslash newline sequence.  Brace quoting not permitted. */
+
+		/*
+		 * Backslash newline sequence.  Brace quoting not permitted.
+		 */
+
 		requireEscape = 1;
 		length -= (length > 0);
 		p++;
@@ -1031,35 +1135,47 @@ TclScanElement(
 	    forbidNone = 1;
 #if COMPAT
 	    preferBrace = 1;
-#endif
+#endif /* COMPAT */
 	    break;
-	case '\0':
+	case '\0':	/* TYPE_SUBS */
 	    if (length == -1) {
 		goto endOfString;
 	    }
 	    /* TODO: Panic on improper encoding? */
 	    break;
 	}
+      }
 	length -= (length > 0);
 	p++;
     }
 
-    endOfString:
+  endOfString:
     if (nestingLevel != 0) {
-	/* Unbalanced braces!  Cannot format with brace quoting. */
+	/*
+	 * Unbalanced braces!  Cannot format with brace quoting.
+	 */
+
 	requireEscape = 1;
     }
 
-    /* We need at least as many bytes as are in the element value... */
+    /*
+     * We need at least as many bytes as are in the element value...
+     */
+
     bytesNeeded = p - src;
 
     if (requireEscape) {
 	/*
-	 * We must use escape sequences.  Add all the extra bytes needed
-	 * to have room to create them.
+	 * 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. */
+
+	/*
+	 * Make room to escape leading #, if needed.
+	 */
+
 	if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
 	    bytesNeeded++;
 	}
@@ -1069,12 +1185,13 @@ TclScanElement(
     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.
+	 * 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;
 	}
@@ -1082,59 +1199,78 @@ TclScanElement(
 	*flagPtr |= TCL_DONT_USE_BRACES;
     }
     if (forbidNone) {
-	/* We must request some form of quoting of escaping... */
+	/*
+	 * 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.
+	     * 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
+#endif /* COMPAT */
 	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. */
+
+	    /*
+	     * 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. */
+	    /*
+	     * Add 2 bytes for room for the enclosing braces.
+	     */
+
 	    bytesNeeded += 2;
 	}
 	*flagPtr = CONVERT_BRACE;
 	goto overflowCheck;
     }
 
-    /* So far, no need to quote or escape anything. */
+    /*
+     * 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. */
+	/*
+	 * If we need to quote a leading #, make room to enclose in braces.
+	 */
+
 	bytesNeeded += 2;
     }
     *flagPtr = CONVERT_NONE;
 
-    overflowCheck:
+  overflowCheck:
     if (bytesNeeded < 0) {
 	Tcl_Panic("TclScanElement: string length overflow");
     }
@@ -1164,7 +1300,7 @@ TclScanElement(
 
 int
 Tcl_ConvertElement(
-    register CONST char *src,	/* Source information for list element. */
+    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. */
 {
@@ -1194,7 +1330,7 @@ Tcl_ConvertElement(
 
 int
 Tcl_ConvertCountedElement(
-    register CONST char *src,	/* Source information for list element. */
+    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. */
@@ -1209,9 +1345,9 @@ Tcl_ConvertCountedElement(
  *
  * 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.
+ *	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
@@ -1225,8 +1361,9 @@ Tcl_ConvertCountedElement(
  *----------------------------------------------------------------------
  */
 
-int TclConvertElement(
-    register CONST char *src,	/* Source information for list element. */
+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. */
@@ -1234,19 +1371,28 @@ int TclConvertElement(
     int conversion = flags & CONVERT_MASK;
     char *p = dst;
 
-    /* Let the caller demand we use escape sequences rather than braces. */
+    /*
+     * 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))) {
+    /*
+     * No matter what the caller demands, empty string must be braced!
+     */
+
+    if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
 	src = tclEmptyStringRep;
 	length = 0;
 	conversion = CONVERT_BRACE;
     }
 
-    /* Escape leading hash as needed and requested. */
+    /*
+     * Escape leading hash as needed and requested.
+     */
+
     if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
 	if (conversion == CONVERT_ESCAPE) {
 	    p[0] = '\\';
@@ -1259,7 +1405,10 @@ int TclConvertElement(
 	}
     }
 
-    /* No escape or quoting needed.  Copy the literal string value. */
+    /*
+     * No escape or quoting needed.  Copy the literal string value.
+     */
+
     if (conversion == CONVERT_NONE) {
 	if (length == -1) {
 	    /* TODO: INT_MAX overflow? */
@@ -1273,7 +1422,10 @@ int TclConvertElement(
 	}
     }
 
-    /* Formatted string is original string enclosed in braces. */
+    /*
+     * Formatted string is original string enclosed in braces.
+     */
+
     if (conversion == CONVERT_BRACE) {
 	*p = '{';
 	p++;
@@ -1293,7 +1445,10 @@ int TclConvertElement(
 
     /* conversion == CONVERT_ESCAPE or CONVERT_MASK */
 
-    /* Formatted string is original string converted to escape sequences. */
+    /*
+     * Formatted string is original string converted to escape sequences.
+     */
+
     for ( ; length; src++, length -= (length > 0)) {
 	switch (*src) {
 	case ']':
@@ -1309,13 +1464,12 @@ int TclConvertElement(
 	case '{':
 	case '}':
 #if COMPAT
-	    if (conversion == CONVERT_ESCAPE) {
-#endif
+	    if (conversion == CONVERT_ESCAPE)
+#endif /* COMPAT */
+	    {
 		*p = '\\';
 		p++;
-#if COMPAT
 	    }
-#endif
 	    break;
 	case '\f':
 	    *p = '\\';
@@ -1351,13 +1505,15 @@ int TclConvertElement(
 	    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().
+	     * 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;
@@ -1389,19 +1545,20 @@ int TclConvertElement(
 char *
 Tcl_Merge(
     int argc,			/* How many strings to merge. */
-    CONST char * CONST *argv)	/* Array of string values. */
+    const char *const *argv)	/* Array of string values. */
 {
-#   define LOCAL_SIZE 20
+#define LOCAL_SIZE 20
     int localFlags[LOCAL_SIZE], *flagPtr = NULL;
     int i, bytesNeeded = 0;
     char *result, *dst;
     const int maxFlags = UINT_MAX / sizeof(int);
 
+    /*
+     * Handle empty list case first, so logic of the general case can be
+     * simpler.
+     */
+
     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;
@@ -1415,20 +1572,20 @@ Tcl_Merge(
 	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.
+	 * We cannot allocate a large enough flag array to format this list in
+	 * one pass.  We could imagine converting this routine to a multi-pass
+	 * implementation, but for sizeof(int) == 4, the limit is a max of
+	 * 2^30 list elements and since each element is at least one byte
+	 * formatted, and requires one byte space between it and the next one,
+	 * that a minimum space requirement of 2^31 bytes, which is already
+	 * INT_MAX. If we tried to format a list of > maxFlags elements, we're
+	 * just going to overflow the size limits on the formatted string
+	 * anyway, so just issue that same panic early.
 	 */
+
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     } else {
-	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
+	flagPtr = ckalloc(argc * sizeof(int));
     }
     for (i = 0; i < argc; i++) {
 	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
@@ -1446,7 +1603,7 @@ Tcl_Merge(
      * Pass two: copy into the result area.
      */
 
-    result = ckalloc((unsigned) bytesNeeded);
+    result = ckalloc(bytesNeeded);
     dst = result;
     for (i = 0; i < argc; i++) {
 	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
@@ -1457,7 +1614,7 @@ Tcl_Merge(
     dst[-1] = 0;
 
     if (flagPtr != localFlags) {
-	ckfree((char *) flagPtr);
+	ckfree(flagPtr);
     }
     return result;
 }
@@ -1483,7 +1640,7 @@ Tcl_Merge(
 
 char
 Tcl_Backslash(
-    CONST char *src,		/* Points to the backslash character of a
+    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. */
@@ -1500,9 +1657,10 @@ 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.
+ *
+ *	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.
@@ -1515,10 +1673,10 @@ Tcl_Backslash(
 
 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 *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;
@@ -1527,12 +1685,18 @@ TclTrimRight(
 	Tcl_Panic("TclTrimRight works only on null-terminated strings");
     }
 
-    /* Empty strings -> nothing to do */
+    /*
+     * Empty strings -> nothing to do.
+     */
+
     if ((numBytes == 0) || (numTrim == 0)) {
 	return 0;
     }
 
-    /* Outer loop: iterate over string to be trimmed */
+    /*
+     * Outer loop: iterate over string to be trimmed.
+     */
+
     do {
 	Tcl_UniChar ch1;
 	const char *q = trim;
@@ -1541,7 +1705,10 @@ TclTrimRight(
 	p = Tcl_UtfPrev(p, bytes);
  	pInc = TclUtfToUniChar(p, &ch1);
 
-	/* Inner loop: scan trim string for match to current character */
+	/*
+	 * Inner loop: scan trim string for match to current character.
+	 */
+
 	do {
 	    Tcl_UniChar ch2;
 	    int qInc = TclUtfToUniChar(q, &ch2);
@@ -1555,7 +1722,10 @@ TclTrimRight(
 	} while (bytesLeft);
 
 	if (bytesLeft == 0) {
-	    /* No match; trim task done; *p is last non-trimmed char */
+	    /*
+	     * No match; trim task done; *p is last non-trimmed char.
+	     */
+
 	    p += pInc;
 	    break;
 	}
@@ -1568,9 +1738,10 @@ TclTrimRight(
  *----------------------------------------------------------------------
  *
  * 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.
+ *
+ *	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.
@@ -1583,10 +1754,10 @@ TclTrimRight(
 
 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 *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;
 
@@ -1594,19 +1765,28 @@ TclTrimLeft(
 	Tcl_Panic("TclTrimLeft works only on null-terminated strings");
     }
 
-    /* Empty strings -> nothing to do */
+    /*
+     * Empty strings -> nothing to do.
+     */
+
     if ((numBytes == 0) || (numTrim == 0)) {
 	return 0;
     }
 
-    /* Outer loop: iterate over string to be trimmed */
+    /*
+     * 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 */
+	/*
+	 * Inner loop: scan trim string for match to current character.
+	 */
+
 	do {
 	    Tcl_UniChar ch2;
 	    int qInc = TclUtfToUniChar(q, &ch2);
@@ -1620,7 +1800,10 @@ TclTrimLeft(
 	} while (bytesLeft);
 
 	if (bytesLeft == 0) {
-	    /* No match; trim task done; *p is first non-trimmed char */
+	    /*
+	     * No match; trim task done; *p is first non-trimmed char.
+	     */
+
 	    break;
 	}
 
@@ -1651,25 +1834,30 @@ TclTrimLeft(
  */
 
 /* The whitespace characters trimmed during [concat] operations */
-#define CONCAT_WS " \f\v\r\t\n"
-#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
 
 char *
 Tcl_Concat(
     int argc,			/* Number of strings to concatenate. */
-    CONST char * CONST *argv)	/* Array of strings to concatenate. */
+    const char *const *argv)	/* Array of strings to concatenate. */
 {
     int i, needSpace = 0, bytesNeeded = 0;
     char *result, *p;
 
-    /* Dispose of the empty result corner case first to simplify later code */
+    /*
+     * Dispose of the empty result corner case first to simplify later code.
+     */
+
     if (argc == 0) {
 	result = (char *) ckalloc(1);
 	result[0] = '\0';
 	return result;
     }
 
-    /* First allocate the result buffer at the size required */
+    /*
+     * First allocate the result buffer at the size required.
+     */
+
     for (i = 0;  i < argc;  i++) {
 	bytesNeeded += strlen(argv[i]);
 	if (bytesNeeded < 0) {
@@ -1678,13 +1866,18 @@ Tcl_Concat(
     }
     if (bytesNeeded + argc - 1 < 0) {
 	/*
-	 * Panic test could be tighter, but not going to bother for
-	 * this legacy routine.
+	 * Panic test could be tighter, but not going to bother for this
+	 * legacy routine.
 	 */
+
 	Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
     }
-    /* All element bytes + (argc - 1) spaces + 1 terminating NULL */
-    result = (char *) ckalloc((unsigned) (bytesNeeded + argc));
+
+    /*
+     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
+     */
+
+    result = ckalloc((unsigned) (bytesNeeded + argc));
 
     for (p = result, i = 0;  i < argc;  i++) {
 	int trim, elemLength;
@@ -1693,26 +1886,37 @@ Tcl_Concat(
 	element = argv[i];
 	elemLength = strlen(argv[i]);
 
-	/* Trim away the leading whitespace */
-	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	/*
+	 * Trim away the leading whitespace.
+	 */
+
+	trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	element += trim;
 	elemLength -= trim;
 
 	/*
-	 * Trim away the trailing whitespace.  Do not permit trimming
-	 * to expose a final backslash character.
+	 * 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 = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	trim -= trim && (element[elemLength - trim - 1] == '\\');
 	elemLength -= trim;
 
-	/* If we're left with empty element after trimming, do nothing */
+	/*
+	 * If we're left with empty element after trimming, do nothing.
+	 */
+
 	if (elemLength == 0) {
 	    continue;
 	}
 
-	/* Append to the result with space if needed */
+	/*
+	 * Append to the result with space if needed.
+	 */
+
 	if (needSpace) {
 	    *p++ = ' ';
 	}
@@ -1745,7 +1949,7 @@ Tcl_Concat(
 Tcl_Obj *
 Tcl_ConcatObj(
     int objc,			/* Number of objects to concatenate. */
-    Tcl_Obj *CONST objv[])	/* Array of objects to concatenate. */
+    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
 {
     int i, elemLength, needSpace = 0, bytesNeeded = 0;
     const char *element;
@@ -1770,36 +1974,20 @@ Tcl_ConcatObj(
 	}
     }
     if (i == objc) {
-	Tcl_Obj **listv;
-	int listc;
-
 	resPtr = NULL;
 	for (i = 0;  i < objc;  i++) {
-	    /*
-	     * Tcl_ListObjAppendList could be used here, but this saves us a
-	     * bit of type checking (since we've already done it). Use of
-	     * INT_MAX tells us to always put the new stuff on the end. It
-	     * will be set right in Tcl_ListObjReplace.
-	     * Note that all objs at this point are either lists or have an
-	     * empty string rep.
-	     */
-
 	    objPtr = objv[i];
 	    if (objPtr->bytes && objPtr->length == 0) {
 		continue;
 	    }
-	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
-	    if (listc) {
-		if (resPtr) {
-		    if (TCL_OK != Tcl_ListObjReplace(NULL, resPtr,
-			    INT_MAX, 0, listc, listv)) {
-			/* Abandon ship! */
-			Tcl_DecrRefCount(resPtr);
-			goto slow;
-		    }
-		} else {
-		    resPtr = TclListObjCopy(NULL, objPtr);
+	    if (resPtr) {
+		if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
+		    /* Abandon ship! */
+		    Tcl_DecrRefCount(resPtr);
+		    goto slow;
 		}
+	    } else {
+		resPtr = TclListObjCopy(NULL, objPtr);
 	    }
 	}
 	if (!resPtr) {
@@ -1808,13 +1996,14 @@ Tcl_ConcatObj(
 	return resPtr;
     }
 
+  slow:
     /*
      * 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.
      */
 
-  slow:
-    /* First try to pre-allocate the size required */
     for (i = 0;  i < objc;  i++) {
 	element = TclGetStringFromObj(objv[i], &elemLength);
 	bytesNeeded += elemLength;
@@ -1822,13 +2011,15 @@ Tcl_ConcatObj(
 	    break;
 	}
     }
+
     /*
-     * 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.
+     * Does not matter if this fails, will simply try later to build up the
+     * string with each Append reallocating as needed with the usual string
+     * append algorithm.  When that fails it will report the error.
      */
+
     TclNewObj(resPtr);
-    Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
+    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
     Tcl_SetObjLength(resPtr, 0);
 
     for (i = 0;  i < objc;  i++) {
@@ -1836,26 +2027,37 @@ Tcl_ConcatObj(
 
 	element = TclGetStringFromObj(objv[i], &elemLength);
 
-	/* Trim away the leading whitespace */
-	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	/*
+	 * Trim away the leading whitespace.
+	 */
+
+	trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	element += trim;
 	elemLength -= trim;
 
 	/*
-	 * Trim away the trailing whitespace.  Do not permit trimming
-	 * to expose a final backslash character.
+	 * 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 = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	trim -= trim && (element[elemLength - trim - 1] == '\\');
 	elemLength -= trim;
 
-	/* If we're left with empty element after trimming, do nothing */
+	/*
+	 * If we're left with empty element after trimming, do nothing.
+	 */
+
 	if (elemLength == 0) {
 	    continue;
 	}
 
-	/* Append to the result with space if needed */
+	/*
+	 * Append to the result with space if needed.
+	 */
+
 	if (needSpace) {
 	    Tcl_AppendToObj(resPtr, " ", 1);
 	}
@@ -1885,8 +2087,8 @@ Tcl_ConcatObj(
 
 int
 Tcl_StringMatch(
-    CONST char *str,		/* String. */
-    CONST char *pattern)	/* Pattern, which may contain special
+    const char *str,		/* String. */
+    const char *pattern)	/* Pattern, which may contain special
 				 * characters. */
 {
     return Tcl_StringCaseMatch(str, pattern, 0);
@@ -1913,13 +2115,13 @@ Tcl_StringMatch(
 
 int
 Tcl_StringCaseMatch(
-    CONST char *str,		/* String. */
-    CONST char *pattern,	/* Pattern, which may contain special
+    const char *str,		/* String. */
+    const char *pattern,	/* Pattern, which may contain special
 				 * characters. */
     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) {
@@ -2146,11 +2348,12 @@ 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 */
+    const unsigned char *string,/* String. */
+    int strLen,			/* Length of String */
+    const unsigned char *pattern,
+				/* Pattern, which may contain special
+				 * characters. */
+    int ptnLen,			/* Length of Pattern */
     int flags)
 {
     const unsigned char *stringEnd, *patternEnd;
@@ -2258,6 +2461,7 @@ TclByteArrayMatch(
 			/*
 			 * Matches ranges of form [a-z] or [z-a].
 			 */
+
 			break;
 		    }
 		} else if (startChar == ch1) {
@@ -2304,9 +2508,9 @@ TclByteArrayMatch(
  *
  * 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.
+ *	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
@@ -2321,9 +2525,10 @@ TclByteArrayMatch(
 
 int
 TclStringMatchObj(
-    Tcl_Obj *strObj,	/* string object. */
-    Tcl_Obj *ptnObj,	/* pattern object. */
-    int flags)		/* Only TCL_MATCH_NOCASE should be passed or 0. */
+    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;
 
@@ -2334,7 +2539,7 @@ TclStringMatchObj(
     trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
      */
 
-    if (strObj->typePtr == &tclStringType) {
+    if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) {
 	Tcl_UniChar *udata, *uptn;
 
 	udata = Tcl_GetUnicodeFromObj(strObj, &length);
@@ -2402,15 +2607,13 @@ Tcl_DStringInit(
 char *
 Tcl_DStringAppend(
     Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
-    CONST char *bytes,		/* String to append. If length is -1 then this
+    const char *bytes,		/* String to append. If length is -1 then this
 				 * must be null-terminated. */
     int length)			/* Number of bytes from "bytes" to append. If
 				 * < 0, then append all of bytes, up to null
 				 * at end. */
 {
     int newSize;
-    char *dst;
-    CONST char *end;
 
     if (length < 0) {
 	length = strlen(bytes);
@@ -2426,7 +2629,7 @@ Tcl_DStringAppend(
     if (newSize >= dsPtr->spaceAvl) {
 	dsPtr->spaceAvl = newSize * 2;
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+	    char *newString = ckalloc(dsPtr->spaceAvl);
 
 	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
 	    dsPtr->string = newString;
@@ -2439,8 +2642,7 @@ Tcl_DStringAppend(
 		offset = bytes - dsPtr->string;
 	    }
 
-	    dsPtr->string = ckrealloc((void *) dsPtr->string,
-		    (size_t) dsPtr->spaceAvl);
+	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
 
 	    if (offset >= 0) {
 		bytes = dsPtr->string + offset;
@@ -2452,18 +2654,46 @@ Tcl_DStringAppend(
      * Copy the new string into the buffer at the end of the old one.
      */
 
-    for (dst = dsPtr->string + dsPtr->length, end = bytes+length;
-	    bytes < end; bytes++, dst++) {
-	*dst = *bytes;
-    }
-    *dst = '\0';
+    memcpy(dsPtr->string + dsPtr->length, bytes, length);
     dsPtr->length += length;
+    dsPtr->string[dsPtr->length] = '\0';
     return dsPtr->string;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * TclDStringAppendObj, TclDStringAppendDString --
+ *
+ *	Simple wrappers round Tcl_DStringAppend that make it easier to append
+ *	from particular sources of strings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclDStringAppendObj(
+    Tcl_DString *dsPtr,
+    Tcl_Obj *objPtr)
+{
+    int length;
+    char *bytes = Tcl_GetStringFromObj(objPtr, &length);
+
+    return Tcl_DStringAppend(dsPtr, bytes, length);
+}
+
+char *
+TclDStringAppendDString(
+    Tcl_DString *dsPtr,
+    Tcl_DString *toAppendPtr)
+{
+    return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr),
+	    Tcl_DStringLength(toAppendPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DStringAppendElement --
  *
  *	Append a list element to the current value of a dynamic string.
@@ -2482,7 +2712,7 @@ Tcl_DStringAppend(
 char *
 Tcl_DStringAppendElement(
     Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
-    CONST char *element)	/* String to append. Must be
+    const char *element)	/* String to append. Must be
 				 * null-terminated. */
 {
     char *dst = dsPtr->string + dsPtr->length;
@@ -2502,7 +2732,7 @@ Tcl_DStringAppendElement(
     if (newSize >= dsPtr->spaceAvl) {
 	dsPtr->spaceAvl = newSize * 2;
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+	    char *newString = ckalloc(dsPtr->spaceAvl);
 
 	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
 	    dsPtr->string = newString;
@@ -2515,8 +2745,7 @@ Tcl_DStringAppendElement(
 		offset = element - dsPtr->string;
 	    }
 
-	    dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
-		    (size_t) dsPtr->spaceAvl);
+	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
 
 	    if (offset >= 0) {
 		element = dsPtr->string + offset;
@@ -2597,13 +2826,12 @@ Tcl_DStringSetLength(
 	    dsPtr->spaceAvl = length + 1;
 	}
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+	    char *newString = ckalloc(dsPtr->spaceAvl);
 
 	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
-		    (size_t) dsPtr->spaceAvl);
+	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
 	}
     }
     dsPtr->length = length;
@@ -2667,21 +2895,7 @@ Tcl_DStringResult(
 				 * result of interp. */
 {
     Tcl_ResetResult(interp);
-
-    if (dsPtr->string != dsPtr->staticSpace) {
-	interp->result = dsPtr->string;
-	interp->freeProc = TCL_DYNAMIC;
-    } else if (dsPtr->length < TCL_RESULT_SIZE) {
-	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;
-    dsPtr->staticSpace[0] = '\0';
+    Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
 }
 
 /*
@@ -2717,6 +2931,39 @@ Tcl_DStringGetResult(
     }
 
     /*
+     * Do more efficient transfer when we know the result is a Tcl_Obj. When
+     * there's no st`ring result, we only have to deal with two cases:
+     *
+     *  1. When the string rep is the empty string, when we don't copy but
+     *     instead use the staticSpace in the DString to hold an empty string.
+
+     *  2. When the string rep is not there or there's a real string rep, when
+     *     we use Tcl_GetString to fetch (or generate) the string rep - which
+     *     we know to have been allocated with ckalloc() - and use it to
+     *     populate the DString space. Then, we free the internal rep. and set
+     *     the object's string representation back to the canonical empty
+     *     string.
+     */
+
+    if (!iPtr->result[0] && iPtr->objResultPtr
+	    && !Tcl_IsShared(iPtr->objResultPtr)) {
+	if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
+	    dsPtr->string = dsPtr->staticSpace;
+	    dsPtr->string[0] = 0;
+	    dsPtr->length = 0;
+	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+	} else {
+	    dsPtr->string = Tcl_GetString(iPtr->objResultPtr);
+	    dsPtr->length = iPtr->objResultPtr->length;
+	    dsPtr->spaceAvl = dsPtr->length + 1;
+	    TclFreeIntRep(iPtr->objResultPtr);
+	    iPtr->objResultPtr->bytes = tclEmptyStringRep;
+	    iPtr->objResultPtr->length = 0;
+	}
+	return;
+    }
+
+    /*
      * If the string result is empty, move the object result to the string
      * result, then reset the object result.
      */
@@ -2729,9 +2976,9 @@ Tcl_DStringGetResult(
 	    dsPtr->string = iPtr->result;
 	    dsPtr->spaceAvl = dsPtr->length+1;
 	} else {
-	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
+	    dsPtr->string = ckalloc(dsPtr->length+1);
 	    memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
-	    (*iPtr->freeProc)(iPtr->result);
+	    iPtr->freeProc(iPtr->result);
 	}
 	dsPtr->spaceAvl = dsPtr->length+1;
 	iPtr->freeProc = NULL;
@@ -2740,7 +2987,7 @@ Tcl_DStringGetResult(
 	    dsPtr->string = dsPtr->staticSpace;
 	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
 	} else {
-	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
+	    dsPtr->string = ckalloc(dsPtr->length+1);
 	    dsPtr->spaceAvl = dsPtr->length + 1;
 	}
 	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
@@ -2753,6 +3000,66 @@ 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->string == dsPtr->staticSpace) {
+	if (dsPtr->length == 0) {
+	    TclNewObj(result);
+	} else {
+	    /*
+	     * 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
@@ -2773,9 +3080,9 @@ Tcl_DStringStartSublist(
     Tcl_DString *dsPtr)		/* Dynamic string. */
 {
     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
-	Tcl_DStringAppend(dsPtr, " {", -1);
+	TclDStringAppendLiteral(dsPtr, " {");
     } else {
-	Tcl_DStringAppend(dsPtr, "{", -1);
+	TclDStringAppendLiteral(dsPtr, "{");
     }
 }
 
@@ -2801,7 +3108,7 @@ void
 Tcl_DStringEndSublist(
     Tcl_DString *dsPtr)		/* Dynamic string. */
 {
-    Tcl_DStringAppend(dsPtr, "}", -1);
+    TclDStringAppendLiteral(dsPtr, "}");
 }
 
 /*
@@ -2836,91 +3143,90 @@ Tcl_PrintDouble(
     char *p, c;
     int exponent;
     int signum;
-    char* digits;
-    char* end;
-
-    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
+    char *digits;
+    char *end;
+    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
 
     /*
-	 * Handle NaN.
-	 */
+     * Handle NaN.
+     */
 
-	if (TclIsNaN(value)) {
-	    TclFormatNaN(value, dst);
-	    return;
-	}
+    if (TclIsNaN(value)) {
+	TclFormatNaN(value, dst);
+	return;
+    }
 
-	/*
-	 * Handle infinities.
-	 */
+    /*
+     * Handle infinities.
+     */
 
-	if (TclIsInfinite(value)) {
+    if (TclIsInfinite(value)) {
 	/*
 	 * Remember to copy the terminating NUL too.
 	 */
 
-	    if (value < 0) {
+	if (value < 0) {
 	    memcpy(dst, "-Inf", 5);
-	    } else {
+	} else {
 	    memcpy(dst, "Inf", 4);
-	    }
-	    return;
 	}
+	return;
+    }
 
-	/*
-	 * Ordinary (normal and denormal) values.
-	 */
+    /*
+     * Ordinary (normal and denormal) values.
+     */
 
     if (*precisionPtr == 0) {
 	digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
-				 &exponent, &signum, &end);
+		&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".
+	 * $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."
+	 * 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
+	 *	% 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).
+	 * 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.
+	 * 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);
+		TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
+		&exponent, &signum, &end);
+    }
+    if (signum) {
+	*dst++ = '-';
     }
-	if (signum) {
-	    *dst++ = '-';
-	}
     p = digits;
     if (exponent < -4 || exponent > 16) {
 	/*
@@ -2936,10 +3242,12 @@ Tcl_PrintDouble(
 		c = *++p;
 	    }
 	}
+
 	/*
-	 * Tcl 8.4 appears to format with at least a two-digit exponent; \
+	 * Tcl 8.4 appears to format with at least a two-digit exponent;
 	 * preserve that behaviour when tcl_precision != 0
 	 */
+
 	if (*precisionPtr == 0) {
 	    sprintf(dst, "e%+d", exponent);
 	} else {
@@ -3004,11 +3312,11 @@ 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. */
+    const char *name1,		/* Name of variable. */
+    const char *name2,		/* Second part of variable name. */
     int flags)			/* Information about what happened. */
 {
-    Tcl_Obj* value;
+    Tcl_Obj *value;
     int prec;
     int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
 
@@ -3045,13 +3353,13 @@ TclPrecTraceProc(
      */
 
     if (Tcl_IsSafe(interp)) {
-	return "can't modify precision from a safe interpreter";
+	return (char *) "can't modify precision from a safe interpreter";
     }
     value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
     if (value == NULL
-	    || Tcl_GetIntFromObj((Tcl_Interp*) NULL, value, &prec) != TCL_OK
+	    || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
 	    || prec < 0 || prec > TCL_MAX_PREC) {
-	return "improper value for precision";
+	return (char *) "improper value for precision";
     }
     *precisionPtr = prec;
     return NULL;
@@ -3076,8 +3384,8 @@ TclPrecTraceProc(
 
 int
 TclNeedSpace(
-    CONST char *start,		/* First character in string. */
-    CONST char *end)		/* End of string (place where space will be
+    const char *start,		/* First character in string. */
+    const char *end)		/* End of string (place where space will be
 				 * added, if appropriate). */
 {
     /*
@@ -3127,6 +3435,7 @@ TclNeedSpace(
 	 * NOTE: Remove this if other Unicode spaces ever get accepted as
 	 * list-element separators.
 	 */
+
 	return 1;
     }
     switch (*end) {
@@ -3151,33 +3460,33 @@ 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, "%ld", n) but is faster as proven in
+ *	benchmarks.  This is key to UpdateStringOfInt, which is a common path
+ *	for a lot of code (e.g. int-indexed arrays).
  *
  * Results:
  *	An integer representing the number of characters formatted, not
  *	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.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclFormatInt(buffer, n)
-    char *buffer;		/* Points to the storage into which the
+TclFormatInt(
+    char *buffer,		/* Points to the storage into which the
 				 * formatted characters are written. */
-    long n;			/* The integer to format. */
+    long n)			/* The integer to format. */
 {
     long intVal;
     int i;
     int numFormatted, j;
-    char *digits = "0123456789";
+    const char *digits = "0123456789";
 
     /*
      * Check first whether "n" is zero.
@@ -3190,9 +3499,9 @@ TclFormatInt(buffer, n)
     }
 
     /*
-     * Check whether "n" is the maximum negative value. This is
-     * -2^(m-1) for an m-bit word, and has no positive equivalent;
-     * negating it produces the same value.
+     * Check whether "n" is the maximum negative value. This is -2^(m-1) for
+     * an m-bit word, and has no positive equivalent; negating it produces the
+     * same value.
      */
 
     intVal = -n;			/* [Bug 3390638] Workaround for*/
@@ -3224,6 +3533,7 @@ TclFormatInt(buffer, n)
 
     for (j = 0;  j < i;  j++, i--) {
 	char tmp = buffer[i];
+
 	buffer[i] = buffer[j];
 	buffer[j] = tmp;
     }
@@ -3267,7 +3577,8 @@ TclGetIntForIndex(
 				 * representing an index. */
 {
     int length;
-    char *opPtr, *bytes;
+    char *opPtr;
+    const char *bytes;
 
     if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
 	return TCL_OK;
@@ -3328,21 +3639,15 @@ TclGetIntForIndex(
 
   parseError:
     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_AppendResult(interp, "bad index \"", bytes,
-		"\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
+	bytes = Tcl_GetString(objPtr);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad index \"%s\": must be integer?[+-]integer? or"
+		" end?[+-]integer?", bytes));
 	if (!strncmp(bytes, "end-", 4)) {
 	    bytes += 4;
 	}
 	TclCheckBadOctal(interp, bytes);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
     }
 
     return TCL_ERROR;
@@ -3370,13 +3675,12 @@ TclGetIntForIndex(
 
 static void
 UpdateStringOfEndOffset(
-    register Tcl_Obj* objPtr)
+    register Tcl_Obj *objPtr)
 {
-    char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
-    register int len;
+    char buffer[TCL_INTEGER_SPACE + 5];
+    register int len = 3;
 
-    strcpy(buffer, "end");
-    len = sizeof("end") - 1;
+    memcpy(buffer, "end", 4);
     if (objPtr->internalRep.longValue != 0) {
 	buffer[len++] = '-';
 	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
@@ -3410,7 +3714,7 @@ SetEndOffsetFromAny(
     Tcl_Obj *objPtr)		/* Pointer to the object to parse */
 {
     int offset;			/* Offset in the "end-offset" expression */
-    register char* bytes;	/* String rep of the object */
+    register const char *bytes;	/* String rep of the object */
     int length;			/* Length of the object's string rep */
 
     /*
@@ -3429,9 +3733,9 @@ SetEndOffsetFromAny(
     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_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad index \"%s\": must be end?[+-]integer?", bytes));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
 	}
 	return TCL_ERROR;
     }
@@ -3449,7 +3753,7 @@ SetEndOffsetFromAny(
 	 */
 
 	if (TclIsSpaceProc(bytes[4])) {
-	    return TCL_ERROR;
+	    goto badIndexFormat;
 	}
 	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
 	    return TCL_ERROR;
@@ -3462,10 +3766,11 @@ SetEndOffsetFromAny(
 	 * Conversion failed. Report the error.
 	 */
 
+    badIndexFormat:
 	if (interp != NULL) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad index \"", bytes,
-		    "\": must be end?[+-]integer?", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad index \"%s\": must be end?[+-]integer?", bytes));
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
 	}
 	return TCL_ERROR;
     }
@@ -3504,9 +3809,9 @@ 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. */
+    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
@@ -3521,7 +3826,7 @@ TclCheckBadOctal(
     }
     if (*p == '0') {
 	if ((p[1] == 'o') || p[1] == 'O') {
-	    p+=2;
+	    p += 2;
 	}
 	while (isdigit(UCHAR(*p))) {	/* INTL: digit. */
 	    p++;
@@ -3540,8 +3845,8 @@ TclCheckBadOctal(
 		 * be added to an existing error message as extra info.
 		 */
 
-		Tcl_AppendResult(interp, " (looks like invalid octal number)",
-			NULL);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			" (looks like invalid octal number)", -1);
 	    }
 	    return 1;
 	}
@@ -3568,7 +3873,8 @@ ClearHash(
 
     for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&search)) {
-	Tcl_Obj *objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+	Tcl_Obj *objPtr = Tcl_GetHashValue(hPtr);
+
 	Tcl_DecrRefCount(objPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
@@ -3596,12 +3902,12 @@ static Tcl_HashTable *
 GetThreadHash(
     Tcl_ThreadDataKey *keyPtr)
 {
-    Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)
-	    Tcl_GetThreadData(keyPtr, (int) sizeof(Tcl_HashTable *));
+    Tcl_HashTable **tablePtrPtr =
+	    Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
 
     if (NULL == *tablePtrPtr) {
-	*tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
-	Tcl_CreateThreadExitHandler(FreeThreadHash, (ClientData)*tablePtrPtr);
+	*tablePtrPtr = ckalloc(sizeof(Tcl_HashTable));
+	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
 	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
     }
     return *tablePtrPtr;
@@ -3625,11 +3931,11 @@ static void
 FreeThreadHash(
     ClientData clientData)
 {
-    Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
+    Tcl_HashTable *tablePtr = clientData;
 
     ClearHash(tablePtr);
     Tcl_DeleteHashTable(tablePtr);
-    ckfree((char *) tablePtr);
+    ckfree(tablePtr);
 }
 
 /*
@@ -3647,7 +3953,7 @@ static void
 FreeProcessGlobalValue(
     ClientData clientData)
 {
-    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData;
+    ProcessGlobalValue *pgvPtr = clientData;
 
     pgvPtr->epoch++;
     pgvPtr->numBytes = 0;
@@ -3677,7 +3983,7 @@ TclSetProcessGlobalValue(
     Tcl_Obj *newValue,
     Tcl_Encoding encoding)
 {
-    CONST char *bytes;
+    const char *bytes;
     Tcl_HashTable *cacheMap;
     Tcl_HashEntry *hPtr;
     int dummy;
@@ -3692,10 +3998,10 @@ TclSetProcessGlobalValue(
     if (NULL != pgvPtr->value) {
 	ckfree(pgvPtr->value);
     } else {
-	Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
+	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
     }
     bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes);
-    pgvPtr->value = ckalloc((unsigned) pgvPtr->numBytes + 1);
+    pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
     memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
     if (pgvPtr->encoding) {
 	Tcl_FreeEncoding(pgvPtr->encoding);
@@ -3711,9 +4017,8 @@ TclSetProcessGlobalValue(
     Tcl_IncrRefCount(newValue);
     cacheMap = GetThreadHash(&pgvPtr->key);
     ClearHash(cacheMap);
-    hPtr = Tcl_CreateHashEntry(cacheMap,
-	    (char *) INT2PTR(pgvPtr->epoch), &dummy);
-    Tcl_SetHashValue(hPtr, (ClientData) newValue);
+    hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
+    Tcl_SetHashValue(hPtr, newValue);
     Tcl_MutexUnlock(&pgvPtr->mutex);
 }
 
@@ -3761,8 +4066,7 @@ TclGetProcessGlobalValue(
 	    Tcl_DStringLength(&native), &newValue);
 	    Tcl_DStringFree(&native);
 	    ckfree(pgvPtr->value);
-	    pgvPtr->value = ckalloc((unsigned int)
-		    Tcl_DStringLength(&newValue) + 1);
+	    pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
 	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
 		    (size_t) Tcl_DStringLength(&newValue) + 1);
 	    Tcl_DStringFree(&newValue);
@@ -3794,12 +4098,11 @@ TclGetProcessGlobalValue(
 	Tcl_MutexLock(&pgvPtr->mutex);
 	if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
 	    pgvPtr->epoch++;
-	    (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
-		    &pgvPtr->encoding);
+	    pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding);
 	    if (pgvPtr->value == NULL) {
 		Tcl_Panic("PGV Initializer did not initialize");
 	    }
-	    Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData)pgvPtr);
+	    Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
 	}
 
 	/*
@@ -3808,12 +4111,12 @@ TclGetProcessGlobalValue(
 
 	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
 	hPtr = Tcl_CreateHashEntry(cacheMap,
-		(char *) INT2PTR(pgvPtr->epoch), &dummy);
+		INT2PTR(pgvPtr->epoch), &dummy);
 	Tcl_MutexUnlock(&pgvPtr->mutex);
-	Tcl_SetHashValue(hPtr, (ClientData) value);
+	Tcl_SetHashValue(hPtr, value);
 	Tcl_IncrRefCount(value);
     }
-    return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+    return Tcl_GetHashValue(hPtr);
 }
 
 /*
@@ -3825,7 +4128,7 @@ TclGetProcessGlobalValue(
  *	(normally as computed by TclpFindExecutable).
  *
  * Results:
- * 	None.
+ *	None.
  *
  * Side effects:
  *	Stores the executable name.
@@ -3856,7 +4159,7 @@ TclSetObjNameOfExecutable(
  *	pathname of the application is unknown.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -3875,20 +4178,20 @@ TclGetObjNameOfExecutable(void)
  *	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.
+ *	The returned string belongs to Tcl and should be copied if the caller
+ *	plans to keep it, to guard against it becoming invalid.
  *
  * Results:
  *	A pointer to the internal string or NULL if the internal full path
  *	name has not been computed or unknown.
  *
  * Side effects:
- * 	None.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-CONST char *
+const char *
 Tcl_GetNameOfExecutable(void)
 {
     int numBytes;
@@ -3975,14 +4278,18 @@ TclReToGlob(
     const char *reStr,
     int reStrLen,
     Tcl_DString *dsPtr,
-    int *exactPtr)
+    int *exactPtr,
+    int *quantifiersFoundPtr)
 {
     int anchorLeft, anchorRight, lastIsStar, numStars;
-    char *dsStr, *dsStrStart, *msg;
-    const char *p, *strEnd;
+    char *dsStr, *dsStrStart;
+    const char *msg, *p, *strEnd, *code;
 
     strEnd = reStr + reStrLen;
     Tcl_DStringInit(dsPtr);
+    if (quantifiersFoundPtr != NULL) {
+	*quantifiersFoundPtr = 0;
+    }
 
     /*
      * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
@@ -3990,10 +4297,11 @@ TclReToGlob(
 
     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.
+	 * At most, the glob pattern has length 2*reStrLen + 2 to backslash
+	 * escape every character and have * at each end.
 	 */
-	Tcl_DStringSetLength(dsPtr, 2*reStrLen + 2);
+
+	Tcl_DStringSetLength(dsPtr, reStrLen + 2);
 	dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
 	*dsStr++ = '*';
 	for (p = reStr + 4; p < strEnd; p++) {
@@ -4016,8 +4324,8 @@ TclReToGlob(
     }
 
     /*
-     * At most, the glob pattern has length reStrLen + 2 to account
-     * for possible * at each end.
+     * At most, the glob pattern has length reStrLen + 2 to account for
+     * possible * at each end.
      */
 
     Tcl_DStringSetLength(dsPtr, reStrLen + 2);
@@ -4027,12 +4335,12 @@ TclReToGlob(
      * 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.
+     * 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;
@@ -4089,10 +4397,14 @@ TclReToGlob(
 		break;
 	    default:
 		msg = "invalid escape sequence";
+		code = "BADESCAPE";
 		goto invalidGlob;
 	    }
 	    break;
 	case '.':
+	    if (quantifiersFoundPtr != NULL) {
+		*quantifiersFoundPtr = 1;
+	    }
 	    anchorLeft = 0; /* prevent exact match */
 	    if (p+1 < strEnd) {
 		if (p[1] == '*') {
@@ -4117,6 +4429,7 @@ TclReToGlob(
 	case '$':
 	    if (p+1 != strEnd) {
 		msg = "$ not anchor";
+		code = "NONANCHOR";
 		goto invalidGlob;
 	    }
 	    anchorRight = 1;
@@ -4124,8 +4437,8 @@ TclReToGlob(
 	case '*': case '+': case '?': case '|': case '^':
 	case '{': case '}': case '(': case ')': case '[': case ']':
 	    msg = "unhandled RE special char";
+	    code = "UNHANDLED";
 	    goto invalidGlob;
-	    break;
 	default:
 	    *dsStr++ = *p;
 	    break;
@@ -4137,7 +4450,9 @@ TclReToGlob(
 	 * 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;
     }
 
@@ -4150,22 +4465,12 @@ TclReToGlob(
 	*exactPtr = (anchorLeft && anchorRight);
     }
 
-#if 0
-    fprintf(stderr, "INPUT RE '%.*s' OUTPUT GLOB '%s' anchor %d:%d \n",
-	    reStrLen, reStr,
-	    Tcl_DStringValue(dsPtr), anchorLeft, anchorRight);
-    fflush(stderr);
-#endif
     return TCL_OK;
 
   invalidGlob:
-#if 0
-    fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n",
-	    reStrLen, reStr, msg, *p);
-    fflush(stderr);
-#endif
     if (interp != NULL) {
-	Tcl_AppendResult(interp, msg, NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
     }
     Tcl_DStringFree(dsPtr);
     return TCL_ERROR;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index e540c49..30e2f9b 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -18,6 +18,7 @@
  */
 
 #include "tclInt.h"
+#include "tclOOInt.h"
 
 /*
  * Prototypes for the variable hash key methods.
@@ -26,12 +27,11 @@
 static Tcl_HashEntry *	AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr);
 static void		FreeVarEntry(Tcl_HashEntry *hPtr);
 static int		CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr);
-static unsigned int	HashVarKey(Tcl_HashTable *tablePtr, void *keyPtr);
 
-static Tcl_HashKeyType tclVarHashKeyType = {
+static const Tcl_HashKeyType tclVarHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,	/* version */
     0,				/* flags */
-    HashVarKey,			/* hashKeyProc */
+    TclHashObjKey,		/* hashKeyProc */
     CompareVarKeys,		/* compareKeysProc */
     AllocVarEntry,		/* allocEntryProc */
     FreeVarEntry		/* freeEntryProc */
@@ -60,8 +60,8 @@ VarHashCreateVar(
     Tcl_Obj *key,
     int *newPtr)
 {
-    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
-	    (char *) key, newPtr);
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
+	    key, newPtr);
 
     if (hPtr) {
 	return VarHashGetValue(hPtr);
@@ -72,13 +72,15 @@ VarHashCreateVar(
 
 #define VarHashFindVar(tablePtr, key) \
     VarHashCreateVar((tablePtr), (key), NULL)
+
 #define VarHashInvalidateEntry(varPtr) \
     ((varPtr)->flags |= VAR_DEAD_HASH)
+
 #define VarHashDeleteEntry(varPtr) \
     Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))
 
 #define VarHashFirstEntry(tablePtr, searchPtr) \
-    Tcl_FirstHashEntry((Tcl_HashTable *) (tablePtr), (searchPtr))
+    Tcl_FirstHashEntry(&(tablePtr)->table, (searchPtr))
 
 #define VarHashNextEntry(searchPtr) \
     Tcl_NextHashEntry((searchPtr))
@@ -114,7 +116,7 @@ VarHashNextVar(
     (((VarInHash *)(varPtr))->entry.key.objPtr)
 
 #define VarHashDeleteTable(tablePtr) \
-    Tcl_DeleteHashTable((Tcl_HashTable *) (tablePtr))
+    Tcl_DeleteHashTable(&(tablePtr)->table)
 
 /*
  * The strings below are used to indicate what went wrong when a variable
@@ -173,8 +175,8 @@ static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *patternPtr, int includeLinks);
 static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
 static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
-			    Var *varPtr, int flags);
-static Tcl_Var          ObjFindNamespaceVar(Tcl_Interp *interp,
+			    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,
@@ -185,7 +187,7 @@ 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);
+			    Tcl_Obj *part2Ptr, int flags, int index);
 static int		SetArraySearchObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 
@@ -213,13 +215,9 @@ static Tcl_SetFromAnyProc	PanicOnSetVarName;
  * 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
- *
- * nsVarName - INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1:	pointer to the namespace containing the reference
- *   twoPtrValue.ptr2:	pointer to the corresponding Var
+ *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
+ *			  or NULL if it is this same obj
+ *   twoPtrValue.ptr2: index into locals table
  *
  * parsedVarName - INTERNALREP DEFINITION:
  *   twoPtrValue.ptr1:	pointer to the array name Tcl_Obj, or NULL if it is a
@@ -228,31 +226,12 @@ static Tcl_SetFromAnyProc	PanicOnSetVarName;
  *			Tcl_Obj), or NULL if it is a scalar variable
  */
 
-static Tcl_ObjType localVarNameType = {
+static const Tcl_ObjType localVarNameType = {
     "localVarName",
     FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
 };
 
-/*
- * Caching of namespace variables disabled: no simple way was found to avoid
- * interfering with the resolver's idea of variable existence. A cached
- * varName may keep a variable's name in the namespace's hash table, which is
- * the resolver's criterion for existence (see test namespace-17.10).
- */
-
-#define ENABLE_NS_VARNAME_CACHING 0
-
-#if ENABLE_NS_VARNAME_CACHING
-static Tcl_FreeInternalRepProc FreeNsVarName;
-static Tcl_DupInternalRepProc DupNsVarName;
-
-static Tcl_ObjType tclNsVarNameType = {
-    "namespaceVarName",
-    FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
-};
-#endif
-
-static Tcl_ObjType tclParsedVarNameType = {
+static const Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
     FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
 };
@@ -269,7 +248,7 @@ static Tcl_ObjType tclParsedVarNameType = {
  * as this can be safely copied.
  */
 
-Tcl_ObjType tclArraySearchType = {
+const Tcl_ObjType tclArraySearchType = {
     "array search",
     NULL, NULL, NULL, SetArraySearchObj
 };
@@ -324,7 +303,7 @@ CleanupVar(
 	    && !TclIsVarTraced(varPtr)
 	    && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
 	if (VarHashRefCount(varPtr) == 0) {
-	    ckfree((char *) varPtr);
+	    ckfree(varPtr);
 	} else {
 	    VarHashDeleteEntry(varPtr);
 	}
@@ -333,7 +312,7 @@ CleanupVar(
 	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
 	    (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
 	if (VarHashRefCount(arrayPtr) == 0) {
-	    ckfree((char *) arrayPtr);
+	    ckfree(arrayPtr);
 	} else {
 	    VarHashDeleteEntry(arrayPtr);
 	}
@@ -545,39 +524,22 @@ TclObjLookupVarEx(
     Interp *iPtr = (Interp *) interp;
     register Var *varPtr;	/* Points to the variable's in-frame Var
 				 * structure. */
-    char *part1;
+    const char *part1;
     int index, len1, len2;
     int parsed = 0;
     Tcl_Obj *objPtr;
     const Tcl_ObjType *typePtr = part1Ptr->typePtr;
     const char *errMsg = NULL;
     CallFrame *varFramePtr = iPtr->varFramePtr;
-#if ENABLE_NS_VARNAME_CACHING
-    Namespace *nsPtr;
-#endif
-    char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
+    const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
     char *newPart2 = NULL;
-
     *arrayPtrPtr = NULL;
 
-#if ENABLE_NS_VARNAME_CACHING
-    if (varFramePtr) {
-	nsPtr = varFramePtr->nsPtr;
-    } else {
-	/*
-	 * Some variables in the global ns have to be initialized before the
-	 * root call frame is in place.
-	 */
-
-	nsPtr = NULL;
-    }
-#endif
-
     if (typePtr == &localVarNameType) {
 	int localIndex;
 
     localVarNameTypeHandling:
-	localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
+	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
 	if (HasLocalVars(varFramePtr)
 		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
 		&& (localIndex < varFramePtr->numCompiledLocals)) {
@@ -585,8 +547,7 @@ TclObjLookupVarEx(
 	     * Use the cached index if the names coincide.
 	     */
 
-	    Tcl_Obj *namePtr = (Tcl_Obj *)
-		    part1Ptr->internalRep.ptrAndLongRep.ptr;
+	    Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
 	    Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
 
 	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -596,44 +557,6 @@ TclObjLookupVarEx(
 	    }
 	}
 	goto doneParsing;
-#if ENABLE_NS_VARNAME_CACHING
-    } else if (typePtr == &tclNsVarNameType) {
-	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)) {
-	    /*
-	     * 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
-	     * 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.
-	     */
-
-	    goto donePart1;
-	}
-	goto doneParsing;
-#endif
     }
 
     /*
@@ -652,6 +575,7 @@ TclObjLookupVarEx(
 		if (flags & TCL_LEAVE_ERR_MSG) {
 		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
 			    noSuchVar, -1);
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
 		}
 		return NULL;
 	    }
@@ -686,6 +610,8 @@ TclObjLookupVarEx(
 		    if (flags & TCL_LEAVE_ERR_MSG) {
 			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
 				needArray, -1);
+			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
+				NULL);
 		    }
 		    return NULL;
 		}
@@ -699,8 +625,8 @@ TclObjLookupVarEx(
 		len2 = len1 - i - 2;
 		len1 = i;
 
-		newPart2 = ckalloc((unsigned int) (len2+1));
-		memcpy(newPart2, part2, (unsigned int) len2);
+		newPart2 = ckalloc(len2 + 1);
+		memcpy(newPart2, part2, (unsigned) len2);
 		*(newPart2+len2) = '\0';
 		part2 = newPart2;
 		part2Ptr = Tcl_NewStringObj(newPart2, -1);
@@ -744,13 +670,14 @@ TclObjLookupVarEx(
      */
 
     TclFreeIntRep(part1Ptr);
-    part1Ptr->typePtr = NULL;
 
     varPtr = TclLookupSimpleVar(interp, part1Ptr, 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);
@@ -766,31 +693,20 @@ TclObjLookupVarEx(
 	/*
 	 * An indexed local variable.
 	 */
+	Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index);
 
 	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);
+	if (part1Ptr != cachedNamePtr) {
+	    part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
+	    Tcl_IncrRefCount(cachedNamePtr);
+	    if (cachedNamePtr->typePtr != &localVarNameType
+		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
+	        TclFreeIntRep(cachedNamePtr);
+	    }
 	} else {
-	    part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
+	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
 	}
-	part1Ptr->internalRep.ptrAndLongRep.value = (long) index;
-#if ENABLE_NS_VARNAME_CACHING
-    } else if (index > -3) {
-	/*
-	 * A cacheable namespace or global variable.
-	 */
-
-	Namespace *nsPtr;
-
-	nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr);
-	varPtr->refCount++;
-	part1Ptr->typePtr = &tclNsVarNameType;
-	part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr;
-	part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
-#endif
+	part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
     } else {
 	/*
 	 * At least mark part1Ptr as already parsed.
@@ -802,16 +718,6 @@ TclObjLookupVarEx(
     }
 
   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);
-	}
-	return NULL;
-    }
-#endif
     while (TclIsVarLink(varPtr)) {
 	varPtr = varPtr->value.linkPtr;
     }
@@ -832,21 +738,6 @@ TclObjLookupVarEx(
 }
 
 /*
- * This flag bit should not interfere with TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
- * lookup is performed for upvar (or similar) purposes, with slightly
- * different rules:
- *    - Bug #696893 - variable is either proc-local or in the current
- *	namespace; never follow the second (global) resolution path
- *    - Bug #631741 - do not use special namespace or interp resolvers
- *
- * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
- * (Bug #835020)
- */
-
-#define AVOID_RESOLVERS 0x40000
-
-/*
  *----------------------------------------------------------------------
  *
  * TclLookupSimpleVar --
@@ -895,8 +786,8 @@ TclLookupSimpleVar(
     Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
 				 * represent a scalar or an array. */
     int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
-				 * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
-				 * matter. */
+				 * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
+				 * bits matter. */
     const int create,		/* If 1, create hash table entry for varname,
 				 * if it doesn't already exist. If 0, return
 				 * error if it doesn't exist. */
@@ -916,8 +807,8 @@ TclLookupSimpleVar(
 				 * the variable. */
     Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
     ResolverScheme *resPtr;
-    int isNew;
-    const char *varName = TclGetString(varNamePtr);
+    int isNew, i, result, varLen;
+    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);
 
     varPtr = NULL;
     varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
@@ -936,12 +827,10 @@ TclLookupSimpleVar(
      */
 
     if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
-	    && !(flags & AVOID_RESOLVERS)) {
-	int result;
-
+	    && !(flags & TCL_AVOID_RESOLVERS)) {
 	resPtr = iPtr->resolverPtr;
 	if (cxtNsPtr->varResProc) {
-	    result = (*cxtNsPtr->varResProc)(interp, varName,
+	    result = cxtNsPtr->varResProc(interp, varName,
 		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
 	} else {
 	    result = TCL_CONTINUE;
@@ -949,7 +838,7 @@ TclLookupSimpleVar(
 
 	while (result == TCL_CONTINUE && resPtr) {
 	    if (resPtr->varResProc) {
-		result = (*resPtr->varResProc)(interp, varName,
+		result = resPtr->varResProc(interp, varName,
 			(Tcl_Namespace *) cxtNsPtr, flags, &var);
 	    }
 	    resPtr = resPtr->nextPtr;
@@ -991,7 +880,7 @@ TclLookupSimpleVar(
 	    *indexPtr = -1;
 	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
 	} else {
-	    if (flags & AVOID_RESOLVERS) {
+	    if (flags & TCL_AVOID_RESOLVERS) {
 		flags = (flags | TCL_NAMESPACE_ONLY);
 	    }
 	    if (flags & TCL_NAMESPACE_ONLY) {
@@ -1006,12 +895,11 @@ TclLookupSimpleVar(
 
 	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
 		(Tcl_Namespace *) cxtNsPtr,
-		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
+		(flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
 	if (varPtr == NULL) {
+	    Tcl_Obj *tailPtr;
 
 	    if (create) {	/* Var wasn't found so create it. */
-		Tcl_Obj *tailPtr;
-
 		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
 			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
 		if (varNsPtr == NULL) {
@@ -1045,18 +933,18 @@ TclLookupSimpleVar(
 	    }
 	}
     } else {			/* Local var: look in frame varFramePtr. */
-	int localCt = varFramePtr->numCompiledLocals;
+	int localLen, localCt = varFramePtr->numCompiledLocals;
 	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
-	int i;
+	const char *localNameStr;
 
 	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
 	    register Tcl_Obj *objPtr = *objPtrPtr;
 
 	    if (objPtr) {
-		char *localName = TclGetString(objPtr);
+		localNameStr = TclGetStringFromObj(objPtr, &localLen);
 
-		if ((varName[0] == localName[0])
-			&& (strcmp(varName, localName) == 0)) {
+		if ((varLen == localLen) && (varName[0] == localNameStr[0])
+			&& !memcmp(varName, localNameStr, varLen)) {
 		    *indexPtr = i;
 		    return (Var *) &varFramePtr->compiledLocals[i];
 		}
@@ -1065,8 +953,7 @@ TclLookupSimpleVar(
 	tablePtr = varFramePtr->varTablePtr;
 	if (create) {
 	    if (tablePtr == NULL) {
-		tablePtr = (TclVarHashTable *)
-			ckalloc(sizeof(TclVarHashTable));
+		tablePtr = ckalloc(sizeof(TclVarHashTable));
 		TclInitVarHashTable(tablePtr, NULL);
 		varFramePtr->varTablePtr = tablePtr;
 	    }
@@ -1146,6 +1033,7 @@ TclLookupArrayElement(
     int isNew;
     Var *varPtr;
     TclVarHashTable *tablePtr;
+    Namespace *nsPtr;
 
     /*
      * We're dealing with an array element. Make sure the variable is an array
@@ -1153,12 +1041,12 @@ TclLookupArrayElement(
      */
 
     if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
-	Namespace *nsPtr;
-
 	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);
 	    }
 	    return NULL;
 	}
@@ -1172,12 +1060,14 @@ TclLookupArrayElement(
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
 			danglingVar, index);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
 	    }
 	    return NULL;
 	}
 
 	TclSetVarArray(arrayPtr);
-	tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable));
+	tablePtr = ckalloc(sizeof(TclVarHashTable));
 	arrayPtr->value.tablePtr = tablePtr;
 
 	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
@@ -1190,6 +1080,8 @@ TclLookupArrayElement(
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
 		    index);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
 	}
 	return NULL;
     }
@@ -1249,7 +1141,15 @@ Tcl_GetVar(
 				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
 				 * bits. */
 {
-    return Tcl_GetVar2(interp, varName, NULL, flags);
+    Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1);
+    Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);
+
+    TclDecrRefCount(varNamePtr);
+
+    if (resultPtr == NULL) {
+	return NULL;
+    }
+    return TclGetString(resultPtr);
 }
 
 /*
@@ -1287,13 +1187,24 @@ Tcl_GetVar2(
 				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
 				 * bits. */
 {
-    Tcl_Obj *objPtr;
+    Tcl_Obj *resultPtr;
+    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
 
-    objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);
-    if (objPtr == NULL) {
+    if (part2) {
+	part2Ptr = Tcl_NewStringObj(part2, -1);
+	Tcl_IncrRefCount(part2Ptr);
+    }
+
+    resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+
+    Tcl_DecrRefCount(part1Ptr);
+    if (part2Ptr) {
+	Tcl_DecrRefCount(part2Ptr);
+    }
+    if (resultPtr == NULL) {
 	return NULL;
     }
-    return TclGetString(objPtr);
+    return TclGetString(resultPtr);
 }
 
 /*
@@ -1484,6 +1395,7 @@ TclPtrGetVar(
      */
 
   errorReturn:
+    Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL);
     if (TclIsVarUndefined(varPtr)) {
 	TclCleanupVar(varPtr, arrayPtr);
     }
@@ -1574,7 +1486,17 @@ Tcl_SetVar(
 				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    return Tcl_SetVar2(interp, varName, NULL, newValue, flags);
+    Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1);
+
+    Tcl_IncrRefCount(varNamePtr);
+    varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+	    Tcl_NewStringObj(newValue, -1), flags);
+    Tcl_DecrRefCount(varNamePtr);
+
+    if (varValuePtr == NULL) {
+	return NULL;
+    }
+    return TclGetString(varValuePtr);
 }
 
 /*
@@ -1808,6 +1730,7 @@ TclPtrSetVar(
     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
@@ -1822,9 +1745,11 @@ TclPtrSetVar(
 	    if (TclIsVarArrayElement(varPtr)) {
 		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
 			danglingElement, index);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
 	    } else {
 		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
 			danglingVar, index);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 	    }
 	}
 	goto earlyError;
@@ -1837,6 +1762,7 @@ TclPtrSetVar(
     if (TclIsVarArray(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
+	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
 	}
 	goto earlyError;
     }
@@ -1846,7 +1772,7 @@ TclPtrSetVar(
      * requested. This was done for INST_LAPPEND_* but that was inconsistent
      * with the non-bc instruction, and would cause failures trying to
      * lappend to any non-existing ::env var, which is inconsistent with
-     * documented behavior.  [Bug #3057639]
+     * documented behavior. [Bug #3057639].
      */
 
     if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ)
@@ -1870,17 +1796,6 @@ TclPtrSetVar(
 	varPtr->value.objPtr = NULL;
     }
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
-#if 0
-	/*
-	 * Can't happen now!
-	 */
-
-	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
-	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
-	    varPtr->value.objPtr = NULL;
-	    oldValuePtr = NULL;
-	}
-#endif
 	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
 	    if (oldValuePtr == NULL) {
 		TclNewObj(oldValuePtr);
@@ -1909,12 +1824,7 @@ TclPtrSetVar(
 		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
 		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
 
-		    /*
-		     * 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);
+		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
 
 		    TclDecrRefCount(oldValuePtr);
 		    oldValuePtr = varPtr->value.objPtr;
@@ -1975,13 +1885,16 @@ TclPtrSetVar(
      */
 
   cleanup:
+    if (resultPtr == NULL) {
+	Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL);
+    }
     if (TclIsVarUndefined(varPtr)) {
 	TclCleanupVar(varPtr, arrayPtr);
     }
     return resultPtr;
 
   earlyError:
-    if (newValuePtr->refCount == 0) {
+    if (cleanupOnEarlyError) {
 	Tcl_DecrRefCount(newValuePtr);
     }
     goto cleanup;
@@ -2036,8 +1949,8 @@ TclIncrObjVar2(
     varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
 	    1, 1, &arrayPtr);
     if (varPtr == NULL) {
-	Tcl_AddObjErrorInfo(interp,
-		"\n    (reading value of variable to increment)", -1);
+	Tcl_AddErrorInfo(interp,
+		"\n    (reading value of variable to increment)");
 	return NULL;
     }
     return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
@@ -2168,7 +2081,21 @@ Tcl_UnsetVar(
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    return Tcl_UnsetVar2(interp, varName, NULL, flags);
+    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;
 }
 
 /*
@@ -2254,10 +2181,7 @@ TclObjUnsetVar2(
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Var *varPtr;
-    Interp *iPtr = (Interp *) interp;
-    Var *arrayPtr;
-    int result;
+    Var *varPtr, *arrayPtr;
 
     varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
@@ -2265,7 +2189,52 @@ TclObjUnsetVar2(
 	return TCL_ERROR;
     }
 
-    result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+    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);
 
     /*
      * Keep the variable alive until we're done with it. We used to
@@ -2278,7 +2247,7 @@ TclObjUnsetVar2(
 	VarHashRefCount(varPtr)++;
     }
 
-    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags);
+    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
 
     /*
      * It's an error to unset an undefined variable.
@@ -2287,23 +2256,11 @@ TclObjUnsetVar2(
     if (result != TCL_OK) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
-		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
+	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
 	}
     }
 
-#if ENABLE_NS_VARNAME_CACHING
-    /*
-     * 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 = NULL;
-    }
-#endif
-
     /*
      * Finally, if the variable is truly not in use then free up its Var
      * structure and remove it from its hash table, if any. The ref count of
@@ -2343,7 +2300,8 @@ UnsetVarStruct(
     Interp *iPtr,
     Tcl_Obj *part1Ptr,
     Tcl_Obj *part2Ptr,
-    int flags)
+    int flags,
+    int index)
 {
     Var dummyVar;
     int traced = TclIsVarTraced(varPtr)
@@ -2383,6 +2341,7 @@ UnsetVarStruct(
 
     if (traced) {
 	VarTrace *tracePtr = NULL;
+	Tcl_HashEntry *tPtr;
 
 	if (TclIsVarTraced(&dummyVar)) {
 	    /*
@@ -2391,44 +2350,38 @@ UnsetVarStruct(
 	     */
 
 	    int isNew;
-	    Tcl_HashEntry *tPtr =
-		    Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
 
+	    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,
-			(char *) &dummyVar, &isNew);
+			&dummyVar, &isNew);
 		Tcl_SetHashValue(tPtr, tracePtr);
-	    } else {
-		tPtr = NULL;
 	    }
 	}
 
 	if ((dummyVar.flags & VAR_TRACED_UNSET)
 		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
-	    Tcl_HashEntry *tPtr = NULL;
-
 	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
 	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
 		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
 			    | TCL_TRACE_UNSETS,
-		    /* leaveErrMsg */ 0, -1);
+		    /* leaveErrMsg */ 0, index);
 
 	    /*
 	     * The traces that we just called may have triggered a change in
-	     * the set of traces. [Bug 2629338]
+	     * the set of traces. If so, reload the traces to manipulate.
 	     */
 
 	    tracePtr = NULL;
 	    if (TclIsVarTraced(&dummyVar)) {
-		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) &dummyVar);
-		tracePtr = Tcl_GetHashValue(tPtr);
-	    }
-
-	    if (tPtr) {
-		Tcl_DeleteHashEntry(tPtr);
+		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
+		if (tPtr) {
+		    tracePtr = Tcl_GetHashValue(tPtr);
+		    Tcl_DeleteHashEntry(tPtr);
+		}
 	    }
 	}
 
@@ -2440,7 +2393,7 @@ UnsetVarStruct(
 
 		tracePtr = tracePtr->nextPtr;
 		prevPtr->nextPtr = NULL;
-		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
 	    }
 	    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
 		    activePtr = activePtr->nextPtr) {
@@ -2470,7 +2423,8 @@ UnsetVarStruct(
 	 */
 
 	DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags
-		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS,
+		index);
     } else if (TclIsVarLink(&dummyVar)) {
 	/*
 	 * For global/upvar variables referenced in procedures, decrement the
@@ -2520,7 +2474,7 @@ Tcl_UnsetObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register int i, flags = TCL_LEAVE_ERR_MSG;
-    register char *name;
+    register const char *name;
 
     if (objc == 1) {
 	/*
@@ -2587,11 +2541,13 @@ Tcl_AppendObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    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 value ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
 	return TCL_ERROR;
     }
 
@@ -2601,9 +2557,6 @@ Tcl_AppendObjCmd(
 	    return TCL_ERROR;
 	}
     } else {
-	Var *arrayPtr, *varPtr;
-	int i;
-
 	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	if (varPtr == NULL) {
@@ -2655,11 +2608,12 @@ Tcl_LappendObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *varValuePtr, *newValuePtr;
-    int numElems;
+    int numElems, createdNewObj;
+    Var *varPtr, *arrayPtr;
     int result;
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
 	return TCL_ERROR;
     }
     if (objc == 2) {
@@ -2683,9 +2637,6 @@ Tcl_LappendObjCmd(
 	    }
 	}
     } else {
-	Var *varPtr, *arrayPtr;
-	int createdNewObj = 0;
-
 	/*
 	 * 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
@@ -2696,6 +2647,8 @@ Tcl_LappendObjCmd(
 	 * 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
@@ -2773,66 +2726,314 @@ Tcl_LappendObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ArrayObjCmd --
+ * TclArraySet --
  *
- *	This object-based function is invoked to process the "array" 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.
+ *	Callers must Incr arrayNameObj if they pland to Decr it.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_ArrayObjCmd(
-    ClientData dummy,		/* Not used. */
+TclArraySet(
     Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+    Tcl_Obj *arrayNameObj,	/* The array name. */
+    Tcl_Obj *arrayElemObj)	/* The array elements list or dict. If this is
+				 * NULL, create an empty array. */
 {
+    Var *varPtr, *arrayPtr;
+    int result, i;
+
+    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
+	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
+	    /*createPart2*/ 1, &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;
+    }
+
+    if (arrayElemObj == NULL) {
+	goto ensureArray;
+    }
+
     /*
-     * The list of constants below should match the arrayOptions string array
-     * below.
+     * Install the contents of the dictionary or list into the array.
      */
 
-    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", NULL
-    };
+    if (arrayElemObj->typePtr == &tclDictType) {
+	Tcl_Obj *keyPtr, *valuePtr;
+	Tcl_DictSearch search;
+	int done;
 
+	if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (done == 0) {
+	    /*
+	     * Empty, so we'll just force the array to be properly existing
+	     * instead.
+	     */
+
+	    goto ensureArray;
+	}
+
+	/*
+	 * Don't need to look at result of Tcl_DictObjFirst as we've just
+	 * successfully used a dictionary operation on the same object.
+	 */
+
+	for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
+		&keyPtr, &valuePtr, &done) ; !done ;
+		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
+	    /*
+	     * At this point, it would be nice if the key was directly usable
+	     * by the array. This isn't the case though.
+	     */
+
+	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+	    if ((elemVarPtr == NULL) ||
+		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
+		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
+		Tcl_DictObjDone(&search);
+		return TCL_ERROR;
+	    }
+	}
+	return TCL_OK;
+    } else {
+	/*
+	 * Not a dictionary, so assume (and convert to, for backward-
+	 * -compatibility 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;
+    }
+
+    /*
+     * The list is empty make sure we have an array, or create one if
+     * necessary.
+     */
+
+  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;
+	}
+    }
+    TclSetVarArray(varPtr);
+    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
+    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayStartSearchCmd --
+ *
+ *	This object-based function is invoked to process the "array
+ *	startsearch" 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
+ArrayStartSearchCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
     Interp *iPtr = (Interp *) interp;
     Var *varPtr, *arrayPtr;
     Tcl_HashEntry *hPtr;
-    Tcl_Obj *varNamePtr;
-    int notArray;
-    int index, result;
+    Tcl_Obj *varNameObj;
+    int isNew;
+    ArraySearch *searchPtr;
+    const char *varName;
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
+    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't an array", varName));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
 	return TCL_ERROR;
     }
 
-    if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
-	    0, &index) != TCL_OK) {
+    /*
+     * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayAnyMoreCmd --
+ *
+ *	This object-based function is invoked to process the "array anymore"
+ *	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
+ArrayAnyMoreCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Interp *iPtr = (Interp *) interp;
+    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
+     * Locate the array variable.
      */
 
-    varNamePtr = objv[2];
-    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, /*flags*/ 0,
+    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
 	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
     /*
@@ -2842,7 +3043,7 @@ Tcl_ArrayObjCmd(
 
     if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
 	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr, NULL,
+	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;
@@ -2855,682 +3056,1136 @@ Tcl_ArrayObjCmd(
      * traces.
      */
 
-    notArray = 0;
     if ((varPtr == NULL) || !TclIsVarArray(varPtr)
 	    || TclIsVarUndefined(varPtr)) {
-	notArray = 1;
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't an array", TclGetString(varNameObj)));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+		TclGetString(varNameObj), NULL);
+	return TCL_ERROR;
     }
 
-    switch (index) {
-    case ARRAY_ANYMORE: {
-	ArraySearch *searchPtr;
+    /*
+     * Get the search.
+     */
 
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
-	    return TCL_ERROR;
-	}
-	if (notArray) {
-	    goto error;
-	}
-	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
-	if (searchPtr == NULL) {
-	    return TCL_ERROR;
-	}
-	while (1) {
-	    if (searchPtr->nextEntry != NULL) {
-		Var *varPtr2 = VarHashGetValue(searchPtr->nextEntry);
-		if (!TclIsVarUndefined(varPtr2)) {
-		    break;
-		}
-	    }
-	    searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
-	    if (searchPtr->nextEntry == NULL) {
-		Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]);
-		return TCL_OK;
-	    }
-	}
-	Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[1]);
-	break;
+    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
+    if (searchPtr == NULL) {
+	return TCL_ERROR;
     }
-    case ARRAY_DONESEARCH: {
-	ArraySearch *searchPtr, *prevPtr;
 
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
-	    return TCL_ERROR;
+    /*
+     * Scan forward to find if there are any further elements in the array
+     * that are defined.
+     */
+
+    while (1) {
+	if (searchPtr->nextEntry != NULL) {
+	    varPtr = VarHashGetValue(searchPtr->nextEntry);
+	    if (!TclIsVarUndefined(varPtr)) {
+		gotValue = 1;
+		break;
+	    }
 	}
-	if (notArray) {
-	    goto error;
+	searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
+	if (searchPtr->nextEntry == NULL) {
+	    gotValue = 0;
+	    break;
 	}
-	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
-	if (searchPtr == NULL) {
+    }
+    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayNextElementCmd --
+ *
+ *	This object-based function is invoked to process the "array
+ *	nextelement" 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
+ArrayNextElementCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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;
 	}
-	hPtr = Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
-	if (searchPtr == Tcl_GetHashValue(hPtr)) {
-	    if (searchPtr->nextPtr) {
-		Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
-	    } else {
-		varPtr->flags &= ~VAR_SEARCH_ACTIVE;
-		Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * 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_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't an array", TclGetString(varNameObj)));
+	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;
+    }
+
+    /*
+     * 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.
+     */
+
+    while (1) {
+	Tcl_HashEntry *hPtr = searchPtr->nextEntry;
+
+	if (hPtr == NULL) {
+	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
+	    if (hPtr == NULL) {
+		return TCL_OK;
 	    }
 	} else {
-	    for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
-		if (prevPtr->nextPtr == searchPtr) {
-		    prevPtr->nextPtr = searchPtr->nextPtr;
-		    break;
-		}
-	    }
+	    searchPtr->nextEntry = NULL;
+	}
+	varPtr = VarHashGetValue(hPtr);
+	if (!TclIsVarUndefined(varPtr)) {
+	    Tcl_SetObjResult(interp, VarHashGetKey(varPtr));
+	    return TCL_OK;
 	}
-	ckfree((char *) searchPtr);
-	break;
     }
-    case ARRAY_NEXTELEMENT: {
-	ArraySearch *searchPtr;
-	Tcl_HashEntry *hPtr;
-	Var *varPtr2;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayDoneSearchCmd --
+ *
+ *	This object-based function is invoked to process the "array
+ *	donesearch" 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
+ArrayDoneSearchCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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);
 
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
+    /*
+     * 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;
 	}
-	if (notArray) {
-	    goto error;
-	}
-	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
-	if (searchPtr == NULL) {
-	    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_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't an array", TclGetString(varNameObj)));
+	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;
+    }
+
+    /*
+     * 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);
 	}
-	while (1) {
-	    hPtr = searchPtr->nextEntry;
-	    if (hPtr == NULL) {
-		hPtr = Tcl_NextHashEntry(&searchPtr->search);
-		if (hPtr == NULL) {
-		    return TCL_OK;
-		}
-	    } else {
-		searchPtr->nextEntry = NULL;
-	    }
-	    varPtr2 = VarHashGetValue(hPtr);
-	    if (!TclIsVarUndefined(varPtr2)) {
+    } else {
+	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+	    if (prevPtr->nextPtr == searchPtr) {
+		prevPtr->nextPtr = searchPtr->nextPtr;
 		break;
 	    }
 	}
-	Tcl_SetObjResult(interp, VarHashGetKey(varPtr2));
-	break;
     }
-    case ARRAY_STARTSEARCH: {
-	ArraySearch *searchPtr;
-	int isNew;
-	char *varName = TclGetString(varNamePtr);
+    ckfree(searchPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayExistsCmd --
+ *
+ *	This object-based function is invoked to process the "array exists"
+ *	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
+ArrayExistsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr, *arrayPtr;
+    Tcl_Obj *arrayNameObj;
+    int notArray;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
+	return TCL_ERROR;
+    }
+    arrayNameObj = objv[1];
 
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+    /*
+     * 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 (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) {
 	    return TCL_ERROR;
 	}
-	if (notArray) {
-	    goto error;
-	}
-	searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
-	hPtr = Tcl_CreateHashEntry(&iPtr->varSearches,
-		(char *) varPtr, &isNew);
-	if (isNew) {
-	    searchPtr->id = 1;
-	    Tcl_AppendResult(interp, "s-1-", varName, NULL);
-	    varPtr->flags |= VAR_SEARCH_ACTIVE;
-	    searchPtr->nextPtr = NULL;
-	} else {
-	    char string[TCL_INTEGER_SPACE];
+    }
 
-	    searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
-	    TclFormatInt(string, searchPtr->id);
-	    Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
-	    searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
-	}
-	searchPtr->varPtr = varPtr;
-	searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
-		&searchPtr->search);
-	Tcl_SetHashValue(hPtr, searchPtr);
+    /*
+     * 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;
     }
 
-    case ARRAY_EXISTS:
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+    /*
+     * 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_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
-	break;
-    case ARRAY_GET: {
-	Tcl_HashSearch search;
-	Var *varPtr2;
-	char *pattern = NULL;
-	char *name;
-	Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
-	int i, count;
-
-	if ((objc != 3) && (objc != 4)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
-	    return TCL_ERROR;
+    }
+
+    /*
+     * 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.
+     */
+
+    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+	    || TclIsVarUndefined(varPtr)) {
+	return TCL_OK;
+    }
+
+    pattern = (patternObj ? TclGetString(patternObj) : NULL);
+
+    /*
+     * Store the array names in a new object.
+     */
+
+    TclNewObj(nameLstObj);
+    Tcl_IncrRefCount(nameLstObj);
+    if ((patternObj != NULL) && TclMatchIsTrivial(pattern)) {
+	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
+	if (varPtr2 == NULL) {
+	    goto searchDone;
 	}
-	if (notArray) {
-	    return TCL_OK;
+	if (TclIsVarUndefined(varPtr2)) {
+	    goto searchDone;
 	}
-	if (objc == 4) {
-	    pattern = TclGetString(objv[3]);
+	result = Tcl_ListObjAppendElement(interp, nameLstObj,
+		VarHashGetKey(varPtr2));
+	if (result != TCL_OK) {
+	    TclDecrRefCount(nameLstObj);
+	    return result;
 	}
+	goto searchDone;
+    }
 
-	/*
-	 * Store the array names in a new object.
-	 */
-
-	TclNewObj(nameLstPtr);
-	Tcl_IncrRefCount(nameLstPtr);
-	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
-	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
-	    if (varPtr2 == NULL) {
-		goto searchDone;
-	    }
-	    if (TclIsVarUndefined(varPtr2)) {
-		goto searchDone;
-	    }
-	    result = Tcl_ListObjAppendElement(interp, nameLstPtr,
-		    VarHashGetKey(varPtr2));
-	    if (result != TCL_OK) {
-		TclDecrRefCount(nameLstPtr);
-		return result;
-	    }
-	    goto searchDone;
+    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. */
 	}
-	for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
-		varPtr2; varPtr2 = VarHashNextVar(&search)) {
-	    if (TclIsVarUndefined(varPtr2)) {
-		continue;
-	    }
-	    namePtr = VarHashGetKey(varPtr2);
-	    name = TclGetString(namePtr);
-	    if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
-		continue;	/* Element name doesn't match pattern. */
-	    }
 
-	    result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr);
-	    if (result != TCL_OK) {
-		TclDecrRefCount(nameLstPtr);
-		return result;
-	    }
+	result = Tcl_ListObjAppendElement(interp, nameLstObj, nameObj);
+	if (result != TCL_OK) {
+	    TclDecrRefCount(nameLstObj);
+	    return result;
 	}
+    }
 
-    searchDone:
-	/*
-	 * Make sure the Var structure of the array is not removed by a trace
-	 * while we're working.
-	 */
+    /*
+     * Make sure the Var structure of the array is not removed by a trace
+     * while we're working.
+     */
 
-	if (TclIsVarInHash(varPtr)) {
-	    VarHashRefCount(varPtr)++;
-	}
+  searchDone:
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)++;
+    }
 
-	/*
-	 * Get the array values corresponding to each element name.
-	 */
+    /*
+     * Get the array values corresponding to each element name.
+     */
 
-	TclNewObj(tmpResPtr);
-	result = Tcl_ListObjGetElements(interp, nameLstPtr, &count,
-		&namePtrPtr);
-	if (result != TCL_OK) {
-	    goto errorInArrayGet;
-	}
+    TclNewObj(tmpResObj);
+    result = Tcl_ListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
+    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) {
+    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)) {
 		/*
-		 * Some trace played a trick on us; we need to diagnose to
-		 * adapt our behaviour: was the array element unset, or did
-		 * the modification modify the complete array?
+		 * The array itself looks OK, the variable was undefined:
+		 * forget it.
 		 */
 
-		if (TclIsVarArray(varPtr)) {
-		    /*
-		     * The array itself looks OK, the variable was undefined:
-		     * forget it.
-		     */
-
-		    continue;
-		} else {
-		    result = TCL_ERROR;
-		    goto errorInArrayGet;
-		}
-	    }
-	    result = Tcl_DictObjPut(interp, tmpResPtr, namePtr, valuePtr);
-	    if (result != TCL_OK) {
-		goto errorInArrayGet;
+		continue;
 	    }
+	    result = TCL_ERROR;
+	    goto errorInArrayGet;
 	}
-	if (TclIsVarInHash(varPtr)) {
-	    VarHashRefCount(varPtr)--;
+	result = Tcl_DictObjPut(interp, tmpResObj, nameObj, valueObj);
+	if (result != TCL_OK) {
+	    goto errorInArrayGet;
 	}
-	Tcl_SetObjResult(interp, tmpResPtr);
-	TclDecrRefCount(nameLstPtr);
-	break;
+    }
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+    }
+    Tcl_SetObjResult(interp, tmpResObj);
+    TclDecrRefCount(nameLstObj);
+    return TCL_OK;
 
-    errorInArrayGet:
-	if (TclIsVarInHash(varPtr)) {
-	    VarHashRefCount(varPtr)--;
-	}
-	TclDecrRefCount(nameLstPtr);
-	TclDecrRefCount(tmpResPtr);	/* Free unneeded temp result. */
-	return result;
+  errorInArrayGet:
+    if (TclIsVarInHash(varPtr)) {
+	VarHashRefCount(varPtr)--;
+    }
+    TclDecrRefCount(nameLstObj);
+    TclDecrRefCount(tmpResObj);	/* Free unneeded temp result. */
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayNamesCmd --
+ *
+ *	This object-based function is invoked to process the "array names" 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
+ArrayNamesCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    static const char *const options[] = {
+	"-exact", "-glob", "-regexp", 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;
+
+    if ((objc < 2) || (objc > 4)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
+	return TCL_ERROR;
     }
-    case ARRAY_NAMES: {
-	Tcl_HashSearch search;
-	Var *varPtr2;
-	char *pattern;
-	char *name;
-	Tcl_Obj *namePtr, *resultPtr, *patternPtr;
-	int mode, matched = 0;
-	static const char *options[] = {
-	    "-exact", "-glob", "-regexp", NULL
-	};
-	enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
-
-	mode = OPT_GLOB;
-
-	if ((objc < 3) || (objc > 5)) {
-	    Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?");
+    varNameObj = objv[1];
+    patternObj = (objc > 2 ? objv[objc-1] : NULL);
+
+    /*
+     * 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;
 	}
-	if (notArray) {
-	    return TCL_OK;
+    }
+
+    /*
+     * 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.
+     */
+
+    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+	    || TclIsVarUndefined(varPtr)) {
+	return TCL_OK;
+    }
+
+    /*
+     * Check for the trivial cases where we can use a direct lookup.
+     */
+
+    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));
 	}
-	if (objc == 4) {
-	    patternPtr = objv[3];
-	    pattern = TclGetString(patternPtr);
-	} else if (objc == 5) {
-	    patternPtr = objv[4];
-	    pattern = TclGetString(patternPtr);
-	    if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0,
-		    &mode) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	} else {
-	    patternPtr = NULL;
-	    pattern = NULL;
-	}
-	TclNewObj(resultPtr);
-	if (((enum options) mode)==OPT_GLOB && pattern!=NULL &&
-		TclMatchIsTrivial(pattern)) {
-	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternPtr);
-	    if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
-		result = Tcl_ListObjAppendElement(interp, resultPtr,
-			VarHashGetKey(varPtr2));
-		if (result != TCL_OK) {
-		    TclDecrRefCount(resultPtr);
-		    return result;
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+    }
+
+    /*
+     * Must scan the array to select the elements.
+     */
+
+    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+	    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+	if (TclIsVarUndefined(varPtr2)) {
+	    continue;
+	}
+	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;
 		}
+		break;
 	    }
-	    Tcl_SetObjResult(interp, resultPtr);
-	    return TCL_OK;
-	}
-	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
-		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
-	    if (TclIsVarUndefined(varPtr2)) {
+	    if (matched == 0) {
 		continue;
 	    }
-	    namePtr = VarHashGetKey(varPtr2);
-	    name = TclGetString(namePtr);
-	    if (objc > 3) {
-		switch ((enum options) mode) {
-		case OPT_EXACT:
-		    matched = (strcmp(name, pattern) == 0);
-		    break;
-		case OPT_GLOB:
-		    matched = Tcl_StringMatch(name, pattern);
-		    break;
-		case OPT_REGEXP:
-		    matched = Tcl_RegExpMatch(interp, name, pattern);
-		    if (matched < 0) {
-			TclDecrRefCount(resultPtr);
-			return TCL_ERROR;
-		    }
-		    break;
-		}
-		if (matched == 0) {
-		    continue;
-		}
-	    }
-
-	    result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
-	    if (result != TCL_OK) {
-		TclDecrRefCount(namePtr);	/* Free unneeded name obj. */
-		return result;
-	    }
 	}
-	Tcl_SetObjResult(interp, resultPtr);
-	break;
+
+	Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
     }
-    case ARRAY_SET:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
-	    return TCL_ERROR;
-	}
-	return TclArraySet(interp, objv[2], objv[3]);
-    case ARRAY_UNSET:
-	if ((objc != 3) && (objc != 4)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
-	    return TCL_ERROR;
-	}
-	if (notArray) {
-	    return TCL_OK;
-	}
-	if (objc == 3) {
-	    /*
-	     * When no pattern is given, just unset the whole array.
-	     */
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFindArrayPtrElements --
+ *
+ *	Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry
+ *	for each existing element of the given array. The provided hash table
+ *	is assumed to be initially empty.
+ *
+ * Result:
+ *	none
+ *
+ * Side effects:
+ *	The keys of the array gain an extra reference. The supplied hash table
+ *	has elements added to it.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    return TclObjUnsetVar2(interp, varNamePtr, NULL, 0);
-	} else {
-	    Tcl_HashSearch search;
-	    Var *varPtr2, *protectedVarPtr;
-	    const char *pattern = TclGetString(objv[3]);
+void
+TclFindArrayPtrElements(
+    Var *arrayPtr,
+    Tcl_HashTable *tablePtr)
+{
+    Var *varPtr;
+    Tcl_HashSearch search;
 
-	    /*
-	     * With a trivial pattern, we can just unset.
-	     */
+    if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
+	    || TclIsVarUndefined(arrayPtr)) {
+	return;
+    }
 
-	    if (TclMatchIsTrivial(pattern)) {
-		varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
-		if (varPtr2 != NULL && !TclIsVarUndefined(varPtr2)) {
-		    return TclObjUnsetVar2(interp, varNamePtr, objv[3], 0);
-		}
-		return TCL_OK;
-	    }
+    for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
+	    varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
+	Tcl_HashEntry *hPtr;
+	Tcl_Obj *nameObj;
+	int dummy;
 
-	    /*
-	     * 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]
-	     */
+	if (TclIsVarUndefined(varPtr)) {
+	    continue;
+	}
+	nameObj = VarHashGetKey(varPtr);
+	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy);
+	Tcl_SetHashValue(hPtr, nameObj);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	    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.
-		 */
+	/* ARGSUSED */
+static int
+ArraySetCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr, *arrayPtr;
 
-		if (varPtr2 == protectedVarPtr) {
-		    VarHashRefCount(varPtr2)--;
-		}
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
+	return TCL_ERROR;
+    }
 
-		/*
-		 * Guard the next item in the search chain by incrementing its
-		 * refcount. This guarantees that the hash table iterator
-		 * won't be dangling on the next time through the loop.
-		 */
+    /*
+     * Locate the array variable.
+     */
 
-		if (search.nextEntryPtr != NULL) {
-		    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
-		    VarHashRefCount(protectedVarPtr)++;
-		} else {
-		    protectedVarPtr = NULL;
-		}
+    varPtr = TclObjLookupVarEx(interp, objv[1], NULL, /*flags*/ 0,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
-		if (!TclIsVarUndefined(varPtr2)) {
-		    Tcl_Obj *namePtr = VarHashGetKey(varPtr2);
-
-		    if (Tcl_StringMatch(TclGetString(namePtr), pattern)
-			    && TclObjUnsetVar2(interp, varNamePtr, namePtr,
-				    0) != TCL_OK) {
-			/*
-			 * If we incremented a refcount, we must decrement it
-			 * here as we will not be coming back properly due to
-			 * the error.
-			 */
-
-			if (protectedVarPtr) {
-			    VarHashRefCount(protectedVarPtr)--;
-			    CleanupVar(protectedVarPtr, varPtr);
-			}
-			return TCL_ERROR;
-		    }
-		} else {
-		    CleanupVar(varPtr2, varPtr);
-		}
-	    }
-	    break;
+    /*
+     * 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, objv[1], NULL,
+		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+	    return TCL_ERROR;
 	}
+    }
 
-    case ARRAY_SIZE: {
-	Tcl_HashSearch search;
-	int size;
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* 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;
+
+    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 (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+    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;
 	}
-	size = 0;
+    }
+
+    /*
+     * 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...
+     */
 
+    if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
 	/*
 	 * Must iterate in order to get chance to check for present but
 	 * "undefined" entries.
 	 */
 
-	if (!notArray) {
-	    Var *varPtr2;
-
-	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
-		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
-		if (TclIsVarUndefined(varPtr2)) {
-		    continue;
-		}
+	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
+	    if (!TclIsVarUndefined(varPtr2)) {
 		size++;
 	    }
 	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
-	break;
     }
 
-    case ARRAY_STATISTICS: {
-	const char *stats;
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayStatsCmd --
+ *
+ *	This object-based function is invoked to process the "array
+ *	statistics" 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
+ArrayStatsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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.
+     */
 
-	if (notArray) {
-	    goto error;
-	}
+    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
-	stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
-	if (stats != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
-	    ckfree((void *)stats);
-	} else {
-	    Tcl_SetResult(interp,"error reading array statistics",TCL_STATIC);
+    /*
+     * 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;
 	}
-	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.
+     */
+
+    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+	    || TclIsVarUndefined(varPtr)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't an array", TclGetString(varNameObj)));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
+		TclGetString(varNameObj), NULL);
+	return TCL_ERROR;
+    }
+
+    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
+    if (stats == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"error reading array statistics", -1));
+	return TCL_ERROR;
     }
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
+    ckfree(stats);
     return TCL_OK;
-
-  error:
-    Tcl_AppendResult(interp, "\"", TclGetString(varNamePtr),
-	    "\" isn't an array", NULL);
-    return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclArraySet --
+ * ArrayUnsetCmd --
  *
- *	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.
+ *	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:
- *	A variable will be created if one does not already exist.
- *	Callers must Incr arrayNameObj if they pland to Decr it.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+	/* ARGSUSED */
+static int
+ArrayUnsetCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
 {
-    Var *varPtr, *arrayPtr;
-    int result, i;
+    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? */
 
-    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
-	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
-	    /*createPart2*/ 1, &arrayPtr);
-    if (varPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (arrayPtr) {
-	CleanupVar(varPtr, arrayPtr);
-	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
+    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;
     }
 
-    if (arrayElemObj == NULL) {
-	goto ensureArray;
-    }
-
     /*
-     * Install the contents of the dictionary or list into the array.
+     * Locate the array variable
      */
 
-    if (arrayElemObj->typePtr == &tclDictType) {
-	Tcl_Obj *keyPtr, *valuePtr;
-	Tcl_DictSearch search;
-	int done;
+    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
 
-	if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
+    /*
+     * 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;
 	}
-	if (done == 0) {
-	    /*
-	     * Empty, so we'll just force the array to be properly existing
-	     * instead.
-	     */
+    }
 
-	    goto ensureArray;
-	}
+    /*
+     * 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) {
 	/*
-	 * Don't need to look at result of Tcl_DictObjFirst as we've just
-	 * successfully used a dictionary operation on the same object.
+	 * When no pattern is given, just unset the whole array.
 	 */
 
-	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.
-	     */
+	return TclObjUnsetVar2(interp, varNameObj, NULL, 0);
+    }
 
-	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
-		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+    /*
+     * With a trivial pattern, we can just unset.
+     */
 
-	    if ((elemVarPtr == NULL) ||
-		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
-		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
-		Tcl_DictObjDone(&search);
-		return TCL_ERROR;
-	    }
+    pattern = TclGetString(patternObj);
+    if (TclMatchIsTrivial(pattern)) {
+	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
+	if (!varPtr2 || TclIsVarUndefined(varPtr2)) {
+	    return TCL_OK;
 	}
-	return TCL_OK;
-    } else {
+	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]
+     */
+
+    protectedVarPtr = NULL;
+    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
+	    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
 	/*
-	 * Not a dictionary, so assume (and convert to, for backward-
-	 * -compatibility reasons) a list.
+	 * Drop the extra ref immediately. We don't need to free it at this
+	 * point though; we'll be unsetting it if necessary soon.
 	 */
 
-	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));
-	    return TCL_ERROR;
-	}
-	if (elemLen == 0) {
-	    goto ensureArray;
+	if (varPtr2 == protectedVarPtr) {
+	    VarHashRefCount(varPtr2)--;
 	}
 
 	/*
-	 * 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.
+	 * 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.
 	 */
 
-	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;
-	    }
+	if (search.nextEntryPtr != NULL) {
+	    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
+	    VarHashRefCount(protectedVarPtr)++;
+	} else {
+	    protectedVarPtr = NULL;
 	}
-	Tcl_DecrRefCount(copyListObj);
-	return result;
-    }
-
-    /*
-     * The list is empty make sure we have an array, or create one if
-     * necessary.
-     */
 
-  ensureArray:
-    if (varPtr != NULL) {
-	if (TclIsVarArray(varPtr)) {
-	    /*
-	     * Already an array, done.
-	     */
+	/*
+	 * If the variable is undefined, clean it out as it has been hit by
+	 * something else (i.e., an unset trace).
+	 */
 
-	    return TCL_OK;
+	if (TclIsVarUndefined(varPtr2)) {
+	    CleanupVar(varPtr2, varPtr);
+	    continue;
 	}
-	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+
+	nameObj = VarHashGetKey(varPtr2);
+	if (Tcl_StringMatch(TclGetString(nameObj), pattern)
+		&& TclPtrUnsetVar(interp, varPtr2, varPtr, varNameObj,
+			nameObj, unsetFlags, -1) != TCL_OK) {
 	    /*
-	     * Either an array element, or a scalar: lose!
+	     * If we incremented a refcount, we must decrement it here as we
+	     * will not be coming back properly due to the error.
 	     */
 
-	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
-		    needArray, -1);
+	    if (protectedVarPtr) {
+		VarHashRefCount(protectedVarPtr)--;
+		CleanupVar(protectedVarPtr, varPtr);
+	    }
 	    return TCL_ERROR;
 	}
     }
-    TclSetVarArray(varPtr);
-    varPtr->value.tablePtr = (TclVarHashTable *)
-	    ckalloc(sizeof(TclVarHashTable));
-    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
     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,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
+	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
+	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"unset",	ArrayUnsetCmd,		TclCompileArrayUnsetCmd, 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"
@@ -3610,9 +4265,11 @@ ObjMakeUpvar(
 			|| (varFramePtr == NULL)
 			|| !HasLocalVars(varFramePtr)
 			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
-	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
-		    TclGetString(myNamePtr), "\": can't create namespace "
-		    "variable that refers to procedure variable", NULL);
+	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+		    "bad variable name \"%s\": can't create namespace "
+		    "variable that refers to procedure variable",
+		    TclGetString(myNamePtr)));
+	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -3682,7 +4339,7 @@ TclPtrObjMakeUpvar(
 {
     Interp *iPtr = (Interp *) interp;
     CallFrame *varFramePtr = iPtr->varFramePtr;
-    const char *errMsg, *myName;
+    const char *errMsg, *p, *myName;
     Var *varPtr;
 
     if (index >= 0) {
@@ -3693,7 +4350,6 @@ TclPtrObjMakeUpvar(
 	myNamePtr = localName(iPtr->varFramePtr, index);
 	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
     } else {
-	const char *p;
 	/*
 	 * 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
@@ -3710,41 +4366,49 @@ TclPtrObjMakeUpvar(
 		 * myName looks like an array reference.
 		 */
 
-		Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
-			myName, "\": can't create a scalar variable that "
-			"looks like an array element", NULL);
+		Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+			"bad variable name \"%s\": can't create a scalar "
+			"variable that looks like an array element", myName));
+		Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
+			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:
+	 * TCL_AVOID_RESOLVERS to indicate the special resolution rules for
+	 * upvar purposes:
 	 *   - Bug #696893 - variable is either proc-local or in the current
 	 *     namespace; never follow the second (global) resolution path.
 	 *   - Bug #631741 - do not use special namespace or interp resolvers.
 	 */
 
 	varPtr = TclLookupSimpleVar(interp, myNamePtr,
-		myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
+		myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
 	if (varPtr == NULL) {
 	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    TclGetString(myNamePtr), NULL);
 	    return TCL_ERROR;
 	}
     }
 
     if (varPtr == otherPtr) {
-	Tcl_SetResult((Tcl_Interp *) iPtr,
-		"can't upvar from variable to itself", TCL_STATIC);
+	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
+		"can't upvar from variable to itself", -1));
+	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL);
 	return TCL_ERROR;
     }
 
     if (TclIsVarTraced(varPtr)) {
-	Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
-		"\" has traces: can't use for upvar", NULL);
+	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+		"variable \"%s\" has traces: can't use for upvar", myName));
+	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", 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
@@ -3752,22 +4416,23 @@ TclPtrObjMakeUpvar(
 	 * disconnect it from the thing it currently refers to.
 	 */
 
-	if (TclIsVarLink(varPtr)) {
-	    Var *linkPtr = varPtr->value.linkPtr;
-	    if (linkPtr == otherPtr) {
-		return TCL_OK;
-	    }
-	    if (TclIsVarInHash(linkPtr)) {
-		VarHashRefCount(linkPtr)--;
-		if (TclIsVarUndefined(linkPtr)) {
-		    CleanupVar(linkPtr, NULL);
-		}
-	    }
-	} else {
-	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
-		    "\" already exists", NULL);
+	if (!TclIsVarLink(varPtr)) {
+	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+		    "variable \"%s\" already exists", myName));
+	    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 (TclIsVarUndefined(linkPtr)) {
+		CleanupVar(linkPtr, NULL);
+	    }
+	}
     }
     TclSetVarLink(varPtr);
     varPtr->value.linkPtr = otherPtr;
@@ -3791,8 +4456,9 @@ TclPtrObjMakeUpvar(
  *
  * Side effects:
  *	The variable in frameName whose name is given by varName becomes
- *	accessible under the name localName, so that references to localName
- *	are redirected to the other variable like a symbolic link.
+ *	accessible under the name localNameStr, so that references to
+ *	localNameStr are redirected to the other variable like a symbolic
+ *	link.
  *
  *----------------------------------------------------------------------
  */
@@ -3807,11 +4473,28 @@ Tcl_UpVar(
     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. */
+    const char *localNameStr,	/* Name of link variable. */
     int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
-				 * indicates scope of localName. */
+				 * indicates scope of localNameStr. */
 {
-    return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
+    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;
 }
 
 /*
@@ -3828,8 +4511,9 @@ Tcl_UpVar(
  *
  * Side effects:
  *	The variable in frameName whose name is given by part1 and part2
- *	becomes accessible under the name localName, so that references to
- *	localName are redirected to the other variable like a symbolic link.
+ *	becomes accessible under the name localNameStr, so that references to
+ *	localNameStr are redirected to the other variable like a symbolic
+ *	link.
  *
  *----------------------------------------------------------------------
  */
@@ -3843,9 +4527,9 @@ Tcl_UpVar2(
     const char *part1,
     const char *part2,		/* Two parts of source variable name to link
 				 * to. */
-    const char *localName,	/* Name of link variable. */
+    const char *localNameStr,	/* Name of link variable. */
     int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
-				 * indicates scope of localName. */
+				 * indicates scope of localNameStr. */
 {
     int result;
     CallFrame *framePtr;
@@ -3857,7 +4541,7 @@ Tcl_UpVar2(
 
     part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
-    localNamePtr = Tcl_NewStringObj(localName, -1);
+    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
     Tcl_IncrRefCount(localNamePtr);
 
     result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
@@ -3896,38 +4580,36 @@ Tcl_GetVariableFullName(
 {
     Interp *iPtr = (Interp *) interp;
     register Var *varPtr = (Var *) variable;
+    Tcl_Obj *namePtr;
+    Namespace *nsPtr;
+
+    if (!varPtr || TclIsVarArrayElement(varPtr)) {
+	return;
+    }
 
     /*
      * Add the full name of the containing namespace (if any), followed by the
      * "::" separator, then the variable name.
      */
 
-    if (varPtr) {
-	if (!TclIsVarArrayElement(varPtr)) {
-	    Tcl_Obj *namePtr;
-	    Namespace *nsPtr;
-
-	    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;
+    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 >= 0
-			&& index < iPtr->varFramePtr->numCompiledLocals) {
-		    namePtr = localName(iPtr->varFramePtr, index);
-		    Tcl_AppendObjToObj(objPtr, namePtr);
-		}
-	    }
+	if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) {
+	    namePtr = localName(iPtr->varFramePtr, index);
+	    Tcl_AppendObjToObj(objPtr, namePtr);
 	}
     }
 }
@@ -3958,14 +4640,9 @@ Tcl_GlobalObjCmd(
 {
     Interp *iPtr = (Interp *) interp;
     register Tcl_Obj *objPtr, *tailPtr;
-    char *varName;
-    register char *tail;
-    int i;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
-	return TCL_ERROR;
-    }
+    const char *varName;
+    register const char *tail;
+    int result, i;
 
     /*
      * If we are not executing inside a Tcl procedure, just return.
@@ -3976,8 +4653,6 @@ Tcl_GlobalObjCmd(
     }
 
     for (i=1 ; i<objc ; i++) {
-	int result;
-
 	/*
 	 * Make a local variable linked to its counterpart in the global ::
 	 * namespace.
@@ -4068,19 +4743,13 @@ Tcl_VariableObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    char *varName, *tail, *cp;
+    const char *varName, *tail, *cp;
+    Var *varPtr, *arrayPtr;
     Tcl_Obj *varValuePtr;
     int i, result;
     Tcl_Obj *varNamePtr, *tailPtr;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
-	return TCL_ERROR;
-    }
-
     for (i=1 ; i<objc ; i+=2) {
-	Var *varPtr, *arrayPtr;
-
 	/*
 	 * Look up each variable in the current namespace context, creating it
 	 * if necessary.
@@ -4100,6 +4769,7 @@ Tcl_VariableObjCmd(
 
 	    TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
 		    isArrayElement, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
 	    return TCL_ERROR;
 	}
 
@@ -4206,29 +4876,60 @@ Tcl_UpvarObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     CallFrame *framePtr;
-    int result;
+    int result, hasLevel;
+    Tcl_Obj *levelObj;
 
     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.
+	 */
+
+	levelObj = NULL;
+	hasLevel = 0;
+    } else {
+	/*
+	 * Odd number of arguments, so objv[1] must contain the level.
+	 */
+
+	levelObj = objv[1];
+	hasLevel = 1;
+    }
+
     /*
      * Find the call frame containing each of the "other variables" to be
      * linked to.
      */
 
-    result = TclObjGetFrame(interp, objv[1], &framePtr);
+    result = TclObjGetFrame(interp, levelObj, &framePtr);
     if (result == -1) {
 	return TCL_ERROR;
     }
-    objc -= result+1;
-    if ((objc & 1) != 0) {
-	goto upvarSyntax;
+    if ((result == 0) && hasLevel) {
+	/*
+	 * Synthesize an error message since TclObjGetFrame doesn't do this
+	 * for this particular case.
+	 */
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad level \"%s\"", TclGetString(levelObj)));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
+		TclGetString(levelObj), NULL);
+	return TCL_ERROR;
     }
-    objv += result+1;
+
+    /*
+     * We've now finished with parsing levels; skip to the variable names.
+     */
+
+    objc -= hasLevel + 1;
+    objv += hasLevel + 1;
 
     /*
      * Iterate over each (other variable, local variable) pair. Divide the
@@ -4271,8 +4972,8 @@ SetArraySearchObj(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr)
 {
-    char *string;
-    char *end;
+    const char *string;
+    char *end;			/* Can't be const due to strtoul defn. */
     int id;
     size_t offset;
 
@@ -4309,7 +5010,9 @@ SetArraySearchObj(
     return TCL_OK;
 
   syntax:
-    Tcl_AppendResult(interp, "illegal search identifier \"",string,"\"",NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "illegal search identifier \"%s\"", string));
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
     return TCL_ERROR;
 }
 
@@ -4345,17 +5048,18 @@ ParseSearchId(
 				 * name. */
 {
     Interp *iPtr = (Interp *) interp;
-    register char *string;
+    register const char *string;
     register size_t offset;
     int id;
     ArraySearch *searchPtr;
-    char *varName = TclGetString(varNamePtr);
+    const char *varName = TclGetString(varNamePtr);
 
     /*
      * Parse the id.
      */
 
-    if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
+    if ((handleObj->typePtr != &tclArraySearchType)
+	    && (SetArraySearchObj(interp, handleObj) != TCL_OK)) {
 	return NULL;
     }
 
@@ -4363,17 +5067,9 @@ ParseSearchId(
      * Extract the information out of the Tcl_Obj.
      */
 
-#if 1
     id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
     string = TclGetString(handleObj);
     offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
-#else
-    id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) -
-	    ((char *) NULL));
-    string = TclGetString(handleObj);
-    offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) -
-	    ((char *) NULL));
-#endif
 
     /*
      * This test cannot be placed inside the Tcl_Obj machinery, since it is
@@ -4381,8 +5077,9 @@ ParseSearchId(
      */
 
     if (strcmp(string+offset, varName) != 0) {
-	Tcl_AppendResult(interp, "search identifier \"", string,
-		"\" isn't for variable \"", varName, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"search identifier \"%s\" isn't for variable \"%s\"",
+		string, varName));
 	goto badLookup;
     }
 
@@ -4397,16 +5094,17 @@ ParseSearchId(
 
     if (varPtr->flags & VAR_SEARCH_ACTIVE) {
 	Tcl_HashEntry *hPtr =
-		Tcl_FindHashEntry(&iPtr->varSearches, (char *) varPtr);
+		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
 
-	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
-		searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
+	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
+		searchPtr = searchPtr->nextPtr) {
 	    if (searchPtr->id == id) {
 		return searchPtr;
 	    }
 	}
     }
-    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "couldn't find search \"%s\"", string));
   badLookup:
     Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
     return NULL;
@@ -4435,15 +5133,15 @@ DeleteSearches(
     register Var *arrayVarPtr)	/* Variable whose searches are to be
 				 * deleted. */
 {
-    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
-	ArraySearch *searchPtr, *nextPtr;
-	Tcl_HashEntry *sPtr;
+    ArraySearch *searchPtr, *nextPtr;
+    Tcl_HashEntry *sPtr;
 
-	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
-	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
-		searchPtr != NULL; searchPtr = nextPtr) {
+    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((char *) searchPtr);
+	    ckfree(searchPtr);
 	}
 	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
 	Tcl_DeleteHashEntry(sPtr);
@@ -4492,12 +5190,11 @@ TclDeleteNamespaceVars(
     for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
 	    varPtr = VarHashFirstVar(tablePtr, &search)) {
 	Tcl_Obj *objPtr = Tcl_NewObj();
-
 	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
 					 * hash. */
 	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
 	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
-		NULL, flags);
+		NULL, flags, -1);
 
 	/*
 	 * We just unset the variable. However, an unset trace might
@@ -4509,17 +5206,16 @@ TclDeleteNamespaceVars(
 	 */
 
 	if (TclIsVarTraced(varPtr)) {
+	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
+	    VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
 	    ActiveVarTrace *activePtr;
-	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces,
-		    (char *) varPtr);
-	    VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
 
 	    while (tracePtr) {
 		VarTrace *prevPtr = tracePtr;
 
 		tracePtr = tracePtr->nextPtr;
 		prevPtr->nextPtr = NULL;
-		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
 	    }
 	    Tcl_DeleteHashEntry(tPtr);
 	    varPtr->flags &= ~VAR_ALL_TRACES;
@@ -4538,7 +5234,7 @@ TclDeleteNamespaceVars(
 
 	if (!TclIsVarUndefined(varPtr)) {
 	    UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
-		    NULL, flags);
+		    NULL, flags, -1);
 	}
 	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
 	VarHashRefCount(varPtr)--;
@@ -4591,9 +5287,9 @@ TclDeleteVars(
     }
 
     for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
-	     varPtr = VarHashFirstVar(tablePtr, &search)) {
-
-	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags);
+	 varPtr = VarHashFirstVar(tablePtr, &search)) {
+	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
+		-1);
 	VarHashDeleteEntry(varPtr);
     }
     VarHashDeleteTable(tablePtr);
@@ -4636,7 +5332,7 @@ TclDeleteCompiledLocalVars(
     namePtrPtr = &localName(framePtr, 0);
     for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
 	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
-		TCL_TRACE_UNSETS);
+		TCL_TRACE_UNSETS, i);
     }
     framePtr->numCompiledLocals = 0;
 }
@@ -4669,9 +5365,10 @@ DeleteArray(
 				 * or NULL if it is to be computed on
 				 * demand. */
     Var *varPtr,		/* Pointer to variable structure. */
-    int flags)			/* Flags to pass to TclCallVarTraces:
+    int flags,			/* Flags to pass to TclCallVarTraces:
 				 * TCL_TRACE_UNSETS and sometimes
 				 * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */
+    int index)
 {
     Tcl_HashSearch search;
     Tcl_HashEntry *tPtr;
@@ -4707,15 +5404,16 @@ DeleteArray(
 
 		elPtr->flags &= ~VAR_TRACE_ACTIVE;
 		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
-			elNamePtr, flags,/* leaveErrMsg */ 0, -1);
+			elNamePtr, flags,/* leaveErrMsg */ 0, index);
 	    }
-	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) elPtr);
-	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
+	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
+	    tracePtr = Tcl_GetHashValue(tPtr);
 	    while (tracePtr) {
 		VarTrace *prevPtr = tracePtr;
 
 		tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+		prevPtr->nextPtr = NULL;
+		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
 	    }
 	    Tcl_DeleteHashEntry(tPtr);
 	    elPtr->flags &= ~VAR_ALL_TRACES;
@@ -4738,13 +5436,13 @@ DeleteArray(
 	TclClearVarNamespaceVar(elPtr);
     }
     VarHashDeleteTable(varPtr->value.tablePtr);
-    ckfree((char *) varPtr->value.tablePtr);
+    ckfree(varPtr->value.tablePtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclTclObjVarErrMsg --
+ * TclObjVarErrMsg --
  *
  *	Generate a reasonable error message describing why a variable
  *	operation failed.
@@ -4796,6 +5494,9 @@ TclObjVarErrMsg(
 				 * 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",
@@ -4838,16 +5539,17 @@ PanicOnSetVarName(
  * 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 name obj in varFramePtr->localCache
+ *			  or NULL if it is this same obj
+ *   twoPtrValue.ptr2: index into locals table
  */
 
 static void
 FreeLocalVarName(
     Tcl_Obj *objPtr)
 {
-    Tcl_Obj *namePtr = (Tcl_Obj *) objPtr->internalRep.ptrAndLongRep.ptr;
+    Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1;
+
     if (namePtr) {
 	Tcl_DecrRefCount(namePtr);
     }
@@ -4859,60 +5561,19 @@ DupLocalVarName(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;
+    Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1;
 
     if (!namePtr) {
 	namePtr = srcPtr;
     }
-    dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
+    dupPtr->internalRep.twoPtrValue.ptr1 = namePtr;
     Tcl_IncrRefCount(namePtr);
 
-    dupPtr->internalRep.ptrAndLongRep.value =
-	    srcPtr->internalRep.ptrAndLongRep.value;
+    dupPtr->internalRep.twoPtrValue.ptr2 =
+	    srcPtr->internalRep.twoPtrValue.ptr2;
     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);
-	}
-    }
-    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 -
  *
@@ -4944,13 +5605,12 @@ DupParsedVarName(
     register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
     register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
     char *elemCopy;
+    unsigned elemLen;
 
     if (arrayPtr != NULL) {
-	unsigned int elemLen;
-
 	Tcl_IncrRefCount(arrayPtr);
 	elemLen = strlen(elem);
-	elemCopy = ckalloc(elemLen+1);
+	elemCopy = ckalloc(elemLen + 1);
 	memcpy(elemCopy, elem, elemLen);
 	*(elemCopy + elemLen) = '\0';
 	elem = elemCopy;
@@ -4967,7 +5627,8 @@ UpdateParsedVarName(
 {
     Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
     char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
-    char *part1, *p;
+    const char *part1;
+    char *p;
     int len1, len2, totalLen;
 
     if (arrayPtr == NULL) {
@@ -4982,14 +5643,14 @@ UpdateParsedVarName(
     len2 = strlen(part2);
 
     totalLen = len1 + len2 + 2;
-    p = ckalloc((unsigned int) totalLen + 1);
+    p = ckalloc(totalLen + 1);
     objPtr->bytes = p;
     objPtr->length = totalLen;
 
-    memcpy(p, part1, (unsigned int) len1);
+    memcpy(p, part1, (unsigned) len1);
     p += len1;
     *p++ = '(';
-    memcpy(p, part2, (unsigned int) len2);
+    memcpy(p, part2, (unsigned) len2);
     p += len2;
     *p++ = ')';
     *p = '\0';
@@ -5029,11 +5690,12 @@ Tcl_FindNamespaceVar(
 				 * 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
+    int flags)			/* An OR'd combination of:
+				 * TCL_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. */
@@ -5059,11 +5721,12 @@ ObjFindNamespaceVar(
 				 * 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
+    int flags)			/* An OR'd combination of:
+				 * TCL_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. */
@@ -5074,9 +5737,10 @@ ObjFindNamespaceVar(
     const char *simpleName;
     Var *varPtr;
     register int search;
+    int result;
     Tcl_Var var;
     Tcl_Obj *simpleNamePtr;
-    char *name = TclGetString(namePtr);
+    const char *name = TclGetString(namePtr);
 
     /*
      * If this namespace has a variable resolver, then give it first crack at
@@ -5092,14 +5756,12 @@ ObjFindNamespaceVar(
 	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     }
 
-    if (!(flags & AVOID_RESOLVERS) &&
+    if (!(flags & TCL_AVOID_RESOLVERS) &&
 	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
-	int result;
-
 	resPtr = iPtr->resolverPtr;
 
 	if (cxtNsPtr->varResProc) {
-	    result = (*cxtNsPtr->varResProc)(interp, name,
+	    result = cxtNsPtr->varResProc(interp, name,
 		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
 	} else {
 	    result = TCL_CONTINUE;
@@ -5107,7 +5769,7 @@ ObjFindNamespaceVar(
 
 	while (result == TCL_CONTINUE && resPtr) {
 	    if (resPtr->varResProc) {
-		result = (*resPtr->varResProc)(interp, name,
+		result = resPtr->varResProc(interp, name,
 			(Tcl_Namespace *) cxtNsPtr, flags, &var);
 	    }
 	    resPtr = resPtr->nextPtr;
@@ -5116,7 +5778,7 @@ ObjFindNamespaceVar(
 	if (result == TCL_OK) {
 	    return var;
 	} else if (result != TCL_CONTINUE) {
-	    return (Tcl_Var) NULL;
+	    return NULL;
 	}
     }
 
@@ -5149,8 +5811,8 @@ ObjFindNamespaceVar(
 	Tcl_DecrRefCount(simpleNamePtr);
     }
     if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"unknown variable \"%s\"", name));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
     }
     return (Tcl_Var) varPtr;
@@ -5188,15 +5850,15 @@ TclInfoVarsCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    char *pattern;
-    const char *simplePattern;
+    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;
+    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
     int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
-    Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;
+    Tcl_Obj *simplePatternPtr = NULL;
 
     /*
      * Get the pattern and find the "effective namespace" in which to list
@@ -5220,9 +5882,8 @@ TclInfoVarsCmd(
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
 	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
-		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
-		&simplePattern);
+	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
+		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
 
 	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
@@ -5248,11 +5909,7 @@ TclInfoVarsCmd(
 
     listPtr = Tcl_NewListObj(0, NULL);
 
-    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
-	    || specificNsInPattern) {
-	Var *varPtr;
-	Tcl_Obj *elemObjPtr;
-
+    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
@@ -5293,11 +5950,9 @@ TclInfoVarsCmd(
 	    /*
 	     * Have to scan the tables of variables.
 	     */
-	    char *varName;
 
 	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
 	    while (varPtr) {
-
 		if (!TclIsVarUndefined(varPtr)
 			|| TclIsVarNamespaceVar(varPtr)) {
 		    varNamePtr = VarHashGetKey(varPtr);
@@ -5346,7 +6001,7 @@ TclInfoVarsCmd(
 		}
 	    }
 	}
-    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
+    } else if (iPtr->varFramePtr->procPtr != NULL) {
 	AppendLocals(interp, listPtr, simplePatternPtr, 1);
     }
 
@@ -5385,11 +6040,11 @@ TclInfoGlobalsCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *pattern;
+    const char *varName, *pattern;
     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
     Tcl_HashSearch search;
     Var *varPtr;
-    Tcl_Obj *listPtr, *patternPtr;
+    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
 
     if (objc == 1) {
 	pattern = NULL;
@@ -5436,9 +6091,6 @@ TclInfoGlobalsCmd(
 	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
 		varPtr != NULL;
 		varPtr = VarHashNextVar(&search)) {
-	    char *varName;
-	    Tcl_Obj *varNamePtr;
-
 	    if (TclIsVarUndefined(varPtr)) {
 		continue;
 	    }
@@ -5482,8 +6134,7 @@ TclInfoLocalsCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *patternPtr;
-    Tcl_Obj *listPtr;
+    Tcl_Obj *patternPtr, *listPtr;
 
     if (objc == 1) {
 	patternPtr = NULL;
@@ -5494,7 +6145,7 @@ TclInfoLocalsCmd(
 	return TCL_ERROR;
     }
 
-    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
+    if (!HasLocalVars(iPtr->varFramePtr)) {
 	return TCL_OK;
     }
 
@@ -5536,18 +6187,21 @@ AppendLocals(
 {
     Interp *iPtr = (Interp *) interp;
     Var *varPtr;
-    int i, localVarCt;
-    Tcl_Obj **varNamePtr;
-    char *varName;
+    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;
-    Tcl_Obj *objNamePtr;
 
     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++) {
 	/*
@@ -5559,6 +6213,9 @@ AppendLocals(
 	    varName = TclGetString(*varNamePtr);
 	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
 		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+		if (includeLinks) {
+		    Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
+		}
 	    }
 	}
 	varPtr++;
@@ -5569,7 +6226,7 @@ AppendLocals(
      */
 
     if (localVarTablePtr == NULL) {
-	return;
+	goto objectVars;
     }
 
     /*
@@ -5583,9 +6240,13 @@ AppendLocals(
 		    && (includeLinks || !TclIsVarLink(varPtr))) {
 		Tcl_ListObjAppendElement(interp, listPtr,
 			VarHashGetKey(varPtr));
+		if (includeLinks) {
+		    Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
+			    &added);
+		}
 	    }
 	}
-	return;
+	goto objectVars;
     }
 
     /*
@@ -5601,9 +6262,41 @@ AppendLocals(
 	    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;
+    }
+
+    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
+	CallContext *contextPtr = iPtr->varFramePtr->clientData;
+	Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+
+	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);
+		}
 	    }
 	}
     }
+    Tcl_DeleteHashTable(&addedTable);
 }
 
 /*
@@ -5625,16 +6318,16 @@ AllocVarEntry(
     Tcl_HashTable *tablePtr,	/* Hash table. */
     void *keyPtr)		/* Key to store in the hash table entry. */
 {
-    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    Tcl_Obj *objPtr = keyPtr;
     Tcl_HashEntry *hPtr;
     Var *varPtr;
 
-    varPtr = (Var *) ckalloc(sizeof(VarInHash));
+    varPtr = ckalloc(sizeof(VarInHash));
     varPtr->flags = VAR_IN_HASHTABLE;
     varPtr->value.objPtr = NULL;
     VarHashRefCount(varPtr) = 1;
 
-    hPtr = &(((VarInHash *)varPtr)->entry);
+    hPtr = &(((VarInHash *) varPtr)->entry);
     Tcl_SetHashValue(hPtr, varPtr);
     hPtr->key.objPtr = objPtr;
     Tcl_IncrRefCount(objPtr);
@@ -5651,7 +6344,7 @@ FreeVarEntry(
 
     if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
 	    && (VarHashRefCount(varPtr) == 1)) {
-	ckfree((char *) varPtr);
+	ckfree(varPtr);
     } else {
 	VarHashInvalidateEntry(varPtr);
 	TclSetVarUndefined(varPtr);
@@ -5665,18 +6358,17 @@ CompareVarKeys(
     void *keyPtr,		/* New key to compare. */
     Tcl_HashEntry *hPtr)	/* Existing key to compare. */
 {
-    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+    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.
-     */
+     * OPT: this comparison was moved to the caller
 
-    if (objPtr1 == objPtr2) {
-	return 1;
-    }
+       if (objPtr1 == objPtr2) return 1;
+    */
 
     /*
      * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
@@ -5689,54 +6381,10 @@ CompareVarKeys(
     l2 = objPtr2->length;
 
     /*
-     * Only compare if the string representations are of the same length.
+     * Only compare string representations of the same length.
      */
 
-    if (l1 == l2) {
-	for (;; p1++, p2++, l1--) {
-	    if (*p1 != *p2) {
-		break;
-	    }
-	    if (l1 == 0) {
-		return 1;
-	    }
-	}
-    }
-
-    return 0;
-}
-
-static unsigned int
-HashVarKey(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key from which to compute hash value. */
-{
-    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
-    const char *string = TclGetString(objPtr);
-    int length = objPtr->length;
-    unsigned int result = 0;
-    int i;
-
-    /*
-     * I tried a zillion different hash functions and asked many other people
-     * for advice. Many people had their own favorite functions, all
-     * different, but no-one had much idea why they were good ones. I chose
-     * the one below (multiply by 9 and add new character) because of the
-     * following reasons:
-     *
-     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
-     *	  multiplying by 9 is just about as good.
-     * 2. Times-9 is (shift-left-3) plus (old). This means that each
-     *	  character's bits hang around in the low-order bits of the hash value
-     *	  for ever, plus they spread fairly rapidly up to the high-order bits
-     *	  to fill out the hash value. This seems works well both for decimal
-     *	  and non-decimal strings.
-     */
-
-    for (i=0 ; i<length ; i++) {
-	result += (result << 3) + string[i];
-    }
-    return result;
+    return ((l1 == l2) && !memcmp(p1, p2, l1));
 }
 
 /*
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
new file mode 100644
index 0000000..fc20d7e
--- /dev/null
+++ b/generic/tclZlib.c
@@ -0,0 +1,4058 @@
+/*
+ * 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-2012 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>
+#include "tclIO.h"
+
+/*
+ * The version of the zlib "package" that this implements. Note that this
+ * thoroughly supersedes the versions included with tclkit, which are "1.1",
+ * so this is at least "2.0" (there's no general *commitment* to have the same
+ * interface, even if that is mostly true).
+ */
+
+#define TCL_ZLIB_VERSION	"2.0.1"
+
+/*
+ * 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. */
+    Tcl_Obj *compDictObj;	/* Byte-array object containing compression
+				 * dictionary (not dictObj!) to use if
+				 * necessary. */
+    int flags;			/* Miscellaneous flag bits. */
+    GzipHeader *gzHeaderPtr;	/* If we've allocated a gzip header
+				 * structure. */
+} ZlibStreamHandle;
+
+#define DICT_TO_SET	0x1	/* If we need to set a compression dictionary
+				 * in the low-level engine at the next
+				 * opportunity. */
+
+/*
+ * Macros to make it clearer in some of the twiddlier accesses what is
+ * happening.
+ */
+
+#define IsRawStream(zshPtr)	((zshPtr)->format == TCL_ZLIB_FORMAT_RAW)
+#define HaveDictToSet(zshPtr)	((zshPtr)->flags & DICT_TO_SET)
+#define DictWasSet(zshPtr)	((zshPtr)->flags |= ~DICT_TO_SET)
+
+/*
+ * 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. */
+    int format;			/* What format of data is going on the wire.
+				 * Needed so that the correct [fconfigure]
+				 * options can be enabled. */
+    int readAheadLimit;		/* The maximum number of bytes to read from
+				 * the underlying stream in one go. */
+    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. */
+    Tcl_DString decompressed;	/* Buffer for decompression results. */
+    Tcl_Obj *compDictObj;	/* Byte-array object containing compression
+				 * dictionary (not dictObj!) to use if
+				 * necessary. */
+} 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, and the range it can be set to.  The
+ * same sorts of values apply to streams, except with different limits (they
+ * permit byte-level activity). Channels always use bytes unless told to use
+ * larger buffers.
+ */
+
+#define DEFAULT_BUFFER_SIZE	4096
+#define MIN_NONSTREAM_BUFFER_SIZE 16
+#define MAX_BUFFER_SIZE		65536
+
+/*
+ * 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	ZlibTransformEventHandler;
+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 Tcl_ObjCmdProc		ZlibStreamAddCmd;
+static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
+static Tcl_ObjCmdProc		ZlibStreamPutCmd;
+
+static void		ConvertError(Tcl_Interp *interp, int code,
+			    uLong adler);
+static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
+static inline int	Deflate(z_streamp strm, void *bufferPtr,
+			    int bufferSize, int flush, int *writtenPtr);
+static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
+static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
+			    GzipHeader *headerPtr, int *extraSizePtr);
+static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
+			    int toRead);
+static int		ResultGenerate(ZlibChannelData *cd, int n, int flush,
+			    int *errorCodePtr);
+static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
+			    int mode, int format, int level, int limit,
+			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
+			    Tcl_Obj *compDictObj);
+static void		ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
+static int		ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static inline void	ZlibTransformEventTimerKill(ZlibChannelData *cd);
+static void		ZlibTransformTimerRun(ClientData clientData);
+
+/*
+ * 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 */
+    ZlibTransformEventHandler,
+    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. */
+    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
+{
+    const char *codeStr, *codeStr2 = NULL;
+    char codeStrBuf[TCL_INTEGER_SPACE];
+
+    if (interp == NULL) {
+	return;
+    }
+
+    switch (code) {
+	/*
+	 * Firstly, the case that is *different* because it's really coming
+	 * from the OS and is just being reported via zlib. It should be
+	 * really uncommon because Tcl handles all I/O rather than delegating
+	 * it to zlib, but proving it can't happen is hard.
+	 */
+
+    case Z_ERRNO:
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
+	return;
+
+	/*
+	 * Normal errors/conditions, some of which have additional detail and
+	 * some which don't. (This is not defined by array lookup because zlib
+	 * error codes are sometimes negative.)
+	 */
+
+    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;
+    case Z_NEED_DICT:
+	codeStr = "NEED_DICT";
+	codeStr2 = codeStrBuf;
+	sprintf(codeStrBuf, "%lu", adler);
+	break;
+
+	/*
+	 * These should _not_ happen! This function is for dealing with error
+	 * cases, not non-errors!
+	 */
+
+    case Z_OK:
+	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
+    case Z_STREAM_END:
+	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
+
+	/*
+	 * Anything else is bad news; it's unexpected. Convert to generic
+	 * error.
+	 */
+
+    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);
+}
+
+static Tcl_Obj *
+ConvertErrorToList(
+    int code,			/* The zlib error code. */
+    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
+{
+    Tcl_Obj *objv[4];
+
+    TclNewLiteralStringObj(objv[0], "TCL");
+    TclNewLiteralStringObj(objv[1], "ZLIB");
+    switch (code) {
+    case Z_STREAM_ERROR:
+	TclNewLiteralStringObj(objv[2], "STREAM");
+	return Tcl_NewListObj(3, objv);
+    case Z_DATA_ERROR:
+	TclNewLiteralStringObj(objv[2], "DATA");
+	return Tcl_NewListObj(3, objv);
+    case Z_MEM_ERROR:
+	TclNewLiteralStringObj(objv[2], "MEM");
+	return Tcl_NewListObj(3, objv);
+    case Z_BUF_ERROR:
+	TclNewLiteralStringObj(objv[2], "BUF");
+	return Tcl_NewListObj(3, objv);
+    case Z_VERSION_ERROR:
+	TclNewLiteralStringObj(objv[2], "VERSION");
+	return Tcl_NewListObj(3, objv);
+    case Z_ERRNO:
+	TclNewLiteralStringObj(objv[2], "POSIX");
+	objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
+	return Tcl_NewListObj(4, objv);
+    case Z_NEED_DICT:
+	TclNewLiteralStringObj(objv[2], "NEED_DICT");
+	objv[3] = Tcl_NewWideIntObj((Tcl_WideInt) adler);
+	return Tcl_NewListObj(4, objv);
+
+	/*
+	 * These should _not_ happen! This function is for dealing with error
+	 * cases, not non-errors!
+	 */
+
+    case Z_OK:
+	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
+    case Z_STREAM_END:
+	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
+
+	/*
+	 * Catch-all. Should be unreachable because all cases are already
+	 * listed above.
+	 */
+
+    default:
+	TclNewLiteralStringObj(objv[2], "UNKNOWN");
+	TclNewIntObj(objv[3], code);
+	return Tcl_NewListObj(4, objv);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+	if (extraSizePtr != NULL) {
+	    *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;
+	if (extraSizePtr != NULL) {
+	    *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 macro.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Updates the dictionary, which must be writable (i.e. refCount < 2).
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define SetValue(dictObj, key, value) \
+	Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))
+
+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);
+    }
+}
+
+/*
+ * Disentangle the worst of how the zlib API is used.
+ */
+
+static int
+SetInflateDictionary(
+    z_streamp strm,
+    Tcl_Obj *compDictObj)
+{
+    if (compDictObj != NULL) {
+	int length;
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
+
+	return inflateSetDictionary(strm, bytes, (unsigned) length);
+    }
+    return Z_OK;
+}
+
+static int
+SetDeflateDictionary(
+    z_streamp strm,
+    Tcl_Obj *compDictObj)
+{
+    if (compDictObj != NULL) {
+	int length;
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
+
+	return deflateSetDictionary(strm, bytes, (unsigned) length);
+    }
+    return Z_OK;
+}
+
+static inline int
+Deflate(
+    z_streamp strm,
+    void *bufferPtr,
+    int bufferSize,
+    int flush,
+    int *writtenPtr)
+{
+    int e;
+
+    strm->next_out = (Bytef *) bufferPtr;
+    strm->avail_out = (unsigned) bufferSize;
+    e = deflate(strm, flush);
+    if (writtenPtr != NULL) {
+	*writtenPtr = bufferSize - strm->avail_out;
+    }
+    return e;
+}
+
+static inline void
+AppendByteArray(
+    Tcl_Obj *listObj,
+    void *buffer,
+    int size)
+{
+    if (size > 0) {
+	Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);
+
+	Tcl_ListObjAppendElement(NULL, listObj, baObj);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+    GzipHeader *gzHeaderPtr = NULL;
+
+    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;
+	    if (dictObj) {
+		gzHeaderPtr = ckalloc(sizeof(GzipHeader));
+		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
+		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
+			NULL) != TCL_OK) {
+		    ckfree(gzHeaderPtr);
+		    return TCL_ERROR;
+		}
+	    }
+	    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;
+	    gzHeaderPtr = ckalloc(sizeof(GzipHeader));
+	    memset(gzHeaderPtr, 0, sizeof(GzipHeader));
+	    gzHeaderPtr->header.name = (Bytef *)
+		    gzHeaderPtr->nativeFilenameBuf;
+	    gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
+	    gzHeaderPtr->header.comment = (Bytef *)
+		    gzHeaderPtr->nativeCommentBuf;
+	    gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;
+	    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;
+    zshPtr->compDictObj = NULL;
+    zshPtr->flags = 0;
+    zshPtr->gzHeaderPtr = gzHeaderPtr;
+    memset(&zshPtr->stream, 0, sizeof(z_stream));
+    zshPtr->stream.adler = 1;
+
+    /*
+     * 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);
+	if (e == Z_OK && zshPtr->gzHeaderPtr) {
+	    e = deflateSetHeader(&zshPtr->stream,
+		    &zshPtr->gzHeaderPtr->header);
+	}
+    } else {
+	e = inflateInit2(&zshPtr->stream, wbits);
+	if (e == Z_OK && zshPtr->gzHeaderPtr) {
+	    e = inflateGetHeader(&zshPtr->stream,
+		    &zshPtr->gzHeaderPtr->header);
+	}
+    }
+
+    if (e != Z_OK) {
+	ConvertError(interp, e, zshPtr->stream.adler);
+	goto error;
+    }
+
+    /*
+     * I could do all this in C, but this is easier.
+     */
+
+    if (interp != NULL) {
+	if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) {
+	    goto error;
+	}
+	Tcl_DStringInit(&cmdname);
+	TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
+	TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
+	if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname),
+		NULL, 0) != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "BUG: Stream command name already exists", -1));
+	    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:
+    if (zshPtr->compDictObj) {
+	Tcl_DecrRefCount(zshPtr->compDictObj);
+    }
+    if (zshPtr->gzHeaderPtr) {
+	ckfree(zshPtr->gzHeaderPtr);
+    }
+    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);
+    }
+    if (zshPtr->compDictObj) {
+	Tcl_DecrRefCount(zshPtr->compDictObj);
+    }
+    if (zshPtr->gzHeaderPtr) {
+	ckfree(zshPtr->gzHeaderPtr);
+    }
+
+    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);
+	if (e == Z_OK && HaveDictToSet(zshPtr)) {
+	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+	    if (e == Z_OK) {
+		DictWasSet(zshPtr);
+	    }
+	}
+    } else {
+	e = inflateInit2(&zshPtr->stream, zshPtr->wbits);
+	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr) && e == Z_OK) {
+	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+	    if (e == Z_OK) {
+		DictWasSet(zshPtr);
+	    }
+	}
+    }
+
+    if (e != Z_OK) {
+	ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+	/* 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_ZlibStreamSetCompressionDictionary --
+ *
+ *	Sets the compression dictionary for a stream. This will be used as
+ *	appropriate for the next compression or decompression action performed
+ *	on the stream.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ZlibStreamSetCompressionDictionary(
+    Tcl_ZlibStream zshandle,
+    Tcl_Obj *compressionDictionaryObj)
+{
+    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
+
+    if (compressionDictionaryObj != NULL) {
+	if (Tcl_IsShared(compressionDictionaryObj)) {
+	    compressionDictionaryObj =
+		    Tcl_DuplicateObj(compressionDictionaryObj);
+	}
+	Tcl_IncrRefCount(compressionDictionaryObj);
+	zshPtr->flags |= DICT_TO_SET;
+    } else {
+	zshPtr->flags &= ~DICT_TO_SET;
+    }
+    if (zshPtr->compDictObj != NULL) {
+	Tcl_DecrRefCount(zshPtr->compDictObj);
+    }
+    zshPtr->compDictObj = compressionDictionaryObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamPut --
+ *
+ *	Add data to the stream for compression or decompression from a
+ *	bytearray Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define BUFFER_SIZE_LIMIT	0xFFFF
+
+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, toStore;
+
+    if (zshPtr->streamEnd) {
+	if (zshPtr->interp) {
+	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+		    "already past compressed stream end", -1));
+	    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;
+
+	/*
+	 * Must not do a zero-length compress unless finalizing. [Bug 25842c161]
+	 */
+
+	if (size == 0 && flush != Z_FINISH) {
+	    return TCL_OK;
+	}
+
+	if (HaveDictToSet(zshPtr)) {
+	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+	    if (e != Z_OK) {
+		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+		return TCL_ERROR;
+	    }
+	    DictWasSet(zshPtr);
+	}
+
+	/*
+	 * deflateBound() doesn't seem to take various header sizes into
+	 * account, so we add 100 extra bytes. However, we can also loop
+	 * around again so we also set an upper bound on the output buffer
+	 * size.
+	 */
+
+	outSize = deflateBound(&zshPtr->stream, size) + 100;
+	if (outSize > BUFFER_SIZE_LIMIT) {
+	    outSize = BUFFER_SIZE_LIMIT;
+	}
+	dataTmp = ckalloc(outSize);
+
+	while (1) {
+	    e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);
+
+	    /*
+	     * Test if we've filled the buffer up and have to ask deflate() to
+	     * give us some more. Note that the condition for needing to
+	     * repeat a buffer transfer when the result is Z_OK is whether
+	     * there is no more space in the buffer we provided; the zlib
+	     * library does not necessarily return a different code in that
+	     * case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b]
+	     */
+
+	    if ((e != Z_BUF_ERROR) && (e != Z_OK || toStore < outSize)) {
+		if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) {
+		    break;
+		}
+		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Output buffer too small to hold the data being generated or we
+	     * are doing the end-of-stream flush (which can spit out masses of
+	     * data). This means we need to put a new buffer into place after
+	     * saving the old generated data to the outData list.
+	     */
+
+	    AppendByteArray(zshPtr->outData, dataTmp, outSize);
+
+	    if (outSize < BUFFER_SIZE_LIMIT) {
+		outSize = BUFFER_SIZE_LIMIT;
+		/* There may be *lots* of data left to output... */
+		dataTmp = ckrealloc(dataTmp, outSize);
+	    }
+	}
+
+	/*
+	 * And append the final data block to the outData list.
+	 */
+
+	AppendByteArray(zshPtr->outData, dataTmp, toStore);
+	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 = MAX_BUFFER_SIZE;
+	}
+
+	/*
+	 * 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);
+	    }
+	}
+
+	/*
+	 * When dealing with a raw stream, we set the dictionary here, once.
+	 * (You can't do it in response to getting Z_NEED_DATA as raw streams
+	 * don't ever issue that.)
+	 */
+
+	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
+	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+	    if (e != Z_OK) {
+		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
+		return TCL_ERROR;
+	    }
+	    DictWasSet(zshPtr);
+	}
+	e = inflate(&zshPtr->stream, zshPtr->flush);
+	if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
+	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
+	    if (e == Z_OK) {
+		DictWasSet(zshPtr);
+		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_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+			    "unexpected zlib internal state during"
+			    " decompression", -1));
+		    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.
+	     */
+
+	    do {
+		e = inflate(&zshPtr->stream, zshPtr->flush);
+		if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) {
+		    break;
+		}
+		e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj);
+		DictWasSet(zshPtr);
+	    } while (e == Z_OK);
+	}
+	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, zshPtr->stream.adler);
+	    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, stream.adler);
+    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) {
+	    inflateEnd(&stream);
+	    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;
+	    break;
+	}
+	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, stream.adler);
+    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, i, option, level = -1;
+    unsigned start, buffersize = 0;
+    Byte *data;
+    Tcl_Obj *headerDictObj;
+    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
+    };
+
+    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)
+		(uLong) 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)
+		(uLong) 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 */
+	headerDictObj = NULL;
+
+	/*
+	 * Legacy argument format support.
+	 */
+
+	if (objc == 4
+		&& Tcl_GetIntFromObj(interp, objv[3], &level) == TCL_OK) {
+	    if (level < 0 || level > 9) {
+		extraInfoStr = "\n    (in -level option)";
+		goto badLevel;
+	    }
+	    return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
+		    level, NULL);
+	}
+
+	if (objc < 3 || objc > 7 || ((objc & 1) == 0)) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "data ?-level level? ?-header header?");
+	    return TCL_ERROR;
+	}
+	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 < MIN_NONSTREAM_BUFFER_SIZE
+		    || buffersize > MAX_BUFFER_SIZE) {
+		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 < MIN_NONSTREAM_BUFFER_SIZE
+		    || buffersize > MAX_BUFFER_SIZE) {
+		goto badBuffer;
+	    }
+	}
+	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
+		buffersize, NULL);
+    case CMD_GUNZIP: {			/* gunzip gzippeddata ?bufferSize?
+					 *	-> decompressedData */
+	Tcl_Obj *headerVarObj;
+
+	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 < MIN_NONSTREAM_BUFFER_SIZE
+			|| buffersize > MAX_BUFFER_SIZE) {
+		    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) {
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+    case CMD_STREAM:			/* stream deflate/inflate/...gunzip \
+					 *    ?options...?
+					 *	-> handleCmd */
+	return ZlibStreamSubcmd(interp, objc, objv);
+    case CMD_PUSH:			/* push mode channel options...
+					 *	-> channel */
+	return ZlibPushSubcmd(interp, objc, objv);
+    };
+
+    return TCL_ERROR;
+
+  badLevel:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1));
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
+    if (extraInfoStr) {
+	Tcl_AddErrorInfo(interp, extraInfoStr);
+    }
+    return TCL_ERROR;
+  badBuffer:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "buffer size must be %d to %d",
+	    MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE));
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamSubcmd --
+ *
+ *	Implementation of the [zlib stream] subcommand.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibStreamSubcmd(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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
+    };
+    int i, format, mode = 0, option, level;
+    enum objIndices {
+	OPT_COMPRESSION_DICTIONARY = 0,
+	OPT_GZIP_HEADER = 1,
+	OPT_COMPRESSION_LEVEL = 2,
+	OPT_END = -1
+    };
+    Tcl_Obj *obj[3] = { NULL, NULL, NULL };
+#define compDictObj	obj[OPT_COMPRESSION_DICTIONARY]
+#define gzipHeaderObj	obj[OPT_GZIP_HEADER]
+#define levelObj	obj[OPT_COMPRESSION_LEVEL]
+    typedef struct {
+	const char *name;
+	enum objIndices offset;
+    } OptDescriptor;
+    static const OptDescriptor compressionOpts[] = {
+	{ "-dictionary", OPT_COMPRESSION_DICTIONARY },
+	{ "-level",	 OPT_COMPRESSION_LEVEL },
+	{ NULL, OPT_END }
+    };
+    static const OptDescriptor gzipOpts[] = {
+	{ "-header",	 OPT_GZIP_HEADER },
+	{ "-level",	 OPT_COMPRESSION_LEVEL },
+	{ NULL, OPT_END }
+    };
+    static const OptDescriptor expansionOpts[] = {
+	{ "-dictionary", OPT_COMPRESSION_DICTIONARY },
+	{ NULL, OPT_END }
+    };
+    static const OptDescriptor gunzipOpts[] = {
+	{ NULL, OPT_END }
+    };
+    const OptDescriptor *desc = NULL;
+    Tcl_ZlibStream zh;
+
+    if (objc < 3 || !(objc & 1)) {
+	Tcl_WrongNumArgs(interp, 2, objv, "mode ?-option value...?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
+	    &format) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * The format determines the compression mode and the options that may be
+     * specified.
+     */
+
+    switch ((enum zlibFormats) format) {
+    case FMT_DEFLATE:
+	desc = compressionOpts;
+	mode = TCL_ZLIB_STREAM_DEFLATE;
+	format = TCL_ZLIB_FORMAT_RAW;
+	break;
+    case FMT_INFLATE:
+	desc = expansionOpts;
+	mode = TCL_ZLIB_STREAM_INFLATE;
+	format = TCL_ZLIB_FORMAT_RAW;
+	break;
+    case FMT_COMPRESS:
+	desc = compressionOpts;
+	mode = TCL_ZLIB_STREAM_DEFLATE;
+	format = TCL_ZLIB_FORMAT_ZLIB;
+	break;
+    case FMT_DECOMPRESS:
+	desc = expansionOpts;
+	mode = TCL_ZLIB_STREAM_INFLATE;
+	format = TCL_ZLIB_FORMAT_ZLIB;
+	break;
+    case FMT_GZIP:
+	desc = gzipOpts;
+	mode = TCL_ZLIB_STREAM_DEFLATE;
+	format = TCL_ZLIB_FORMAT_GZIP;
+	break;
+    case FMT_GUNZIP:
+	desc = gunzipOpts;
+	mode = TCL_ZLIB_STREAM_INFLATE;
+	format = TCL_ZLIB_FORMAT_GZIP;
+	break;
+    default:
+	Tcl_Panic("should be unreachable");
+    }
+
+    /*
+     * Parse the options.
+     */
+
+    for (i=3 ; i<objc ; i+=2) {
+	if (Tcl_GetIndexFromObjStruct(interp, objv[i], desc,
+		sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	obj[desc[option].offset] = objv[i+1];
+    }
+
+    /*
+     * If a compression level was given, parse it (integral: 0..9). Otherwise
+     * use the default.
+     */
+
+    if (levelObj == NULL) {
+	level = Z_DEFAULT_COMPRESSION;
+    } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
+	return TCL_ERROR;
+    } else if (level < 0 || level > 9) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
+	Tcl_AddErrorInfo(interp, "\n    (in -level option)");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Construct the stream now we know its configuration.
+     */
+
+    if (Tcl_ZlibStreamInit(interp, mode, format, level, gzipHeaderObj,
+	    &zh) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (compDictObj != NULL) {
+	Tcl_ZlibStreamSetCompressionDictionary(zh, compDictObj);
+    }
+    Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
+    return TCL_OK;
+#undef compDictObj
+#undef gzipHeaderObj
+#undef levelObj
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibPushSubcmd --
+ *
+ *	Implementation of the [zlib push] subcommand.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibPushSubcmd(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    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
+    };
+    Tcl_Channel chan;
+    int chanMode, format, mode = 0, level, i, option;
+    static const char *const pushCompressOptions[] = {
+	"-dictionary", "-header", "-level", NULL
+    };
+    static const char *const pushDecompressOptions[] = {
+	"-dictionary", "-header", "-level", "-limit", NULL
+    };
+    const char *const *pushOptions = pushDecompressOptions;
+    enum pushOptions {poDictionary, poHeader, poLevel, poLimit};
+    Tcl_Obj *headerObj = NULL, *compDictObj = 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;
+	pushOptions = pushCompressOptions;
+	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;
+	pushOptions = pushCompressOptions;
+	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;
+	pushOptions = pushCompressOptions;
+	break;
+    case FMT_GUNZIP:
+	mode = TCL_ZLIB_STREAM_INFLATE;
+	format = TCL_ZLIB_FORMAT_GZIP;
+	break;
+    default:
+	Tcl_Panic("should be unreachable");
+    }
+
+    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_SetObjResult(interp, Tcl_NewStringObj(
+		"compression may only be applied to writable channels", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
+	return TCL_ERROR;
+    }
+    if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"decompression may only be applied to readable channels",-1));
+	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;
+	}
+	if (++i > objc-1) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "value missing for %s option", pushOptions[option]));
+	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+	    return TCL_ERROR;
+	}
+	switch ((enum pushOptions) option) {
+	case poHeader:
+	    headerObj = objv[i];
+	    if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
+		goto genericOptionError;
+	    }
+	    break;
+	case poLevel:
+	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) {
+		goto genericOptionError;
+	    }
+	    if (level < 0 || level > 9) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"level must be 0 to 9", -1));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL",
+			NULL);
+		goto genericOptionError;
+	    }
+	    break;
+	case poLimit:
+	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) {
+		goto genericOptionError;
+	    }
+	    if (limit < 1 || limit > MAX_BUFFER_SIZE) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"read ahead limit must be 1 to %d",
+			MAX_BUFFER_SIZE));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
+		goto genericOptionError;
+	    }
+	    break;
+	case poDictionary:
+	    if (format == TCL_ZLIB_FORMAT_GZIP) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"a compression dictionary may not be set in the "
+			"gzip format", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL);
+		goto genericOptionError;
+	    }
+	    compDictObj = objv[i];
+	    break;
+	}
+    }
+
+    if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan,
+	    headerObj, compDictObj) == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, objv[3]);
+    return TCL_OK;
+
+  genericOptionError:
+    Tcl_AddErrorInfo(interp, "\n    (in ");
+    Tcl_AddErrorInfo(interp, pushOptions[option]);
+    Tcl_AddErrorInfo(interp, " option)");
+    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, count, code;
+    Tcl_Obj *obj;
+    static const char *const cmds[] = {
+	"add", "checksum", "close", "eof", "finalize", "flush",
+	"fullflush", "get", "header", "put", "reset",
+	NULL
+    };
+    enum zlibStreamCommands {
+	zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush,
+	zs_fullflush, zs_get, zs_header, zs_put, zs_reset
+    };
+
+    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 */
+	return ZlibStreamAddCmd(zstream, interp, objc, objv);
+    case zs_header:		/* $strm header */
+	return ZlibStreamHeaderCmd(zstream, interp, objc, objv);
+    case zs_put:		/* $strm put ?$flushopt? $data */
+	return ZlibStreamPutCmd(zstream, interp, objc, objv);
+
+    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)
+		(uLong) 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;
+}
+
+static int
+ZlibStreamAddCmd(
+    ClientData cd,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_ZlibStream zstream = cd;
+    int index, code, buffersize = -1, flush = -1, i;
+    Tcl_Obj *obj, *compDictObj = NULL;
+    static const char *const add_options[] = {
+	"-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL
+    };
+    enum addOptions {
+	ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush
+    };
+
+    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_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-buffer\" option must be followed by integer "
+			"decompression buffersize", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"buffer size must be 1 to %d",
+			MAX_BUFFER_SIZE));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
+		return TCL_ERROR;
+	    }
+	    break;
+	case ao_dictionary:
+	    if (i == objc-2) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-dictionary\" option must be followed by"
+			" compression dictionary bytes", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+		return TCL_ERROR;
+	    }
+	    compDictObj = objv[++i];
+	    break;
+	}
+
+	if (flush == -2) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "\"-flush\", \"-fullflush\" and \"-finalize\" options"
+		    " are mutually exclusive", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
+	    return TCL_ERROR;
+	}
+    }
+    if (flush == -1) {
+	flush = 0;
+    }
+
+    /*
+     * Set the compression dictionary if requested.
+     */
+
+    if (compDictObj != NULL) {
+	int len;
+
+	(void) Tcl_GetByteArrayFromObj(compDictObj, &len);
+	if (len == 0) {
+	    compDictObj = NULL;
+	}
+	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
+    }
+
+    /*
+     * Send the data to the stream core, along with any flushing directive.
+     */
+
+    if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get such data out as we can (up to the requested length).
+     */
+
+    TclNewObj(obj);
+    code = Tcl_ZlibStreamGet(zstream, obj, buffersize);
+    if (code == TCL_OK) {
+	Tcl_SetObjResult(interp, obj);
+    } else {
+	TclDecrRefCount(obj);
+    }
+    return code;
+}
+
+static int
+ZlibStreamPutCmd(
+    ClientData cd,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_ZlibStream zstream = cd;
+    int index, flush = -1, i;
+    Tcl_Obj *compDictObj = NULL;
+    static const char *const put_options[] = {
+	"-dictionary", "-finalize", "-flush", "-fullflush", NULL
+    };
+    enum putOptions {
+	po_dictionary, po_finalize, po_flush, po_fullflush
+    };
+
+    for (i=2; i<objc-1; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], put_options, "option", 0,
+		&index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+
+	switch ((enum putOptions) index) {
+	case po_flush: /* -flush */
+	    if (flush > -1) {
+		flush = -2;
+	    } else {
+		flush = Z_SYNC_FLUSH;
+	    }
+	    break;
+	case po_fullflush: /* -fullflush */
+	    if (flush > -1) {
+		flush = -2;
+	    } else {
+		flush = Z_FULL_FLUSH;
+	    }
+	    break;
+	case po_finalize: /* -finalize */
+	    if (flush > -1) {
+		flush = -2;
+	    } else {
+		flush = Z_FINISH;
+	    }
+	    break;
+	case po_dictionary:
+	    if (i == objc-2) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"\"-dictionary\" option must be followed by"
+			" compression dictionary bytes", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
+		return TCL_ERROR;
+	    }
+	    compDictObj = objv[++i];
+	    break;
+	}
+	if (flush == -2) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "\"-flush\", \"-fullflush\" and \"-finalize\" options"
+		    " are mutually exclusive", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
+	    return TCL_ERROR;
+	}
+    }
+    if (flush == -1) {
+	flush = 0;
+    }
+
+    /*
+     * Set the compression dictionary if requested.
+     */
+
+    if (compDictObj != NULL) {
+	int len;
+
+	(void) Tcl_GetByteArrayFromObj(compDictObj, &len);
+	if (len == 0) {
+	    compDictObj = NULL;
+	}
+	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
+    }
+
+    /*
+     * Send the data to the stream core, along with any flushing directive.
+     */
+
+    return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
+}
+
+static int
+ZlibStreamHeaderCmd(
+    ClientData cd,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    ZlibStreamHandle *zshPtr = cd;
+    Tcl_Obj *resultObj;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	return TCL_ERROR;
+    } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE
+	    || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"only gunzip streams can produce header information", -1));
+	Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL);
+	return TCL_ERROR;
+    }
+
+    TclNewObj(resultObj);
+    ExtractHeader(&zshPtr->gzHeaderPtr->header, resultObj);
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *	Set of functions to support channel stacking.
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformClose --
+ *
+ *	How to shut down a stacked compressing/decompressing transform.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformClose(
+    ClientData instanceData,
+    Tcl_Interp *interp)
+{
+    ZlibChannelData *cd = instanceData;
+    int e, written, result = TCL_OK;
+
+    /*
+     * Delete the support timer.
+     */
+
+    ZlibTransformEventTimerKill(cd);
+
+    /*
+     * Flush any data waiting to be compressed.
+     */
+
+    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
+	cd->outStream.avail_in = 0;
+	do {
+	    e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
+		    Z_FINISH, &written);
+
+	    /*
+	     * Can't be sure that deflate() won't declare the buffer to be
+	     * full (with Z_BUF_ERROR) so handle that case.
+	     */
+
+	    if (e == Z_BUF_ERROR) {
+		e = Z_OK;
+		written = cd->outAllocated;
+	    }
+	    if (e != Z_OK && e != Z_STREAM_END) {
+		/* TODO: is this the right way to do errors on close? */
+		if (!TclInThreadExit()) {
+		    ConvertError(interp, e, cd->outStream.adler);
+		}
+		result = TCL_ERROR;
+		break;
+	    }
+	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 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() && interp) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "error while finalizing file: %s",
+			    Tcl_PosixError(interp)));
+		}
+		result = TCL_ERROR;
+		break;
+	    }
+	} while (e != Z_STREAM_END);
+	(void) deflateEnd(&cd->outStream);
+    } else {
+	(void) inflateEnd(&cd->inStream);
+    }
+
+    /*
+     * Release all memory.
+     */
+
+    if (cd->compDictObj) {
+	Tcl_DecrRefCount(cd->compDictObj);
+	cd->compDictObj = NULL;
+    }
+    Tcl_DStringFree(&cd->decompressed);
+
+    if (cd->inBuffer) {
+	ckfree(cd->inBuffer);
+	cd->inBuffer = NULL;
+    }
+    if (cd->outBuffer) {
+	ckfree(cd->outBuffer);
+	cd->outBuffer = NULL;
+    }
+    ckfree(cd);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformInput --
+ *
+ *	Reader filter that does decompression.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformInput(
+    ClientData instanceData,
+    char *buf,
+    int toRead,
+    int *errorCodePtr)
+{
+    ZlibChannelData *cd = instanceData;
+    Tcl_DriverInputProc *inProc =
+	    Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
+    int readBytes, gotBytes, copied;
+
+    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
+	return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
+		errorCodePtr);
+    }
+
+    gotBytes = 0;
+    while (toRead > 0) {
+	/*
+	 * Loop until the request is satisfied (or no data available from
+	 * below, possibly EOF).
+	 */
+
+	copied = ResultCopy(cd, buf, toRead);
+	toRead -= copied;
+	buf += copied;
+	gotBytes += copied;
+
+	if (toRead == 0) {
+	    return gotBytes;
+	}
+
+	/*
+	 * 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 (cd->decompressed) == 0, toRead > 0 here.
+	 *
+	 * The zlib transform allows us to read at most one character from the
+	 * underlying channel to properly identify Z_STREAM_END without
+	 * reading over the border.
+	 */
+
+	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);
+
+	/*
+	 * Three cases here:
+	 *  1.	Got some data from the underlying channel (readBytes > 0) so
+	 *	it should be fed through the decompression engine.
+	 *  2.	Got an error (readBytes < 0) which we should report up except
+	 *	for the case where we can convert it to a short read.
+	 *  3.	Got an end-of-data from EOF or blocking (readBytes == 0). If
+	 *	it is EOF, try flushing the data out of the decompressor.
+	 */
+
+	if (readBytes < 0) {
+
+	    /* See ReflectInput() in tclIORTrans.c */
+	    if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
+		return gotBytes;
+	    }
+
+	    *errorCodePtr = Tcl_GetErrno();
+	    return -1;
+	}
+	if (readBytes == 0) {
+	    /*
+	     * Eof in parent.
+	     *
+	     * Now this is a bit different. The partial data waiting is
+	     * converted and returned.
+	     */
+
+	    if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) {
+		return -1;
+	    }
+
+	    if (Tcl_DStringLength(&cd->decompressed) == 0) {
+		/*
+		 * The drain delivered nothing. Time to deliver what we've
+		 * got.
+		 */
+
+		return gotBytes;
+	    }
+	} else /* readBytes > 0 */ {
+	    /*
+	     * Transform the read chunk, which was not empty. Anything we get
+	     * back is a transformation result to be put into our buffers, and
+	     * the next iteration will put it into the result.
+	     */
+
+	    if (ResultGenerate(cd, readBytes, Z_NO_FLUSH,
+		    errorCodePtr) != TCL_OK) {
+		return -1;
+	    }
+	}
+    }
+    return gotBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformOutput --
+ *
+ *	Writer filter that does compression.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+    Tcl_Obj *errObj;
+
+    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
+	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
+		errorCodePtr);
+    }
+
+    /*
+     * No zero-length writes. Flushes must be explicit.
+     */
+
+    if (toWrite == 0) {
+	return 0;
+    }
+
+    cd->outStream.next_in = (Bytef *) buf;
+    cd->outStream.avail_in = toWrite;
+    while (cd->outStream.avail_in > 0) {
+	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
+		Z_NO_FLUSH, &produced);
+	if (e != Z_OK || produced == 0) {
+	    break;
+	}
+
+	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
+	    *errorCodePtr = Tcl_GetErrno();
+	    return -1;
+	}
+    }
+
+    if (e == Z_OK) {
+	return toWrite - cd->outStream.avail_in;
+    }
+
+    errObj = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    ConvertErrorToList(e, cd->outStream.adler));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    Tcl_NewStringObj(cd->outStream.msg, -1));
+    Tcl_SetChannelError(cd->parent, errObj);
+    *errorCodePtr = EINVAL;
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformFlush --
+ *
+ *	How to perform a flush of a compressing transform.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformFlush(
+    Tcl_Interp *interp,
+    ZlibChannelData *cd,
+    int flushType)
+{
+    int e, len;
+
+    cd->outStream.avail_in = 0;
+    do {
+	/*
+	 * Get the bytes to go out of the compression engine.
+	 */
+
+	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
+		flushType, &len);
+	if (e != Z_OK && e != Z_BUF_ERROR) {
+	    ConvertError(interp, e, cd->outStream.adler);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Write the bytes we've received to the next layer.
+	 */
+
+	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "problem flushing channel: %s",
+		    Tcl_PosixError(interp)));
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * If we get to this point, either we're in the Z_OK or the
+	 * Z_BUF_ERROR state. In the former case, we're done. In the latter
+	 * case, it's because there's more bytes to go than would fit in the
+	 * buffer we provided, and we need to go round again to get some more.
+	 *
+	 * We also stop the loop if we would have done a zero-length write.
+	 * Those can cause problems at the OS level.
+	 */
+    } while (len > 0 && e == Z_BUF_ERROR);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformSetOption --
+ *
+ *	Writing side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 *compressChanOptions = "dictionary flush";
+    static const char *gzipChanOptions = "flush";
+    static const char *decompressChanOptions = "dictionary limit";
+    static const char *gunzipChanOptions = "flush limit";
+    int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE);
+
+    if (optionName && (strcmp(optionName, "-dictionary") == 0)
+	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
+	Tcl_Obj *compDictObj;
+	int code;
+
+	TclNewStringObj(compDictObj, value, strlen(value));
+	Tcl_IncrRefCount(compDictObj);
+	(void) Tcl_GetByteArrayFromObj(compDictObj, NULL);
+	if (cd->compDictObj) {
+	    TclDecrRefCount(cd->compDictObj);
+	}
+	cd->compDictObj = compDictObj;
+	code = Z_OK;
+	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
+	    code = SetDeflateDictionary(&cd->outStream, compDictObj);
+	    if (code != Z_OK) {
+		ConvertError(interp, code, cd->outStream.adler);
+		return TCL_ERROR;
+	    }
+	} else if (cd->format == TCL_ZLIB_FORMAT_RAW) {
+	    code = SetInflateDictionary(&cd->inStream, compDictObj);
+	    if (code != Z_OK) {
+		ConvertError(interp, code, cd->inStream.adler);
+		return TCL_ERROR;
+	    }
+	}
+	return TCL_OK;
+    }
+
+    if (haveFlushOpt) {
+	if (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_SetObjResult(interp, Tcl_ObjPrintf(
+			"unknown -flush type \"%s\": must be full or sync",
+			value));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Try to actually do the flush now.
+	     */
+
+	    return ZlibTransformFlush(interp, cd, flushType);
+	}
+    } else {
+	if (optionName && strcmp(optionName, "-limit") == 0) {
+	    int newLimit;
+
+	    if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) {
+		return TCL_ERROR;
+	    } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"-limit must be between 1 and 65536", -1));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL);
+		return TCL_ERROR;
+	    }
+	}
+    }
+
+    if (setOptionProc == NULL) {
+	if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
+	    return Tcl_BadChannelOption(interp, optionName,
+		    (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+		    ? gzipChanOptions : gunzipChanOptions);
+	} else {
+	    return Tcl_BadChannelOption(interp, optionName,
+		    (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+		    ? compressChanOptions : decompressChanOptions);
+	}
+    }
+
+    /*
+     * Pass all unknown options down, to deeper transforms and/or the base
+     * channel.
+     */
+
+    return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
+	    optionName, value);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformGetOption --
+ *
+ *	Reading side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 *compressChanOptions = "checksum dictionary";
+    static const char *gzipChanOptions = "checksum";
+    static const char *decompressChanOptions = "checksum dictionary limit";
+    static const char *gunzipChanOptions = "checksum header limit";
+
+    /*
+     * 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;
+	}
+    }
+
+    if ((cd->format != TCL_ZLIB_FORMAT_GZIP) &&
+	    (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) {
+	/*
+	 * Embedded NUL bytes are ok; they'll be C080-encoded.
+	 */
+
+	if (optionName == NULL) {
+	    Tcl_DStringAppendElement(dsPtr, "-dictionary");
+	    if (cd->compDictObj) {
+		Tcl_DStringAppendElement(dsPtr,
+			Tcl_GetString(cd->compDictObj));
+	    } else {
+		Tcl_DStringAppendElement(dsPtr, "");
+	    }
+	} else {
+	    if (cd->compDictObj) {
+		int len;
+		const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
+
+		Tcl_DStringAppend(dsPtr, str, len);
+	    }
+	    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 {
+	    TclDStringAppendObj(dsPtr, tmpObj);
+	    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;
+    }
+    if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
+	return Tcl_BadChannelOption(interp, optionName,
+		(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+		? gzipChanOptions : gunzipChanOptions);
+    } else {
+	return Tcl_BadChannelOption(interp, optionName,
+		(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
+		? compressChanOptions : decompressChanOptions);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformWatch, ZlibTransformEventHandler --
+ *
+ *	If we have data pending, trigger a readable event after a short time
+ *	(in order to allow a real event to catch up).
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) || Tcl_DStringLength(&cd->decompressed) == 0) {
+	ZlibTransformEventTimerKill(cd);
+    } else if (cd->timer == NULL) {
+	cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+		ZlibTransformTimerRun, cd);
+    }
+}
+
+static int
+ZlibTransformEventHandler(
+    ClientData instanceData,
+    int interestMask)
+{
+    ZlibChannelData *cd = instanceData;
+
+    ZlibTransformEventTimerKill(cd);
+    return interestMask;
+}
+
+static inline void
+ZlibTransformEventTimerKill(
+    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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformGetHandle --
+ *
+ *	Anything that needs the OS handle is told to get it from what we are
+ *	stacked on top of.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformGetHandle(
+    ClientData instanceData,
+    int direction,
+    ClientData *handlePtr)
+{
+    ZlibChannelData *cd = instanceData;
+
+    return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformBlockMode --
+ *
+ *	We need to keep track of the blocking mode; it changes our behavior.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+    int limit,			/* The limit on the number of bytes to read
+				 * ahead; always at least 1. */
+    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. */
+    Tcl_Obj *compDictObj)	/* Byte-array object containing compression
+				 * dictionary (not dictObj!) to use if
+				 * necessary. */
+{
+    ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
+    Tcl_Channel chan;
+    int wbits = 0;
+
+    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;
+    cd->format = format;
+    cd->readAheadLimit = limit;
+
+    if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) {
+	if (mode == TCL_ZLIB_STREAM_DEFLATE) {
+	    if (gzipHeaderDictPtr) {
+		cd->flags |= OUT_HEADER;
+		if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader,
+			NULL) != 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 (compDictObj != NULL) {
+	cd->compDictObj = Tcl_DuplicateObj(compDictObj);
+	Tcl_IncrRefCount(cd->compDictObj);
+	Tcl_GetByteArrayFromObj(cd->compDictObj, NULL);
+    }
+
+    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) {
+	if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
+	    goto error;
+	}
+	cd->inAllocated = DEFAULT_BUFFER_SIZE;
+	cd->inBuffer = ckalloc(cd->inAllocated);
+	if (cd->flags & IN_HEADER) {
+	    if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
+		goto error;
+	    }
+	}
+	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
+	    if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
+		goto error;
+	    }
+	}
+    } else {
+	if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
+		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
+	    goto error;
+	}
+	cd->outAllocated = DEFAULT_BUFFER_SIZE;
+	cd->outBuffer = ckalloc(cd->outAllocated);
+	if (cd->flags & OUT_HEADER) {
+	    if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
+		goto error;
+	    }
+	}
+	if (cd->compDictObj) {
+	    if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {
+		goto error;
+	    }
+	}
+    }
+
+    Tcl_DStringInit(&cd->decompressed);
+
+    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);
+    }
+    if (cd->compDictObj) {
+	Tcl_DecrRefCount(cd->compDictObj);
+    }
+    ckfree(cd);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 inline int
+ResultCopy(
+    ZlibChannelData *cd,	/* The location of the buffer to read from. */
+    char *buf,			/* The buffer to copy into */
+    int toRead)			/* Number of requested bytes */
+{
+    int have = Tcl_DStringLength(&cd->decompressed);
+
+    if (have == 0) {
+	/*
+	 * Nothing to copy in the case of an empty buffer.
+	 */
+
+	return 0;
+    } else if (have > toRead) {
+	/*
+	 * The internal buffer contains more than requested. Copy the
+	 * requested subset to the caller, shift the remaining bytes down, and
+	 * truncate.
+	 */
+
+	char *src = Tcl_DStringValue(&cd->decompressed);
+
+	memcpy(buf, src, toRead);
+	memmove(src, src + toRead, have - toRead);
+
+	Tcl_DStringSetLength(&cd->decompressed, have - toRead);
+	return toRead;
+    } else /* have <= toRead */ {
+	/*
+	 * There is just or not enough in the buffer to fully satisfy the
+	 * caller, so take everything as best effort.
+	 */
+
+	memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
+	TclDStringClear(&cd->decompressed);
+	return have;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultGenerate --
+ *
+ *	Extract uncompressed bytes from the compression engine and store them
+ *	in our working buffer.
+ *
+ * Result:
+ *	TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason).
+ *
+ * Side effects:
+ *	See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResultGenerate(
+    ZlibChannelData *cd,
+    int n,
+    int flush,
+    int *errorCodePtr)
+{
+#define MAXBUF	1024
+    unsigned char buf[MAXBUF];
+    int e, written;
+    Tcl_Obj *errObj;
+
+    cd->inStream.next_in = (Bytef *) cd->inBuffer;
+    cd->inStream.avail_in = n;
+
+    while (1) {
+	cd->inStream.next_out = (Bytef *) buf;
+	cd->inStream.avail_out = MAXBUF;
+
+	e = inflate(&cd->inStream, flush);
+	if (e == Z_NEED_DICT && cd->compDictObj) {
+	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
+	    if (e == Z_OK) {
+		/*
+		 * A repetition of Z_NEED_DICT is just an error.
+		 */
+
+		cd->inStream.next_out = (Bytef *) buf;
+		cd->inStream.avail_out = MAXBUF;
+		e = inflate(&cd->inStream, flush);
+	    }
+	}
+
+	/*
+	 * avail_out is now the left over space in the output.  Therefore
+	 * "MAXBUF - avail_out" is the amount of bytes generated.
+	 */
+
+	written = MAXBUF - cd->inStream.avail_out;
+	if (written) {
+	    Tcl_DStringAppend(&cd->decompressed, (char *) buf, written);
+	}
+
+	/*
+	 * The cases where we're definitely done.
+	 */
+
+	if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR))
+		|| (e == Z_STREAM_END)
+		|| (e == Z_OK && cd->inStream.avail_out == 0)) {
+	    return TCL_OK;
+	}
+
+	/*
+	 * 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.
+	 *
+	 * Otherwise, we've got errors and need to report to higher-up.
+	 */
+
+	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
+	    goto handleError;
+	}
+
+	/*
+	 * Check if the inflate stopped early.
+	 */
+
+	if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
+	    return TCL_OK;
+	}
+    }
+
+  handleError:
+    errObj = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    ConvertErrorToList(e, cd->inStream.adler));
+    Tcl_ListObjAppendElement(NULL, errObj,
+	    Tcl_NewStringObj(cd->inStream.msg, -1));
+    Tcl_SetChannelError(cd->parent, errObj);
+    *errorCodePtr = EINVAL;
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *	Finally, the TclZlibInit function. Used to install the zlib API.
+ *----------------------------------------------------------------------
+ */
+
+int
+TclZlibInit(
+    Tcl_Interp *interp)
+{
+    Tcl_Config cfg[2];
+
+    /*
+     * 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_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0);
+
+    /*
+     * Create the public scripted interface to this file's functionality.
+     */
+
+    Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
+
+    /*
+     * Store the underlying configuration information.
+     *
+     * TODO: Describe whether we're using the system version of the library or
+     * a compatibility version built into Tcl?
+     */
+
+    cfg[0].key = "zlibVersion";
+    cfg[0].value = zlibVersion();
+    cfg[1].key = NULL;
+    Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
+
+    /*
+     * Formally provide the package as a Tcl built-in.
+     */
+
+    return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *	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)
+{
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+	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)
+{
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+	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)
+{
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+	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;
+}
+
+void
+Tcl_ZlibStreamSetCompressionDictionary(
+    Tcl_ZlibStream zshandle,
+    Tcl_Obj *compressionDictionaryObj)
+{
+    /* Do nothing. */
+}
+#endif /* HAVE_ZLIB */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */