summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-05-10 12:57:38 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-05-10 12:57:38 (GMT)
commit9571165813914daaf16bd8fb71b4f97e7affa1d6 (patch)
treee3a3f746b8489114553d023b0be33b4398e8d308 /generic/tclCompCmds.c
parentebbffb3ea5b1b5609e3fb86ddea543aa3d24693d (diff)
downloadtcl-9571165813914daaf16bd8fb71b4f97e7affa1d6.zip
tcl-9571165813914daaf16bd8fb71b4f97e7affa1d6.tar.gz
tcl-9571165813914daaf16bd8fb71b4f97e7affa1d6.tar.bz2
Optimizations and general bytecode generation improvements.
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c199
1 files changed, 170 insertions, 29 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index f6ca0e0..9ffdbc3 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -155,7 +155,7 @@ TclCompileAppendCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
- int simpleVarName, isScalar, localIndex, numWords;
+ int simpleVarName, isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
numWords = parsePtr->numWords;
@@ -169,10 +169,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;
}
/*
@@ -222,6 +223,42 @@ TclCompileAppendCmd(
}
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.
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &simpleVarName, &isScalar, 1);
+ if (!isScalar || 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;
}
/*
@@ -4067,8 +4104,8 @@ TclCompileLappendCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *varTokenPtr;
- int simpleVarName, isScalar, localIndex, numWords;
+ Tcl_Token *varTokenPtr, *valueTokenPtr;
+ int simpleVarName, isScalar, localIndex, numWords, i, fwd, offsetFwd;
DefineLineInformation; /* TIP #280 */
/*
@@ -4085,10 +4122,11 @@ TclCompileLappendCmd(
}
if (numWords != 3) {
/*
- * LAPPEND instructions currently only handle one value appends.
+ * LAPPEND instructions currently only handle one value, but we can
+ * handle some multi-value cases by stringing them together.
*/
- return TCL_ERROR;
+ goto lappendMultiple;
}
/*
@@ -4141,6 +4179,45 @@ TclCompileLappendCmd(
}
return TCL_OK;
+
+ lappendMultiple:
+ /*
+ * Can only handle the case where we are appending to a local scalar when
+ * there are multiple values to append. Fortunately, this is common.
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_ERROR;
+ }
+ varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+ &localIndex, &simpleVarName, &isScalar, 1);
+ if (!isScalar || 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_LIST, numWords-2, envPtr);
+ TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitOpcode( INST_LIST_CONCAT, envPtr);
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
+
+ return TCL_OK;
}
/*
@@ -4390,14 +4467,7 @@ TclCompileListCmd(
DefineLineInformation; /* TIP #280 */
Tcl_Token *valueTokenPtr;
int i, numWords;
-
- /*
- * If we're not in a procedure, don't compile.
- */
-
- if (envPtr->procPtr == NULL) {
- return TCL_ERROR;
- }
+ Tcl_Obj *listObj, *objPtr;
if (parsePtr->numWords == 1) {
/*
@@ -4405,20 +4475,57 @@ TclCompileListCmd(
*/
PushLiteral(envPtr, "", 0);
- } else {
- /*
- * Push the all values onto the stack.
- */
+ 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);
- for (i = 1; i < numWords; i++) {
- CompileWord(envPtr, valueTokenPtr, interp, i);
- valueTokenPtr = TokenAfter(valueTokenPtr);
+ 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;
}
- TclEmitInstInt4( INST_LIST, numWords - 1, envPtr);
+ valueTokenPtr = TokenAfter(valueTokenPtr);
}
+ if (listObj != NULL) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(listObj, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(listObj);
+ if (len > 0) {
+ /*
+ * Force list interpretation!
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Push the all values onto the stack.
+ */
+
+ numWords = parsePtr->numWords;
+ valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i = 1; i < numWords; i++) {
+ CompileWord(envPtr, valueTokenPtr, interp, i);
+ valueTokenPtr = TokenAfter(valueTokenPtr);
+ }
+ TclEmitInstInt4( INST_LIST, numWords - 1, envPtr);
return TCL_OK;
}
@@ -5578,15 +5685,20 @@ TclCompileReturnCmd(
objv[objc] = Tcl_NewObj();
Tcl_IncrRefCount(objv[objc]);
if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
- objc++;
- status = TCL_ERROR;
- goto cleanup;
+ /*
+ * Non-literal, so punt to run-time.
+ */
+
+ for (; objc>=0 ; objc--) {
+ TclDecrRefCount(objv[objc]);
+ }
+ TclStackFree(interp, objv);
+ goto issueRuntimeReturn;
}
wordTokenPtr = TokenAfter(wordTokenPtr);
}
status = TclMergeReturnOptions(interp, objc, objv,
&returnOpts, &code, &level);
- cleanup:
while (--objc >= 0) {
TclDecrRefCount(objv[objc]);
}
@@ -5667,6 +5779,35 @@ TclCompileReturnCmd(
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 {
+ PushLiteral(envPtr, "", 0);
+ }
+
+ /*
+ * Issue the RETURN itself.
+ */
+
+ TclEmitOpcode(INST_RETURN_STK, envPtr);
+ return TCL_OK;
}
static void