From c13e34da3740d014ade6f5e1dadcae12e18e27ed Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 Mar 2018 20:34:33 +0000 Subject: Update the command compilers and bytecode execution engine to use new machinery. --- generic/tclAssembly.c | 4 +- generic/tclCompCmdsGR.c | 128 +++++++----------------------------------------- generic/tclCompCmdsSZ.c | 16 +++--- generic/tclCompile.h | 4 +- generic/tclExecute.c | 39 +++++---------- 5 files changed, 44 insertions(+), 147 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index a3fac8f..608459e 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -2263,8 +2263,8 @@ GetListIndexOperand( * 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); + status = TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, + TCL_INDEX_BEFORE, result); *tokenPtrPtr = TokenAfter(tokenPtr); if (status == TCL_ERROR && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%.*s\"", diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index e2ddb11..396947c 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -35,45 +35,7 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, * 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. + * compile time. * * Returns: * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. @@ -88,69 +50,17 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, int TclGetIndexFromToken( Tcl_Token *tokenPtr, - int *index, - int minBoundary, - int maxBoundary) + int before, + int after, + int *indexPtr) { Tcl_Obj *tmpObj = Tcl_NewObj(); - int result, idx; + int result = TCL_ERROR; - 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; - } - } + if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr); } Tcl_DecrRefCount(tmpObj); - - if (result == TCL_OK) { - *index = idx; - } - return result; } @@ -1177,8 +1087,8 @@ TclCompileLindexCmd( } idxTokenPtr = TokenAfter(valTokenPtr); - if (TclGetIndexFromToken(idxTokenPtr, &idx, TCL_INDEX_BEFORE, - TCL_INDEX_BEFORE) == TCL_OK) { + if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_BEFORE, + &idx) == TCL_OK) { /* * The idxTokenPtr parsed as a valid index value and was * encoded as expected by INST_LIST_INDEX_IMM. @@ -1406,8 +1316,8 @@ TclCompileLrangeCmd( listTokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(listTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx1, TCL_INDEX_START, - TCL_INDEX_AFTER) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, + &idx1) != TCL_OK) { return TCL_ERROR; } /* @@ -1416,8 +1326,8 @@ TclCompileLrangeCmd( */ tokenPtr = TokenAfter(tokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx2, TCL_INDEX_BEFORE, - TCL_INDEX_END) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, + &idx2) != TCL_OK) { return TCL_ERROR; } /* @@ -1481,8 +1391,8 @@ TclCompileLinsertCmd( * 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) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END, + &idx) != TCL_OK) { return TCL_ERROR; } @@ -1571,14 +1481,14 @@ TclCompileLreplaceCmd( listTokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(listTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx1, TCL_INDEX_START, - TCL_INDEX_AFTER) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, + &idx1) != TCL_OK) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx2, TCL_INDEX_BEFORE, - TCL_INDEX_END) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, + &idx2) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index f98d375..5cd1c3b 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -937,8 +937,8 @@ TclCompileStringRangeCmd( * Parse the two indices. */ - if (TclGetIndexFromToken(fromTokenPtr, &idx1, TCL_INDEX_START, - TCL_INDEX_AFTER) != TCL_OK) { + if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, + &idx1) != TCL_OK) { goto nonConstantIndices; } /* @@ -953,8 +953,8 @@ TclCompileStringRangeCmd( return TCL_OK; } - if (TclGetIndexFromToken(toTokenPtr, &idx2, TCL_INDEX_BEFORE, - TCL_INDEX_END) != TCL_OK) { + if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, + &idx2) != TCL_OK) { goto nonConstantIndices; } /* @@ -1010,8 +1010,8 @@ TclCompileStringReplaceCmd( } tokenPtr = TokenAfter(valueTokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx1, TCL_INDEX_START, - TCL_INDEX_AFTER) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER, + &idx1) != TCL_OK) { goto genericReplace; } /* @@ -1020,8 +1020,8 @@ TclCompileStringReplaceCmd( */ tokenPtr = TokenAfter(tokenPtr); - if (TclGetIndexFromToken(tokenPtr, &idx2, TCL_INDEX_BEFORE, - TCL_INDEX_END) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, + &idx2) != TCL_OK) { goto genericReplace; } /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index d842fdd..6aaa855 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1121,8 +1121,8 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, 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 int TclGetIndexFromToken(Tcl_Token *tokenPtr, + int before, int after, int *indexPtr); MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7043179..188eadc 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5093,9 +5093,7 @@ TEBCresume( * Decode end-offset index values. */ - if (index <= TCL_INDEX_END) { - index += (objc - 1 - TCL_INDEX_END); - } + index = TclIndexDecode(index, objc - 1); pcAdjustment = 5; lindexFastPath: @@ -5250,11 +5248,9 @@ TEBCresume( 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; - } + toIdx = TclIndexDecode(toIdx, objc - 1); + if (toIdx < 0) { + goto emptyList; } else if (toIdx >= objc) { toIdx = objc - 1; } @@ -5263,13 +5259,10 @@ TEBCresume( 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; - } + fromIdx = TclIndexDecode(fromIdx, objc - 1); + if (fromIdx < 0) { + fromIdx = 0; } - assert ( fromIdx >= 0 ); if (fromIdx <= toIdx) { /* Construct the subsquence list */ @@ -5643,11 +5636,9 @@ TEBCresume( 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; - } + toIdx = TclIndexDecode(toIdx, length - 1); + if (toIdx < 0) { + goto emptyRange; } else if (toIdx >= length) { toIdx = length - 1; } @@ -5657,15 +5648,11 @@ TEBCresume( 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; - } + fromIdx = TclIndexDecode(fromIdx, length - 1); + if (fromIdx < 0) { + fromIdx = 0; } - assert ( fromIdx >= 0 ); - if (fromIdx <= toIdx) { objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } else { -- cgit v0.12