* generic/tclCompExpr.c: changed INST_STREQ -> INST_STR_EQ,

	INST_STRNEQ -> INST_STR_NEQ
	* generic/tclCompile.c: added streq, strneq, strcmp, strlen &
	strmatch to the compiled stats instructionTable
	* generic/tclCompile.h: added instructions INST_STR_CMP,
	INST_STR_INDEX, INST_STR_MATCH
	* generic/tclCompCmds.c: added byte compiler support for
	[string compare|match|index].
	* generic/tclExecute.c:
	Changed INST_STR_(N)EQ to return an Int object and not bother
	trying to reuse the top stack object.
	Added INST_STR_CMP, INST_STR_INDEX, INST_STR_MATCH bytecode ops.
	Extended evalstats output info with Tcl_IsShared stat info.

5 files changed, 456 insertions, 230 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5b6c966..6d9b273 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.6 2000/05/23 22:10:50 ericm Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.7 2000/05/26 08:53:40 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -2021,14 +2021,32 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
     
     switch ((enum options) index) {
 	case STR_BYTELENGTH:
+	case STR_FIRST:
+	case STR_IS:
+	case STR_LAST:
+	case STR_MAP:
+	case STR_RANGE:
+	case STR_REPEAT:
+	case STR_REPLACE:
+	case STR_TOLOWER:
+	case STR_TOUPPER:
+	case STR_TOTITLE:
+	case STR_TRIM:
+	case STR_TRIMLEFT:
+	case STR_TRIMRIGHT:
+	case STR_WORDEND:
+	case STR_WORDSTART:
+	    /*
+	     * All other cases: compile out of line.
+	     */
+	    return TCL_OUT_LINE_COMPILE;
+
 	case STR_COMPARE: 
-	    break;
 	case STR_EQUAL: {
-	    int i;
-	    int depth;
+	    int i, depth;
 	    /*
 	     * If there are any flags to the command, we can't byte compile it
-	     * because the INST_STREQ bytecode doesn't support flags.
+	     * because the INST_STR_EQ bytecode doesn't support flags.
 	     */
 
 	    if (parsePtr->numWords != 4) {
@@ -2059,59 +2077,124 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
 	    }
 
 	    envPtr->maxStackDepth = depth;
-	    TclEmitOpcode(INST_STREQ, envPtr);
+	    TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
+		    INST_STR_CMP : INST_STR_EQ), envPtr);
+	    return TCL_OK;
+	}
+	case STR_INDEX: {
+	    int i, depth;
+
+	    if (parsePtr->numWords != 4) {
+		Tcl_SetResult(interp, "wrong # args: should be "
+			"\"string index string charIndex\"", TCL_STATIC);
+		return TCL_ERROR;
+	    }
+
+	    depth = 0;
+
+	    /*
+	     * Push the two operands onto the stack.
+	     */
+
+	    for (i = 0; i < 2; i++) {
+		if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+		    TclEmitPush(TclRegisterLiteral(envPtr,
+			    varTokenPtr[1].start, varTokenPtr[1].size,
+			    0), envPtr);
+		    depth++;
+		} else {
+		    code = TclCompileTokens(interp, varTokenPtr+1,
+			    varTokenPtr->numComponents, envPtr);
+		    if (code != TCL_OK) {
+			return code;
+		    }
+		    depth += envPtr->maxStackDepth;
+		}
+		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+	    }
+
+	    envPtr->maxStackDepth = depth;
+	    TclEmitOpcode(INST_STR_INDEX, envPtr);
 	    return TCL_OK;
-	    break;
 	}
-	case STR_FIRST:
-	case STR_INDEX:
-	case STR_IS:
-	case STR_LAST:
-	    break;
 	case STR_LENGTH: {
 	    if (parsePtr->numWords != 3) {
 		Tcl_SetResult(interp, "wrong # args: should be "
 			"\"string length string\"", TCL_STATIC);
 		return TCL_ERROR;
 	    }
-	    
+
 	    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 		TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start,
 			varTokenPtr[1].size, 0), envPtr);
 		envPtr->maxStackDepth = 1;
-		TclEmitOpcode(INST_STRLEN, envPtr);
-		return TCL_OK;
 	    } else {
 		code = TclCompileTokens(interp, varTokenPtr+1,
 			varTokenPtr->numComponents, envPtr);
 		if (code != TCL_OK) {
 		    return code;
 		}
-		TclEmitOpcode(INST_STRLEN, envPtr);
-		return TCL_OK;
 	    }
-	    break;
+	    TclEmitOpcode(INST_STR_LEN, envPtr);
+	    return TCL_OK;
+	}
+	case STR_MATCH: {
+	    int i, length, nocase = 0, depth = 0;
+	    char *str;
+
+	    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+		Tcl_SetResult(interp, "wrong # args: should be "
+			"\"string match ?-nocase? pattern string\"",
+			TCL_STATIC);
+		return TCL_ERROR;
+	    }
+
+	    if (parsePtr->numWords == 5) {
+		if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+		    return TCL_OUT_LINE_COMPILE;
+		}
+		str    = varTokenPtr[1].start;
+		length = varTokenPtr[1].size;
+		if ((length > 1) &&
+			strncmp(str, "-nocase", (size_t) length) == 0) {
+		    nocase = 1;
+		} else {
+		    char c = str[length];
+		    str[length] = '\0';
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			    "bad option \"", str, "\": must be -nocase",
+			    (char *) NULL);
+		    str[length] = c;
+		    return TCL_ERROR;
+		}
+		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+	    }
+	    TclEmitPush(TclRegisterLiteral(envPtr, (nocase ? "1" : "0"),
+		    1, 0), envPtr);
+	    depth++;
+
+	    for (i = 0; i < 2; i++) {
+		if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+		    TclEmitPush(TclRegisterLiteral(envPtr,
+			    varTokenPtr[1].start, varTokenPtr[1].size,
+			    0), envPtr);
+		    depth++;
+		} else {
+		    code = TclCompileTokens(interp, varTokenPtr+1,
+			    varTokenPtr->numComponents, envPtr);
+		    if (code != TCL_OK) {
+			return code;
+		    }
+		    depth += envPtr->maxStackDepth;
+		}
+		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+	    }
+
+	    envPtr->maxStackDepth = depth;
+	    TclEmitOpcode(INST_STR_MATCH, envPtr);
+	    return TCL_OK;
 	}
-	case STR_MAP:
-	case STR_MATCH:
-	case STR_RANGE:
-	case STR_REPEAT:
-	case STR_REPLACE:
-	case STR_TOLOWER:
-	case STR_TOUPPER:
-	case STR_TOTITLE:
-	case STR_TRIM:
-	case STR_TRIMLEFT:
-	case STR_TRIMRIGHT:
-	case STR_WORDEND:
-	case STR_WORDSTART:
-	    break;
     }
-    
-    /*
-     * All other cases: compile out of line.
-     */
-    return TCL_OUT_LINE_COMPILE;
 
     return TCL_OK;
 }
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 8a781b9..b619e2c 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompExpr.c,v 1.5 2000/05/09 00:00:34 hobbs Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.6 2000/05/26 08:53:40 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -144,8 +144,8 @@ OperatorDesc operatorTable[] = {
     {"?",   0},
     {"!",   1,  INST_LNOT},
     {"~",   1,  INST_BITNOT},
-    {"eq",  2,  INST_STREQ},
-    {"ne",  2,  INST_STRNEQ},
+    {"eq",  2,  INST_STR_EQ},
+    {"ne",  2,  INST_STR_NEQ},
     {NULL}
 };
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7a9f64d..6a108ab 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.20 2000/03/30 04:36:11 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.21 2000/05/26 08:53:41 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -50,166 +50,178 @@ static int traceInitialized = 0;
  */
 
 InstructionDesc instructionTable[] = {
-   /* Name	      Bytes #Opnds Operand types        Stack top, next   */
-    {"done",	          1,   0,   {OPERAND_NONE}},
-        /* Finish ByteCode execution and return stktop (top stack item) */
-    {"push1",	          2,   1,   {OPERAND_UINT1}},
-        /* Push object at ByteCode objArray[op1] */
-    {"push4",	          5,   1,   {OPERAND_UINT4}},
-        /* Push object at ByteCode objArray[op4] */
-    {"pop",	          1,   0,   {OPERAND_NONE}},
-        /* Pop the topmost stack object */
-    {"dup",	          1,   0,   {OPERAND_NONE}},
-        /* Duplicate the topmost stack object and push the result */
-    {"concat1",	          2,   1,   {OPERAND_UINT1}},
-        /* Concatenate the top op1 items and push result */
-    {"invokeStk1",        2,   1,   {OPERAND_UINT1}},
-        /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
-    {"invokeStk4",        5,   1,   {OPERAND_UINT4}},
-        /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
-    {"evalStk",           1,   0,   {OPERAND_NONE}},
-        /* Evaluate command in stktop using Tcl_EvalObj. */
-    {"exprStk",           1,   0,   {OPERAND_NONE}},
-        /* Execute expression in stktop using Tcl_ExprStringObj. */
+   /* Name	      Bytes #Opnds Operand types	Stack top, next	  */
+    {"done",		  1,   0,   {OPERAND_NONE}},
+	/* Finish ByteCode execution and return stktop (top stack item) */
+    {"push1",		  2,   1,   {OPERAND_UINT1}},
+	/* Push object at ByteCode objArray[op1] */
+    {"push4",		  5,   1,   {OPERAND_UINT4}},
+	/* Push object at ByteCode objArray[op4] */
+    {"pop",		  1,   0,   {OPERAND_NONE}},
+	/* Pop the topmost stack object */
+    {"dup",		  1,   0,   {OPERAND_NONE}},
+	/* Duplicate the topmost stack object and push the result */
+    {"concat1",		  2,   1,   {OPERAND_UINT1}},
+	/* Concatenate the top op1 items and push result */
+    {"invokeStk1",	  2,   1,   {OPERAND_UINT1}},
+	/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
+    {"invokeStk4",	  5,   1,   {OPERAND_UINT4}},
+	/* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
+    {"evalStk",		  1,   0,   {OPERAND_NONE}},
+	/* Evaluate command in stktop using Tcl_EvalObj. */
+    {"exprStk",		  1,   0,   {OPERAND_NONE}},
+	/* Execute expression in stktop using Tcl_ExprStringObj. */
     
-    {"loadScalar1",       2,   1,   {OPERAND_UINT1}},
-        /* Load scalar variable at index op1 <= 255 in call frame */
-    {"loadScalar4",       5,   1,   {OPERAND_UINT4}},
-        /* Load scalar variable at index op1 >= 256 in call frame */
-    {"loadScalarStk",     1,   0,   {OPERAND_NONE}},
-        /* Load scalar variable; scalar's name is stktop */
-    {"loadArray1",        2,   1,   {OPERAND_UINT1}},
-        /* Load array element; array at slot op1<=255, element is stktop */
-    {"loadArray4",        5,   1,   {OPERAND_UINT4}},
-        /* Load array element; array at slot op1 > 255, element is stktop */
-    {"loadArrayStk",      1,   0,   {OPERAND_NONE}},
-        /* Load array element; element is stktop, array name is stknext */
-    {"loadStk",           1,   0,   {OPERAND_NONE}},
-        /* Load general variable; unparsed variable name is stktop */
-    {"storeScalar1",      2,   1,   {OPERAND_UINT1}},
-        /* Store scalar variable at op1<=255 in frame; value is stktop */
-    {"storeScalar4",      5,   1,   {OPERAND_UINT4}},
-        /* Store scalar variable at op1 > 255 in frame; value is stktop */
-    {"storeScalarStk",    1,   0,   {OPERAND_NONE}},
-        /* Store scalar; value is stktop, scalar name is stknext */
-    {"storeArray1",       2,   1,   {OPERAND_UINT1}},
-        /* Store array element; array at op1<=255, value is top then elem */
-    {"storeArray4",       5,   1,   {OPERAND_UINT4}},
-        /* Store array element; array at op1>=256, value is top then elem */
-    {"storeArrayStk",     1,   0,   {OPERAND_NONE}},
-        /* Store array element; value is stktop, then elem, array names */
-    {"storeStk",          1,   0,   {OPERAND_NONE}},
-        /* Store general variable; value is stktop, then unparsed name */
+    {"loadScalar1",	  2,   1,   {OPERAND_UINT1}},
+	/* Load scalar variable at index op1 <= 255 in call frame */
+    {"loadScalar4",	  5,   1,   {OPERAND_UINT4}},
+	/* Load scalar variable at index op1 >= 256 in call frame */
+    {"loadScalarStk",	  1,   0,   {OPERAND_NONE}},
+	/* Load scalar variable; scalar's name is stktop */
+    {"loadArray1",	  2,   1,   {OPERAND_UINT1}},
+	/* Load array element; array at slot op1<=255, element is stktop */
+    {"loadArray4",	  5,   1,   {OPERAND_UINT4}},
+	/* Load array element; array at slot op1 > 255, element is stktop */
+    {"loadArrayStk",	  1,   0,   {OPERAND_NONE}},
+	/* Load array element; element is stktop, array name is stknext */
+    {"loadStk",		  1,   0,   {OPERAND_NONE}},
+	/* Load general variable; unparsed variable name is stktop */
+    {"storeScalar1",	  2,   1,   {OPERAND_UINT1}},
+	/* Store scalar variable at op1<=255 in frame; value is stktop */
+    {"storeScalar4",	  5,   1,   {OPERAND_UINT4}},
+	/* Store scalar variable at op1 > 255 in frame; value is stktop */
+    {"storeScalarStk",	  1,   0,   {OPERAND_NONE}},
+	/* Store scalar; value is stktop, scalar name is stknext */
+    {"storeArray1",	  2,   1,   {OPERAND_UINT1}},
+	/* Store array element; array at op1<=255, value is top then elem */
+    {"storeArray4",	  5,   1,   {OPERAND_UINT4}},
+	/* Store array element; array at op1>=256, value is top then elem */
+    {"storeArrayStk",	  1,   0,   {OPERAND_NONE}},
+	/* Store array element; value is stktop, then elem, array names */
+    {"storeStk",	  1,   0,   {OPERAND_NONE}},
+	/* Store general variable; value is stktop, then unparsed name */
     
-    {"incrScalar1",       2,   1,   {OPERAND_UINT1}},
-        /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
-    {"incrScalarStk",     1,   0,   {OPERAND_NONE}},
-        /* Incr scalar; incr amount is stktop, scalar's name is stknext */
-    {"incrArray1",        2,   1,   {OPERAND_UINT1}},
-        /* Incr array elem; arr at slot op1<=255, amount is top then elem */
-    {"incrArrayStk",      1,   0,   {OPERAND_NONE}},
-        /* Incr array element; amount is top then elem then array names */
-    {"incrStk",           1,   0,   {OPERAND_NONE}},
-        /* Incr general variable; amount is stktop then unparsed var name */
-    {"incrScalar1Imm",    3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
-        /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
+    {"incrScalar1",	  2,   1,   {OPERAND_UINT1}},
+	/* Incr scalar at index op1<=255 in frame; incr amount is stktop */
+    {"incrScalarStk",	  1,   0,   {OPERAND_NONE}},
+	/* Incr scalar; incr amount is stktop, scalar's name is stknext */
+    {"incrArray1",	  2,   1,   {OPERAND_UINT1}},
+	/* Incr array elem; arr at slot op1<=255, amount is top then elem */
+    {"incrArrayStk",	  1,   0,   {OPERAND_NONE}},
+	/* Incr array element; amount is top then elem then array names */
+    {"incrStk",		  1,   0,   {OPERAND_NONE}},
+	/* Incr general variable; amount is stktop then unparsed var name */
+    {"incrScalar1Imm",	  3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
+	/* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
     {"incrScalarStkImm",  2,   1,   {OPERAND_INT1}},
-        /* Incr scalar; scalar name is stktop; incr amount is op1 */
-    {"incrArray1Imm",     3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
-        /* Incr array elem; array at slot op1 <= 255, elem is stktop,
+	/* Incr scalar; scalar name is stktop; incr amount is op1 */
+    {"incrArray1Imm",	  3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
+	/* Incr array elem; array at slot op1 <= 255, elem is stktop,
 	 * amount is 2nd operand byte */
-    {"incrArrayStkImm",   2,   1,   {OPERAND_INT1}},
-        /* Incr array element; elem is top then array name, amount is op1 */
-    {"incrStkImm",        2,   1,   {OPERAND_INT1}},
-        /* Incr general variable; unparsed name is top, amount is op1 */
+    {"incrArrayStkImm",	  2,   1,   {OPERAND_INT1}},
+	/* Incr array element; elem is top then array name, amount is op1 */
+    {"incrStkImm",	  2,   1,   {OPERAND_INT1}},
+	/* Incr general variable; unparsed name is top, amount is op1 */
     
-    {"jump1",             2,   1,   {OPERAND_INT1}},
-        /* Jump relative to (pc + op1) */
-    {"jump4",             5,   1,   {OPERAND_INT4}},
-        /* Jump relative to (pc + op4) */
-    {"jumpTrue1",         2,   1,   {OPERAND_INT1}},
-        /* Jump relative to (pc + op1) if stktop expr object is true */
-    {"jumpTrue4",         5,   1,   {OPERAND_INT4}},
-        /* Jump relative to (pc + op4) if stktop expr object is true */
-    {"jumpFalse1",        2,   1,   {OPERAND_INT1}},
-        /* Jump relative to (pc + op1) if stktop expr object is false */
-    {"jumpFalse4",        5,   1,   {OPERAND_INT4}},
-        /* Jump relative to (pc + op4) if stktop expr object is false */
-
-    {"lor",               1,   0,   {OPERAND_NONE}},
-        /* Logical or:	push (stknext || stktop) */
-    {"land",              1,   0,   {OPERAND_NONE}},
-        /* Logical and:	push (stknext && stktop) */
-    {"bitor",             1,   0,   {OPERAND_NONE}},
-        /* Bitwise or:	push (stknext | stktop) */
-    {"bitxor",            1,   0,   {OPERAND_NONE}},
-        /* Bitwise xor	push (stknext ^ stktop) */
-    {"bitand",            1,   0,   {OPERAND_NONE}},
-        /* Bitwise and:	push (stknext & stktop) */
-    {"eq",                1,   0,   {OPERAND_NONE}},
-        /* Equal:	push (stknext == stktop) */
-    {"neq",               1,   0,   {OPERAND_NONE}},
-        /* Not equal:	push (stknext != stktop) */
-    {"lt",                1,   0,   {OPERAND_NONE}},
-        /* Less:	push (stknext < stktop) */
-    {"gt",                1,   0,   {OPERAND_NONE}},
-        /* Greater:	push (stknext || stktop) */
-    {"le",                1,   0,   {OPERAND_NONE}},
-        /* Logical or:	push (stknext || stktop) */
-    {"ge",                1,   0,   {OPERAND_NONE}},
-        /* Logical or:	push (stknext || stktop) */
-    {"lshift",            1,   0,   {OPERAND_NONE}},
-        /* Left shift:	push (stknext << stktop) */
-    {"rshift",            1,   0,   {OPERAND_NONE}},
-        /* Right shift:	push (stknext >> stktop) */
-    {"add",               1,   0,   {OPERAND_NONE}},
-        /* Add:		push (stknext + stktop) */
-    {"sub",               1,   0,   {OPERAND_NONE}},
-        /* Sub:		push (stkext - stktop) */
-    {"mult",              1,   0,   {OPERAND_NONE}},
-        /* Multiply:	push (stknext * stktop) */
-    {"div",               1,   0,   {OPERAND_NONE}},
-        /* Divide:	push (stknext / stktop) */
-    {"mod",               1,   0,   {OPERAND_NONE}},
-        /* Mod:		push (stknext % stktop) */
-    {"uplus",             1,   0,   {OPERAND_NONE}},
-        /* Unary plus:	push +stktop */
-    {"uminus",            1,   0,   {OPERAND_NONE}},
-        /* Unary minus:	push -stktop */
-    {"bitnot",            1,   0,   {OPERAND_NONE}},
-        /* Bitwise not:	push ~stktop */
-    {"not",               1,   0,   {OPERAND_NONE}},
-        /* Logical not:	push !stktop */
+    {"jump1",		  2,   1,   {OPERAND_INT1}},
+	/* Jump relative to (pc + op1) */
+    {"jump4",		  5,   1,   {OPERAND_INT4}},
+	/* Jump relative to (pc + op4) */
+    {"jumpTrue1",	  2,   1,   {OPERAND_INT1}},
+	/* Jump relative to (pc + op1) if stktop expr object is true */
+    {"jumpTrue4",	  5,   1,   {OPERAND_INT4}},
+	/* Jump relative to (pc + op4) if stktop expr object is true */
+    {"jumpFalse1",	  2,   1,   {OPERAND_INT1}},
+	/* Jump relative to (pc + op1) if stktop expr object is false */
+    {"jumpFalse4",	  5,   1,   {OPERAND_INT4}},
+	/* Jump relative to (pc + op4) if stktop expr object is false */
+
+    {"lor",		  1,   0,   {OPERAND_NONE}},
+	/* Logical or:	push (stknext || stktop) */
+    {"land",		  1,   0,   {OPERAND_NONE}},
+	/* Logical and:	push (stknext && stktop) */
+    {"bitor",		  1,   0,   {OPERAND_NONE}},
+	/* Bitwise or:	push (stknext | stktop) */
+    {"bitxor",		  1,   0,   {OPERAND_NONE}},
+	/* Bitwise xor	push (stknext ^ stktop) */
+    {"bitand",		  1,   0,   {OPERAND_NONE}},
+	/* Bitwise and:	push (stknext & stktop) */
+    {"eq",		  1,   0,   {OPERAND_NONE}},
+	/* Equal:	push (stknext == stktop) */
+    {"neq",		  1,   0,   {OPERAND_NONE}},
+	/* Not equal:	push (stknext != stktop) */
+    {"lt",		  1,   0,   {OPERAND_NONE}},
+	/* Less:	push (stknext < stktop) */
+    {"gt",		  1,   0,   {OPERAND_NONE}},
+	/* Greater:	push (stknext || stktop) */
+    {"le",		  1,   0,   {OPERAND_NONE}},
+	/* Logical or:	push (stknext || stktop) */
+    {"ge",		  1,   0,   {OPERAND_NONE}},
+	/* Logical or:	push (stknext || stktop) */
+    {"lshift",		  1,   0,   {OPERAND_NONE}},
+	/* Left shift:	push (stknext << stktop) */
+    {"rshift",		  1,   0,   {OPERAND_NONE}},
+	/* Right shift:	push (stknext >> stktop) */
+    {"add",		  1,   0,   {OPERAND_NONE}},
+	/* Add:		push (stknext + stktop) */
+    {"sub",		  1,   0,   {OPERAND_NONE}},
+	/* Sub:		push (stkext - stktop) */
+    {"mult",		  1,   0,   {OPERAND_NONE}},
+	/* Multiply:	push (stknext * stktop) */
+    {"div",		  1,   0,   {OPERAND_NONE}},
+	/* Divide:	push (stknext / stktop) */
+    {"mod",		  1,   0,   {OPERAND_NONE}},
+	/* Mod:		push (stknext % stktop) */
+    {"uplus",		  1,   0,   {OPERAND_NONE}},
+	/* Unary plus:	push +stktop */
+    {"uminus",		  1,   0,   {OPERAND_NONE}},
+	/* Unary minus:	push -stktop */
+    {"bitnot",		  1,   0,   {OPERAND_NONE}},
+	/* Bitwise not:	push ~stktop */
+    {"not",		  1,   0,   {OPERAND_NONE}},
+	/* Logical not:	push !stktop */
     {"callBuiltinFunc1",  2,   1,   {OPERAND_UINT1}},
-        /* Call builtin math function with index op1; any args are on stk */
-    {"callFunc1",         2,   1,   {OPERAND_UINT1}},
-        /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
-    {"tryCvtToNumeric",   1,   0,   {OPERAND_NONE}},
-        /* Try converting stktop to first int then double if possible. */
-
-    {"break",             1,   0,   {OPERAND_NONE}},
-        /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
-    {"continue",          1,   0,   {OPERAND_NONE}},
-        /* Skip to next iteration of closest enclosing loop; if none,
+	/* Call builtin math function with index op1; any args are on stk */
+    {"callFunc1",	  2,   1,   {OPERAND_UINT1}},
+	/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
+    {"tryCvtToNumeric",	  1,   0,   {OPERAND_NONE}},
+	/* Try converting stktop to first int then double if possible. */
+
+    {"break",		  1,   0,   {OPERAND_NONE}},
+	/* Abort closest enclosing loop; if none, return TCL_BREAK code. */
+    {"continue",	  1,   0,   {OPERAND_NONE}},
+	/* Skip to next iteration of closest enclosing loop; if none,
 	 * return TCL_CONTINUE code. */
 
-    {"foreach_start4",    5,   1,   {OPERAND_UINT4}},
-        /* Initialize execution of a foreach loop. Operand is aux data index
+    {"foreach_start4",	  5,   1,   {OPERAND_UINT4}},
+	/* Initialize execution of a foreach loop. Operand is aux data index
 	 * of the ForeachInfo structure for the foreach command. */
-    {"foreach_step4",     5,   1,   {OPERAND_UINT4}},
-        /* "Step" or begin next iteration of foreach loop. Push 0 if to
+    {"foreach_step4",	  5,   1,   {OPERAND_UINT4}},
+	/* "Step" or begin next iteration of foreach loop. Push 0 if to
 	 *  terminate loop, else push 1. */
 
     {"beginCatch4",	  5,   1,   {OPERAND_UINT4}},
-        /* Record start of catch with the operand's exception index.
+	/* Record start of catch with the operand's exception index.
 	 * Push the current stack depth onto a special catch stack. */
     {"endCatch",	  1,   0,   {OPERAND_NONE}},
-        /* End of last catch. Pop the bytecode interpreter's catch stack. */
+	/* End of last catch. Pop the bytecode interpreter's catch stack. */
     {"pushResult",	  1,   0,   {OPERAND_NONE}},
-        /* Push the interpreter's object result onto the stack. */
+	/* Push the interpreter's object result onto the stack. */
     {"pushReturnCode",	  1,   0,   {OPERAND_NONE}},
-        /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
+	/* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
 	 * a new object onto the stack. */
+    {"streq",		  1,   0,   {OPERAND_NONE}},
+	/* Str Equal:	push (stknext eq stktop) */
+    {"strneq",		  1,   0,   {OPERAND_NONE}},
+	/* Str !Equal:	push (stknext neq stktop) */
+    {"strcmp",		  1,   0,   {OPERAND_NONE}},
+	/* Str Compare:	push (stknext cmp stktop) */
+    {"strlen",		  1,   0,   {OPERAND_NONE}},
+	/* Str Length:	push (strlen stktop) */
+    {"strindex",	  1,   0,   {OPERAND_NONE}},
+	/* Str Index:	push (strindex stknext stktop) */
+    {"strmatch",	  1,   0,   {OPERAND_NONE}},
+	/* Str Match:	push (strmatch stkforenext stknext stktop) */
     {0}
 };
 
@@ -3383,7 +3395,7 @@ RecordByteCodeStats(codePtr)
     statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
     
     statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
-    statsPtr->byteCodeCount[TclLog2(codePtr->structureSize)]++;
+    statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;
 
     statsPtr->currentInstBytes   += (double) codePtr->numCodeBytes;
     statsPtr->currentLitBytes    +=
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a7efb6b..935f5a7 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -7,7 +7,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.13 2000/05/23 22:10:51 ericm Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.14 2000/05/26 08:53:42 hobbs Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -495,12 +495,15 @@ typedef struct ByteCode {
 #define INST_PUSH_RETURN_CODE		72
 
 /* Opcodes 73 to 74 */
-#define INST_STREQ			73
-#define INST_STRNEQ			74
-#define INST_STRLEN			75
+#define INST_STR_EQ			73
+#define INST_STR_NEQ			74
+#define INST_STR_CMP			75
+#define INST_STR_LEN			76
+#define INST_STR_INDEX			77
+#define INST_STR_MATCH			78
 
 /* The last opcode */
-#define LAST_INST_OPCODE        	75
+#define LAST_INST_OPCODE        	78
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1169689..88b5299 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.12 2000/05/23 22:10:51 ericm Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.13 2000/05/26 08:53:42 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1757,15 +1757,14 @@ TclExecuteByteCode(interp, codePtr)
 	    }
 	    ADJUST_PC(1);
 
-	case INST_STREQ:
-	case INST_STRNEQ:
+	case INST_STR_EQ:
+	case INST_STR_NEQ:
 	    {
 		/*
 		 * String (in)equality check
 		 */
 		char *s1, *s2;
-		int s1len, s2len;
-		long iResult;
+		int s1len, s2len, iResult;
 
 		value2Ptr = POP_OBJECT();
 		valuePtr  = POP_OBJECT();
@@ -1777,54 +1776,160 @@ TclExecuteByteCode(interp, codePtr)
 		     * We only need to check (in)equality when we have equal
 		     * length strings.
 		     */
-		    if (*pc == INST_STRNEQ) {
+		    if (*pc == INST_STR_NEQ) {
 			iResult = (strcmp(s1, s2) != 0);
 		    } else {
-			/* INST_STREQ */
+			/* INST_STR_EQ */
 			iResult = (strcmp(s1, s2) == 0);
 		    }
 		} else {
-		    iResult = (*pc == INST_STRNEQ);
+		    iResult = (*pc == INST_STR_NEQ);
 		}
 
+		PUSH_OBJECT(Tcl_NewIntObj(iResult));
+		TRACE(("%.20s %.20s => %d\n",
+			O2S(valuePtr), O2S(value2Ptr), iResult));
+		TclDecrRefCount(valuePtr);
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+
+	case INST_STR_CMP:
+	    {
 		/*
-		 * Reuse the valuePtr object already on stack if possible.
+		 * String compare
 		 */
-		
-		if (Tcl_IsShared(valuePtr)) {
-		    PUSH_OBJECT(Tcl_NewLongObj(iResult));
-		    TRACE(("%.20s %.20s => %ld\n",
-			   O2S(valuePtr), O2S(value2Ptr), iResult));
-		    TclDecrRefCount(valuePtr);
+		char *s1, *s2;
+		int s1len, s2len, iResult;
+
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+
+		s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
+		/*
+		 * Compare up to the minimum byte length
+		 */
+		iResult = memcmp(s1, s2,
+			(size_t) ((s1len < s2len) ? s1len : s2len));
+		if (iResult == 0) {
+		    iResult = s1len - s2len;
+		}
+
+		PUSH_OBJECT(Tcl_NewIntObj(iResult));
+		TRACE(("%.20s %.20s => %d\n",
+			O2S(valuePtr), O2S(value2Ptr), iResult));
+		TclDecrRefCount(valuePtr);
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+
+       case INST_STR_LEN:
+	    {
+		int length1;
+		 
+		valuePtr = POP_OBJECT();
+
+		if (valuePtr->typePtr == &tclByteArrayType) {
+		    (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
+		} else {
+		    length1 = Tcl_GetCharLength(valuePtr);
+		}
+		PUSH_OBJECT(Tcl_NewIntObj(length1));
+		TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
+		TclDecrRefCount(valuePtr);
+	    }
+	    ADJUST_PC(1);
+	    
+       case INST_STR_INDEX:
+	    {
+		/*
+		 * String compare
+		 */
+		int index;
+		bytes = NULL; /* lint */
+
+		value2Ptr = POP_OBJECT();
+		valuePtr  = POP_OBJECT();
+
+		/*
+		 * If we have a ByteArray object, avoid indexing in the
+		 * Utf string since the byte array contains one byte per
+		 * character.  Otherwise, use the Unicode string rep to
+		 * get the index'th char.
+		 */
+
+		if (valuePtr->typePtr == &tclByteArrayType) {
+		    bytes = Tcl_GetByteArrayFromObj(valuePtr, &length);
+		} else {
+		    /*
+		     * Get Unicode char length to calulate what 'end' means.
+		     */
+		    length = Tcl_GetCharLength(valuePtr);
+		}
+
+		result = TclGetIntForIndex(interp, value2Ptr, length - 1,
+			&index);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(value2Ptr);
+		    Tcl_DecrRefCount(valuePtr);
+		    goto checkForCatch;
+		}
+
+		if ((index >= 0) && (index < length)) {
+		    if (valuePtr->typePtr == &tclByteArrayType) {
+			objPtr = Tcl_NewByteArrayObj((unsigned char *)
+				(&bytes[index]), 1);
+		    } else {
+			char buf[TCL_UTF_MAX];
+			Tcl_UniChar ch;
+
+			ch     = Tcl_GetUniChar(valuePtr, index);
+			length = Tcl_UniCharToUtf(ch, buf);
+			objPtr = Tcl_NewStringObj(buf, length);
+		    }
+		} else {
+		    objPtr = Tcl_NewObj();
+		}
+
+		PUSH_OBJECT(objPtr);
+		TRACE(("%.20s %.20s => %s\n",
+			O2S(valuePtr), O2S(value2Ptr), O2S(objPtr)));
+		TclDecrRefCount(valuePtr);
+		TclDecrRefCount(value2Ptr);
+	    }
+	    ADJUST_PC(1);
+
+	case INST_STR_MATCH:
+	    {
+		int nocase, match;
+
+		valuePtr  = POP_OBJECT();	/* String */
+		value2Ptr = POP_OBJECT();	/* Pattern */
+		objPtr    = POP_OBJECT();	/* Case Sensitivity */
+
+		Tcl_GetBooleanFromObj(interp, objPtr, &nocase);
+		match = Tcl_UniCharCaseMatch(Tcl_GetUnicode(valuePtr),
+			Tcl_GetUnicode(value2Ptr), nocase);
+
+		/*
+		 * Reuse the casePtr object already on stack if possible.
+		 */
+
+		TRACE(("%.20s %.20s => %d\n",
+			O2S(valuePtr), O2S(value2Ptr), match));
+		if (Tcl_IsShared(objPtr)) {
+		    PUSH_OBJECT(Tcl_NewIntObj(match));
+		    TclDecrRefCount(objPtr);
 		} else {	/* reuse the valuePtr object */
-		    TRACE(("%.20s %.20s => %ld\n",
-			    O2S(valuePtr), O2S(value2Ptr), iResult));
-		    Tcl_SetLongObj(valuePtr, iResult);
+		    Tcl_SetIntObj(objPtr, match);
 		    ++stackTop; /* valuePtr now on stk top has right r.c. */
 		}
+		TclDecrRefCount(valuePtr);
 		TclDecrRefCount(value2Ptr);
 	    }
 	    ADJUST_PC(1);
 
-       case INST_STRLEN:
-           {
-	       int length1;
-	       valuePtr = POP_OBJECT();
-	       if (valuePtr->typePtr == &tclByteArrayType) {
-		   (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
-	       } else {
-		   length1 = Tcl_GetCharLength(valuePtr);
-	       }
-	       if (Tcl_IsShared(valuePtr)) {
-		   PUSH_OBJECT(Tcl_NewIntObj(length1));
-		   TclDecrRefCount(valuePtr);
-	       } else {
-		   Tcl_SetIntObj(valuePtr, length1);
-		   ++stackTop;
-	       }
-	   }
-	   ADJUST_PC(1);
-	    
 	case INST_EQ:
 	case INST_NEQ:
 	case INST_LT:
@@ -4519,7 +4624,7 @@ EvalStatsCmd(unused, interp, argc, argv)
     fprintf(stdout, "  Mean code/source		%.1f\n",
 	    totalCodeBytes / statsPtr->totalSrcBytes);
 
-    fprintf(stdout, "\nCurrent ByteCodes		%ld\n",
+    fprintf(stdout, "\nCurrent (active) ByteCodes	%ld\n",
 	    numCurrentByteCodes);
     fprintf(stdout, "  Source bytes			%.6g\n",
 	    statsPtr->currentSrcBytes);
@@ -4542,6 +4647,29 @@ EvalStatsCmd(unused, interp, argc, argv)
 	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
 
     /*
+     * Tcl_IsShared statistics check
+     *
+     * This gives the refcount of each obj as Tcl_IsShared was called
+     * for it.  Shared objects must be duplicated before they can be
+     * modified.
+     */
+
+    numSharedMultX = 0;
+    fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
+    fprintf(stdout, "  Object had refcount <=1 (not shared)	%ld\n",
+	    tclObjsShared[1]);
+    for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
+	fprintf(stdout, "  refcount ==%d		%ld\n",
+		i, tclObjsShared[i]);
+	numSharedMultX += tclObjsShared[i];
+    }
+    fprintf(stdout, "  refcount >=%d		%ld\n",
+	    i, tclObjsShared[0]);
+    numSharedMultX += tclObjsShared[0];
+    fprintf(stdout, "  Total shared objects			%d\n",
+	    numSharedMultX);
+
+    /*
      * Literal table statistics.
      */
 
@@ -4581,7 +4709,7 @@ EvalStatsCmd(unused, interp, argc, argv)
 	    (tclObjsAlloced - tclObjsFreed));
     fprintf(stdout, "Total literal objects		%ld\n",
 	    statsPtr->numLiteralsCreated);
-    
+
     fprintf(stdout, "\nCurrent literal objects		%d (%0.1f%% of current objects)\n",
 	    globalTablePtr->numEntries,
 	    (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
@@ -4732,7 +4860,7 @@ EvalStatsCmd(unused, interp, argc, argv)
 		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
     }
 
-    fprintf(stdout, "\nByteCode longevity (excludes current ByteCodes):\n");
+    fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
     fprintf(stdout, "	       Up to ms		Percentage\n");
     minSizeDecade = maxSizeDecade = 0;
     for (i = 0;  i < 31;  i++) {