Tcl Source Code

2011-04-18  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: fix for [Bug 3288345]: Wrong Tcl_StatBuf
	used on MinGW.

2011-04-16  Donal K. Fellows  <[email protected]>

    /*
     * An object which either has no string rep or else is a canonical list is
     * guaranteed to have been generated dynamically: bail out, this cannot
     * have a usable absolute location. _Do not touch_ the information the set
     * up by the caller. It knows better than us.
     */

    if ((!obj->bytes) || ((obj->typePtr == &tclListType) &&
	    ((List *)obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) {
	return;
    }

    /*
     * First look for location information recorded in the argument
     * stack. That is nearest.
     */

     *
     * This restriction has been relaxed a bit by storing in lists whether
     * they are "canonical" or not (a canonical list being one that is either
     * pure or that has its string rep derived by UpdateStringOfList from the
     * internal rep).
     */

    if (objPtr->typePtr == &tclListType) {	/* is a list... */
	List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;

	if (objPtr->bytes == NULL ||	/* ...without a string rep */
	    listRepPtr->canonicalFlag) {/* ...or that is canonical */
	    /*
	     * TIP #280 Structures for tracking lines. As we know that this is
	     * dynamic execution we ignore the invoker, even if known.
	     */

	    int nelements;
	    Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
	    CmdFrame *eoFramePtr = (CmdFrame *)
		TclStackAlloc(interp, sizeof(CmdFrame));

	    eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
				 1 : iPtr->cmdFramePtr->level + 1);
	    eoFramePtr->framePtr = iPtr->framePtr;
	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;

	    eoFramePtr->nline = 0;
	    eoFramePtr->line = NULL;

	    eoFramePtr->cmd.listPtr  = objPtr;
	    Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
	    eoFramePtr->data.eval.path = NULL;

	    /*
	     * TIP #280 We do _not_ compute all the line numbers for the words
	     * in the command. For the eval of a pure list the most sensible
	     * choice is to put all words on line 1. Given that we neither
	     * need memory for them nor compute anything.  'line' is left
	     * NULL. The two places using this information (TclInfoFrame, and
	     * TclInitCompileEnv), are special-cased to use the proper line
	     * number directly instead of accessing the 'line' array.
	     */

	    Tcl_ListObjGetElements(NULL, copyPtr,
				   &nelements, &elements);

	    iPtr->cmdFramePtr = eoFramePtr;
	    result = Tcl_EvalObjv(interp, nelements, elements,
				  flags);

	    Tcl_DecrRefCount(copyPtr);
	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
	    Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
	    TclStackFree(interp, eoFramePtr);

	    goto done;
	}
    }

    if (flags & TCL_EVAL_DIRECT) {
	/*
	 * We're not supposed to use the compiler or byte-code interpreter.
	 * Let Tcl_EvalEx evaluate the command directly (and probably more
	 * slowly).
	 */

	/*

		Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	    }
	}
	iPtr->evalFlags = 0;
	iPtr->varFramePtr = savedVarFramePtr;
    }

  done:
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *

#define ListObjGetElements(listPtr, objc, objv) \
    ((objv) = &(ListRepPtr(listPtr)->elements), \
     (objc) = ListRepPtr(listPtr)->elemCount)

#define ListObjLength(listPtr, len) \
    ((len) = ListRepPtr(listPtr)->elemCount)




#define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
    (((listPtr)->typePtr == &tclListType) \
	    ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\
	    : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)))

#define TclListObjLength(interp, listPtr, lenPtr) \
    (((listPtr)->typePtr == &tclListType) \
	    ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
	    : Tcl_ListObjLength((interp), (listPtr), (lenPtr)))




/*
 * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
 * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
 *
 * WARNING: these macros eval their args more than once.
 */

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	List *listRepPtr;

	objPtr = objv[i];
	if (objPtr->typePtr != &tclListType) {
	    TclGetString(objPtr);
	    if (objPtr->length) {
		break;
	    } else {
		continue;
	    }
	}
	listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
	if (objPtr->bytes != NULL && !listRepPtr->canonicalFlag) {

	    break;
	}
    }
    if (i == objc) {
	Tcl_Obj **listv;
	int listc;

	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    /*
	     * Tcl_ListObjAppendList could be used here, but this saves us a
	     * bit of type checking (since we've already done it). Use of
	     * INT_MAX tells us to always put the new stuff on the end. It
	     * will be set right in Tcl_ListObjReplace.
	     * Note that all objs at this point are either lists or have an
	     * empty string rep.
	     */

	    objPtr = objv[i];
	    if (objPtr->bytes && !objPtr->length) {
		continue;
	    }
	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
	    if (listc) {
		if (resPtr) {
		    Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
		} else {