diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 2 | ||||
| -rw-r--r-- | generic/tclCompCmdsGR.c | 122 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 |
3 files changed, 126 insertions, 1 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 46b532b..2f0ba01 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -223,7 +223,7 @@ static const CmdInfo builtInCmds[] = { {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, - {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"join", Tcl_JoinObjCmd, TclCompileJoinCmd, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index b3e273f..539f934 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -843,6 +843,128 @@ TclCompileInfoObjectNamespaceCmd( /* *---------------------------------------------------------------------- * + * TclCompileJoinCmd -- + * + * Procedure called to compile the "join" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "join" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileJoinCmd( + 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. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + int separator, foreach, valueVar, loopCounter, memberVar; + int loopOffset, loopOffset2; + ForeachInfo *infoPtr; + JumpFixup jumpFalseFixup, separatorFixup; + + /* + * Requires a local variable table; we're using foreach instructions + * internally. + */ + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + + /* + * Handles: join someList ?separator? + * + * The separator, if supplied, must be a compile-time known string. + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + if (parsePtr->numWords == 3) { + Tcl_Obj *separatorObj = Tcl_NewObj(); + char *bytes; + int length; + + if (!TclWordKnownAtCompileTime(TokenAfter(tokenPtr), separatorObj)) { + Tcl_DecrRefCount(separatorObj); + return TCL_ERROR; + } + bytes = Tcl_GetStringFromObj(separatorObj, &length); + if (length > 0) { + separator = TclRegisterNewLiteral(envPtr, bytes, length); + } else { + separator = -1; + } + Tcl_DecrRefCount(separatorObj); + } else if (parsePtr->numWords == 2) { + separator = TclRegisterNewLiteral(envPtr, " ", 1); + } else { + return TCL_ERROR; + } + + /* + * Create the various variables and the auxiliary data. + */ + + valueVar = AnonymousLocal(envPtr); + loopCounter = AnonymousLocal(envPtr); + memberVar = AnonymousLocal(envPtr); + + infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *)); + infoPtr->numLists = 1; + infoPtr->firstValueTemp = valueVar; + infoPtr->loopCtTemp = loopCounter; + infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int)); + infoPtr->varLists[0]->numVars = 1; + infoPtr->varLists[0]->varIndexes[0] = memberVar; + foreach = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); + + /* + * Issue instructions! + */ + + CompileWord(envPtr, tokenPtr, interp, 1); + Emit14Inst( INST_STORE_SCALAR, valueVar, envPtr); + TclEmitOpcode( INST_POP, envPtr); + PushStringLiteral(envPtr, ""); + TclEmitInstInt4( INST_FOREACH_START4, foreach, envPtr); + loopOffset = loopOffset2 = CurrentOffset(envPtr); + TclEmitInstInt4( INST_FOREACH_STEP4, foreach, envPtr); + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); + if (separator >= 0) { + Emit14Inst( INST_LOAD_SCALAR, loopCounter, envPtr); + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &separatorFixup); + Emit14Inst( INST_PUSH, separator, envPtr); + Emit14Inst( INST_LOAD_SCALAR, memberVar, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, 3, envPtr); + loopOffset2 -= CurrentOffset(envPtr); + TclEmitInstInt1(INST_JUMP1, loopOffset2, envPtr); + (void) TclFixupForwardJumpToHere(envPtr, &separatorFixup, 127); + } + Emit14Inst( INST_LOAD_SCALAR, memberVar, envPtr); + TclEmitInstInt1( INST_STR_CONCAT1, 2, envPtr); + loopOffset -= CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP1, loopOffset, envPtr); + (void) TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127); + TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); + TclEmitInt4( valueVar, envPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileLappendCmd -- * * Procedure called to compile the "lappend" command. diff --git a/generic/tclInt.h b/generic/tclInt.h index a9f4c16..a559c37 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3535,6 +3535,9 @@ MODULE_SCOPE int TclCompileInfoObjectNamespaceCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileJoinCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); |