TIP 429 Implementation: [string cat]

3 files changed, 107 insertions, 0 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 0f7f20a..ea5d7a4 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2838,6 +2838,76 @@ StringCmpCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * StringCatCmd --
+ *
+ *	This procedure is invoked to process the "string cat" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringCatCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int tot, i, length;
+    char *bytes, *p;
+    Tcl_Obj *objResultPtr;
+
+    /*
+     * NOTE: this implementation aims for simplicity, not speed, because all
+     * speed-critical uses of [string cat] will involve the compiled variant
+     * anyway. Thus we avoid code duplication (from TEBC/INST_CONCAT1) without
+     * sacrificing perf.
+     */
+	
+    if (objc < 2) {
+	/*
+	 * If there are no args, the result is an empty object.
+	 * Just leave the preset empty interp result.
+	 */
+	return TCL_OK;
+    }
+    tot = 0;
+    for(i = 1;i < objc;i++) {
+	bytes = TclGetStringFromObj(objv[i], &length);
+	if (bytes != NULL) {
+	    tot += length;
+	}
+    }
+    if (tot < 0) {
+	/* TODO: convert panic to error ? */
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
+    p = ckalloc(tot + 1);
+    TclNewObj(objResultPtr);
+    objResultPtr->bytes = p;
+    objResultPtr->length = tot;
+    for (i = 1;i < objc;i++) {
+	bytes = TclGetStringFromObj(objv[i], &length);
+	if (bytes != NULL) {
+	    memcpy(p, bytes, (size_t) length);
+	    p += length;
+	}
+    }
+    *p = '\0';
+    Tcl_SetObjResult(interp,objResultPtr);
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * StringBytesCmd --
  *
  *	This procedure is invoked to process the "string bytelength" Tcl
@@ -3330,6 +3400,7 @@ TclInitStringCmd(
 {
     static const EnsembleImplMap stringImplMap[] = {
 	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
 	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
 	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
 	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index e6ec0a6..8ade6a5 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -269,6 +269,39 @@ TclCompileSetCmd(
  */
 
 int
+TclCompileStringCatCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    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. */
+{
+    int numWords = parsePtr->numWords;
+    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    DefineLineInformation;	/* TIP #280 */
+
+    if (numWords>=2) {
+	int i;
+
+	for (i = 1; i < numWords; i++) {
+	    CompileWord(envPtr, wordTokenPtr, interp, i);
+	    wordTokenPtr = TokenAfter(wordTokenPtr);
+	}
+	while (numWords > 256) {
+	    TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
+	    numWords -= 254;	/* concat pushes 1 obj, the result */
+	}
+	if (numWords > 2) {
+	    TclEmitInstInt1(INST_STR_CONCAT1, numWords - 1, envPtr);
+	}
+    } else {
+	PushStringLiteral(envPtr, "");
+    }
+    return TCL_OK;
+}
+
+int
 TclCompileStringCmpCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1bb2103..6bf1ef9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3646,6 +3646,9 @@ MODULE_SCOPE int	TclCompileReturnCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileSetCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringCatCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileStringCmpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);