summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCompCmds.c64
-rw-r--r--generic/tclCompCmdsSZ.c6
-rw-r--r--generic/tclExecute.c19
-rw-r--r--generic/tclInt.h3
5 files changed, 83 insertions, 11 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 46b532b..8527b1a 100644
--- a/generic/tclBasic.c
+++ b/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},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d1d7a80..2140789 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2209,6 +2209,70 @@ TclCompileErrorCmd(
/*
*----------------------------------------------------------------------
*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileExprCmd --
*
* Procedure called to compile the "expr" command.
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 639b4a5..8f5b60d 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/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;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 58d85e1..d65469c 100644
--- a/generic/tclExecute.c
+++ b/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:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a9f4c16..d3f77b8 100644
--- a/generic/tclInt.h
+++ b/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);
generated by cgit v0.12 at 2025-06-01 02:41:41 (GMT)