From 2cd8bf554e767af28e60465bb3f683399421e0f6 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 1 Mar 2018 16:48:55 +0000 Subject: Refactor to eliminate duplicate routine parsing tokens as indices. --- generic/tclCompCmdsGR.c | 61 +++++++++++++++++++++-------------------- generic/tclCompCmdsSZ.c | 72 +++++++------------------------------------------ generic/tclCompile.h | 7 +++++ 3 files changed, 47 insertions(+), 93 deletions(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index ffe39ba..aa0f7bb 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -28,12 +28,11 @@ static void CompileReturnInternal(CompileEnv *envPtr, static int IndexTailVarIfKnown(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr); -#define INDEX_END (-2) /* *---------------------------------------------------------------------- * - * GetIndexFromToken -- + * TclGetIndexFromToken -- * * Parse a token and get the encoded version of the index (as understood * by TEBC), assuming it is at all knowable at compile time. Only handles @@ -48,8 +47,8 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, *---------------------------------------------------------------------- */ -static inline int -GetIndexFromToken( +int +TclGetIndexFromToken( Tcl_Token *tokenPtr, int *index) { @@ -67,8 +66,8 @@ GetIndexFromToken( result = TCL_ERROR; } } else { - result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx); - if (result == TCL_OK && idx > INDEX_END) { + result = TclGetIntForIndexM(NULL, tmpObj, TCL_INDEX_END, &idx); + if (result == TCL_OK && idx > TCL_INDEX_END) { result = TCL_ERROR; } } @@ -1053,7 +1052,7 @@ TclCompileLassignCmd( */ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( INDEX_END, envPtr); + TclEmitInt4( TCL_INDEX_END, envPtr); return TCL_OK; } @@ -1104,7 +1103,7 @@ TclCompileLindexCmd( } idxTokenPtr = TokenAfter(valTokenPtr); - if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) { + if (TclGetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) { /* * All checks have been completed, and we have exactly one of these * constructs: @@ -1258,7 +1257,7 @@ TclCompileListCmd( if (concat && numWords == 2) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); - TclEmitInt4( INDEX_END, envPtr); + TclEmitInt4( TCL_INDEX_END, envPtr); } return TCL_OK; } @@ -1339,12 +1338,12 @@ TclCompileLrangeCmd( */ tokenPtr = TokenAfter(listTokenPtr); - if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); - if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { return TCL_ERROR; } @@ -1396,21 +1395,21 @@ TclCompileLinsertCmd( */ tokenPtr = TokenAfter(listTokenPtr); - if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx) != 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' (== INDEX_END), this is an append. Otherwise, + * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise, * this is a splice (== split, insert values as list, concat-3). */ CompileWord(envPtr, listTokenPtr, interp, 1); if (parsePtr->numWords == 3) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); - TclEmitInt4( INDEX_END, envPtr); + TclEmitInt4( TCL_INDEX_END, envPtr); return TCL_OK; } @@ -1423,7 +1422,7 @@ TclCompileLinsertCmd( if (idx == 0 /*start*/) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); - } else if (idx == INDEX_END /*end*/) { + } else if (idx == TCL_INDEX_END /*end*/) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { if (idx < 0) { @@ -1434,7 +1433,7 @@ TclCompileLinsertCmd( TclEmitInt4( idx-1, envPtr); TclEmitInstInt4( INST_REVERSE, 3, envPtr); TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( INDEX_END, envPtr); + TclEmitInt4( TCL_INDEX_END, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); } @@ -1479,12 +1478,12 @@ TclCompileLreplaceCmd( */ tokenPtr = TokenAfter(listTokenPtr); - if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { return TCL_ERROR; } tokenPtr = TokenAfter(tokenPtr); - if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { return TCL_ERROR; } @@ -1492,9 +1491,9 @@ TclCompileLreplaceCmd( * idx1, idx2 are now in canonical form: * * - integer: [0,len+1] - * - end index: INDEX_END - * - -ive offset: INDEX_END-[len-1,0] - * - +ive offset: INDEX_END+1 + * - end index: TCL_INDEX_END + * - -ive offset: TCL_INDEX_END-[len-1,0] + * - +ive offset: TCL_INDEX_END+1 */ /* @@ -1503,11 +1502,11 @@ TclCompileLreplaceCmd( * now. [Bug 47ac84309b] */ - if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) { + if ((idx1 <= TCL_INDEX_END) != (idx2 <= TCL_INDEX_END)) { return TCL_ERROR; } - if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) { + if (idx2 != TCL_INDEX_END && idx2 >= 0 && idx2 < idx1) { idx2 = idx1 - 1; } @@ -1519,13 +1518,13 @@ TclCompileLreplaceCmd( CompileWord(envPtr, listTokenPtr, interp, 1); if (parsePtr->numWords == 4) { if (idx1 == 0) { - if (idx2 == INDEX_END) { + if (idx2 == TCL_INDEX_END) { goto dropAll; } idx1 = idx2 + 1; - idx2 = INDEX_END; + idx2 = TCL_INDEX_END; goto dropEnd; - } else if (idx2 == INDEX_END) { + } else if (idx2 == TCL_INDEX_END) { idx2 = idx1 - 1; idx1 = 0; goto dropEnd; @@ -1549,13 +1548,13 @@ TclCompileLreplaceCmd( TclEmitInstInt4( INST_LIST, i - 4, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); if (idx1 == 0) { - if (idx2 == INDEX_END) { + if (idx2 == TCL_INDEX_END) { goto replaceAll; } idx1 = idx2 + 1; - idx2 = INDEX_END; + idx2 = TCL_INDEX_END; goto replaceHead; - } else if (idx2 == INDEX_END) { + } else if (idx2 == TCL_INDEX_END) { idx2 = idx1 - 1; idx1 = 0; goto replaceTail; @@ -1623,7 +1622,7 @@ TclCompileLreplaceCmd( TclEmitInt4( idx1 - 1, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr); - TclEmitInt4( INDEX_END, envPtr); + TclEmitInt4( TCL_INDEX_END, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); goto done; @@ -1693,7 +1692,7 @@ TclCompileLreplaceCmd( TclEmitInt4( idx1 - 1, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr); - TclEmitInt4( INDEX_END, envPtr); + TclEmitInt4( TCL_INDEX_END, envPtr); TclEmitInstInt4( INST_REVERSE, 3, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 101edbd..fb0981d 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -107,58 +107,6 @@ const AuxDataType tclJumptableInfoType = { #define INVOKE(name) \ TclEmitInvoke(envPtr,INST_##name) -#define INDEX_END (-2) - -/* - *---------------------------------------------------------------------- - * - * GetIndexFromToken -- - * - * Parse a token and get the encoded version of the index (as understood - * by TEBC), assuming it is at all knowable at compile time. Only handles - * indices that are integers or 'end' or 'end-integer'. - * - * Returns: - * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. - * - * Side effects: - * Sets *index to the index value if successful. - * - *---------------------------------------------------------------------- - */ - -static inline int -GetIndexFromToken( - Tcl_Token *tokenPtr, - int *index) -{ - 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) { - if (idx < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx); - if (result == TCL_OK && idx > INDEX_END) { - result = TCL_ERROR; - } - } - Tcl_DecrRefCount(tmpObj); - - if (result == TCL_OK) { - *index = idx; - } - - return result; -} /* *---------------------------------------------------------------------- @@ -986,10 +934,10 @@ TclCompileStringRangeCmd( * Parse the two indices. */ - if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) { goto nonConstantIndices; } - if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) { goto nonConstantIndices; } @@ -1044,18 +992,18 @@ TclCompileStringReplaceCmd( */ tokenPtr = TokenAfter(valueTokenPtr); - if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { goto genericReplace; } tokenPtr = TokenAfter(tokenPtr); - if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + if (TclGetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { goto genericReplace; } /* * We handle these replacements specially: first character (where - * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything + * idx1=idx2=0) and last character (where idx1=idx2=TCL_INDEX_END). Anything * else and the semantics get rather screwy. */ @@ -1069,7 +1017,7 @@ TclCompileStringReplaceCmd( CompileWord(envPtr, valueTokenPtr, interp, 1); if (replacementTokenPtr == NULL) { /* Drop first */ - OP44( STR_RANGE_IMM, 1, INDEX_END); + OP44( STR_RANGE_IMM, 1, TCL_INDEX_END); return TCL_OK; } /* Replace first */ @@ -1083,12 +1031,12 @@ TclCompileStringReplaceCmd( FIXJUMP1(notEq); TclAdjustStackDepth(1, envPtr); OP4( REVERSE, 2); - OP44( STR_RANGE_IMM, 1, INDEX_END); + OP44( STR_RANGE_IMM, 1, TCL_INDEX_END); OP1( STR_CONCAT1, 2); FIXJUMP1(end); return TCL_OK; - } else if (idx1 == INDEX_END && idx2 == INDEX_END) { + } else if (idx1 == TCL_INDEX_END && idx2 == TCL_INDEX_END) { int notEq, end; /* @@ -1098,7 +1046,7 @@ TclCompileStringReplaceCmd( CompileWord(envPtr, valueTokenPtr, interp, 1); if (replacementTokenPtr == NULL) { /* Drop last */ - OP44( STR_RANGE_IMM, 0, INDEX_END-1); + OP44( STR_RANGE_IMM, 0, TCL_INDEX_END-1); return TCL_OK; } /* Replace last */ @@ -1112,7 +1060,7 @@ TclCompileStringReplaceCmd( FIXJUMP1(notEq); TclAdjustStackDepth(1, envPtr); OP4( REVERSE, 2); - OP44( STR_RANGE_IMM, 0, INDEX_END-1); + OP44( STR_RANGE_IMM, 0, TCL_INDEX_END-1); OP4( REVERSE, 2); OP1( STR_CONCAT1, 2); FIXJUMP1(end); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c04fc0e..1c64a21 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1121,6 +1121,7 @@ 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); MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, @@ -1684,6 +1685,12 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define TCL_NO_ELEMENT 2 /* Do not push the array element. */ /* + * Special value used by TclGetIndexFromToken to encoding the "end" index. + */ + +#define TCL_INDEX_END (-2) + +/* * DTrace probe macros (NOPs if DTrace support is not enabled). */ -- cgit v0.12 From 683dada2173aaa8eb39f76d13d7e9505e77ec5b7 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 1 Mar 2018 20:07:29 +0000 Subject: Some comments info for the next folks who come wandering in. --- generic/tclCompCmdsGR.c | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index aa0f7bb..375653b 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -1425,7 +1425,19 @@ TclCompileLinsertCmd( } else if (idx == TCL_INDEX_END /*end*/) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { - if (idx < 0) { + /* + * Here we handle two ranges for idx. First when idx > 0, we + * want the first half of the split to end at index idx-1 and + * the second half to start at index idx. + * Second when idx < TCL_INDEX_END, indicating "end-N" indexing, + * we want the first half of the split to end at index end-N and + * the second half to start at index end-N+1. We accomplish this + * with a pre-adjustment of the end-N value. + * The root of this is that the commands [lrange] and [linsert] + * differ in their interpretation of the "end" index. + */ + + if (idx < TCL_INDEX_END) { idx++; } TclEmitInstInt4( INST_OVER, 1, envPtr); -- cgit v0.12