merge main working branch

generic/tclBasic.c

@@ -215,7 +215,7 @@ static const CmdInfo builtInCmds[] = {
     {"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},
+    {"eval",		Tcl_EvalObjCmd,		TclCompileEvalCmd,	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},

generic/tclCompCmds.c

@@ -2206,6 +2206,70 @@ TclCompileErrorCmd(
     return TCL_OK;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileEvalCmd --
+ *
+ *	Procedure called to compile the "eval" 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 "eval" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileEvalCmd(
+    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. */
+{
+    Tcl_Token *tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    int i;
+
+    /*
+     * Error case: no arguments at all.
+     */
+
+    if (parsePtr->numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    /*
+     * Must push, concatenate (when more than one word) and eval. Note that
+     * when we evaluate, we must first duplicate to ensure that a reference to
+     * the script is kept for the duration of the evaluation.
+     */
+
+    for (i=1 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+
+    if (i > 2) {
+	TclEmitInstInt4(	INST_CONCAT_STK, i-1,		envPtr);
+    }
+
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitOpcode(		INST_EVAL_STK,			envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+
+    return TCL_OK;
+}
+
 /*
  *----------------------------------------------------------------------
  *

generic/tclCompCmdsSZ.c

@@ -1088,7 +1088,7 @@ TclCompileStringTrimLCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	PushStringLiteral(envPtr, DEFAULT_TRIM_SET);
     }
     OP(			STR_TRIM_LEFT);
     return TCL_OK;
@@ -1116,7 +1116,7 @@ TclCompileStringTrimRCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	PushStringLiteral(envPtr, DEFAULT_TRIM_SET);
     }
     OP(			STR_TRIM_RIGHT);
     return TCL_OK;
@@ -1144,7 +1144,7 @@ TclCompileStringTrimCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	PushStringLiteral(envPtr, DEFAULT_TRIM_SET);
     }
     OP(			STR_TRIM);
     return TCL_OK;

generic/tclExecute.c

@@ -177,22 +177,24 @@ typedef struct TEBCdata {
     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. */
+    int numLevels;		/* 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);	\
+    do {							\
+	esPtr->tosPtr = tosPtr;					\
+	TD->numLevels = ((Interp *) interp)->numLevels;		\
+	TclNRAddCallback(interp, TEBCresume,			\
+		TD, pc, INT2PTR(cleanup), NULL);		\
     } while (0)
 
 #define TEBC_DATA_DIG() \
-    do {					\
-	tosPtr = esPtr->tosPtr;			\
+    do {							\
+	((Interp *) interp)->numLevels = TD->numLevels;		\
+	tosPtr = esPtr->tosPtr;					\
     } while (0)
 
 #define PUSH_TAUX_OBJ(objPtr) \
@@ -2084,6 +2086,7 @@ TclNRExecuteByteCode(
     TD->codePtr     = codePtr;
     TD->catchTop    = initCatchTop;
     TD->auxObjList  = NULL;
+    TD->numLevels   = ((Interp *) interp)->numLevels;
 
     /*
      * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
@@ -2980,6 +2983,7 @@ TEBCresume(
 	cleanup = 1;
 	pc++;
 	TEBC_YIELD();
+	((Interp *) interp)->numLevels++;
 	return TclNRExecuteByteCode(interp, newCodePtr);
     }
 
@@ -2995,6 +2999,7 @@ TEBCresume(
 	cleanup = 1;
 	pc += 1;
 	TEBC_YIELD();
+	((Interp *) interp)->numLevels++;
 	return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);
 
     case INST_INVOKE_EXPANDED:

generic/tclInt.h

@@ -3493,6 +3493,9 @@ MODULE_SCOPE int	TclCompileEnsemble(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileErrorCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileEvalCmd(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);