summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-11-03 20:21:13 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-11-03 20:21:13 (GMT)
commit259635cd9b7b5e6be9e1bc44a5d2a7d3a2536743 (patch)
treea93fafd75fa76aa22a3b7253e2ce2f08ee98af7b /generic/tclCompCmds.c
parentecb5e9981dc6a833c08ccd3c8a2aba31db07061d (diff)
downloadtcl-259635cd9b7b5e6be9e1bc44a5d2a7d3a2536743.zip
tcl-259635cd9b7b5e6be9e1bc44a5d2a7d3a2536743.tar.gz
tcl-259635cd9b7b5e6be9e1bc44a5d2a7d3a2536743.tar.bz2
Added compilation of [string last] and improved the compilation of [string range]. This in turn enables compilation of [namespace qualifiers] and [namespace tail] (also done).
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c73
1 files changed, 73 insertions, 0 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 0829072..463e82c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -4683,6 +4683,79 @@ TclCompileNamespaceCodeCmd(
}
int
+TclCompileNamespaceQualifiersCmd(
+ 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. */
+{
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ DefineLineInformation; /* TIP #280 */
+ int off;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ PushLiteral(envPtr, "0", 1);
+ PushLiteral(envPtr, "::", 2);
+ TclEmitInstInt4( INST_OVER, 2, envPtr);
+ TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
+ off = CurrentOffset(envPtr);
+ PushLiteral(envPtr, "1", 1);
+ TclEmitOpcode( INST_SUB, envPtr);
+ TclEmitInstInt4( INST_OVER, 2, envPtr);
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_STR_INDEX, envPtr);
+ PushLiteral(envPtr, ":", 1);
+ TclEmitOpcode( INST_STR_EQ, envPtr);
+ off = off - CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr);
+ TclEmitOpcode( INST_STR_RANGE, envPtr);
+ return TCL_OK;
+}
+
+int
+TclCompileNamespaceTailCmd(
+ 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. */
+{
+ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ DefineLineInformation; /* TIP #280 */
+ JumpFixup jumpFixup;
+
+ if (parsePtr->numWords != 2) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Take care; only add 2 to found index if the string was actually found.
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, 1);
+ PushLiteral(envPtr, "::", 2);
+ TclEmitInstInt4( INST_OVER, 1, envPtr);
+ TclEmitOpcode( INST_STR_FIND_LAST, envPtr);
+ TclEmitOpcode( INST_DUP, envPtr);
+ PushLiteral(envPtr, "0", 1);
+ TclEmitOpcode( INST_GE, envPtr);
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
+ PushLiteral(envPtr, "2", 1);
+ TclEmitOpcode( INST_ADD, envPtr);
+ TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+ PushLiteral(envPtr, "end", 3);
+ TclEmitOpcode( INST_STR_RANGE, envPtr);
+ return TCL_OK;
+}
+
+int
TclCompileNamespaceUpvarCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command