Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Tcl_RegisterObjType() in alphabetical order. Backport some formatting and type-casts from 8.7/9.0 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-8-6-branch |
Files: | files | file ages | folders |
SHA3-256: |
3f5699efd2f4d6872aa28725d59e6555 |
User & Date: | jan.nijtmans 2024-07-03 12:34:15 |
Context
2024-07-14
| ||
19:14 | [info vars] test coverage for global vars resolve check-in: 24436f8d2a user: sebres tags: core-8-6-branch | |
2024-07-03
| ||
13:09 | Merge 8.6 check-in: e715cf23da user: jan.nijtmans tags: core-8-branch | |
12:34 | Tcl_RegisterObjType() in alphabetical order. Backport some formatting and type-casts from 8.7/9.0 check-in: 3f5699efd2 user: jan.nijtmans tags: core-8-6-branch | |
2024-07-02
| ||
14:36 | info frame: restored return {type precompiled} in case of no frame information; see [0de6c1d79cfba2e... check-in: 8c2c0a6d7d user: sebres tags: core-8-6-branch | |
Changes
Changes to generic/tclObj.c.
1 2 3 4 5 6 7 | /* * tclObj.c -- * * This file contains Tcl object-related functions that are used by many * Tcl commands. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* * tclObj.c -- * * This file contains Tcl object-related functions that are used by many * Tcl commands. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 Scriptics Corporation. * Copyright (c) 2001 ActiveState Corporation. * Copyright (c) 2005 Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Daniel A. Steffen <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" |
︙ | ︙ | |||
74 75 76 77 78 79 80 | * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ typedef struct ThreadSpecificData { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj | | | | | | | | | | | | | | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | * * Notice that different structures with the same name appear in other files. * The structure defined below is used in this file only. */ typedef struct ThreadSpecificData { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj * generated by a call to the function * TclSubstTokens() from a literal text * where bs+nl sequences occurred in it, if * any. I.e. this table keeps track of * invisible and stripped continuation lines. * Its keys are Tcl_Obj pointers, the values * are ContLineLoc pointers. See the file * tclCompile.h for the definition of this * structure, and for references to all * related places in the core. */ #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) Tcl_HashTable *objThreadMap;/* Thread local table that is used to check * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); |
︙ | ︙ | |||
165 166 167 168 169 170 171 | static __thread PendingObjData pendingObjData; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = &pendingObjData #else static Tcl_ThreadDataKey pendingObjDataKey; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = \ | | | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | static __thread PendingObjData pendingObjData; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = &pendingObjData #else static Tcl_ThreadDataKey pendingObjDataKey; #define ObjInitDeletionContext(contextPtr) \ PendingObjData *const contextPtr = \ (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) #endif /* * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep */ #define PACK_BIGNUM(bignum, objPtr) \ |
︙ | ︙ | |||
191 192 193 194 195 196 197 | | ((bignum).alloc << 15) | ((bignum).used)); \ } #define UNPACK_BIGNUM(objPtr, bignum) \ if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \ (bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \ } else { \ | | | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | | ((bignum).alloc << 15) | ((bignum).used)); \ } #define UNPACK_BIGNUM(objPtr, bignum) \ if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \ (bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \ } else { \ (bignum).dp = (mp_digit *)(objPtr)->internalRep.twoPtrValue.ptr1; \ (bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \ (bignum).alloc = \ (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7FFF; \ (bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7FFF; \ } /* |
︙ | ︙ | |||
390 391 392 393 394 395 396 397 398 399 400 | TclInitObjSubsystem(void) { Tcl_MutexLock(&tableMutex); typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); | > > > > < | < < < | | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 | TclInitObjSubsystem(void) { Tcl_MutexLock(&tableMutex); typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); Tcl_RegisterObjType(&tclArraySearchType); Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclByteCodeType); Tcl_RegisterObjType(&tclCmdNameType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclProcBodyType); Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclStringType); /* For backward compatibility only ... */ Tcl_RegisterObjType(&oldBooleanType); #ifndef TCL_WIDE_INT_IS_LONG Tcl_RegisterObjType(&tclWideIntType); #endif |
︙ | ︙ | |||
453 454 455 456 457 458 459 | Tcl_HashSearch hSearch; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { | | | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 | Tcl_HashSearch hSearch; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { ckfree(objData); } } Tcl_DeleteHashTable(tablePtr); |
︙ | ︙ | |||
632 633 634 635 636 637 638 | void TclContinuationsEnterDerived( Tcl_Obj *objPtr, int start, int *clNext) { | | > | 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 | void TclContinuationsEnterDerived( Tcl_Obj *objPtr, int start, int *clNext) { int length; int end, num; int *wordCLLast = clNext; /* * We have to handle invisible continuations lines here as well, despite * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If * our script is the sole argument to an 'eval' command, for example, the * scriptCLLocPtr we are using was generated by a previous call to TST, |
︙ | ︙ | |||
726 727 728 729 730 731 732 | void TclContinuationsCopy( Tcl_Obj *objPtr, Tcl_Obj *originObjPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = | | | | 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 | void TclContinuationsCopy( Tcl_Obj *objPtr, Tcl_Obj *originObjPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); if (hPtr) { ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr); TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc); } } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
760 761 762 763 764 765 766 | ContLineLoc * TclContinuationsGet( Tcl_Obj *objPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = | | | | | 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 | ContLineLoc * TclContinuationsGet( Tcl_Obj *objPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (!hPtr) { return NULL; } return (ContLineLoc *)Tcl_GetHashValue(hPtr); } /* *---------------------------------------------------------------------- * * TclThreadFinalizeContLines -- * |
︙ | ︙ | |||
893 894 895 896 897 898 899 | * that. */ Tcl_MutexLock(&tableMutex); for (hPtr = Tcl_FirstHashEntry(&typeTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, objPtr, | | | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 | * that. */ Tcl_MutexLock(&tableMutex); for (hPtr = Tcl_FirstHashEntry(&typeTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), -1)); } Tcl_MutexUnlock(&tableMutex); return TCL_OK; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
926 927 928 929 930 931 932 | { Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { | | | 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 | { Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { typePtr = (const Tcl_ObjType *)Tcl_GetHashValue(hPtr); } Tcl_MutexUnlock(&tableMutex); return typePtr; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1013 1014 1015 1016 1017 1018 1019 | tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { | | | 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 | tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { fprintf(outFile, "key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n", Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr, objData->file, objData->line); } else { |
︙ | ︙ | |||
1313 1314 1315 1316 1317 1318 1319 | Tcl_HashEntry *hPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tablePtr = tsdPtr->objThreadMap; if (!tablePtr) { Tcl_Panic("TclFreeObj: object table not initialized"); } | | | | 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 | Tcl_HashEntry *hPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tablePtr = tsdPtr->objThreadMap; if (!tablePtr) { Tcl_Panic("TclFreeObj: object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, (char *)objPtr); if (hPtr) { /* * As the Tcl_Obj is going to be deleted we remove the entry. */ ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { ckfree(objData); } Tcl_DeleteHashEntry(hPtr); } |
︙ | ︙ | |||
1397 1398 1399 1400 1401 1402 1403 | * already killed the thread-global data structures. Performing * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); | | | | 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 | * already killed the thread-global data structures. Performing * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } |
︙ | ︙ | |||
1488 1489 1490 1491 1492 1493 1494 | * already killed the thread-global data structures. Performing * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); | | | | 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 | * already killed the thread-global data structures. Performing * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } |
︙ | ︙ | |||
2001 2002 2003 2004 2005 2006 2007 | return TCL_ERROR; } static int ParseBoolean( Tcl_Obj *objPtr) /* The object to parse/convert. */ { | | > | | | 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 | return TCL_ERROR; } static int ParseBoolean( Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; int i, length; const char *str = TclGetStringFromObj(objPtr, &length); if ((length < 1) || (length > 5)) { /* * Longest valid boolean string rep. is "false". */ return TCL_ERROR; } switch (str[0]) { case '0': if (length == 1) { |
︙ | ︙ | |||
2280 2281 2282 2283 2284 2285 2286 | { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); | | | | 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 | { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", (char *)NULL); } return TCL_ERROR; } *dblPtr = (double) objPtr->internalRep.doubleValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { |
︙ | ︙ | |||
2790 2791 2792 2793 2794 2795 2796 | return TCL_OK; } goto tooLarge; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { | | | | | 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 | return TCL_OK; } goto tooLarge; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a long, even |
︙ | ︙ | |||
3086 3087 3088 3089 3090 3091 3092 | #endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt)objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { | | | | | 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 | #endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt)objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a |
︙ | ︙ | |||
3422 3423 3424 3425 3426 3427 3428 | TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { | | | | | 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 | TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; |
︙ | ︙ | |||
3674 3675 3676 3677 3678 3679 3680 | *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } #endif if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; | | | | 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 | *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; return TCL_OK; } #endif if (objPtr->typePtr == &tclBignumType) { static Tcl_ThreadDataKey bignumKey; mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey, (int)sizeof(mp_int)); UNPACK_BIGNUM(objPtr, *bigPtr); *typePtr = TCL_NUMBER_BIG; *clientDataPtr = bigPtr; return TCL_OK; } } while (TCL_OK == |
︙ | ︙ | |||
3742 3743 3744 3745 3746 3747 3748 | if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", | | | 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 | if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "incr ref count"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ ++(objPtr)->refCount; } |
︙ | ︙ | |||
3805 3806 3807 3808 3809 3810 3811 | if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", | | | 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 | if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "decr ref count"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ if (objPtr->refCount-- <= 1) { TclFreeObj(objPtr); |
︙ | ︙ | |||
3870 3871 3872 3873 3874 3875 3876 | if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", | | | 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 | if (!tablePtr) { Tcl_Panic("object table not initialized"); } hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", "check shared status"); } } # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); |
︙ | ︙ | |||
3972 3973 3974 3975 3976 3977 3978 | */ int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { | | | | > > | 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 | */ int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *)hPtr->key.oneWordValue; const char *p1, *p2; size_t l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller if (objPtr1 == objPtr2) { return 1; } */ /* * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being * in a register. */ |
︙ | ︙ | |||
4061 4062 4063 4064 4065 4066 4067 | */ unsigned int TclHashObjKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { | | | 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 | */ unsigned int TclHashObjKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; int length; const char *string = TclGetStringFromObj(objPtr, &length); unsigned int result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all |
︙ | ︙ | |||
4159 4160 4161 4162 4163 4164 4165 | * Check also that the command's epoch is up to date, and that the command * is not deleted. * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ | | | | | | | | | | | | | | | | | | | | 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 | * Check also that the command's epoch is up to date, and that the command * is not deleted. * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) { Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && !(cmdPtr->flags & CMD_IS_DELETED) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) && (resPtr->refNsId == refNsPtr->nsId) && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { return (Tcl_Command) cmdPtr; } } } /* * OK, must create a new internal representation (or fail) as any cache we * had is invalid one way or another. */ /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { return NULL; } resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL); } /* *---------------------------------------------------------------------- * * TclSetCmdNameObj -- |
︙ | ︙ | |||
4221 4222 4223 4224 4225 4226 4227 | Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { | | | | 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 | Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { Interp *iPtr = (Interp *)interp; ResolvedCmdName *resPtr; Namespace *currNsPtr; const char *name; if (objPtr->typePtr == &tclCmdNameType) { resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } cmdPtr->refCount++; resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName)); |
︙ | ︙ | |||
4291 4292 4293 4294 4295 4296 4297 | */ static void FreeCmdNameInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { | | | | 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 | */ static void FreeCmdNameInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != (ResolvedCmdName *)NULL) { /* * Decrement the reference count of the ResolvedCmdName structure. If * there are no more uses, free the ResolvedCmdName structure. */ if (resPtr->refCount-- == 1) { /* |
︙ | ︙ | |||
4340 4341 4342 4343 4344 4345 4346 | */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { | | | 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 | */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; if (resPtr != NULL) { resPtr->refCount++; } copyPtr->typePtr = &tclCmdNameType; |
︙ | ︙ | |||
4376 4377 4378 4379 4380 4381 4382 | */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { | | | 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 | */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *)interp; const char *name; Command *cmdPtr; Namespace *currNsPtr; ResolvedCmdName *resPtr; if (interp == NULL) { return TCL_ERROR; |
︙ | ︙ | |||
4406 4407 4408 4409 4410 4411 4412 | * Free the old internalRep before setting the new one. Do this after * getting the string rep to allow the conversion code (in particular, * Tcl_GetStringFromObj) to use that old internalRep. */ if (cmdPtr) { cmdPtr->refCount++; | | | 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 | * Free the old internalRep before setting the new one. Do this after * getting the string rep to allow the conversion code (in particular, * Tcl_GetStringFromObj) to use that old internalRep. */ if (cmdPtr) { cmdPtr->refCount++; resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) && resPtr && (resPtr->refCount == 1)) { /* * Reuse the old ResolvedCmdName struct instead of freeing it */ Command *oldCmdPtr = resPtr->cmdPtr; |
︙ | ︙ | |||
4494 4495 4496 4497 4498 4499 4500 | * Value is a bignum with a refcount of 14, object pointer at 0x12345678, * internal representation 0x45671234:0x98765432, string representation * "1872361827361287" */ snprintf(ptrBuffer, sizeof(ptrBuffer), "%p", (void *) objv[1]); descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," | | | | 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 | * Value is a bignum with a refcount of 14, object pointer at 0x12345678, * internal representation 0x45671234:0x98765432, string representation * "1872361827361287" */ snprintf(ptrBuffer, sizeof(ptrBuffer), "%p", (void *) objv[1]); descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," " object pointer at %s", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, ptrBuffer); /* * This is a workaround to silence reports from `make valgrind` * on 64-bit systems. The problem is that the test suite * includes calling the [representation] command on values of * &tclDoubleType. When these values are created, the "doubleValue" |
︙ | ︙ | |||
4525 4526 4527 4528 4529 4530 4531 | (void *) objv[1]->internalRep.twoPtrValue.ptr1, (void *) objv[1]->internalRep.twoPtrValue.ptr2); Tcl_AppendPrintfToObj(descObj, ", internal representation %s", ptrBuffer); } if (objv[1]->bytes) { | | | | 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 | (void *) objv[1]->internalRep.twoPtrValue.ptr1, (void *) objv[1]->internalRep.twoPtrValue.ptr2); Tcl_AppendPrintfToObj(descObj, ", internal representation %s", ptrBuffer); } if (objv[1]->bytes) { Tcl_AppendToObj(descObj, ", string representation \"", -1); Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length, 16, "..."); Tcl_AppendToObj(descObj, "\"", -1); } else { Tcl_AppendToObj(descObj, ", no string representation", -1); } Tcl_SetObjResult(interp, descObj); return TCL_OK; |
︙ | ︙ |