Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge 8.7 |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
08dd3497f136da3d4cf2aa5f43b41640 |
User & Date: | jan.nijtmans 2019-01-28 21:47:50.476 |
Context
2019-02-22
| ||
16:45 | Merge and resolve more from the trunk. check-in: 11271c0a32 user: dgp tags: dgp-properbytearray | |
2019-01-28
| ||
22:05 | Merge 8.7 check-in: acbbb06fbe user: jan.nijtmans tags: trunk | |
21:47 | Merge 8.7 check-in: 08dd3497f1 user: jan.nijtmans tags: trunk | |
21:34 | New internal macro TclFetchIntRep, which is faster than Tcl_FetchIntRep. But ... don't use this fun... check-in: d3ed67412e user: jan.nijtmans tags: core-8-branch | |
16:23 | merge 8.7 check-in: be327fce6d user: sebres tags: trunk | |
Changes
Changes to generic/tclBasic.c.
︙ | ︙ | |||
6700 6701 6702 6703 6704 6705 6706 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { | | | 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } } #endif |
︙ | ︙ | |||
6740 6741 6742 6743 6744 6745 6746 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { | | | 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } } #endif |
︙ | ︙ | |||
6880 6881 6882 6883 6884 6885 6886 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { | | | 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } } #endif |
︙ | ︙ | |||
6927 6928 6929 6930 6931 6932 6933 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { | | | 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d); #ifdef ACCEPT_NAN if (code != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { d = irPtr->doubleValue; Tcl_ResetResult(interp); code = TCL_OK; } } |
︙ | ︙ | |||
6991 6992 6993 6994 6995 6996 6997 | if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d1); #ifdef ACCEPT_NAN if (code != TCL_OK) { | | | | 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 7019 7020 | if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d1); #ifdef ACCEPT_NAN if (code != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { d1 = irPtr->doubleValue; Tcl_ResetResult(interp); code = TCL_OK; } } #endif if (code != TCL_OK) { return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[2], &d2); #ifdef ACCEPT_NAN if (code != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType); if (irPtr) { d2 = irPtr->doubleValue; Tcl_ResetResult(interp); code = TCL_OK; } } |
︙ | ︙ | |||
7154 7155 7156 7157 7158 7159 7160 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) { #ifdef ACCEPT_NAN | | | 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 | if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) { #ifdef ACCEPT_NAN if (objv[1]->typePtr == &tclDoubleType) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } #endif return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult)); |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
287 288 289 290 291 292 293 | #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) int TclIsPureByteArray( Tcl_Obj * objPtr) { | | | 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 | #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) int TclIsPureByteArray( Tcl_Obj * objPtr) { return objPtr->typePtr == &properByteArrayType; } /* *---------------------------------------------------------------------- * * Tcl_NewByteArrayObj -- * |
︙ | ︙ | |||
444 445 446 447 448 449 450 | unsigned char * Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; | | | | | | 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | unsigned char * Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); } } } baPtr = GET_BYTEARRAY(irPtr); if (lengthPtr != NULL) { *lengthPtr = baPtr->used; |
︙ | ︙ | |||
498 499 500 501 502 503 504 | ByteArray *byteArrayPtr; Tcl_ObjIntRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } | | | | | | 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 | ByteArray *byteArrayPtr; Tcl_ObjIntRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); } } } byteArrayPtr = GET_BYTEARRAY(irPtr); if (length > byteArrayPtr->allocated) { byteArrayPtr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length)); |
︙ | ︙ | |||
549 550 551 552 553 554 555 | size_t length; int improper = 0; const char *src, *srcEnd; unsigned char *dst; ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; | | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | size_t length; int improper = 0; const char *src, *srcEnd; unsigned char *dst; ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; if (objPtr->typePtr == &properByteArrayType) { return TCL_OK; } if (objPtr->typePtr == &tclByteArrayType) { return TCL_OK; } src = TclGetString(objPtr); length = objPtr->length; srcEnd = src + length; |
︙ | ︙ | |||
598 599 600 601 602 603 604 | *---------------------------------------------------------------------- */ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { | | | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 | *---------------------------------------------------------------------- */ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); } static void FreeProperByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); } /* *---------------------------------------------------------------------- * * DupByteArrayInternalRep -- * |
︙ | ︙ | |||
634 635 636 637 638 639 640 | Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; | | | | 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 | Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); SET_BYTEARRAY(&ir, copyArrayPtr); Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir); } static void DupProperByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); |
︙ | ︙ | |||
689 690 691 692 693 694 695 | */ static void UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { | | | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 | */ static void UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; size_t i, length = byteArrayPtr->used; size_t size = length; /* * How much space will string rep need? |
︙ | ︙ | |||
759 760 761 762 763 764 765 | "TclAppendBytesToByteArray"); } if (len == 0) { /* Append zero bytes is a no-op. */ return; } | | | | | | 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 | "TclAppendBytesToByteArray"); } if (len == 0) { /* Append zero bytes is a no-op. */ return; } irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); } } } byteArrayPtr = GET_BYTEARRAY(irPtr); if (len > UINT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX); |
︙ | ︙ | |||
2013 2014 2015 2016 2017 2018 2019 | /* * Double-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { | | | | 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 | /* * Double-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); if (irPtr == NULL) { return TCL_ERROR; } dvalue = irPtr->doubleValue; } CopyNumber(&dvalue, *cursorPtr, sizeof(double), type); *cursorPtr += sizeof(double); return TCL_OK; case 'f': case 'r': case 'R': /* * Single-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); if (irPtr == NULL) { return TCL_ERROR; } dvalue = irPtr->doubleValue; } /* |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
448 449 450 451 452 453 454 | } /* * fields.seconds could be an unsigned number that overflowed. Make sure * that it isn't. */ | | | 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 | } /* * fields.seconds could be an unsigned number that overflowed. Make sure * that it isn't. */ if (objv[1]->typePtr == &tclBignumType) { Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; } /* * Convert UTC time to local. */ |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
1647 1648 1649 1650 1651 1652 1653 | } break; } case STR_IS_DIGIT: chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { | | | | | 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 | } break; } case STR_IS_DIGIT: chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || (objPtr->typePtr == &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } |
︙ | ︙ | |||
1678 1679 1680 1681 1682 1683 1684 | break; } case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; case STR_IS_INT: case STR_IS_ENTIER: | | | | 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 | break; } case STR_IS_GRAPH: chcomp = Tcl_UniCharIsGraph; break; case STR_IS_INT: case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || (objPtr->typePtr == &tclBignumType)) { break; } string1 = TclGetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; } |
︙ | ︙ | |||
1960 1961 1962 1963 1964 1965 1966 | /* * This test is tricky, but has to be that way or you get other strange * inconsistencies (see test string-10.20.1 for illustration why!) */ if (!TclHasStringRep(objv[objc-2]) | | | 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 | /* * This test is tricky, but has to be that way or you get other strange * inconsistencies (see test string-10.20.1 for illustration why!) */ if (!TclHasStringRep(objv[objc-2]) && (objv[objc-2]->typePtr == &tclDictType)){ int i, done; Tcl_DictSearch search; /* * We know the type exactly, so all dict operations will succeed for * sure. This shortens this code quite a bit. */ |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
524 525 526 527 528 529 530 | } while (0) #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | } while (0) #define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), (typePtr)); \ (codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in * tclCompile.c. Also, the order and number of the expression opcodes (e.g., |
︙ | ︙ |
Changes to generic/tclDictObj.c.
︙ | ︙ | |||
169 170 171 172 173 174 175 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &tclDictType, &ir); \ } while (0) #define DictGetIntRep(objPtr, dictRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &tclDictType, &ir); \ } while (0) #define DictGetIntRep(objPtr, dictRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclDictType); \ (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The type of the specially adapted version of the Tcl_Obj*-containing hash * table defined in the tclObj.c code. This version differs in that it * allocates a bit more space in each hash entry in order to hold the pointers |
︙ | ︙ | |||
613 614 615 616 617 618 619 | /* * Since lists and dictionaries have very closely-related string * representations (i.e. the same parsing code) we can safely special-case * the conversion from lists to dictionaries. */ | | | 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 | /* * Since lists and dictionaries have very closely-related string * representations (i.e. the same parsing code) we can safely special-case * the conversion from lists to dictionaries. */ if (objPtr->typePtr == &tclListType) { int objc, i; Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ TclListObjGetElements(NULL, objPtr, &objc, &objv); if (objc & 1) { goto missingValue; |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
52 53 54 55 56 57 58 | ir.wideValue = (inst); \ Tcl_StoreIntRep((objPtr), &instNameType, &ir); \ } while (0) #define InstNameGetIntRep(objPtr, inst) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | ir.wideValue = (inst); \ Tcl_StoreIntRep((objPtr), &instNameType, &ir); \ } while (0) #define InstNameGetIntRep(objPtr, inst) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &instNameType); \ assert(irPtr != NULL); \ (inst) = (size_t)irPtr->wideValue; \ } while (0) /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1379 1380 1381 1382 1383 1384 1385 | */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } | | | 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 | */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } if ((objv[2]->typePtr != &tclByteCodeType) && (TCL_OK != TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) { return TCL_ERROR; } codeObjPtr = objv[2]; break; case DISAS_CLASS_CONSTRUCTOR: |
︙ | ︙ | |||
1580 1581 1582 1583 1584 1585 1586 | if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } | | | 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 | if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { Command cmd; /* * Yes, this is ugly, but we need to pass the namespace in to the * compiler in two places. */ |
︙ | ︙ |
Changes to generic/tclEncoding.c.
︙ | ︙ | |||
286 287 288 289 290 291 292 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &encodingType, &ir); \ } while (0) #define EncodingGetIntRep(objPtr, encoding) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &encodingType, &ir); \ } while (0) #define EncodingGetIntRep(objPtr, encoding) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep ((objPtr), &encodingType); \ (encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclEnsemble.c.
︙ | ︙ | |||
91 92 93 94 95 96 97 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir); \ } while (0) #define ECRGetIntRep(objPtr, ecRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir); \ } while (0) #define ECRGetIntRep(objPtr, ecRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &ensembleCmdType); \ (ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The internal rep for caching ensemble subcommand lookups and spelling * corrections. */ |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
688 689 690 691 692 693 694 | ReleaseDictIterator( Tcl_Obj *objPtr) { Tcl_DictSearch *searchPtr; Tcl_Obj *dictPtr; const Tcl_ObjIntRep *irPtr; | | | 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 | ReleaseDictIterator( Tcl_Obj *objPtr) { Tcl_DictSearch *searchPtr; Tcl_Obj *dictPtr; const Tcl_ObjIntRep *irPtr; irPtr = TclFetchIntRep(objPtr, &dictIteratorType); assert(irPtr != NULL); /* * First kill the search, and then release the reference to the dictionary * that we were holding. */ |
︙ | ︙ | |||
4555 4556 4557 4558 4559 4560 4561 | TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* * Extract the desired list element. */ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) | | | 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 | TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* * Extract the desired list element. */ if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) && (value2Ptr->typePtr != &tclListType) && (TclGetIntForIndexM(NULL, value2Ptr, objc-1, &index) == TCL_OK)) { TclDecrRefCount(value2Ptr); tosPtr--; pcAdjustment = 1; goto lindexFastPath; } |
︙ | ︙ | |||
6734 6735 6736 6737 6738 6739 6740 | TclNewObj(statePtr); ir.twoPtrValue.ptr1 = searchPtr; ir.twoPtrValue.ptr2 = dictPtr; Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir); } varPtr = LOCAL(opnd); if (varPtr->value.objPtr) { | | | | 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 | TclNewObj(statePtr); ir.twoPtrValue.ptr1 = searchPtr; ir.twoPtrValue.ptr2 = dictPtr; Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir); } varPtr = LOCAL(opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr == &dictIteratorType) { Tcl_Panic("mis-issued dictFirst!"); } TclDecrRefCount(varPtr->value.objPtr); } varPtr->value.objPtr = statePtr; Tcl_IncrRefCount(statePtr); goto pushDictIteratorResult; case INST_DICT_NEXT: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); statePtr = (*LOCAL(opnd)).value.objPtr; { const Tcl_ObjIntRep *irPtr; if (statePtr && (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) { searchPtr = irPtr->twoPtrValue.ptr1; Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done); } else { Tcl_Panic("mis-issued dictNext!"); } } pushDictIteratorResult: |
︙ | ︙ | |||
9242 9243 9244 9245 9246 9247 9248 | objBytesIfUnshared = 0.0; strBytesIfUnshared = 0.0; strBytesSharedMultX = 0.0; strBytesSharedOnce = 0.0; for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { | | | 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 | objBytesIfUnshared = 0.0; strBytesIfUnshared = 0.0; strBytesSharedMultX = 0.0; strBytesSharedOnce = 0.0; for (i = 0; i < globalTablePtr->numBuckets; i++) { for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL; entryPtr = entryPtr->nextPtr) { if (entryPtr->objPtr->typePtr == &tclByteCodeType) { numByteCodeLits++; } (void) TclGetStringFromObj(entryPtr->objPtr, &length); refCountSum += entryPtr->refCount; objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj)); strBytesIfUnshared += (entryPtr->refCount * (length+1)); if (entryPtr->refCount > 1) { |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
345 346 347 348 349 350 351 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &chanObjType, &ir); \ } while (0) #define ChanGetIntRep(objPtr, resPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &chanObjType, &ir); \ } while (0) #define ChanGetIntRep(objPtr, resPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &chanObjType); \ (resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) #define BUSY_STATE(st, fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) |
︙ | ︙ |
Changes to generic/tclIndexObj.c.
︙ | ︙ | |||
209 210 211 212 213 214 215 | offset = sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. */ if (!(flags & INDEX_TEMP_TABLE)) { | | | 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | offset = sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. */ if (!(flags & INDEX_TEMP_TABLE)) { irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { indexRep = irPtr->twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; } } |
︙ | ︙ | |||
273 274 275 276 277 278 279 | /* * Cache the found representation. Note that we want to avoid allocating a * new internal-rep if at all possible since that is potentially a slow * operation. */ if (!(flags & INDEX_TEMP_TABLE)) { | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | /* * Cache the found representation. Note that we want to avoid allocating a * new internal-rep if at all possible since that is potentially a slow * operation. */ if (!(flags & INDEX_TEMP_TABLE)) { irPtr = TclFetchIntRep(objPtr, &indexType); if (irPtr) { indexRep = irPtr->twoPtrValue.ptr1; } else { Tcl_ObjIntRep ir; indexRep = Tcl_Alloc(sizeof(IndexRep)); ir.twoPtrValue.ptr1 = indexRep; |
︙ | ︙ | |||
384 385 386 387 388 389 390 | *---------------------------------------------------------------------- */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { | | | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | *---------------------------------------------------------------------- */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; register const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
416 417 418 419 420 421 422 | DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_ObjIntRep ir; IndexRep *dupIndexRep = Tcl_Alloc(sizeof(IndexRep)); | | | 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_ObjIntRep ir; IndexRep *dupIndexRep = Tcl_Alloc(sizeof(IndexRep)); memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, sizeof(IndexRep)); ir.twoPtrValue.ptr1 = dupIndexRep; Tcl_StoreIntRep(dupPtr, &indexType, &ir); } /* |
︙ | ︙ | |||
444 445 446 447 448 449 450 | *---------------------------------------------------------------------- */ static void FreeIndex( Tcl_Obj *objPtr) { | | | 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | *---------------------------------------------------------------------- */ static void FreeIndex( Tcl_Obj *objPtr) { Tcl_Free(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } /* *---------------------------------------------------------------------- * * TclInitPrefixCmd -- |
︙ | ︙ | |||
871 872 873 874 875 876 877 | for (i=0 ; i<toPrint ; i++) { /* * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; | | | 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 | for (i=0 ; i<toPrint ; i++) { /* * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } |
︙ | ︙ | |||
918 919 920 921 922 923 924 | /* * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; | | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 | /* * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { register IndexRep *indexRep = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). */ |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 | * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for | > > | 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 | * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ 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) /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for |
︙ | ︙ |
Changes to generic/tclLink.c.
︙ | ︙ | |||
412 413 414 415 416 417 418 | } LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w; break; case TCL_LINK_DOUBLE: if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN | | | 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 | } LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w; break; case TCL_LINK_DOUBLE: if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN Tcl_ObjIntRep *irPtr = TclFetchIntRep(valueObj, &tclDoubleType); if (irPtr == NULL) { #endif if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) "variable must have real value"; } |
︙ | ︙ |
Changes to generic/tclListObj.c.
︙ | ︙ | |||
57 58 59 60 61 62 63 | (listRepPtr)->refCount++; \ Tcl_StoreIntRep((objPtr), &tclListType, &ir); \ } while (0) #define ListGetIntRep(objPtr, listRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | (listRepPtr)->refCount++; \ Tcl_StoreIntRep((objPtr), &tclListType, &ir); \ } while (0) #define ListGetIntRep(objPtr, listRepPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclListType); \ (listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) #define ListResetIntRep(objPtr, listRepPtr) \ TclFetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr) #ifndef TCL_MIN_ELEMENT_GROWTH #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *) #endif /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1630 1631 1632 1633 1634 1635 1636 | * variable. Later on, when we set valuePtr in its proper place, * then all containing lists will have their values changed, and * will need their string reps spoiled. We maintain a list of all * those Tcl_Obj's (via a little intrep surgery) so we can spoil * them at that time. */ | | | | 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 | * variable. Later on, when we set valuePtr in its proper place, * then all containing lists will have their values changed, and * will need their string reps spoiled. We maintain a list of all * those Tcl_Obj's (via a little intrep surgery) so we can spoil * them at that time. */ irPtr = TclFetchIntRep(parentList, &tclListType); irPtr->twoPtrValue.ptr2 = chainPtr; chainPtr = parentList; } } while (indexCount > 0); /* * Either we've detected and error condition, and exited the loop with * result == TCL_ERROR, or we've successfully reached the last index, and * we're ready to store valuePtr. In either case, we need to clean up our * string spoiling list of Tcl_Obj's. */ while (chainPtr) { Tcl_Obj *objPtr = chainPtr; List *listRepPtr; /* * Clear away our intrep surgery mess. */ irPtr = TclFetchIntRep(objPtr, &tclListType); listRepPtr = irPtr->twoPtrValue.ptr1; chainPtr = irPtr->twoPtrValue.ptr2; if (result == TCL_OK) { /* * We're going to store valuePtr, so spoil string reps of all |
︙ | ︙ | |||
1972 1973 1974 1975 1976 1977 1978 | * Dictionaries are a special case; they have a string representation such * that *all* valid dictionaries are valid lists. Hence we can convert * more directly. Only do this when there's no existing string rep; if * there is, it is the string rep that's authoritative (because it could * describe duplicate keys). */ | | | 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 | * Dictionaries are a special case; they have a string representation such * that *all* valid dictionaries are valid lists. Hence we can convert * more directly. Only do this when there's no existing string rep; if * there is, it is the string rep that's authoritative (because it could * describe duplicate keys). */ if (!TclHasStringRep(objPtr) && (objPtr->typePtr == &tclDictType)) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done, size; /* * Create the new list representation. Note that we do not need to do * anything with the string representation as the transformation (and |
︙ | ︙ |
Changes to generic/tclNamesp.c.
︙ | ︙ | |||
161 162 163 164 165 166 167 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &nsNameType, &ir); \ } while (0) #define NsNameGetIntRep(objPtr, nnPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &nsNameType, &ir); \ } while (0) #define NsNameGetIntRep(objPtr, nnPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &nsNameType); \ (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. */ |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
276 277 278 279 280 281 282 | static void DupMethodNameRep( Tcl_Obj *srcPtr, Tcl_Obj *dstPtr) { StashCallChain(dstPtr, | | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 | static void DupMethodNameRep( Tcl_Obj *srcPtr, Tcl_Obj *dstPtr) { StashCallChain(dstPtr, TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1); } static void FreeMethodNameRep( Tcl_Obj *objPtr) { TclOODeleteChain( TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1); } /* * ---------------------------------------------------------------------- * * TclOOInvokeContext -- * |
︙ | ︙ | |||
1185 1186 1187 1188 1189 1190 1191 | * there are multiple different layers of cache (in the Tcl_Obj, in * the object, and in the class). */ const Tcl_ObjIntRep *irPtr; const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); | | | 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 | * there are multiple different layers of cache (in the Tcl_Obj, in * the object, and in the class). */ const Tcl_ObjIntRep *irPtr; const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) { callPtr = irPtr->twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL); } |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
1876 1877 1878 1879 1880 1881 1882 | */ Tcl_ObjIntRep * Tcl_FetchIntRep( Tcl_Obj *objPtr, /* Object to fetch from. */ const Tcl_ObjType *typePtr) /* Requested type */ { | < < | < < < < | 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 | */ Tcl_ObjIntRep * Tcl_FetchIntRep( Tcl_Obj *objPtr, /* Object to fetch from. */ const Tcl_ObjType *typePtr) /* Requested type */ { return TclFetchIntRep(objPtr, typePtr); } /* *---------------------------------------------------------------------- * * Tcl_FreeIntRep -- * |
︙ | ︙ |
Changes to generic/tclPathObj.c.
︙ | ︙ | |||
97 98 99 100 101 102 103 | #define TCLPATH_NEEDNORM 4 /* * Define some macros to give us convenient access to path-object specific * fields. */ | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | #define TCLPATH_NEEDNORM 4 /* * Define some macros to give us convenient access to path-object specific * fields. */ #define PATHOBJ(pathPtr) ((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) #define SETPATHOBJ(pathPtr,fsPathPtr) \ do { \ Tcl_ObjIntRep ir; \ ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((pathPtr), &fsPathType, &ir); \ } while (0) |
︙ | ︙ | |||
556 557 558 559 560 561 562 | Tcl_Obj * TclPathPart( Tcl_Interp *interp, /* Used for error reporting */ Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { | | | 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 | Tcl_Obj * TclPathPart( Tcl_Interp *interp, /* Used for error reporting */ Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { switch (portion) { case TCL_PATH_DIRNAME: { |
︙ | ︙ | |||
856 857 858 859 860 861 862 | return Tcl_NewObj(); } assert ( elements > 0 ); if (elements == 2) { Tcl_Obj *elt = objv[0]; | | | 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 | return Tcl_NewObj(); } assert ( elements > 0 ); if (elements == 2) { Tcl_Obj *elt = objv[0]; Tcl_ObjIntRep *eltIr = TclFetchIntRep(elt, &fsPathType); /* * This is a special case where we can be much more efficient, where * we are joining a single relative path onto an object that is * already of path type. The 'TclNewFSPathObj' call below creates an * object which can be normalized more efficiently. Currently we only * use the special case when we have exactly two elements, but we |
︙ | ︙ | |||
1152 1153 1154 1155 1156 1157 1158 | int Tcl_FSConvertToPathType( Tcl_Interp *interp, /* Interpreter in which to store error message * (if necessary). */ Tcl_Obj *pathPtr) /* Object to convert to a valid, current path * type. */ { | | | 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 | int Tcl_FSConvertToPathType( Tcl_Interp *interp, /* Interpreter in which to store error message * (if necessary). */ Tcl_Obj *pathPtr) /* Object to convert to a valid, current path * type. */ { Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); /* * While it is bad practice to examine an object's type directly, this is * actually the best thing to do here. The reason is that if we are * converting this object to FsPath type for the first time, we don't need * to worry whether the 'cwd' has changed. On the other hand, if this * object is already of FsPath type, and is a relative path, we do have to |
︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | TclFSMakePathRelative( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { int cwdLen, len; const char *tempStr; | | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | TclFSMakePathRelative( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { int cwdLen, len; const char *tempStr; Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { FsPath *fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { return fsPathPtr->normPathPtr; } |
︙ | ︙ | |||
1474 1475 1476 1477 1478 1479 1480 | static int MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; | | | 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 | static int MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { return TCL_OK; } fsPathPtr = Tcl_Alloc(sizeof(FsPath)); |
︙ | ︙ | |||
1615 1616 1617 1618 1619 1620 1621 | if (translatedCwdPtr == NULL) { return NULL; } retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj); | | | 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 | if (translatedCwdPtr == NULL) { return NULL; } retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj); translatedCwdIrPtr = TclFetchIntRep(translatedCwdPtr, &fsPathType); if (translatedCwdIrPtr) { srcFsPathPtr->filesystemEpoch = PATHOBJ(translatedCwdPtr)->filesystemEpoch; } else { srcFsPathPtr->filesystemEpoch = 0; } Tcl_DecrRefCount(translatedCwdPtr); |
︙ | ︙ | |||
2080 2081 2082 2083 2084 2085 2086 | int TclFSEnsureEpochOk( Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr) { FsPath *srcFsPathPtr; | | | 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 | int TclFSEnsureEpochOk( Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr) { FsPath *srcFsPathPtr; Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr == NULL) { return TCL_OK; } srcFsPathPtr = PATHOBJ(pathPtr); |
︙ | ︙ | |||
2139 2140 2141 2142 2143 2144 2145 | void TclFSSetPathDetails( Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData) { FsPath *srcFsPathPtr; | | | 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 | void TclFSSetPathDetails( Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData) { FsPath *srcFsPathPtr; Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);; /* * Make sure pathPtr is of the correct type. */ if (irPtr == NULL) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { |
︙ | ︙ | |||
2244 2245 2246 2247 2248 2249 2250 | Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { size_t len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; | | | 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 | Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { size_t len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); if (irPtr) { return TCL_OK; } /* * First step is to translate the filename. This is similar to |
︙ | ︙ | |||
2552 2553 2554 2555 2556 2557 2558 | */ int TclNativePathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { | | | 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 | */ int TclNativePathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr) { Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); /* * A special case is required to handle the empty path "". This is a valid * path (i.e. the user should be able to do 'file exists ""' without * throwing an error), but equally the path doesn't exist. Those are the * semantics of Tcl (at present anyway), so we have to abide by them here. */ |
︙ | ︙ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
76 77 78 79 80 81 82 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir); \ } while (0) #define ProcGetIntRep(objPtr, procPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir); \ } while (0) #define ProcGetIntRep(objPtr, procPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclProcBodyType); \ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* * The [upvar]/[uplevel] level reference type. Uses the longValue field * to remember the integer value of a parsed #<integer> format. * |
︙ | ︙ | |||
122 123 124 125 126 127 128 | Tcl_IncrRefCount((nsObjPtr)); \ Tcl_StoreIntRep((objPtr), &lambdaType, &ir); \ } while (0) #define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 | Tcl_IncrRefCount((nsObjPtr)); \ Tcl_StoreIntRep((objPtr), &lambdaType, &ir); \ } while (0) #define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &lambdaType); \ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ (nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
325 326 327 328 329 330 331 | * seem to make a lot of sense to verify the number of arguments we * are about to ignore ... * - could be enhanced to handle also non-empty bodies that contain only * comments; however, parsing the body will slow down the compilation * of all procs whose argument list is just _args_ */ | | | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 | * seem to make a lot of sense to verify the number of arguments we * are about to ignore ... * - could be enhanced to handle also non-empty bodies that contain only * comments; however, parsing the body will slow down the compilation * of all procs whose argument list is just _args_ */ if (TclFetchIntRep(objv[3], &tclProcBodyType)) { goto done; } procArgs = TclGetString(objv[2]); while (*procArgs == ' ') { procArgs++; |
︙ | ︙ | |||
792 793 794 795 796 797 798 | Tcl_GetWideIntFromObj(NULL, objPtr, &w); if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) { result = -1; } else { level = curLevel - level; result = 1; } | | | 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | Tcl_GetWideIntFromObj(NULL, objPtr, &w); if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) { result = -1; } else { level = curLevel - level; result = 1; } } else if ((irPtr = TclFetchIntRep(objPtr, &levelReferenceType))) { level = irPtr->wideValue; result = 1; } else { name = TclGetString(objPtr); if (name[0] == '#') { if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) { if (level < 0 || (level > 0 && name[1] == '-')) { |
︙ | ︙ |
Changes to generic/tclRegexp.c.
︙ | ︙ | |||
117 118 119 120 121 122 123 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir); \ } while (0) #define RegexpGetIntRep(objPtr, rePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | ir.twoPtrValue.ptr2 = NULL; \ Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir); \ } while (0) #define RegexpGetIntRep(objPtr, rePtr) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &tclRegexpType); \ (rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclScan.c.
︙ | ︙ | |||
1006 1007 1008 1009 1010 1011 1012 | Tcl_DecrRefCount(objPtr); string = end; } else { double dvalue; if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN const Tcl_ObjIntRep *irPtr | | | 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 | Tcl_DecrRefCount(objPtr); string = end; } else { double dvalue; if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclDoubleType); if (irPtr) { dvalue = irPtr->doubleValue; } else #endif { Tcl_DecrRefCount(objPtr); goto done; |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
3675 3676 3677 3678 3679 3680 3681 | * "objPtr" holds "end". */ Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ { Tcl_ObjIntRep *irPtr; Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */ | | | 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 | * "objPtr" holds "end". */ Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ { Tcl_ObjIntRep *irPtr; Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */ while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; size_t length; const char *bytes = TclGetStringFromObj(objPtr, &length); if ((length < 3) || (length == 4)) { /* Too short to be "end" or to be "end-$integer" */ return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
263 264 265 266 267 268 269 | ir.twoPtrValue.ptr2 = INT2PTR(index); \ Tcl_StoreIntRep((objPtr), &localVarNameType, &ir); \ } while (0) #define LocalGetIntRep(objPtr, index, name) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | ir.twoPtrValue.ptr2 = INT2PTR(index); \ Tcl_StoreIntRep((objPtr), &localVarNameType, &ir); \ } while (0) #define LocalGetIntRep(objPtr, index, name) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &localVarNameType); \ (name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \ } while (0) static const Tcl_ObjType parsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, NULL, NULL |
︙ | ︙ | |||
288 289 290 291 292 293 294 | ir.twoPtrValue.ptr2 = ptr2; \ Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir); \ } while (0) #define ParsedGetIntRep(objPtr, parsed, array, elem) \ do { \ const Tcl_ObjIntRep *irPtr; \ | | | 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | ir.twoPtrValue.ptr2 = ptr2; \ Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir); \ } while (0) #define ParsedGetIntRep(objPtr, parsed, array, elem) \ do { \ const Tcl_ObjIntRep *irPtr; \ irPtr = TclFetchIntRep((objPtr), &parsedVarNameType); \ (parsed) = (irPtr != NULL); \ (array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \ (elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) Var * TclVarHashCreateVar( |
︙ | ︙ |