Tcl Source Code

 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    size_t before,
    size_t after,
    int *indexPtr)
{
    Tcl_Obj *tmpObj;
    int result = TCL_ERROR;

    TclNewObj(tmpObj);
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {

			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);

	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;




	if (index < 0 || index > elemCount
	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));

Tcl_Size
TclLengthOne(
    TCL_UNUSED(Tcl_Obj *))
{
    return 1;
}

/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
 * describe them in one place.

    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;



	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    return TCL_OK;
	}
    }

    /* objPtr does not hold a number, check the end+/- format... */
    return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
}

 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 *	If the computed index lies within the valid range of Tcl indices
 *	(0..TCL_SIZE_MAX) it is returned. Higher values are returned as
 *	TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1).
 *
 *	Callers should pass reasonable values for endValue - one in the
 *      valid index range or TCL_INDEX_NONE (-1), for example for an empty
 *	list.
 *
 * Results:
 * 	TCL_OK
 *
 * 	    The index is stored at the address given by by 'indexPtr'.

 *
 * 	TCL_ERROR
 *
 * 	    The value of 'objPtr' does not have one of the expected formats. If
 * 	    'interp' is non-NULL, an error message is left in the interpreter's
 * 	    result object.
 *
 * Side effects:
 *
 * 	The internal representation contained within objPtr may shimmer.

 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If

{
    Tcl_WideInt wide;

    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (indexPtr != NULL) {
	/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
	if (wide >= 0 && wide <= TCL_SIZE_MAX) {
	    *indexPtr = (Tcl_Size)wide;
	} else if (wide > TCL_SIZE_MAX) {
	    *indexPtr = TCL_SIZE_MAX;


	} else {
	    *indexPtr = TCL_INDEX_NONE;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType.objType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	/*
	 * Encodes end+1. This is distinguished from end+n as noted above
	 * NOTE: this may wrap around if the caller passes (as lset does)
	 * listLen-1 as endValue and and listLen is 0. The -1 will be
	 * interpreted as FF...FF and adding 1 will result in 0 which
	 * is what we want. 2's complements shenanigans but it is what
	 * it is ...
	 */
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {
	/* -1 - position before first */
	*widePtr = -1;


    } else if (offset < 0) {
	/* end-(n-1) - Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;
    } else if (offset < WIDE_MAX) {
	/* 0:WIDE_MAX-1 - plain old index. */
	*widePtr = offset;
    } else {
	/* Huh, what case remains here? */
	*widePtr = WIDE_MAX;
    }
    return TCL_OK;

    /* Report a parse error. */
  parseError:
    if (interp != NULL) {

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexEncode --
 *      IMPORTANT: function only encodes indices in the range that fits within
 *      an "int" type. Do NOT change this as the byte code compiler and engine
 *      which call this function cannot handle wider index types. Indices
 *      outside the range will result in the function returning an error.
 *
 *      Parse objPtr to determine if it is an index value. Two cases
 *	are possible.  The value objPtr might be parsed as an absolute
 *	index value in the Tcl_Size range.  Note that this includes
 *	index values that are integers as presented and it includes index
 *      arithmetic expressions.


 *
 *      The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX.
 *      This means the largest supported character length is also TCL_SIZE_MAX,
 *      and the index of the last character in a string of length TCL_SIZE_MAX
 *      is TCL_SIZE_MAX-1. Thus the absolute index values that can be
 *	directly meaningful as an index into either a list or a string are
 *	integer values in the range 0 to TCL_SIZE_MAX - 1.
 *
 *      This function however can only handle integer indices in the range
 *      0 : INT_MAX-1.
 *
 *      Any absolute index value parsed outside that range is encoded
 *      using the before and after values passed in by the
 *      caller as the encoding to use for indices that are either
 *      less than or greater than the usable index range. TCL_INDEX_NONE
 *      is available as a good choice for most callers to use for
 *      after. Likewise, the value TCL_INDEX_NONE is good for

 *      index "end" is encoded as -2, down to the index "end-0x7FFFFFFE"
 *      which is encoded as INT_MIN. Since the largest index into a
 *      string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of
 *      "end-0x7FFFFFFE" for that largest string would be 0.  Thus,
 *      if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed,
 *      they can be encoded with the before value.
 *




 * Returns:
 *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the
 *      index does not fit in an int type.
 *
 * Side effects:
 *      When TCL_OK is returned, the encoded index value is written
 *      to *indexPtr.
 *
 *----------------------------------------------------------------------
 */

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;
    const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX;

    assert(ENDVALUE < WIDE_MAX);
    if (TCL_OK != GetWideForIndex(interp, objPtr, ENDVALUE, &wide)) {


	return TCL_ERROR;

    }
    /*
     * We passed 2*INT_MAX as the "end value" to GetWideForIndex. The computed
     * index will be in one of the following ranges that need to be
     * distinguished for encoding purposes in the following code.
     * (1) 0:INT_MAX when
     *     (a) objPtr was a pure non-negative numeric value in that range
     *     (b) objPtr was a numeric computation M+/-N with a result in that range
     *     (c) objPtr was of the form end-N where N was in range INT_MAX:2*INT_MAX
     * (2) INT_MAX+1:2*INT_MAX when
     *     (a,b) as above
     *     (c) objPtr was of the form end-N where N was in range 0:INT_MAX-1
     * (3) 2*INT_MAX:WIDE_MAX when
     *     (a,b) as above
     *     (c) objPtr was of the form end+N
     * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when
     *     (a,b) as above
     *     (c) objPtr was of the form end-N where N was in the range 0:TCL_SIZE_MAX
     * (5) WIDE_MIN:(2*INT_MAX)-TCL_SIZE_MAX
     *     (a,b) as above
     *     (c) objPtr was of the form end-N where N was > TCL_SIZE_MAX
     *
     * For all cases (b) and (c), the internal representation of objPtr
     * will be shimmered to endOffsetType. That allows us to distinguish between
     * (for example) 1a (encodable) and 1c (not encodable) though the computed
     * index value is the same.

     *
     * Further note, the values TCL_SIZE_MAX < N < WIDE_MAX come into play
     * only in the 32-bit builds as TCL_SIZE_MAX == WIDE_MAX for 64-bits.
     */

    const Tcl_ObjInternalRep *irPtr =
	TclFetchInternalRep(objPtr, &endOffsetType.objType);

    if (irPtr && irPtr->wideValue >= 0) {
	/*
	 * "int[+-]int" syntax, works the same here as "int".
	 * Note same does not hold for negative integers.
	 * Distinguishes 1b and 1c where wide will be in 0:INT_MAX for
	 * both but irPtr->wideValue will be negative for 1c.
	 */
	irPtr = NULL;
    }

    if (irPtr == NULL) {
	/* objPtr can be treated as a purely numeric value. */

	/*
	 * On 64-bit systems, indices in the range INT_MAX:TCL_SIZE_MAX are
	 * valid indices but are not in the encodable range. Thus an
	 * error is raised. On 32-bit systems, indices in that range indicate
	 * the position after the end and so do not raise an error.
	 */
	if ((sizeof(int) != sizeof(Tcl_Size)) &&
	    (wide > INT_MAX) && (wide < WIDE_MAX-1)) {
	    /* 2(a,b) on 64-bit systems*/
	    goto rangeerror;
	}
	if (wide > INT_MAX) {
	    /*
	     * 3(a,b) on 64-bit systems and 2(a,b), 3(a,b) on 32-bit systems
	     * Because of the check above, this case holds for indices
	     * greater than INT_MAX on 32-bit systems and > TCL_SIZE_MAX
	     * on 64-bit systems. Always maps to the element after the end.
	     */
	    idx = after;
	} else if (wide < 0) {
	    /* 4(a,b) (32-bit systems), 5(a,b) - before the beginning */
	    idx = before;
	} else {
	    /* 1(a,b) Encodable range */
	    idx = (int)wide;
	}
    } else {
	/* objPtr is not purely numeric (end etc.)  */

	/*
	 * On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX
	 * are valid indices (with max size strings/lists) but are not in
	 * the encodable range. Thus an error is raised. On 32-bit systems,
	 * indices in that range indicate the position before the beginning
	 * and so do not raise an error.
	 */
	if ((sizeof(int) != sizeof(Tcl_Size)) &&
	    (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) {
	    /* 1(c), 4(a,b) on 64-bit systems */
	    goto rangeerror;
	}
	if (wide > ENDVALUE) {
	    /*
	     * 2(c) (32-bit systems), 3(c)
	     * All end+positive or end-negative expressions
	     * always indicate "after the end".
	     * Note we will not reach here for a pure numeric value in this
	     * range because irPtr will be NULL in that case.
	     */
	    idx = after;
	} else if (wide <= INT_MAX) {
	    /* 1(c) (32-bit systems), 4(c) (32-bit systems), 5(c) */

	    idx = before;
	} else {
	    /* 2(c) Encodable end-positive (or end+negative) */
	    idx = (int)wide;
	}
    }
    *indexPtr = idx;
    return TCL_OK;

rangeerror:
    if (interp) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr)));
	Tcl_SetErrorCode(interp,
			 "TCL",
			 "VALUE",
			 "INDEX"
			 "OUTOFRANGE",
			 NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexDecode --
 *

TclIndexDecode(
    int encoded,	/* Value to decode */
    Tcl_Size endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > TCL_INDEX_END) {
	return encoded;
    }
    endValue += encoded - TCL_INDEX_END;
    if (endValue >= 0) {
	return endValue;
    }
    return TCL_INDEX_NONE;
}

/*
 *------------------------------------------------------------------------
 *

    testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -1
} -1
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -2
} -1
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -1
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1







# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

    lindex [lseq 0x7fffffff] 0x80000000
} -result {}

test lseq-4.12 {bug lseq} -constraints has64BitLengths -body {
    llength [lseq 0x100000000]
} -result {4294967296}

test lseq-4.13 {bug lseq} -constraints has64BitLengths -body {
    set l [lseq 0x7fffffffffffffff]
    list \
    [llength $l] \
    [lindex $l end] \
        [lindex $l 9223372036854775800]
} -cleanup {unset l} -result {9223372036854775807 9223372036854775806 9223372036854775800}