diff options
Diffstat (limited to 'generic/tclExecute.c')
| -rw-r--r-- | generic/tclExecute.c | 235 |
1 files changed, 191 insertions, 44 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 97a1da2..5eec236 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -6,11 +6,12 @@ * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. + * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * 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.34 2001/09/21 19:09:03 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.35 2001/11/14 23:17:03 hobbs Exp $ */ #include "tclInt.h" @@ -678,6 +679,13 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("=> "), valuePtr); ADJUST_PC(1); + case INST_OVER: + opnd = TclGetUInt4AtPtr( pc+1 ); + valuePtr = stackPtr[ stackTop - opnd ]; + PUSH_OBJECT( valuePtr ); + TRACE_WITH_OBJ(("=> "), valuePtr); + ADJUST_PC( 5 ); + case INST_CONCAT1: opnd = TclGetUInt1AtPtr(pc+1); { @@ -2013,62 +2021,201 @@ TclExecuteByteCode(interp, codePtr) case INST_LIST_INDEX: { - Tcl_Obj **elemPtrs; - int index; + + /*** lindex with objc == 3 ***/ + + /* Pop the two operands */ value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); - result = Tcl_ListObjGetElements(interp, valuePtr, - &length, &elemPtrs); - if (result != TCL_OK) { - TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), - Tcl_GetObjResult(interp)); - TclDecrRefCount(value2Ptr); - TclDecrRefCount(valuePtr); + /* Extract the desired list element */ + + objPtr = TclLindexList( interp, valuePtr, value2Ptr ); + if ( objPtr == NULL ) { + TRACE_WITH_OBJ( ( "%.30s %.30s => ERROR: ", + O2S( valuePtr ), + O2S( value2Ptr ) ), + Tcl_GetObjResult( interp ) ); + TclDecrRefCount( value2Ptr ); + TclDecrRefCount( valuePtr ); + result = TCL_ERROR; goto checkForCatch; } - result = TclGetIntForIndex(interp, value2Ptr, length - 1, - &index); - if (result != TCL_OK) { - TRACE_WITH_OBJ(("%.20s => ERROR: ", O2S(value2Ptr)), - Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(value2Ptr); - Tcl_DecrRefCount(valuePtr); + /* Stash the list element on the stack */ + + PUSH_OBJECT( objPtr ); + TRACE(( "%.20s %.20s => %s\n", + O2S( valuePtr ), + O2S( value2Ptr ), + O2S( objPtr ) ) ); + TclDecrRefCount( valuePtr ); + TclDecrRefCount( value2Ptr ); + TclDecrRefCount( objPtr ); + } + + ADJUST_PC( 1 ); + + case INST_LIST_INDEX_MULTI: + { + + /* + * 'lindex' with multiple index args: + * + * Determine the count of index args. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + + /* + * Do the 'lindex' operation. + */ + + objPtr = TclLindexFlat( interp, + stackPtr[ stackTop - opnd ], + opnd, + stackPtr + stackTop - opnd + 1 ); + /* + * Clean up ref counts + */ + + for ( i = 0 ; i <= opnd ; i++ ) { + Tcl_DecrRefCount( stackPtr[ stackTop -- ] ); + } + + /* + * Check for errors + */ + + if ( objPtr == NULL ) { + TRACE_WITH_OBJ( ( "%d => ERROR: ", opnd ), + Tcl_GetObjResult( interp ) ); + result = TCL_ERROR; goto checkForCatch; } + + /* + * Set result + */ - if ((index < 0) || (index >= length)) { - objPtr = Tcl_NewObj(); - } else { - /* - * Make sure listPtr still refers to a list object. It - * might have been converted to an int above if the - * argument objects were shared. - */ + PUSH_OBJECT( objPtr ); + TRACE(( "%d => %s\n", opnd, O2S( objPtr ) )); + Tcl_DecrRefCount( objPtr ); + + } + ADJUST_PC( 5 ); - if (valuePtr->typePtr != &tclListType) { - result = Tcl_ListObjGetElements(interp, valuePtr, - &length, &elemPtrs); - if (result != TCL_OK) { - TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), - Tcl_GetObjResult(interp)); - TclDecrRefCount(value2Ptr); - TclDecrRefCount(valuePtr); - goto checkForCatch; - } - } - objPtr = elemPtrs[index]; + case INST_LSET_FLAT: + { + /* + * Lset with 3, 5, or more args. Get the number of index args. + */ + + opnd = TclGetUInt4AtPtr( pc + 1 ); + + /* + * Get the old value of variable, and remove the stack ref. + * This is safe because the variable still references the + * object; the ref count will never go zero here. + */ + + value2Ptr = POP_OBJECT(); + Tcl_DecrRefCount( value2Ptr ); + + /* + * Get the new element value. + */ + + valuePtr = POP_OBJECT(); + + /* + * Compute the new variable value + */ + + objPtr = TclLsetFlat( interp, value2Ptr, opnd, + stackPtr + stackTop - opnd + 1, + valuePtr ); + Tcl_DecrRefCount( valuePtr ); + + /* + * Clean up ref counts + */ + + for ( i = 0 ; i < opnd ; i++ ) { + Tcl_DecrRefCount( stackPtr[ stackTop -- ] ); } - PUSH_OBJECT(objPtr); - TRACE(("%.20s %.20s => %s\n", - O2S(valuePtr), O2S(value2Ptr), O2S(objPtr))); - TclDecrRefCount(valuePtr); - TclDecrRefCount(value2Ptr); + /* + * Check for errors + */ + + if ( objPtr == NULL ) { + TRACE_WITH_OBJ( ( "%d => ERROR: ", opnd ), + Tcl_GetObjResult( interp ) ); + result = TCL_ERROR; + goto checkForCatch; + } + + /* + * Set result + */ + + PUSH_OBJECT( objPtr ); + TRACE(( "%d => %s\n", opnd, O2S( objPtr ) )); + Tcl_DecrRefCount( objPtr ); + } - ADJUST_PC(1); + ADJUST_PC( 5 ); + + case INST_LSET_LIST: + { + /* + * 'lset' with 4 args. + * + * Get the old value of variable, and remove the stack ref. + * This is safe because the variable still references the + * object; the ref count will never go zero here. + */ + + objPtr = POP_OBJECT(); + Tcl_DecrRefCount( objPtr ); + + /* + * Get the new element value, and the index list + */ + + valuePtr = POP_OBJECT(); + value2Ptr = POP_OBJECT(); + + /* + * Compute the new variable value + */ + + objPtr = TclLsetList( interp, objPtr, value2Ptr, valuePtr ); + Tcl_DecrRefCount( valuePtr ); + Tcl_DecrRefCount( value2Ptr ); + + /* + * Check for errors + */ + + if ( objPtr == NULL ) { + TRACE_WITH_OBJ( ( "%d => ERROR: ", opnd ), + Tcl_GetObjResult( interp ) ); + result = TCL_ERROR; + goto checkForCatch; + } + + /* + * Set result + */ + + PUSH_OBJECT( objPtr ); + TRACE(( "%d => %s\n", opnd, O2S( objPtr ) )); + Tcl_DecrRefCount( objPtr ); + } + ADJUST_PC( 1 ); case INST_STR_EQ: case INST_STR_NEQ: @@ -3321,7 +3468,7 @@ TclExecuteByteCode(interp, codePtr) listVarPtr = &(compiledLocals[listTmpIndex]); listPtr = listVarPtr->value.objPtr; - listRepPtr = (List *) listPtr->internalRep.otherValuePtr; + listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; listLen = listRepPtr->elemCount; valIndex = (iterNum * numVars); |