Tcl Source Code

2005-11-04  Kevin Kenny  <[email protected]>

	* generic/tclGetDate.y: Added abbreviations for the Korean
	* library/clock.tcl:    timezone. [Patch 1298737]
	* generic/tclDate.c:    Regenerated.
	
	* tools/findBadExternals.tcl: Added this script, which locates

/*
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBinary.c,v 1.26 2005/09/27 15:20:35 dkf Exp $
 */

#include "tclInt.h"

#include <math.h>

/*

#endif /* TCL_MEM_DEBUG */

		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
		    return TCL_ERROR;
		}
		offset += count;
		break;
	    }
	    case 'b':
	    case 'B': {

		}

		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
		    return TCL_ERROR;
		}
		offset += (count + 7 ) / 8;
		break;
	    }
	    case 'h':
	    case 'H': {

		}

		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
		    return TCL_ERROR;
		}
		offset += (count + 1) / 2;
		break;
	    }
	    case 'c':
		size = 1;

		}

		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    Tcl_DecrRefCount(valuePtr);	/* unneeded */
		    return TCL_ERROR;
		}
		break;
	    }
	    case 'x':
		if (count == BINARY_NOCOUNT) {
		    count = 1;

/*
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters A to H.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdAH.c,v 1.69 2005/10/08 14:42:44 dgp Exp $
 */

#include "tclInt.h"
#include <locale.h>

#define NEW_FORMAT 1

	    return TCL_ERROR;
	}
    }
    if (objc == 4) {
	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
		options, 0)) {
	    Tcl_DecrRefCount(options);
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp,
		    "couldn't save return options in variable", NULL);
	    return TCL_ERROR;
	}
    }

     */

#define STORE_ARY(fieldName, object) \
    Tcl_SetStringObj(field, (fieldName), -1); \
    value = (object); \
    if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
	Tcl_DecrRefCount(field); \
	Tcl_DecrRefCount(value); \
	return TCL_ERROR; \
    }

    Tcl_IncrRefCount(field);

    /*
     * Watch out porters; the inode is meant to be an *unsigned* value, so the

	    if (result != TCL_OK) {
		Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
	    }

	    for (v=0 ; v<varcList[i] ; v++) {
		int k = index[i]++;
		Tcl_Obj *valuePtr, *varValuePtr;
		int isEmptyObj = 0;

		if (k < argcList[i]) {
		    valuePtr = argvList[i][k];
		} else {
		    valuePtr = Tcl_NewObj(); /* empty string */
		    isEmptyObj = 1;
		}
		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
			NULL, valuePtr, 0);
		if (varValuePtr == NULL) {
		    if (isEmptyObj) {
			Tcl_DecrRefCount(valuePtr);
		    }
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "couldn't set loop variable: \"",
			    TclGetString(varvList[i][v]), "\"", (char *) NULL);
		    result = TCL_ERROR;
		    goto done;
		}
	    }

 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdIL.c,v 1.83 2005/10/19 18:39:58 dgp Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"

/*
 * During execution of the "lsort" command, structures of the following type

		}
		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr = Tcl_NewObj();
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
			nullObjPtr, 0);
		if (valueObjPtr == NULL) {
		    Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
		    goto defStoreError;
		}
		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	    }
	    return TCL_OK;
	}
    }

				 * variable. */
    Tcl_Obj *emptyObj = NULL;	/* If non-NULL, an empty object created for
				 * being assigned to variables once we have
				 * run out of values from the list object. */
    Tcl_Obj **listObjv;		/* The contents of the list. */
    int listObjc;		/* The length of the list. */
    int i;


    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list varname ?varname ...?");
	return TCL_ERROR;
    }

    /*
     * First assign values out of the list to variables.

	/*
	 * Make sure the reference count for the value being assigned is
	 * greater than one (other reference minimally in the list) so we
	 * can't get hammered by shimmering.
	 */

	Tcl_IncrRefCount(valueObj);
	if (Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_DecrRefCount(valueObj);

	    if (emptyObj != NULL) {
		Tcl_DecrRefCount(emptyObj);
	    }
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(valueObj);
    }
    if (emptyObj != NULL) {
	Tcl_DecrRefCount(emptyObj);
    }

    /*
     * Now place a list of any values left over into the interpreter result.

 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.132 2005/10/08 14:42:44 dgp Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"

/*
 *----------------------------------------------------------------------

		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    } else {
		Tcl_Obj *valuePtr;
		valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
		if (valuePtr == NULL) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_AppendResult(interp, "couldn't set variable \"",
			    TclGetString(objv[i]), "\"", (char *) NULL);
		    return TCL_ERROR;
		}
	    }
	}

	     * objects) in that case.
	     */

	    if (indexVarObj != NULL) {
		TclNewObj(emptyObj);
		if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    Tcl_DecrRefCount(emptyObj);
		    return TCL_ERROR;
		}
	    }
	    if (matchVarObj != NULL) {
		if (emptyObj == NULL) {
		    TclNewObj(emptyObj);
		}
		if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    if (indexVarObj == NULL) {
			Tcl_DecrRefCount(emptyObj);
		    }
		    return TCL_ERROR;
		}
	    }
	    goto matchFound;
	} else {
	    switch (mode) {
	    case OPT_EXACT:

		Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);
	    }
	}

	if (indexVarObj != NULL) {
	    if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
		Tcl_DecrRefCount(indicesObj);

		/*
		 * Careful! Check to see if we have allocated the list of
		 * matched strings; if so (but there was an error assigning
		 * the indices list) we have a potential memory leak because
		 * the match list has not been written to a variable. Except
		 * that we'll clean that up right now.
		 */

		if (matchesObj != NULL) {
		    Tcl_DecrRefCount(matchesObj);
		}
		return TCL_ERROR;
	    }
	}
	if (matchVarObj != NULL) {
	    if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
		Tcl_DecrRefCount(matchesObj);

		/*
		 * Unlike above, if indicesObj is non-NULL at this point, it
		 * will have been written to a variable already and will hence
		 * not be leaked.
		 */

		return TCL_ERROR;

/*
 * tclDictObj.c --
 *
 *	This file contains functions that implement the Tcl dict object type
 *	and its accessor command.
 *
 * Copyright (c) 2002 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDictObj.c,v 1.38 2005/11/01 15:30:52 dkf Exp $
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * Forward declaration.

	} else {
	    Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
	    Tcl_IncrRefCount(incrPtr);
	    code = TclIncrObj(interp, valuePtr, incrPtr);
	    Tcl_DecrRefCount(incrPtr);
	}
    }
    Tcl_IncrRefCount(dictPtr);
    if (code == TCL_OK) {
	Tcl_InvalidateStringRep(dictPtr);
	valuePtr = Tcl_ObjSetVar2(interp, objv[2], NULL,
		dictPtr, TCL_LEAVE_ERR_MSG);
	if (valuePtr == NULL) {
	    code = TCL_ERROR;
	}

    }

    Tcl_DecrRefCount(dictPtr);
    if (code == TCL_OK) {
	Tcl_SetObjResult(interp, valuePtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *

    if (allocatedValue) {
	Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
    } else if (dictPtr->bytes != NULL) {
	Tcl_InvalidateStringRep(dictPtr);
    }

    Tcl_IncrRefCount(dictPtr);
    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    TclDecrRefCount(dictPtr);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}


    for (i=4 ; i<objc ; i++) {
	Tcl_AppendObjToObj(valuePtr, objv[i]);
    }

    Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);

    Tcl_IncrRefCount(dictPtr);
    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    TclDecrRefCount(dictPtr);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}


    if (result != TCL_OK) {
	if (allocatedDict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

    Tcl_IncrRefCount(dictPtr);
    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    TclDecrRefCount(dictPtr);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}


    if (result != TCL_OK) {
	if (allocatedDict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

    Tcl_IncrRefCount(dictPtr);
    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    TclDecrRefCount(dictPtr);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}


static int
DictUpdateCmd(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST *objv)
{
    Tcl_Obj *dictPtr, *objPtr;
    int i, result, dummy, allocdict = 0;
    Tcl_InterpState state;

    if (objc < 6 || objc & 1) {
	Tcl_WrongNumArgs(interp, 2, objv,
		"varName key varName ?key varName ...? script");
	return TCL_ERROR;
    }

    if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
	Tcl_DiscardInterpState(state);
	return TCL_ERROR;
    }

    if (Tcl_IsShared(dictPtr)) {
	dictPtr = Tcl_DuplicateObj(dictPtr);
	allocdict = 1;
    }

    /*
     * Write back the values from the variables, treating failure to read as
     * an instruction to remove the key.
     */

    /*
     * Write the dictionary back to its variable.
     */

    if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DiscardInterpState(state);
	if (allocdict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

    return Tcl_RestoreInterpState(interp, state);
}

/*

    /*
     * Write back the outermost dictionary to the variable.
     */

    if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	if (allocdict) {
	    TclDecrRefCount(dictPtr);
	}
	Tcl_DiscardInterpState(state);
	return TCL_ERROR;
    }
    return Tcl_RestoreInterpState(interp, state);
}

/*

 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005 by Donal K. Fellows.
 *
 * 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.219 2005/11/02 11:55:47 dkf Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>

		listVarPtr = &(compiledLocals[listTmpIndex]);
		listPtr = listVarPtr->value.objPtr;
		Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements);

		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    int setEmptyStr = 0;

		    if (valIndex >= listLen) {
			setEmptyStr = 1;
			TclNewObj(valuePtr);
		    } else {
			valuePtr = elements[valIndex];
		    }

		    varIndex = varListPtr->varIndexes[j];
		    varPtr = &(compiledLocals[varIndex]);

			DECACHE_STACK_INFO();
			value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1,
				NULL, valuePtr, TCL_LEAVE_ERR_MSG);
			CACHE_STACK_INFO();
			if (value2Ptr == NULL) {
			    TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
				    opnd, varIndex), Tcl_GetObjResult(interp));
			    if (setEmptyStr) {
				TclDecrRefCount(valuePtr);
			    }
			    result = TCL_ERROR;
			    goto checkForCatch;
			}
		    }
		    valIndex++;
		}
		listTmpIndex++;

/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOCmd.c,v 1.32 2005/11/01 15:30:52 dkf Exp $
 */

#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */

	    return TCL_ERROR;
	}
	lineLen = -1;
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_DecrRefCount(linePtr);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
	return TCL_OK;
    } else {
	Tcl_SetObjResult(interp, linePtr);
    }

 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclLink.c,v 1.13 2005/10/08 14:42:45 dgp Exp $
 */

#include "tclInt.h"

/*
 * For each linked variable there is a data structure of the following type,
 * which describes the link and is the clientData for the trace set on the Tcl

    } else {
	linkPtr->flags = 0;
    }
    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	Tcl_DecrRefCount(objPtr);
	ckfree((char *) linkPtr);
	return TCL_ERROR;
    }
    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
	    (ClientData) linkPtr);
    if (code != TCL_OK) {

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 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: tclTest.c,v 1.98 2005/11/02 15:59:48 dkf Exp $
 */

#define TCL_TEST
#include "tclInt.h"

/*
 * Required for Testregexp*Cmd

	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
	if (valuePtr == NULL) {
	    Tcl_DecrRefCount(newPtr);
	    Tcl_AppendResult(interp, "couldn't set variable \"",
		    Tcl_GetString(varPtr), "\"", NULL);
	    return TCL_ERROR;
	}
    }

    /*

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 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: tclVar.c,v 1.114 2005/11/04 02:13:41 msofer Exp $
 */

#include "tclInt.h"

/*
 * The strings below are used to indicate what went wrong when a variable
 * access is denied.

    /*
     * Create an object holding the variable's new value and use Tcl_SetVar2Ex
     * to actually set the variable.
     */

    valuePtr = Tcl_NewStringObj(newValue, -1);
    Tcl_IncrRefCount(valuePtr);

    varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
    TclDecrRefCount(valuePtr); /* done with the object */

    if (varValuePtr == NULL) {
	return NULL;
    }
    return TclGetString(varValuePtr);
}


				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;

    varPtr = TclLookupVar(interp, part1, part2, flags, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {



	return NULL;
    }

    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
	    newValuePtr, flags);
}


    part1 = TclGetString(part1Ptr);
    part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr));

    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {



	return NULL;
    }

    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
	    newValuePtr, flags);
}


	if (flags & TCL_LEAVE_ERR_MSG) {
	    if (TclIsVarArrayElement(varPtr)) {
		TclVarErrMsg(interp, part1, part2, "set", danglingElement);
	    } else {
		TclVarErrMsg(interp, part1, part2, "set", danglingVar);
	    }
	}
	return NULL;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclVarErrMsg(interp, part1, part2, "set", isArray);
	}
	return NULL;
    }

    /*
     * Invoke any read traces that have been set for the variable if it is
     * requested; this is only done in the core when lappending.
     */

    if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL)
	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
	if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
	    return NULL;
	}
    }

    /*
     * Set the variable's new value. If appending, append the new value to the
     * variable, either as a list element or as a string. Also, if appending,
     * then if the variable's old value is unshared we can modify it directly,

		TclDecrRefCount(oldValuePtr);
		oldValuePtr = varPtr->value.objPtr;
		Tcl_IncrRefCount(oldValuePtr);	/* since var is referenced */
	    }
	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
		    newValuePtr);
	    if (result != TCL_OK) {
		return NULL;
	    }
	} else {				/* append string */
	    /*
	     * We append newValuePtr's bytes but don't change its ref count.
	     */

	    if (oldValuePtr == NULL) {

     */

  cleanup:
    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
    }
    return resultPtr;






}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObjVar2 --
 *

/* TODO: Which of these flag values really make sense? */
    CONST int flags)		/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
{
    register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
    int code;

    varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
    if (varValuePtr == NULL) {
	Tcl_AddObjErrorInfo(interp,
		"\n    (reading value of variable to increment)", -1);
	return NULL;
    }
    if (Tcl_IsShared(varValuePtr)) {

	varValuePtr = Tcl_DuplicateObj(varValuePtr);


    }
    code = TclIncrObj(interp, varValuePtr, incrPtr);
    Tcl_IncrRefCount(varValuePtr);
    if (code == TCL_OK) {
	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
		varValuePtr, flags);
    }
    Tcl_DecrRefCount(varValuePtr);

    return newValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnsetVar --

Tcl_LappendObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    int numElems, createdNewObj, createVar;
    Var *varPtr, *arrayPtr;
    char *part1;
    int result;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
	if (newValuePtr == NULL) {
	    /*
	     * The variable doesn't exist yet. Just create it with an empty
	     * initial value.
	     */

	    TclNewObj(varValuePtr);
	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
		    TCL_LEAVE_ERR_MSG);
	    if (newValuePtr == NULL) {
		TclDecrRefCount(varValuePtr); /* free unneeded object */
		return TCL_ERROR;
	    }
	}
    } else {
	/*
	 * We have arguments to append. We used to call Tcl_SetVar2 to append
	 * each argument one at a time to ensure that traces were run for each
	 * append step. We now append the arguments all at once because it's
	 * faster. Note that a read trace and a write trace for the variable
	 * will now each only be called once. Also, if the variable's old
	 * value is unshared we modify it directly, otherwise we create a new
	 * copy to modify: this is "copy on write".
	 */

	createdNewObj = 0;
	createVar = 1;

	/*
	 * Use the TCL_TRACE_READS flag to ensure that if we have an array
	 * with no elements set yet, but with a read trace on it, we will
	 * create the variable and get read traces triggered. Note that you
	 * have to protect the variable pointers around the TclPtrGetVar call
	 * to insure that they remain valid even if the variable was undefined

	if (varValuePtr == NULL) {
	    /*
	     * We couldn't read the old value: either the var doesn't yet
	     * exist or it's an array element. If it's new, we will try to
	     * create it with Tcl_ObjSetVar2 below.
	     */

	    createVar = (TclIsVarUndefined(varPtr));
	    TclNewObj(varValuePtr);
	    createdNewObj = 1;
	} else if (Tcl_IsShared(varValuePtr)) {
	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
	    createdNewObj = 1;
	}

	 * error setting the new value, decrement its ref count if it was new
	 * and we didn't create the variable.
	 */

	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
		varValuePtr, TCL_LEAVE_ERR_MSG);
	if (newValuePtr == NULL) {
	    if (createdNewObj && !createVar) {
		TclDecrRefCount(varValuePtr); /* free unneeded obj */
	    }
	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result to refer to the variable's value
     * object.