From ab8249dfc3c847de69ae379bb7849bdb7346db40 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 26 Oct 2013 08:25:02 +0000
Subject: General [concat] compilation.

---
 generic/tclAssembly.c |  5 ++++-
 generic/tclCompCmds.c | 12 ++++++++++--
 generic/tclCompile.c  |  6 +++++-
 generic/tclCompile.h  |  4 +++-
 generic/tclExecute.c  | 11 +++++++++++
 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
-- 
cgit v0.12