Bytecode compiler for ledit

4 files changed, 124 insertions, 72 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c9697d2..a1eb4cc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -310,9 +310,9 @@ static const CmdInfo builtInCmds[] = {
     {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
     {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
+    {"ledit",		Tcl_LeditObjCmd,	TclCompileLeditCmd,	NULL,	CMD_IS_SAFE},
     {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
     {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
-    {"xx",		Tcl_LinsertObjCmd,	TclCompileXxCmd,	NULL,	CMD_IS_SAFE},
     {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
     {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
     {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
@@ -323,10 +323,9 @@ static const CmdInfo builtInCmds[] = {
     {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
     {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
-    {"lseq",            Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
+    {"lseq",		Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
-    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
     {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 72716a4..bf6288a 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1036,6 +1036,124 @@ TclCompileLassignCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileLeditCmd --
+ *
+ *	How to compile the "ledit" command. We only bother with the case
+ *	where the index is constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLeditCmd(
+    Tcl_Interp *interp,		/* Tcl interpreter for context. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
+				 * command. */
+    TCL_UNUSED(Command *),
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr, *varTokenPtr;
+    int localIndex;             /* Index of var in local var table. */
+    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
+    int tempDepth;		/* Depth used for emitting one part of the
+				 * code burst. */
+    int first, last, i, end_indicator;
+
+    if (parsePtr->numWords < 4) {
+	return TCL_ERROR;
+    }
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    tokenPtr = TokenAfter(varTokenPtr);
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
+	    &first) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
+	    &last) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    end_indicator = 1; /* "end" means last element by default */
+    if (first == (int)TCL_INDEX_NONE) {
+	/* first == TCL_INDEX_NONE => Range after last element. */
+	first = TCL_INDEX_END; /* Insert at end where ... */
+	end_indicator = 0;     /* ... end means AFTER last element */
+	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
+    }
+
+    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar, 1);
+
+    /* Duplicate the variable name if it's been pushed. */
+    if (localIndex < 0) {
+	if (isScalar) {
+	    tempDepth = 0;
+	} else {
+	    tempDepth = 1;
+	}
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
+    }
+
+    /* Duplicate an array index if one's been pushed. */
+    if (!isScalar) {
+	if (localIndex < 0) {
+	    tempDepth = 1;
+	} else {
+	    tempDepth = parsePtr->numWords - 2;
+	}
+	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
+    }
+
+    /* Emit code to load the variable's value.  */
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_LOAD_SCALAR, localIndex, envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_LOAD_ARRAY, localIndex, envPtr);
+	}
+    }
+
+    for (i=4 ; i<parsePtr->numWords ; ++i) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+
+    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
+    TclEmitInt4(end_indicator, envPtr);
+    TclEmitInt4(first, envPtr);
+    TclEmitInt4(last, envPtr);
+    
+    /* Emit code to put the value back in the variable. */
+
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_STORE_SCALAR, localIndex, envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
+	} else {
+	    Emit14Inst(INST_STORE_ARRAY, localIndex, envPtr);
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileLindexCmd --
  *
  *	Procedure called to compile the "lindex" command.
@@ -2908,75 +3026,6 @@ TclCompileObjectSelfCmd(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * TclCompileXxCmd --
- *
- *	How to compile the "linsert2" command. We only bother with the case
- *	where the index is constant.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileXxCmd(
-    Tcl_Interp *interp,		/* Tcl interpreter for context. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
-				 * command. */
-    TCL_UNUSED(Command *),
-    CompileEnv *envPtr)		/* Holds the resulting instructions. */
-{
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Token *tokenPtr, *listTokenPtr;
-    int first, last, i, end_indicator;
-
-    if (parsePtr->numWords < 4) {
-	return TCL_ERROR;
-    }
-    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    tokenPtr = TokenAfter(listTokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
-	    &first) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    tokenPtr = TokenAfter(tokenPtr);
-    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
-	    &last) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    end_indicator = 1; /* "end" means last element by default */
-    if (first == (int)TCL_INDEX_NONE) {
-	/* first == TCL_INDEX_NONE => Range after last element. */
-	first = TCL_INDEX_END; /* Insert at end where ... */
-	end_indicator = 0;     /* ... end means AFTER last element */
-	last = TCL_INDEX_NONE; /* Informs lreplace, nothing to replace */
-    } else if (last == TCL_INDEX_NONE) {
-	/*
-	 * last == TCL_INDEX_NONE => last precedes first element
-	 * lreplace4 will treat this as nothing to delete
-	 * Nought to do, just here for clarity, will be optimized away
-	 */
-    } else {
-
-    }
-
-    CompileWord(envPtr, listTokenPtr, interp, 1);
-
-    for (i=4 ; i<parsePtr->numWords ; i++) {
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, i);
-    }
-
-    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 3, envPtr);
-    TclEmitInt4(end_indicator, envPtr);
-    TclEmitInt4(first, envPtr);
-    TclEmitInt4(last, envPtr);
-    return TCL_OK;
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a67c8f9..5c977e5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3759,6 +3759,9 @@ MODULE_SCOPE int	TclCompileLappendCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLeditCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 2952899..209c3d2 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -521,6 +521,7 @@ apply {{} {
 		foreach i $ins {
 		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
 		    set tester [list ledit ls $a $b {*}$i]
+		    #set script [list catch $tester m]
 		    set script [list catch $tester m]
 		    set script "list \[$script\] \$m"
 		    test ledit-6.[incr n] {ledit battery} -body \