summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-12-12 08:09:45 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-12-12 08:09:45 (GMT)
commit66b561ac5eb7ff1750f8003c6a14a2c7ae52963b (patch)
tree5499b48e0f58deeac6df79c28987dd56b8ba6b42
parent54680ce5e2b52b6cb0a10e77a6627ea92369bcd1 (diff)
parent05c6524f4576db17abf945a46f2a34d85d34a683 (diff)
downloadtcl-66b561ac5eb7ff1750f8003c6a14a2c7ae52963b.zip
tcl-66b561ac5eb7ff1750f8003c6a14a2c7ae52963b.tar.gz
tcl-66b561ac5eb7ff1750f8003c6a14a2c7ae52963b.tar.bz2
merge trunk
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclCompCmds.c42
-rw-r--r--generic/tclCompile.c1
-rw-r--r--generic/tclCompile.h17
-rw-r--r--generic/tclExecute.c29
5 files changed, 48 insertions, 45 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index aab299e..4bf81cc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -848,10 +848,6 @@ typedef struct Tcl_Obj {
void *ptr;
unsigned long value;
} ptrAndLongRep;
- struct {
- long int1;
- long int2;
- } twoIntValue;
} internalRep;
} Tcl_Obj;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 872d476..3542838 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2552,8 +2552,6 @@ CompileEachloopCmd(
ForeachInfo *infoPtr; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
- int collectVar = -1; /* Index of temp var holding the result var
- * index. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
@@ -2669,13 +2667,6 @@ CompileEachloopCmd(
* We will compile the foreach command.
*/
- if (collect == TCL_EACH_COLLECT) {
- collectVar = AnonymousLocal(envPtr);
- if (collectVar < 0) {
- return TCL_ERROR;
- }
- }
-
code = TCL_OK;
/*
@@ -2706,6 +2697,14 @@ CompileEachloopCmd(
infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
/*
+ * Create the collecting object, unshared.
+ */
+
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt4(INST_LIST, 0, envPtr);
+ }
+
+ /*
* Evaluate each value list and leave it on stack.
*/
@@ -2717,16 +2716,6 @@ CompileEachloopCmd(
}
}
- /*
- * Create temporary variable to capture return values from loop body.
- */
-
- if (collect == TCL_EACH_COLLECT) {
- PushStringLiteral(envPtr, "");
- Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- }
-
TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
/*
@@ -2740,9 +2729,10 @@ CompileEachloopCmd(
ExceptionRangeEnds(envPtr, range);
if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr);
+ TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
+ } else {
+ TclEmitOpcode( INST_POP, envPtr);
}
- TclEmitOpcode( INST_POP, envPtr);
/*
* Bottom of loop code: assign each loop variable and check whether
@@ -2766,15 +2756,11 @@ CompileEachloopCmd(
infoPtr->loopCtTemp = -jumpBackOffset;
/*
- * The command's result is an empty string if not collecting, or the
- * list of results from evaluating the loop body.
+ * The command's result is an empty string if not collecting. If
+ * collecting, it is automatically left on stack after FOREACH_END.
*/
- if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( collectVar, envPtr);
- } else {
+ if (collect != TCL_EACH_COLLECT) {
PushStringLiteral(envPtr, "");
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 79c3897..418dd1c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -588,6 +588,7 @@ InstructionDesc const tclInstructionTable[] = {
{"foreach_step", 1, 0, 0, {OPERAND_NONE}},
/* "Step" or begin next iteration of foreach loop. */
{"foreach_end", 1, 0, 0, {OPERAND_NONE}},
+ {"lmap_collect", 1, -1, 0, {OPERAND_NONE}},
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index f149cf6..b2a4b52 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -772,20 +772,21 @@ typedef struct ByteCode {
#define INST_FOREACH_START 166
#define INST_FOREACH_STEP 167
#define INST_FOREACH_END 168
+#define INST_LMAP_COLLECT 169
/* For compilation of [string trim] and related */
-#define INST_STR_TRIM 169
-#define INST_STR_TRIM_LEFT 170
-#define INST_STR_TRIM_RIGHT 171
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
-#define INST_CONCAT_STK 172
+#define INST_CONCAT_STK 173
-#define INST_STR_UPPER 173
-#define INST_STR_LOWER 174
-#define INST_STR_TITLE 175
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
/* The last opcode */
-#define LAST_INST_OPCODE 175
+#define LAST_INST_OPCODE 176
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0a31b38..73f388b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6356,8 +6356,8 @@ TEBCresume(
*/
TclNewObj(tmpPtr);
- tmpPtr->internalRep.twoIntValue.int1 = 0;
- tmpPtr->internalRep.twoIntValue.int2 = iterMax;
+ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
+ tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
PUSH_OBJECT(tmpPtr); /* iterCounts object */
/*
@@ -6387,8 +6387,8 @@ TEBCresume(
numLists = infoPtr->numLists;
tmpPtr = OBJ_AT_DEPTH(1);
- iterNum = tmpPtr->internalRep.twoIntValue.int1;
- iterMax = tmpPtr->internalRep.twoIntValue.int2;
+ iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
+ iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
/*
* If some list still has a remaining list element iterate one more
@@ -6400,7 +6400,7 @@ TEBCresume(
* Set the variables and jump back to run the body
*/
- tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
+ tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
listTmpDepth = numLists + 1;
@@ -6464,6 +6464,25 @@ TEBCresume(
infoPtr = tmpPtr->internalRep.otherValuePtr;
numLists = infoPtr->numLists;
NEXT_INST_V(1, numLists+2, 0);
+
+ case INST_LMAP_COLLECT:
+ /*
+ * This instruction is only issued by lmap. The stack is:
+ * - result
+ * - infoPtr
+ * - loop counters
+ * - valLists
+ * - collecting obj (unshared)
+ * The instruction lappends the result to the collecting obj.
+ */
+
+ tmpPtr = OBJ_AT_DEPTH(1);
+ infoPtr = tmpPtr->internalRep.otherValuePtr;
+ numLists = infoPtr->numLists;
+
+ objPtr = OBJ_AT_DEPTH(3 + numLists);
+ Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+ NEXT_INST_F(1, 1, 0);
}
case INST_BEGIN_CATCH4: