Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.98
diff -u -r1.98 tclCmdMZ.c
--- generic/tclCmdMZ.c	24 Dec 2003 04:18:18 -0000	1.98
+++ generic/tclCmdMZ.c	13 Jan 2004 22:20:33 -0000
@@ -844,29 +844,138 @@
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
     int code, level;
+    Tcl_Obj *returnOpts;
+
+    /*
+     * General syntax: [return ?-option value ...? ?result?]
+     * An even number of words means an explicit result argument is present.
+     */
+    int explicitResult = (0 == (objc % 2));
+    int numOptionWords = objc - 1 - explicitResult;
+
+    if (TCL_ERROR == TclMergeReturnOptions(interp, numOptionWords, objv+1,
+	    &returnOpts, &code, &level)) {
+	return TCL_ERROR;
+    }
+
+    code = TclProcessReturn(interp, code, level, returnOpts);
+    if (explicitResult) {
+	Tcl_SetObjResult(interp, objv[objc-1]);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcessReturn --
+ *
+ *	Does the work of the [return] command based on the code,
+ *	level, and returnOpts arguments.  Note that the code argument
+ *	must agree with the -code entry in returnOpts and the level
+ *	argument must agree with the -level entry in returnOpts, as
+ *	is the case for values returned from TclMergeReturnOptions.
+ *
+ * Results:
+ *	Returns the return code the [return] command should return.
+ *
+ * Side effects:
+ *	When the return code is TCL_ERROR, the values of ::errorInfo
+ *	and ::errorCode may be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclProcessReturn(interp, code, level, returnOpts)
+    Tcl_Interp *interp;
+    int code;
+    int level;
+    Tcl_Obj *returnOpts;
+{
+    Interp *iPtr = (Interp *) interp;
     Tcl_Obj *valuePtr;
 
-    /* Start with the default options */
-    if (iPtr->returnOpts != iPtr->defaultReturnOpts) {
+    /* Store the merged return options */
+    if (iPtr->returnOpts != returnOpts) {
 	Tcl_DecrRefCount(iPtr->returnOpts);
-	iPtr->returnOpts = iPtr->defaultReturnOpts;
+	iPtr->returnOpts = returnOpts;
 	Tcl_IncrRefCount(iPtr->returnOpts);
     }
 
-    objv++, objc--;
-    if (objc) {
-	/* We're going to add our options, so manage Tcl_Obj sharing */
-	Tcl_DecrRefCount(iPtr->returnOpts);
-	iPtr->returnOpts = Tcl_DuplicateObj(iPtr->returnOpts);
-	Tcl_IncrRefCount(iPtr->returnOpts);
+    if (level == 0) {
+	if (code == TCL_ERROR) {
+	    valuePtr = NULL;
+	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
+		    iPtr->returnErrorinfoKey, &valuePtr);
+	    if (valuePtr != NULL) {
+		int infoLen;
+		CONST char *info = Tcl_GetStringFromObj(valuePtr,&infoLen);
+		if (infoLen) {
+		    Tcl_AddObjErrorInfo(interp, info, infoLen);
+		    iPtr->flags |= ERR_ALREADY_LOGGED;
+		}
+	    }
+	    valuePtr = NULL;
+	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
+		    iPtr->returnErrorcodeKey, &valuePtr);
+	    if (valuePtr != NULL) {
+		Tcl_SetVar2Ex(interp, "errorCode", NULL,
+			valuePtr, TCL_GLOBAL_ONLY);
+		iPtr->flags |= ERROR_CODE_SET;
+	    }
+	}
+    } else {
+	code = TCL_RETURN;
     }
-    
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMergeReturnOptions --
+ *
+ *	Parses, checks, and stores the options to the [return] command.
+ *
+ * Results:
+ *	Returns TCL_ERROR is any of the option values are invalid.
+ *	Otherwise, returns TCL_OK, and writes the returnOpts, code,
+ *	and level values to the pointers provided.
+ *
+ * Side effects:
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+    Tcl_Obj **optionsPtrPtr;	/* If not NULL, points to space for a
+				 * (Tcl_Obj *) where the pointer to the
+				 * merged return options dictionary should
+				 * be written */
+    int *codePtr;		/* If not NULL, points to space where the
+				 * -code value should be written */
+    int *levelPtr;		/* If not NULL, points to space where the
+				 * -level value should be written */
+{
+    Interp *iPtr = (Interp *) interp;
+    int code, level, size;
+    Tcl_Obj *valuePtr;
+    Tcl_Obj *returnOpts = Tcl_DuplicateObj(iPtr->defaultReturnOpts);
+
     for (;  objc > 1;  objv += 2, objc -= 2) {
 	int optLen;
 	CONST char *opt = Tcl_GetStringFromObj(objv[0], &optLen);
-	if ((optLen == 8) && (*opt == '-') && (strcmp(opt, "-options") == 0)) {
+	int compareLen;
+	CONST char *compare =
+		Tcl_GetStringFromObj(iPtr->returnOptionsKey, &compareLen);
+
+	if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) {
 	    Tcl_DictSearch search;
 	    int done = 0;
 	    Tcl_Obj *keyPtr;
@@ -876,38 +985,33 @@
 	    if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict,
 		    &search, &keyPtr, &valuePtr, &done)) {
 		/* Value is not a legal dictionary */
-		Tcl_DecrRefCount(iPtr->returnOpts);
-		iPtr->returnOpts = iPtr->defaultReturnOpts;
-		Tcl_IncrRefCount(iPtr->returnOpts);
 		Tcl_ResetResult(interp);
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"bad -options value: expected dictionary but got \"",
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad ",
+			compare, " value: expected dictionary but got \"",
 			Tcl_GetString(objv[1]), "\"", (char *) NULL);
 		return TCL_ERROR;
 	    }
 
 	    while (!done) {
-		Tcl_DictObjPut(NULL, iPtr->returnOpts, keyPtr, valuePtr);
+		Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr);
 		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
 	    }
 
 	    valuePtr = NULL;
-	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
-		    iPtr->returnOptionsKey, &valuePtr);
+	    Tcl_DictObjGet(NULL, returnOpts, iPtr->returnOptionsKey, &valuePtr);
 	    if (valuePtr != NULL) {
 		dict = valuePtr;
-		Tcl_DictObjRemove(NULL, iPtr->returnOpts,
-			iPtr->returnOptionsKey);
+		Tcl_DictObjRemove(NULL, returnOpts, iPtr->returnOptionsKey);
 		goto nestedOptions;
 	    }
 
 	} else {
-	    Tcl_DictObjPut(NULL, iPtr->returnOpts, objv[0], objv[1]);
+	    Tcl_DictObjPut(NULL, returnOpts, objv[0], objv[1]);
 	}
     }
 
     /* Check for bogus -code value */
-    Tcl_DictObjGet(NULL, iPtr->returnOpts, iPtr->returnCodeKey, &valuePtr);
+    Tcl_DictObjGet(NULL, returnOpts, iPtr->returnCodeKey, &valuePtr);
     if (TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &code)) {
 	static CONST char *returnCodes[] = {
 	    "ok", "error", "return", "break", "continue", NULL
@@ -916,9 +1020,6 @@
 	if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
 		NULL, TCL_EXACT, &code)) {
 	    /* Value is not a legal return code */
-	    Tcl_DecrRefCount(iPtr->returnOpts);
-	    iPtr->returnOpts = iPtr->defaultReturnOpts;
-	    Tcl_IncrRefCount(iPtr->returnOpts);
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		    "bad completion code \"",
@@ -928,17 +1029,14 @@
 	    return TCL_ERROR;
 	}
 	/* Have a legal string value for a return code; convert to integer */
-	Tcl_DictObjPut(NULL, iPtr->returnOpts,
+	Tcl_DictObjPut(NULL, returnOpts,
 		iPtr->returnCodeKey, Tcl_NewIntObj(code));
     }
 
     /* Check for bogus -level value */
-    Tcl_DictObjGet(NULL, iPtr->returnOpts, iPtr->returnLevelKey, &valuePtr);
+    Tcl_DictObjGet(NULL, returnOpts, iPtr->returnLevelKey, &valuePtr);
     if (TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &level) || (level < 0)) {
 	/* Value is not a legal level */
-	Tcl_DecrRefCount(iPtr->returnOpts);
-	iPtr->returnOpts = iPtr->defaultReturnOpts;
-	Tcl_IncrRefCount(iPtr->returnOpts);
 	Tcl_ResetResult(interp);
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad -level value: expected non-negative integer but got \"",
@@ -952,43 +1050,35 @@
      */
     if (code == TCL_RETURN) {
 	level++;
-	Tcl_DictObjPut(NULL, iPtr->returnOpts,
+	Tcl_DictObjPut(NULL, returnOpts,
 		iPtr->returnLevelKey, Tcl_NewIntObj(level));
-	Tcl_DictObjPut(NULL, iPtr->returnOpts,
+	Tcl_DictObjPut(NULL, returnOpts,
 		iPtr->returnCodeKey, Tcl_NewIntObj(TCL_OK));
     }
 
-    if (level == 0) {
-	if (code == TCL_ERROR) {
-	    valuePtr = NULL;
-	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
-		    iPtr->returnErrorinfoKey, &valuePtr);
-	    if (valuePtr != NULL) {
-		int infoLen;
-		CONST char *info = Tcl_GetStringFromObj(valuePtr,&infoLen);
-		if (infoLen) {
-		    Tcl_AddObjErrorInfo(interp, info, infoLen);
-		    iPtr->flags |= ERR_ALREADY_LOGGED;
-		}
-	    }
-	    valuePtr = NULL;
-	    Tcl_DictObjGet(NULL, iPtr->returnOpts,
-		    iPtr->returnErrorcodeKey, &valuePtr);
-	    if (valuePtr != NULL) {
-		Tcl_SetVar2Ex(interp, "errorCode", NULL,
-			valuePtr, TCL_GLOBAL_ONLY);
-		iPtr->flags |= ERROR_CODE_SET;
-	    }
-	}
+    /*
+     * Check if we just have the default options.  If so, use them.
+     * A dictionary equality test would be more robust, but seems
+     * tricky, to say the least.
+     */
+    Tcl_DictObjSize(NULL, returnOpts, &size);
+    if (size == 2 && code == TCL_OK && level == 1) {
+	Tcl_DecrRefCount(returnOpts);
+	returnOpts = iPtr->defaultReturnOpts;
+    }
+    if (codePtr != NULL) {
+	*codePtr = code;
+    }
+    if (levelPtr != NULL) {
+	*levelPtr = level;
+    }
+    if ((optionsPtrPtr == NULL) && (returnOpts != iPtr->defaultReturnOpts)) {
+	/* not passing back the options (?!), so clean them up */
+	Tcl_DecrRefCount(returnOpts);
     } else {
-	code = TCL_RETURN;
+	*optionsPtrPtr = returnOpts;
     }
-
-    if (objc == 1) {
-	Tcl_SetObjResult(interp, objv[0]);
-    }
-    return code;
-
+    return TCL_OK;
 }
 
 /*
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.52
diff -u -r1.52 tclCompCmds.c
--- generic/tclCompCmds.c	24 Dec 2003 04:18:19 -0000	1.52
+++ generic/tclCompCmds.c	13 Jan 2004 22:20:34 -0000
@@ -2346,12 +2346,9 @@
  *
  * Results:
  *	The return value is a standard Tcl result, which is TCL_OK if the
- *	compilation was successful.  If the particular return command is
- *	too complex for this function (ie, return with any flags like "-code"
- *	or "-errorinfo"), TCL_OUT_LINE_COMPILE is returned, indicating that
- *	the command should be compiled "out of line" (eg, not byte compiled).
- *	If an error occurs then the interpreter's result contains a standard
- *	error message.
+ *	compilation was successful.  If analysis concludes that the
+ *	command cannot be bytecompiled effectively, a return code of
+ *	TCL__OUT_LINE_COMPILE is returned.
  *
  * Side effects:
  *	Instructions are added to envPtr to execute the "return" command
@@ -2367,65 +2364,114 @@
 				 * command created by Tcl_ParseCommand. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
-    Tcl_Token *varTokenPtr;
-    int code;
+    /*
+     * General syntax: [return ?-option value ...? ?result?]
+     * An even number of words means an explicit result argument is present.
+     */
+    int level = 1, code = TCL_OK, status = TCL_OK;
+    int numWords = parsePtr->numWords;
+    int explicitResult = (0 == (numWords % 2));
+    int numOptionWords = numWords - 1 - explicitResult;
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *returnOpts = iPtr->defaultReturnOpts;
+    Tcl_Token *wordTokenPtr = parsePtr->tokenPtr
+		+ (parsePtr->tokenPtr->numComponents + 1);
 
-    switch (parsePtr->numWords) {
-	case 1: {
-	    /*
-	     * Simple case:  [return]
-	     * Just push the literal string "".
-	     */
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
-	    break;
+    if (numOptionWords > 0) {
+	/* 
+	 * 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.
+	 */
+	int objc;
+	Tcl_Obj **objv = (Tcl_Obj **)
+		ckalloc(numOptionWords * sizeof(Tcl_Obj *));
+	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;
+	    }
+	    wordTokenPtr += wordTokenPtr->numComponents + 1;
+	}
+	status = TclMergeReturnOptions(interp, objc, objv,
+		&returnOpts, &code, &level);
+    cleanup:
+	while (--objc >= 0) {
+	    Tcl_DecrRefCount(objv[objc]);
+	}
+	ckfree((char *)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_OUT_LINE_COMPILE;
 	}
-	case 2: {
-	    /*
-	     * More complex cases:
-	     * [return "foo"]
-	     * [return $value]
-	     * [return [otherCmd]]
-	     */
-	    varTokenPtr = parsePtr->tokenPtr
-		+ (parsePtr->tokenPtr->numComponents + 1);
-	    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-		/*
-		 * [return "foo"] case:  the parse token is a simple word,
-		 * so just push it.
-		 */
-		TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
-			varTokenPtr[1].size), envPtr);
-	    } else {
-		/*
-		 * Parse token is more complex, so compile it; this handles the
-		 * variable reference and nested command cases.  If the
-		 * parse token can be byte-compiled, then this instance of
-		 * "return" will be byte-compiled; otherwise it will be
-		 * out line compiled.
-		 */
-		code = TclCompileTokens(interp, varTokenPtr+1,
-			varTokenPtr->numComponents, envPtr);
-		if (code != TCL_OK) {
-		    return code;
-		}
+    }
+
+    /* All options are known at compile time, so we're going to
+     * bytecompile.   Emit instructions to push the result on
+     * the stack */
+
+    if (explicitResult) {
+	if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    /* Explicit result is a simple word, so we can compile quickly to
+	     * a simple push */
+	    TclEmitPush(TclRegisterNewLiteral(envPtr, wordTokenPtr[1].start,
+			wordTokenPtr[1].size), envPtr);
+	} else {
+	    /* More complex tokens get compiled */
+	    status = TclCompileTokens(interp, wordTokenPtr+1,
+		    wordTokenPtr->numComponents, envPtr);
+	    if (TCL_OK != status) {
+		return status;
 	    }
-	    break;
 	}
-	default: {
-	    /*
-	     * Most complex return cases: everything else, including
-	     * [return -code error], etc.
-	     */
-	    return TCL_OUT_LINE_COMPILE;
+    } else {
+	/* No explict result argument, so default result is empty string */
+	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+    }
+
+    /* 
+     * Check for optimization:  When [return] is in a proc, and there's
+     * no enclosing [catch], and the default return options are in effect,
+     * then the INST_DONE instruction is equivalent, and considerably more
+     * efficient.
+     */
+    if (returnOpts == iPtr->defaultReturnOpts) {
+	/* We have default return options... */
+	if (envPtr->procPtr != NULL) {
+	    /* ... 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. */
+		TclEmitOpcode(INST_DONE, envPtr);
+		return TCL_OK;
+	    }
 	}
     }
 
     /*
-     * The INST_RETURN opcode triggers the branching out of the
-     * subroutine, and takes the top stack item as the return result
-     * (which is why we pushed the value above).
-     */
-    TclEmitOpcode(INST_RETURN, envPtr);
+     * Could not use the optimization, so we push the return options
+     * dictionary, and emit the INST_RETURN instruction with code
+     * and level as operands.
+     */
+    TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
+    TclEmitInstInt4(INST_RETURN, code, envPtr);
+    TclEmitInt4(level, envPtr);
     return TCL_OK;
 }
 
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.55
diff -u -r1.55 tclCompile.c
--- generic/tclCompile.c	24 Dec 2003 04:18:19 -0000	1.55
+++ generic/tclCompile.c	13 Jan 2004 22:20:34 -0000
@@ -269,8 +269,9 @@
 	 * stacked objs: stktop is old value, next is new element value, next 
 	 * come (operand-2) indices; pushes the new value.
 	 */
-    {"return",		  1,   -1,          0,   {OPERAND_NONE}},
-	/* return TCL_RETURN code. */
+    {"return",		  1,   -2,          2,   {OPERAND_INT4, OPERAND_UINT4}},
+	/* Compiled [return], code, level are operands; options and result
+	 * are on the stack. */
     {"expon",		  1,   -1,	    0,	 {OPERAND_NONE}},
 	/* Binary exponentiation operator: push (stknext ** stktop) */
     {"listverify",	  1,    0,	    0,   {OPERAND_NONE}},
@@ -781,6 +782,85 @@
 /*
  *----------------------------------------------------------------------
  *
+ * TclWordKnownAtCompileTime --
+ *
+ *	Test whether the value of a token is completely known at compile
+ *	time.
+ *
+ * Results:
+ *	Returns true if the tokenPtr argument points to a word value that
+ *	is completely known at compile time.  Generally, values that are
+ *	known at compile time can be compiled to their values, while values
+ *	that cannot be	known until substitution at runtime must be compiled
+ *	to bytecode instructions that perform that substitution.  For several
+ *	commands, whether or not arguments are known at compile time determine
+ *	whether it is worthwhile to compile at all.
+ *
+ * Side effects:
+ *	When returning true, appends the known value of the word to
+ *	the unshared Tcl_Obj (*valuePtr), unless valuePtr is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclWordKnownAtCompileTime(tokenPtr, valuePtr)
+    Tcl_Token *tokenPtr;	/* Points to Tcl_Token we should check */
+    Tcl_Obj *valuePtr;		/* If not NULL, points to an unshared Tcl_Obj
+				 * to which we should append the known value
+				 * of the word. */
+{
+    int numComponents = tokenPtr->numComponents;
+    Tcl_Obj *tempPtr = NULL;
+
+    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	if (valuePtr != NULL) {
+	    Tcl_AppendToObj(valuePtr, tokenPtr->start, tokenPtr->size);
+	}
+	return 1;
+    }
+    if (tokenPtr->type != TCL_TOKEN_WORD) {
+	return 0;
+    }
+    tokenPtr++;
+    if (valuePtr != NULL) {
+	tempPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(tempPtr);
+    }
+    while (numComponents--) {
+	switch (tokenPtr->type) {
+	    case TCL_TOKEN_TEXT:
+		if (tempPtr != NULL) {
+		    Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
+		}
+		continue;
+
+	    case TCL_TOKEN_BS:
+		if (tempPtr != NULL) {
+		    char utfBuf[TCL_UTF_MAX];
+		    int length = 
+			    Tcl_UtfBackslash(tokenPtr->start, NULL, utfBuf);
+		    Tcl_AppendToObj(tempPtr, utfBuf, length);
+		}
+		continue;
+	    
+	    default:
+		if (tempPtr != NULL) {
+		    Tcl_DecrRefCount(tempPtr);
+		}
+		return 0;
+	}
+    }
+    if (valuePtr != NULL) {
+	Tcl_AppendObjToObj(valuePtr, tempPtr);
+	Tcl_DecrRefCount(tempPtr);
+    }
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileScript --
  *
  *	Compile a Tcl script in a string.
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.39
diff -u -r1.39 tclCompile.h
--- generic/tclCompile.h	14 Nov 2003 20:44:44 -0000	1.39
+++ generic/tclCompile.h	13 Jan 2004 22:20:34 -0000
@@ -828,6 +828,8 @@
 #endif
 EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr));
+EXTERN int		TclWordKnownAtCompileTime _ANSI_ARGS_((
+			    Tcl_Token *tokenPtr, Tcl_Obj *valuePtr));
 
 /*
  *----------------------------------------------------------------
@@ -885,10 +887,11 @@
     TclUpdateStackReqs(op, 0, envPtr)
 
 /*
- * Macro to emit an integer operand.
- * The ANSI C "prototype" for this macro is:
+ * Macros to emit an integer operand.
+ * The ANSI C "prototype" for these macros are:
  *
  * EXTERN void	TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ * EXTERN void	TclEmitInt4 _ANSI_ARGS_((int i, CompileEnv *envPtr));
  */
 
 #define TclEmitInt1(i, envPtr) \
@@ -896,6 +899,19 @@
         TclExpandCodeArray(envPtr); \
     *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
 
+#define TclEmitInt4(i, envPtr) \
+    if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
+        TclExpandCodeArray(envPtr); \
+    } \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 24); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >> 16); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i) >>  8); \
+    *(envPtr)->codeNext++ = \
+        (unsigned char) ((unsigned int) (i)      )
+
 /*
  * Macros to emit an instruction with signed or unsigned integer operands.
  * Four byte integers are stored in "big-endian" order with the high order
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.119
diff -u -r1.119 tclExecute.c
--- generic/tclExecute.c	12 Jan 2004 03:23:31 -0000	1.119
+++ generic/tclExecute.c	13 Jan 2004 22:20:35 -0000
@@ -1231,12 +1231,23 @@
 
     switch (*pc) {
     case INST_RETURN:
-	if (iPtr->returnOpts != iPtr->defaultReturnOpts) {
-	    Tcl_DecrRefCount(iPtr->returnOpts);
-	    iPtr->returnOpts = iPtr->defaultReturnOpts;
-	    Tcl_IncrRefCount(iPtr->returnOpts);
+	{
+	    int code = TclGetInt4AtPtr(pc+1);
+	    int level = TclGetUInt4AtPtr(pc+5);
+	    Tcl_Obj *returnOpts = POP_OBJECT();
+
+	    DECACHE_STACK_INFO();
+	    Tcl_ResetResult(interp);
+	    result = TclProcessReturn(interp, code, level, returnOpts);
+	    CACHE_STACK_INFO();
+	    Tcl_DecrRefCount(returnOpts);
+	    if (result != TCL_OK) {
+		Tcl_SetObjResult(interp, *tosPtr);
+		cleanup = 1;
+		goto processExceptionReturn;
+	    }
+	    NEXT_INST_F(9, 0, 0);
 	}
-	result = TCL_RETURN;
 
     case INST_DONE:
 	if (tosPtr <= eePtr->stackPtr + initStackTop) {
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.139
diff -u -r1.139 tclInt.h
--- generic/tclInt.h	24 Dec 2003 04:20:05 -0000	1.139
+++ generic/tclInt.h	13 Jan 2004 22:20:35 -0000
@@ -1702,6 +1702,10 @@
 						 Tcl_Obj *CONST indexArray[],
 						 Tcl_Obj* valuePtr
 						 ));
+EXTERN int		TclMergeReturnOptions _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[],
+			    Tcl_Obj **optionsPtrPtr, int *codePtr,
+			    int *levelPtr));
 EXTERN int              TclParseBackslash _ANSI_ARGS_((CONST char *src,
                             int numBytes, int *readPtr, char *dst));
 EXTERN int		TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes,
@@ -1710,6 +1714,8 @@
 			    int numBytes));
 EXTERN int		TclParseWhiteSpace _ANSI_ARGS_((CONST char *src,
 			    int numBytes, Tcl_Parse *parsePtr, char *typePtr));
+EXTERN int		TclProcessReturn _ANSI_ARGS_((Tcl_Interp *interp,
+			    int code, int level, Tcl_Obj *returnOpts));
 EXTERN int		TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename,
 			    int mode));
 EXTERN int              TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, 
