From 5f40c6221b5fef57dec3b1b96604a0391e831d23 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Tue, 11 Dec 2001 19:45:52 +0000 Subject: small change in bytecode instructionsINST_LIST_INDEX_MULTI and INST_LSET_FLAT --- ChangeLog | 11 +++++++++++ generic/tclCompCmds.c | 14 +++----------- generic/tclCompile.c | 14 +++++++------- generic/tclExecute.c | 27 ++++++++++++++++----------- 4 files changed, 37 insertions(+), 29 deletions(-) diff --git a/ChangeLog b/ChangeLog index d1d1f5d..97567d7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,16 @@ 2001-12-11 Miguel Sofer + * generic/tclCompCmds.c: + * generic/tclCompile.c: + * generic/tclExecute.c: consistency patch, to make all + instructions that pop a variable number of Tcl_Obj's off the + execution stack take the number of popped objects as first + operand. Modified *only* the new instructions + INST_LIST_INDEX_MULTI and INST_LSET_FLAT, so this has no effect on + bytecodes generated up to tcl8.4a3 inclusive. + +2001-12-11 Miguel Sofer + * generic/tclExecute.c: fix debug messages in INST_LSET_LIST. 2001-12-11 Miguel Sofer diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 5ed7be0..01d4cea 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.18 2001/12/11 14:29:40 msofer Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.19 2001/12/11 19:45:52 msofer Exp $ */ #include "tclInt.h" @@ -1808,18 +1808,10 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) if ( numWords == 3 ) { TclEmitOpcode( INST_LIST_INDEX, envPtr ); } else { - /* - * envPtr->currStackDepth has to be updated, as this instruction - * does not conform to the convention that its stack balance is - * (1-opnd): it is actually one less (-opnd). - */ - - TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-2, envPtr ); - envPtr->currStackDepth--; + TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr ); } return TCL_OK; - } /* @@ -2123,7 +2115,7 @@ TclCompileLsetCmd( interp, parsePtr, envPtr ) if ( parsePtr->numWords == 4 ) { TclEmitOpcode( INST_LSET_LIST, envPtr ); } else { - TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 3), envPtr ); + TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr ); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 0d223d7..2be7ed3 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.29 2001/12/10 15:44:34 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.30 2001/12/11 19:45:52 msofer Exp $ */ #include "tclInt.h" @@ -256,18 +256,18 @@ InstructionDesc instructionTable[] = { {"lappendStk", 1, -1, 0, {OPERAND_NONE}}, /* Lappend general variable; value is stktop, then unparsed name */ {"lindexMulti", 5, INT_MIN, 1, {OPERAND_UINT4}}, - /* Lindex with generalized args, operand is number of indices. - * (operand) entries from stktop are the indices; then list to - * process. */ + /* Lindex with generalized args, operand is number of stacked objs + * used: (operand-1) entries from stktop are the indices; then list + * to process. */ {"over", 5, +1, 1, {OPERAND_UINT4}}, /* Duplicate the arg-th element from top of stack (TOS=0) */ {"lsetList", 1, -2, 0, {OPERAND_NONE}}, /* Four-arg version of 'lset'. stktop is old value; next is * new element value, next is the index list; pushes new value */ {"lsetFlat", 5, INT_MIN, 1, {OPERAND_UINT4}}, - /* Three- or >=5-arg version of 'lset'. stktop is old value, - * next is new element value; next come objc-2 indices; pushes - * the new value. + /* Three- or >=5-arg version of 'lset', operand is number of + * stacked objs: stktop is old value, next is new element value, next + * come (operand-2) indices; pushes the new value. */ {0} }; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 350c190..8cfe624 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.44 2001/12/11 17:57:12 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.45 2001/12/11 19:45:52 msofer Exp $ */ #include "tclInt.h" @@ -2422,28 +2422,30 @@ TclExecuteByteCode(interp, codePtr) case INST_LIST_INDEX_MULTI: { - /* * 'lindex' with multiple index args: * * Determine the count of index args. */ + + int numIdx; opnd = TclGetUInt4AtPtr(pc+1); - + numIdx = opnd-1; + /* * Do the 'lindex' operation. */ objPtr = TclLindexFlat( interp, - stackPtr[ stackTop - opnd ], - opnd, - stackPtr + stackTop - opnd + 1 ); + stackPtr[ stackTop - numIdx ], + numIdx, + stackPtr + stackTop - numIdx + 1 ); /* * Clean up ref counts */ - for ( i = 0 ; i <= opnd ; i++ ) { + for ( i = 0 ; i <= numIdx ; i++ ) { Tcl_DecrRefCount( stackPtr[ stackTop -- ] ); } @@ -2475,8 +2477,11 @@ TclExecuteByteCode(interp, codePtr) * Lset with 3, 5, or more args. Get the number of index args. */ - opnd = TclGetUInt4AtPtr( pc + 1 ); + int numIdx; + opnd = TclGetUInt4AtPtr( pc + 1 ); + numIdx = opnd - 2; + /* * Get the old value of variable, and remove the stack ref. * This is safe because the variable still references the @@ -2496,8 +2501,8 @@ TclExecuteByteCode(interp, codePtr) * Compute the new variable value */ - objPtr = TclLsetFlat( interp, value2Ptr, opnd, - stackPtr + stackTop - opnd + 1, + objPtr = TclLsetFlat( interp, value2Ptr, numIdx, + stackPtr + stackTop - numIdx + 1, valuePtr ); Tcl_DecrRefCount( valuePtr ); @@ -2505,7 +2510,7 @@ TclExecuteByteCode(interp, codePtr) * Clean up ref counts */ - for ( i = 0 ; i < opnd ; i++ ) { + for ( i = 0 ; i < numIdx ; i++ ) { Tcl_DecrRefCount( stackPtr[ stackTop -- ] ); } -- cgit v0.12