summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-10-26 08:25:02 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-10-26 08:25:02 (GMT)
commit9cc416d585cd447bebe8c27298198f3101b7d6f2 (patch)
tree2c6d109993ecaaac663957806936a709f271c448 /generic
parentf663a0f78dfd7409ced97e98402bb3c0419c5d4a (diff)
downloadtcl-9cc416d585cd447bebe8c27298198f3101b7d6f2.zip
tcl-9cc416d585cd447bebe8c27298198f3101b7d6f2.tar.gz
tcl-9cc416d585cd447bebe8c27298198f3101b7d6f2.tar.bz2
General [concat] compilation.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c5
-rw-r--r--generic/tclCompCmds.c12
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclCompile.h4
-rw-r--r--generic/tclExecute.c11
5 files changed, 33 insertions, 5 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index f709acb..b805c63 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -350,6 +350,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
{"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
{"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
+ {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1},
{"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
{"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
{"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
@@ -497,6 +498,7 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
INST_JUMP1, INST_JUMP4, /* 34-35 */
INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_LIST, /* 79 */
INST_OVER, /* 95 */
INST_PUSH_RETURN_OPTIONS, /* 108 */
INST_REVERSE, /* 126 */
@@ -507,7 +509,8 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_NS_CURRENT, /* 151 */
INST_INFO_LEVEL_NUM, /* 152 */
INST_RESOLVE_COMMAND, /* 154 */
- INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT /* 166-168 */
+ INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT, /* 166-168 */
+ INST_CONCAT_STK /* 169 */
};
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index a1ccd39..2f6cb96 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -779,10 +779,12 @@ TclCompileConcatCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ DefineLineInformation; /* TIP #280 */
Tcl_Obj *objPtr, *listObj;
Tcl_Token *tokenPtr;
int i;
+ /* TODO: Consider compiling expansion case. */
if (parsePtr->numWords == 1) {
/*
* [concat] without arguments just pushes an empty object.
@@ -827,8 +829,14 @@ TclCompileConcatCmd(
* General case: runtime concat.
*/
- // TODO
- return TCL_ERROR;
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
+ }
+
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
+ return TCL_OK;
}
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 48a5456..280bf64 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -561,6 +561,11 @@ InstructionDesc const tclInstructionTable[] = {
* pushes the resulting string.
* Stack: ... string charset => ... trimmedString */
+ {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
+ * is number of values to concatenate.
+ * Operation: push concat(stk1 stk2 ... stktop) */
+
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -4050,7 +4055,6 @@ TclEmitInvoke(
int savedStackDepth = envPtr->currStackDepth;
int savedExpandCount = envPtr->expandCount;
JumpFixup nonTrapFixup;
- ExceptionAux *exceptAux = envPtr->exceptAuxArrayPtr + loopRange;
if (auxBreakPtr != NULL) {
auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 62c41ea..4ae754c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -773,8 +773,10 @@ typedef struct ByteCode {
#define INST_STRTRIM_LEFT 167
#define INST_STRTRIM_RIGHT 168
+#define INST_CONCAT_STK 169
+
/* The last opcode */
-#define LAST_INST_OPCODE 168
+#define LAST_INST_OPCODE 169
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ab7a3f5..cb6afaf 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2712,6 +2712,17 @@ TEBCresume(
NEXT_INST_V(2, opnd, 1);
}
+ case INST_CONCAT_STK:
+ /*
+ * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
+ * and then decrement their ref counts.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+
case INST_EXPAND_START:
/*
* Push an element to the auxObjList. This records the current