From af3406f86c40c78cff50cb5003b8be0eae448d54 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 Jan 2019 21:34:29 +0000 Subject: New internal macro TclFetchIntRep, which is faster than Tcl_FetchIntRep. But ... don't use this function when the result is only compared to NULL: that's just overkill. --- generic/tclBasic.c | 16 ++++++++-------- generic/tclBinary.c | 44 ++++++++++++++++++++++---------------------- generic/tclClock.c | 2 +- generic/tclCmdMZ.c | 12 ++++++------ generic/tclCompile.h | 2 +- generic/tclDictObj.c | 4 ++-- generic/tclDisassemble.c | 6 +++--- generic/tclEncoding.c | 2 +- generic/tclEnsemble.c | 2 +- generic/tclExecute.c | 10 +++++----- generic/tclIO.c | 2 +- generic/tclIndexObj.c | 16 ++++++++-------- generic/tclInt.h | 2 ++ generic/tclLink.c | 2 +- generic/tclListObj.c | 10 +++++----- generic/tclNamesp.c | 2 +- generic/tclOOCall.c | 6 +++--- generic/tclObj.c | 8 +------- generic/tclPathObj.c | 22 +++++++++++----------- generic/tclProc.c | 8 ++++---- generic/tclRegexp.c | 2 +- generic/tclScan.c | 2 +- generic/tclUtil.c | 2 +- generic/tclVar.c | 4 ++-- 24 files changed, 92 insertions(+), 96 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0fc4f9c..44acac8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3870,7 +3870,7 @@ OldMathFuncProc( #ifdef ACCEPT_NAN if (result != TCL_OK) { const Tcl_ObjIntRep *irPtr - = Tcl_FetchIntRep(valuePtr, &tclDoubleType); + = TclFetchIntRep(valuePtr, &tclDoubleType); if (irPtr) { d = irPtr->doubleValue; @@ -7435,7 +7435,7 @@ ExprCeilFunc( code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { Tcl_SetObjResult(interp, objv[1]); @@ -7475,7 +7475,7 @@ ExprFloorFunc( code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { Tcl_SetObjResult(interp, objv[1]); @@ -7615,7 +7615,7 @@ ExprSqrtFunc( code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { Tcl_SetObjResult(interp, objv[1]); @@ -7662,7 +7662,7 @@ ExprUnaryFunc( code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { d = irPtr->doubleValue; @@ -7726,7 +7726,7 @@ ExprBinaryFunc( code = Tcl_GetDoubleFromObj(interp, objv[1], &d1); #ifdef ACCEPT_NAN if (code != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { d1 = irPtr->doubleValue; @@ -7741,7 +7741,7 @@ ExprBinaryFunc( code = Tcl_GetDoubleFromObj(interp, objv[2], &d2); #ifdef ACCEPT_NAN if (code != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { d2 = irPtr->doubleValue; @@ -7889,7 +7889,7 @@ ExprDoubleFunc( } if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) { #ifdef ACCEPT_NAN - if (Tcl_FetchIntRep(objv[1], &tclDoubleType)) { + if (objv[1]->typePtr == &tclDoubleType) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index acd26bf..f069090 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -291,7 +291,7 @@ int TclIsPureByteArray( Tcl_Obj * objPtr) { - return (NULL != Tcl_FetchIntRep(objPtr, &properByteArrayType)); + return objPtr->typePtr == &properByteArrayType; } /* @@ -453,15 +453,15 @@ Tcl_GetByteArrayFromObj( * array of bytes in the ByteArray object. */ { ByteArray *baPtr; - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); - irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); } } } @@ -511,14 +511,14 @@ Tcl_SetByteArrayLength( Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } - irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); - irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); } } } @@ -562,10 +562,10 @@ SetByteArrayFromAny( ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; - if (Tcl_FetchIntRep(objPtr, &properByteArrayType)) { + if (objPtr->typePtr == &properByteArrayType) { return TCL_OK; } - if (Tcl_FetchIntRep(objPtr, &tclByteArrayType)) { + if (objPtr->typePtr == &tclByteArrayType) { return TCL_OK; } @@ -611,14 +611,14 @@ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &tclByteArrayType))); + ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); } static void FreeProperByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &properByteArrayType))); + ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); } /* @@ -647,7 +647,7 @@ DupByteArrayInternalRep( ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; - srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &tclByteArrayType)); + srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); @@ -668,7 +668,7 @@ DupProperByteArrayInternalRep( ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; - srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &properByteArrayType)); + srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); @@ -702,7 +702,7 @@ UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; unsigned int i, length = byteArrayPtr->used; @@ -777,14 +777,14 @@ TclAppendBytesToByteArray( length = (unsigned int)len; - irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); - irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType); + irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType); + irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); } } } @@ -2031,7 +2031,7 @@ FormatNumber( */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); if (irPtr == NULL) { return TCL_ERROR; } @@ -2051,7 +2051,7 @@ FormatNumber( */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); if (irPtr == NULL) { return TCL_ERROR; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 1ec3e28..2c25f6c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -452,7 +452,7 @@ ClockGetdatefieldsObjCmd( * that it isn't. */ - if (Tcl_FetchIntRep(objv[1], &tclBignumType)) { + if (objv[1]->typePtr == &tclBignumType) { Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ab46d52..dac82b8 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1641,9 +1641,9 @@ StringIsCmd( chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { - if (Tcl_FetchIntRep(objPtr, &tclDoubleType) || - Tcl_FetchIntRep(objPtr, &tclIntType) || - Tcl_FetchIntRep(objPtr, &tclBignumType)) { + if ((objPtr->typePtr == &tclDoubleType) || + (objPtr->typePtr == &tclIntType) || + (objPtr->typePtr == &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); @@ -1672,8 +1672,8 @@ StringIsCmd( break; case STR_IS_INT: case STR_IS_ENTIER: - if (Tcl_FetchIntRep(objPtr, &tclIntType) || - Tcl_FetchIntRep(objPtr, &tclBignumType)) { + if ((objPtr->typePtr == &tclIntType) || + (objPtr->typePtr == &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); @@ -1952,7 +1952,7 @@ StringMapCmd( */ if (!TclHasStringRep(objv[objc-2]) - && Tcl_FetchIntRep(objv[objc-2], &tclDictType)){ + && (objv[objc-2]->typePtr == &tclDictType)){ int i, done; Tcl_DictSearch search; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index e5a8d52..cf11e0e 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -528,7 +528,7 @@ typedef struct ByteCode { #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), (typePtr)); \ + irPtr = TclFetchIntRep((objPtr), (typePtr)); \ (codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 13ff0f8..629a3f0 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -173,7 +173,7 @@ const Tcl_ObjType tclDictType = { #define DictGetIntRep(objPtr, dictRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &tclDictType); \ + irPtr = TclFetchIntRep((objPtr), &tclDictType); \ (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) @@ -623,7 +623,7 @@ SetDictFromAny( * the conversion from lists to dictionaries. */ - if (Tcl_FetchIntRep(objPtr, &tclListType)) { + if (objPtr->typePtr == &tclListType) { int objc, i; Tcl_Obj **objv; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 6ea3397..027683d 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -56,7 +56,7 @@ static const Tcl_ObjType instNameType = { #define InstNameGetIntRep(objPtr, inst) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &instNameType); \ + irPtr = TclFetchIntRep((objPtr), &instNameType); \ assert(irPtr != NULL); \ (inst) = (size_t)irPtr->wideValue; \ } while (0) @@ -1384,7 +1384,7 @@ Tcl_DisassembleObjCmd( return TCL_ERROR; } - if ((NULL == Tcl_FetchIntRep(objv[2], &tclByteCodeType)) && (TCL_OK + if ((objv[2]->typePtr != &tclByteCodeType) && (TCL_OK != TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) { return TCL_ERROR; } @@ -1585,7 +1585,7 @@ Tcl_DisassembleObjCmd( "METHODTYPE", NULL); return TCL_ERROR; } - if (NULL == Tcl_FetchIntRep(procPtr->bodyPtr, &tclByteCodeType)) { + if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { Command cmd; /* diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index cb28f5a..e601c3a 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -290,7 +290,7 @@ static const Tcl_ObjType encodingType = { #define EncodingGetIntRep(objPtr, encoding) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep ((objPtr), &encodingType); \ + irPtr = TclFetchIntRep ((objPtr), &encodingType); \ (encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index a5fd715..73e3ce7 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -95,7 +95,7 @@ static const Tcl_ObjType ensembleCmdType = { #define ECRGetIntRep(objPtr, ecRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &ensembleCmdType); \ + irPtr = TclFetchIntRep((objPtr), &ensembleCmdType); \ (ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 06403c7..897e2cd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -750,7 +750,7 @@ ReleaseDictIterator( Tcl_Obj *dictPtr; const Tcl_ObjIntRep *irPtr; - irPtr = Tcl_FetchIntRep(objPtr, &dictIteratorType); + irPtr = TclFetchIntRep(objPtr, &dictIteratorType); assert(irPtr != NULL); /* @@ -4768,7 +4768,7 @@ TEBCresume( */ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) - && (NULL == Tcl_FetchIntRep(value2Ptr, &tclListType)) + && (value2Ptr->typePtr != &tclListType) && (TclGetIntForIndexM(NULL, value2Ptr, objc-1, &index) == TCL_OK)) { TclDecrRefCount(value2Ptr); @@ -7108,7 +7108,7 @@ TEBCresume( } varPtr = LOCAL(opnd); if (varPtr->value.objPtr) { - if (Tcl_FetchIntRep(varPtr->value.objPtr, &dictIteratorType)) { + if (varPtr->value.objPtr->typePtr == &dictIteratorType) { Tcl_Panic("mis-issued dictFirst!"); } TclDecrRefCount(varPtr->value.objPtr); @@ -7125,7 +7125,7 @@ TEBCresume( const Tcl_ObjIntRep *irPtr; if (statePtr && - (irPtr = Tcl_FetchIntRep(statePtr, &dictIteratorType))) { + (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) { searchPtr = irPtr->twoPtrValue.ptr1; Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done); } else { @@ -9622,7 +9622,7 @@ EvalStatsCmd( for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { - if (NULL != Tcl_FetchIntRep(entryPtr->objPtr, &tclByteCodeType)) { + if (entryPtr->objPtr->typePtr == &tclByteCodeType) { numByteCodeLits++; } (void) TclGetStringFromObj(entryPtr->objPtr, &length); diff --git a/generic/tclIO.c b/generic/tclIO.c index d144cbc..7c93e1a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -349,7 +349,7 @@ static const Tcl_ObjType chanObjType = { #define ChanGetIntRep(objPtr, resPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &chanObjType); \ + irPtr = TclFetchIntRep((objPtr), &chanObjType); \ (resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index c39c0dc..965ec24 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -123,7 +123,7 @@ Tcl_GetIndexFromObj( * the common case where the result is cached). */ - const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &indexType); + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { IndexRep *indexRep = irPtr->twoPtrValue.ptr1; @@ -282,7 +282,7 @@ Tcl_GetIndexFromObjStruct( */ if (!(flags & INDEX_TEMP_TABLE)) { - irPtr = Tcl_FetchIntRep(objPtr, &indexType); + irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { indexRep = irPtr->twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { @@ -346,7 +346,7 @@ Tcl_GetIndexFromObjStruct( */ if (!(flags & INDEX_TEMP_TABLE)) { - irPtr = Tcl_FetchIntRep(objPtr, &indexType); + irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { indexRep = irPtr->twoPtrValue.ptr1; } else { @@ -457,7 +457,7 @@ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { - IndexRep *indexRep = Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; + IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; register const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); @@ -489,7 +489,7 @@ DupIndex( Tcl_ObjIntRep ir; IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep)); - memcpy(dupIndexRep, Tcl_FetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, + memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, sizeof(IndexRep)); ir.twoPtrValue.ptr1 = dupIndexRep; @@ -517,7 +517,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree(Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); + ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -966,7 +966,7 @@ Tcl_WrongNumArgs( */ const Tcl_ObjIntRep *irPtr; - if ((irPtr = Tcl_FetchIntRep(origObjv[i], &indexType))) { + if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); @@ -1016,7 +1016,7 @@ Tcl_WrongNumArgs( */ const Tcl_ObjIntRep *irPtr; - if ((irPtr = Tcl_FetchIntRep(objv[i], &indexType))) { + if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); diff --git a/generic/tclInt.h b/generic/tclInt.h index e66514d..b220a31 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4624,6 +4624,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) +#define TclFetchIntRep(objPtr, type) \ + (((objPtr)->typePtr == type) ? &((objPtr)->internalRep) : NULL) /* diff --git a/generic/tclLink.c b/generic/tclLink.c index 952df4e..eb4155a 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -416,7 +416,7 @@ LinkTraceProc( case TCL_LINK_DOUBLE: if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(valueObj, &tclDoubleType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(valueObj, &tclDoubleType); if (irPtr == NULL) { #endif if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) { diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 2ea47ba..7a90950 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -61,12 +61,12 @@ const Tcl_ObjType tclListType = { #define ListGetIntRep(objPtr, listRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &tclListType); \ + irPtr = TclFetchIntRep((objPtr), &tclListType); \ (listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) #define ListResetIntRep(objPtr, listRepPtr) \ - Tcl_FetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr) + TclFetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr) #ifndef TCL_MIN_ELEMENT_GROWTH #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *) @@ -1667,7 +1667,7 @@ TclLsetFlat( * them at that time. */ - irPtr = Tcl_FetchIntRep(parentList, &tclListType); + irPtr = TclFetchIntRep(parentList, &tclListType); irPtr->twoPtrValue.ptr2 = chainPtr; chainPtr = parentList; } @@ -1688,7 +1688,7 @@ TclLsetFlat( * Clear away our intrep surgery mess. */ - irPtr = Tcl_FetchIntRep(objPtr, &tclListType); + irPtr = TclFetchIntRep(objPtr, &tclListType); listRepPtr = irPtr->twoPtrValue.ptr1; chainPtr = irPtr->twoPtrValue.ptr2; @@ -1997,7 +1997,7 @@ SetListFromAny( * describe duplicate keys). */ - if (!TclHasStringRep(objPtr) && Tcl_FetchIntRep(objPtr, &tclDictType)) { + if (!TclHasStringRep(objPtr) && (objPtr->typePtr == &tclDictType)) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done, size; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 5205344..de2222e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -165,7 +165,7 @@ static const Tcl_ObjType nsNameType = { #define NsNameGetIntRep(objPtr, nnPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &nsNameType); \ + irPtr = TclFetchIntRep((objPtr), &nsNameType); \ (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 974e598..908dd26 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -280,7 +280,7 @@ DupMethodNameRep( Tcl_Obj *dstPtr) { StashCallChain(dstPtr, - Tcl_FetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); + TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); } static void @@ -288,7 +288,7 @@ FreeMethodNameRep( Tcl_Obj *objPtr) { TclOODeleteChain( - Tcl_FetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1); + TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1); } /* @@ -1189,7 +1189,7 @@ TclOOGetCallContext( const Tcl_ObjIntRep *irPtr; const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); - if ((irPtr = Tcl_FetchIntRep(cacheInThisObj, &methodNameType))) { + if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) { callPtr = irPtr->twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; diff --git a/generic/tclObj.c b/generic/tclObj.c index e1346cf..3385c0d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1917,13 +1917,7 @@ Tcl_FetchIntRep( Tcl_Obj *objPtr, /* Object to fetch from. */ const Tcl_ObjType *typePtr) /* Requested type */ { - /* If objPtr type doesn't match request, nothing can be fetched */ - if (objPtr->typePtr != typePtr) { - return NULL; - } - - /* Type match! objPtr IntRep is the one sought. */ - return &(objPtr->internalRep); + return TclFetchIntRep(objPtr, typePtr); } /* diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index ea8a7ec..0532b98 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -101,7 +101,7 @@ typedef struct FsPath { * fields. */ -#define PATHOBJ(pathPtr) ((FsPath *) (Tcl_FetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) +#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) #define SETPATHOBJ(pathPtr,fsPathPtr) \ do { \ Tcl_ObjIntRep ir; \ @@ -560,7 +560,7 @@ TclPathPart( Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); @@ -862,7 +862,7 @@ TclJoinPath( if (elements == 2) { Tcl_Obj *elt = objv[0]; - Tcl_ObjIntRep *eltIr = Tcl_FetchIntRep(elt, &fsPathType); + Tcl_ObjIntRep *eltIr = TclFetchIntRep(elt, &fsPathType); /* * This is a special case where we can be much more efficient, where @@ -1158,7 +1158,7 @@ Tcl_FSConvertToPathType( Tcl_Obj *pathPtr) /* Object to convert to a valid, current path * type. */ { - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); /* * While it is bad practice to examine an object's type directly, this is @@ -1412,7 +1412,7 @@ TclFSMakePathRelative( { int cwdLen, len; const char *tempStr; - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); @@ -1481,7 +1481,7 @@ MakePathFromNormalized( Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { return TCL_OK; @@ -1622,7 +1622,7 @@ Tcl_FSGetTranslatedPath( retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj); - translatedCwdIrPtr = Tcl_FetchIntRep(translatedCwdPtr, &fsPathType); + translatedCwdIrPtr = TclFetchIntRep(translatedCwdPtr, &fsPathType); if (translatedCwdIrPtr) { srcFsPathPtr->filesystemEpoch = PATHOBJ(translatedCwdPtr)->filesystemEpoch; @@ -2087,7 +2087,7 @@ TclFSEnsureEpochOk( const Tcl_Filesystem **fsPtrPtr) { FsPath *srcFsPathPtr; - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr == NULL) { return TCL_OK; @@ -2146,7 +2146,7 @@ TclFSSetPathDetails( ClientData clientData) { FsPath *srcFsPathPtr; - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);; + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);; /* * Make sure pathPtr is of the correct type. @@ -2250,7 +2250,7 @@ SetFsPathFromAny( FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { return TCL_OK; @@ -2558,7 +2558,7 @@ TclNativePathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { - Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType); + Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); /* * A special case is required to handle the empty path "". This is a valid diff --git a/generic/tclProc.c b/generic/tclProc.c index f1822a2..8580359 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -80,7 +80,7 @@ const Tcl_ObjType tclProcBodyType = { #define ProcGetIntRep(objPtr, procPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &tclProcBodyType); \ + irPtr = TclFetchIntRep((objPtr), &tclProcBodyType); \ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) @@ -126,7 +126,7 @@ static const Tcl_ObjType lambdaType = { #define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &lambdaType); \ + irPtr = TclFetchIntRep((objPtr), &lambdaType); \ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ (nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) @@ -329,7 +329,7 @@ Tcl_ProcObjCmd( * of all procs whose argument list is just _args_ */ - if (Tcl_FetchIntRep(objv[3], &tclProcBodyType)) { + if (TclFetchIntRep(objv[3], &tclProcBodyType)) { goto done; } @@ -794,7 +794,7 @@ TclObjGetFrame( level = curLevel - level; result = 1; } - } else if ((irPtr = Tcl_FetchIntRep(objPtr, &levelReferenceType))) { + } else if ((irPtr = TclFetchIntRep(objPtr, &levelReferenceType))) { level = irPtr->wideValue; result = 1; } else { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index a01ace3..ce53ced 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -121,7 +121,7 @@ const Tcl_ObjType tclRegexpType = { #define RegexpGetIntRep(objPtr, rePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &tclRegexpType); \ + irPtr = TclFetchIntRep((objPtr), &tclRegexpType); \ (rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) diff --git a/generic/tclScan.c b/generic/tclScan.c index 447b7ba..fbfba2d 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -1010,7 +1010,7 @@ Tcl_ScanObjCmd( if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN const Tcl_ObjIntRep *irPtr - = Tcl_FetchIntRep(objPtr, &tclDoubleType); + = TclFetchIntRep(objPtr, &tclDoubleType); if (irPtr) { dvalue = irPtr->doubleValue; } else diff --git a/generic/tclUtil.c b/generic/tclUtil.c index cf73a18..3d4298e 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3945,7 +3945,7 @@ GetEndOffsetFromObj( Tcl_ObjIntRep *irPtr; Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */ - while ((irPtr = Tcl_FetchIntRep(objPtr, &endOffsetType)) == NULL) { + while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; int length; const char *bytes = TclGetStringFromObj(objPtr, &length); diff --git a/generic/tclVar.c b/generic/tclVar.c index dfe883f..6b88344 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -267,7 +267,7 @@ static const Tcl_ObjType localVarNameType = { #define LocalGetIntRep(objPtr, index, name) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &localVarNameType); \ + irPtr = TclFetchIntRep((objPtr), &localVarNameType); \ (name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \ } while (0) @@ -292,7 +292,7 @@ static const Tcl_ObjType parsedVarNameType = { #define ParsedGetIntRep(objPtr, parsed, array, elem) \ do { \ const Tcl_ObjIntRep *irPtr; \ - irPtr = Tcl_FetchIntRep((objPtr), &parsedVarNameType); \ + irPtr = TclFetchIntRep((objPtr), &parsedVarNameType); \ (parsed) = (irPtr != NULL); \ (array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ (elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ -- cgit v0.12