diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 100 |
1 files changed, 98 insertions, 2 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f62ec14..2d959c0 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -7,6 +7,7 @@ * * Copyright (c) 1996-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2007 BitMover, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -662,6 +663,51 @@ InstructionDesc const tclInstructionTable[] = { {"lappendListStk", 1, -1, 0, {OPERAND_NONE}}, /* Lappend list to general variable. * Stack: ... varName list => ... listVarContents */ + {"rot", 2, 0, 1, {OPERAND_UINT1}}, + /* Rotate the top opnd elements in the stack */ + {"l-index", 5, -1, 1, {OPERAND_UINT4}}, + /* Index into a nested struct/array/hash. opnd contains flags, + * index is stktop, object to index into is stknext. */ + {"l-deep-write", 9, -1, 2, {OPERAND_UINT4, OPERAND_UINT4}}, + /* Write via L deep pointer pushed by l-index above. opnd1 is a local + * var index of a var that points to the top-level object being + * indexed; it will be written if the top-level object needed to be + * copied by l-index for copy-on-write. opnd2 contains flags + * indicating whether to leave old or new value on stack top. + * stktop is the L deep pointer, stknext is the value to write. */ + {"lsplit", 2, 0, 1, {OPERAND_UINT4}}, + /* Perl-like string split. opnd is a flags word (see Expr_f), + * stack contains the limit (optional), then the delimeter + * (optional) then the string to split. */ + {"l-defined", 1, 0, 0, {OPERAND_NONE}}, + /* Test whether value at stackTop is the L undefined value. */ + {"l-push-list-size", 1, 0, 0, {OPERAND_NONE}}, + /* Store the size of the list at stktop in the internal L + * sizes stack. Sizes are used to implement the L END keyword. */ + {"l-push-string-size", 1, 0, 0, {OPERAND_NONE}}, + /* Store the length of the string at stktop in the internal L + * sizes stack. */ + {"l-read-size", 1, 1, 0, {OPERAND_NONE}}, + /* Push what's on the top of the internal L sizes stack. */ + {"l-pop-size", 1, 0, 0, {OPERAND_NONE}}, + /* Pop the internal L sizes stack. */ + {"l-push-undef", 1, 1, 0, {OPERAND_NONE}}, + /* Push the L undef object. */ + {"expandRot", 2, 0, 1, {OPERAND_UINT1}}, + /* Rotate the top opnd1 stack elements with those after + * the expand marker (see expandStart). */ + {"l-lindex-stk", 2, 1, 1, {OPERAND_UINT1}}, + /* push(listindex stktop opnd) except if opnd is <0 or + * > # list elements then push the L undef object. */ + {"l-list-insert", 9, 0, 3, {OPERAND_LVT4, OPERAND_UINT4}}, + /* Insert into list local var. Operands are local slot index, + * flags, and list index to insert before (0 means prepend, + * -1 means append). */ + {"unsetLocal", 5, 0, 1, {OPERAND_LVT4}}, + /* Unset the local variable at index op1. */ + {"different-obj", 5, 0, 1, {OPERAND_LVT4}}, + /* Determine whether the variable whose name is at stktop + * points to a different object as the given local. */ {NULL, 0, 0, 0, {OPERAND_NONE}} }; @@ -1809,13 +1855,29 @@ TclCompileInvocation( int numWords, CompileEnv *envPtr) { - int wordIdx = 0, depth = TclGetStackDepth(envPtr); + int adjust = 0, wordIdx = 0, depth = TclGetStackDepth(envPtr); + char *cmd, *s; + Tcl_Obj *obj; DefineLineInformation; if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr = TokenAfter(tokenPtr); + cmd = Tcl_GetString(cmdObj); + if (!strcmp("L", cmd) || !strcmp("Lhtml", cmd)) { + /* + * If this is the L or Lhtml command, push the argument --line=%d + * to it now. This communicates the source line # to the L + * compiler. + */ + obj = Tcl_ObjPrintf("--line=%d", envPtr->line+1); + Tcl_IncrRefCount(obj); + s = TclGetString(obj); + adjust = TclRegisterNewLiteral(envPtr, s, strlen(s)); + Tcl_DecrRefCount(obj); + TclEmitPush(adjust, envPtr); + } } for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { @@ -1837,6 +1899,14 @@ TclCompileInvocation( TclEmitPush(objIdx, envPtr); } + /* + * Possible adjust for L-command argument injection (see comment + * above). + */ + if (adjust) { + ++wordIdx; + } + if (wordIdx <= 255) { TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx); } else { @@ -1853,7 +1923,8 @@ CompileExpanded( int numWords, CompileEnv *envPtr) { - int wordIdx = 0; + int adjust = 0, wordIdx = 0; + char *cmd; DefineLineInformation; int depth = TclGetStackDepth(envPtr); @@ -1862,6 +1933,23 @@ CompileExpanded( CompileCmdLiteral(interp, cmdObj, envPtr); wordIdx = 1; tokenPtr = TokenAfter(tokenPtr); + cmd = Tcl_GetString(cmdObj); + if (!strcmp("L", cmd) || !strcmp("Lhtml", cmd)) { + /* + * If this is the L or Lhtml command, push the argument --line=%d + * to it now. This communicates the source line # to the L + * compiler. + */ + char *s; + Tcl_Obj *obj; + + obj = Tcl_ObjPrintf("--line=%d", envPtr->line+1); + Tcl_IncrRefCount(obj); + s = TclGetString(obj); + adjust = TclRegisterNewLiteral(envPtr, s, strlen(s)); + Tcl_DecrRefCount(obj); + TclEmitPush(adjust, envPtr); + } } for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { @@ -1888,6 +1976,14 @@ CompileExpanded( } /* + * Possible adjust for L-command argument injection (see comment + * above). + */ + if (adjust) { + ++wordIdx; + } + + /* * The stack depth during argument expansion can only be managed at * runtime, as the number of elements in the expanded lists is not known * at compile time. We adjust here the stack depth estimate so that it is |