Tcl Source Code

     
    /* Convert to an integer, advance to the next token and return. */
    /*
     * NOTE: Indexing a list with an index before it yields the
     * same result as indexing after it, and might be more easily portable
     * when list size limits grow.
     */
    status = TclGetIndexFromToken(tokenPtr, result, TCL_INDEX_BEFORE,
	    TCL_INDEX_BEFORE);
    *tokenPtrPtr = TokenAfter(tokenPtr);
    if (status == TCL_ERROR && interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%.*s\"",
		tokenPtr->size, tokenPtr->start));
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADINDEX", NULL);
    }
    return status;


/*
 *----------------------------------------------------------------------
 *
 * TclGetIndexFromToken --
 *
 *	Parse a token to determine if an index value is known at
 *	compile time. Two cases are possible.  The compile time value
 *	of the token might be parsed as an absolute index value
 *	in the C signed int range.  Note that this includes index
 *	values that are integers as presented as well as index
 *	arithmetic expressions that can be fully computed at compile
 *	time. The absolute index values that can be directly meaningful
 *	as an index into either a list or a string are those integer
 *	values >= TCL_INDEX_START (0) and < TCL_INDEX_AFTER (INT_MAX).
 *	The largest string supported in Tcl 8 has bytelength INT_MAX.
 *	This means the largest character supported length is also INT_MAX,
 *	and the index of the last character in a string of length INT_MAX
 *	is INT_MAX-1.
 *
 *	Any absolute index value parsed outside that range is encoded
 *	using the minBoundary and maxBounday 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_AFTER
 *	is available as a good choice for most callers to use for
 *	maxBoundary. Likewise, the value TCL_INDEX_BEFORE is good for
 *	most callers to use for minBoundary.  Other values are possible
 *	when the caller knows it is helpful in producing its own behavior
 *	for indices before and after the indexed item.
 *
 *	A token can also be parsed as an end-relative index expression.
 *	All end-relative expressions that indicate an index larger
 *	than end (end+2, end--5) point beyond the end of the indexed
 *	collection, and can be encoded as maxBoundary.  The end-relative
 *	expressions that indicate an index less than or equal to end
 *	are encoded relative to the value TCL_INDEX_END (-2).  The
 *	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 minBoundary value.
 *
 *	These details will require re-examination whenever string and
 *	list length limits are increased, but that will likely also
 *	mean a revised routine capable of returning Tcl_WideInt values.
 *
 * Returns:
 *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 *
 * Side effects:
 *	When TCL_OK is returned, the encoded index value is written
 *	to *index.
 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    int *index,
    int minBoundary,
    int maxBoundary)
{
    Tcl_Obj *tmpObj = Tcl_NewObj();
    int result, idx;

    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
	Tcl_DecrRefCount(tmpObj);
	return TCL_ERROR;
    }

    result = TclGetIntFromObj(NULL, tmpObj, &idx);
    if (result == TCL_OK) {
	/* We parsed a value in the range INT_MIN...INT_MAX */
    integerEncode:
	if (idx < TCL_INDEX_START) {
	    /* All negative absolute indices are "before the beginning" */
	    idx = minBoundary;
	} else if (idx == INT_MAX) {
	    /* This index value is always "after the end" */
	    idx = maxBoundary;
	}
	/* usual case, the absolute index value encodes itself */
    } else {
	result = TclGetEndOffsetFromObj(NULL, tmpObj, 0, &idx);
	if (result == TCL_OK) {
	    /*
	     * We parsed an end+offset index value. 
	     * idx holds the offset value in the range INT_MIN...INT_MAX.
	     */
	    if (idx > 0) {
		/*
		 * All end+postive or end-negative expressions 
		 * always indicate "after the end".
		 */
		idx = maxBoundary;
	    } else if (idx < INT_MIN - TCL_INDEX_END) {
		/* These indices always indicate "before the beginning */
		idx = minBoundary;
	    } else {
		/* Encoded end-positive (or end+negative) are offset */
		idx += TCL_INDEX_END;
	    }
	} else {
	    result = TclGetIntForIndexM(NULL, tmpObj, 0, &idx);
	    if (result == TCL_OK) {
		/*
		 * Only reach this case when the index value is a
		 * constant index arithmetic expression, and idx
		 * holds the result. Treat it the same as if it were
		 * parsed as an absolute integer value.
		 */
		goto integerEncode;
	    }
	}
    }
    Tcl_DecrRefCount(tmpObj);

    if (result == TCL_OK) {
	*index = idx;
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileGlobalCmd --

    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (numWords != 3) {
	goto emitComplexLindex;
    }

    idxTokenPtr = TokenAfter(valTokenPtr);
    if (TclGetIndexFromToken(idxTokenPtr, &idx, TCL_INDEX_BEFORE,
	TCL_INDEX_BEFORE) == TCL_OK) {
	/*
	 * The idxTokenPtr parsed as a valid index value and was
	 * encoded as expected by INST_LIST_INDEX_IMM.
	 *
	 * NOTE: that we rely on indexing before a list producing the
	 * same result as indexing after a list.
	 */

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, &idx1, TCL_INDEX_START,
	    TCL_INDEX_AFTER) != TCL_OK) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "first" indices
     * before the list same as the start of the list.
     */

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, &idx2, TCL_INDEX_BEFORE,
	    TCL_INDEX_END) != TCL_OK) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "last" indices
     * after the list same as the end of the list.
     */

    /*
     * NOTE: This command treats all inserts at indices before the list
     * the same as inserts at the start of the list, and all inserts
     * after the list the same as inserts at the end of the list. We
     * make that transformation here so we can use the optimized bytecode
     * as much as possible.
     */
    if (TclGetIndexFromToken(tokenPtr, &idx, TCL_INDEX_START,
	    TCL_INDEX_END) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * There are four main cases. If there are no values to insert, this is
     * just a confirm-listiness check. If the index is '0', this is a prepend.
     * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, &idx1, TCL_INDEX_START,
	    TCL_INDEX_AFTER) != TCL_OK) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, &idx2, TCL_INDEX_BEFORE,
	    TCL_INDEX_END) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * idx1, idx2 are the conventional encoded forms of the tokens parsed
     * as all forms of index values.  Values of idx1 that come before the
     * list are treated the same as if they were the start of the list.

    /* Every path must push the string argument */
    CompileWord(envPtr, stringTokenPtr,			interp, 1);

    /*
     * Parse the two indices.
     */

    if (TclGetIndexFromToken(fromTokenPtr, &idx1, TCL_INDEX_START,
	    TCL_INDEX_AFTER) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices before
     * the string the same as the start of the string.
     */

    if (idx1 == TCL_INDEX_AFTER) {
	/* [string range $s end+1 $last] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    if (TclGetIndexFromToken(toTokenPtr, &idx2, TCL_INDEX_BEFORE,
	    TCL_INDEX_END) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices after
     * the string the same as the end of the string.
     */
    if (idx2 == TCL_INDEX_BEFORE) {

    if (parsePtr->numWords == 5) {
	tokenPtr = TokenAfter(valueTokenPtr);
	tokenPtr = TokenAfter(tokenPtr);
	replacementTokenPtr = TokenAfter(tokenPtr);
    }

    tokenPtr = TokenAfter(valueTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, &idx1, TCL_INDEX_START,
	    TCL_INDEX_AFTER) != TCL_OK) {
	goto genericReplace;
    }
    /*
     * Token parsed as an index value. Indices before the string are
     * treated as index of start of string.
     */

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, &idx2, TCL_INDEX_BEFORE,
	    TCL_INDEX_END) != TCL_OK) {
	goto genericReplace;
    }
    /*
     * Token parsed as an index value. Indices after the string are
     * treated as index of end of string.
     */

MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    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, int *index,
			    int minBoundary, int maxBoundary);
MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);

	    goto gotError;
	}

	/*
	 * Decode end-offset index values.
	 */

	if (index <= TCL_INDEX_END) {
	    index += (objc - 1 - TCL_INDEX_END);
	}
	pcAdjustment = 5;

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);

	/* Decode index value operands. */

	assert ( toIdx != TCL_INDEX_AFTER);

	if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) {
	    goto emptyList;
	}
	if (toIdx <= TCL_INDEX_END) {
	    toIdx += (objc - 1 - TCL_INDEX_END);
	    if (toIdx < 0) {
		goto emptyList;
	    }
	} else if (toIdx >= objc) {
	    toIdx = objc - 1;
	}

	assert ( toIdx >= 0 && toIdx < objc);
	assert ( fromIdx != TCL_INDEX_BEFORE );
	assert ( fromIdx != TCL_INDEX_AFTER);

	if (fromIdx <= TCL_INDEX_END) {
	    fromIdx += (objc - 1 - TCL_INDEX_END);
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	}
	assert ( fromIdx >= 0 );

	if (fromIdx <= toIdx) {
	    /* Construct the subsquence list */
	    /* unshared optimization */
	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	    } else {

	}

	/* Decode index operands. */

	assert ( toIdx != TCL_INDEX_BEFORE );
	assert ( toIdx != TCL_INDEX_AFTER);

	if (toIdx <= TCL_INDEX_END) {
	    toIdx += (length - 1 - TCL_INDEX_END);
	    if (toIdx < 0) {
		goto emptyRange;
	    }
	} else if (toIdx >= length) {
	    toIdx = length - 1;
	}

	assert ( toIdx >= 0 && toIdx < length );

	assert ( fromIdx != TCL_INDEX_BEFORE );
	assert ( fromIdx != TCL_INDEX_AFTER);

	if (fromIdx <= TCL_INDEX_END) {
	    fromIdx += (length - 1 - TCL_INDEX_END);
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	}

	assert ( fromIdx >= 0 );

	if (fromIdx <= toIdx) {
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	} else {
	emptyRange:
	    TclNewObj(objResultPtr);
	}