Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch no-wideint Through [e2f2e6ca33] Excluding Merge-Ins
This is equivalent to a diff from 76eaf9a16b to e2f2e6ca33
|
2017-11-01
| ||
| 21:05 | Fix bug 3c32a3f8bd, segmentation fault in TclOO.c/ReleaseClassContents() for a class mixed into one ... check-in: 5f178e7f03 user: pooryorick tags: trunk | |
| 14:46 | TIP 422 implementation (rebase of branch novem-remove-va to trunk). check-in: e090a04f00 user: dgp tags: tip-422 | |
|
2017-10-31
| ||
| 16:40 | Eliminate most usage of TCL_NUMBER_LONG, just use TCL_NUMBER_WIDE in stead (since both have the same... check-in: 4b60ad78c5 user: jan.nijtmans tags: no-wideint | |
| 16:16 | eliminate most use of (long) type, except for increments check-in: e2f2e6ca33 user: jan.nijtmans tags: no-wideint | |
| 14:48 | Only use 64-bit tables for all platforms check-in: 60ef19dbc0 user: jan.nijtmans tags: no-wideint | |
|
2017-10-30
| ||
| 14:56 | Patch to make changes to Tcl 9 prescribed by TIPs 330 and 336. This makes the Tcl_Interp struct full... check-in: 70e9e38504 user: dgp tags: tip-330-336 | |
| 14:01 | Preliminary (non working at this point) implementation of tip479 check-in: c8c3341810 user: hypnotoad tags: tip479 | |
| 12:41 | Rebase tip-278 branch to workaround CVS conversion woes. Closed-Leaf check-in: 8103b8c9fd user: dgp tags: tip-278 | |
| 12:08 | merge trunk Closed-Leaf check-in: 42c669a1e0 user: dgp tags: tip-278 | |
| 12:03 | merge trunk check-in: bc43c864d7 user: dgp tags: tip-445 | |
| 12:02 | merge trunk Closed-Leaf check-in: 848a10e460 user: dgp tags: tip-345 | |
| 12:02 | merge trunk Closed-Leaf check-in: a2d4cd2f93 user: dgp tags: tip-114 | |
| 08:47 | Experimental branch meant to eliminate the "wideint" type, just merge it to a single "int" type. No ... check-in: c2abe1efd0 user: jan.nijtmans tags: no-wideint | |
| 05:25 | merge bug-fc1409fc91. check-in: 76eaf9a16b user: pooryorick tags: trunk | |
| 05:19 | Fix for issue 9fd5c629c1, TclOO - aborts when a trace on command deletion deletes the object's names... Closed-Leaf check-in: bee7f97ad6 user: pooryorick tags: bug-fc1409fc91 | |
| 03:23 | merge 8.6 check-in: 0c0de52be7 user: dgp tags: trunk | |
Changes to generic/tclAssembly.c.
| ︙ | ︙ | |||
4262 4263 4264 4265 4266 4267 4268 |
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
lineNo = Tcl_NewIntObj(bbPtr->startLine);
Tcl_IncrRefCount(lineNo);
Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
| | | 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 |
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
lineNo = Tcl_NewIntObj(bbPtr->startLine);
Tcl_IncrRefCount(lineNo);
Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
TclSetWideIntObj(lineNo, bbPtr->successor1->startLine);
Tcl_AppendObjToErrorInfo(interp, lineNo);
} else {
Tcl_AddErrorInfo(interp, "end of assembly code");
}
Tcl_DecrRefCount(lineNo);
}
|
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
7438 7439 7440 7441 7442 7443 7444 |
return TCL_ERROR;
}
if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
| | | | | | | | | 7438 7439 7440 7441 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 7460 7461 7462 7463 7464 7465 7466 7467 7468 7469 7470 7471 7472 7473 |
return TCL_ERROR;
}
if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) {
Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
if (l > (Tcl_WideInt)0) {
goto unChanged;
} else if (l == (Tcl_WideInt)0) {
const char *string = objv[1]->bytes;
if (string) {
while (*string != '0') {
if (*string == '-') {
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
string++;
}
}
goto unChanged;
} else if (l == LLONG_MIN) {
TclInitBignumFromWideInt(&big, l);
goto tooLarge;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
return TCL_OK;
}
if (type == TCL_NUMBER_DOUBLE) {
double d = *((const double *) ptr);
static const double poszero = 0.0;
|
| ︙ | ︙ | |||
7483 7484 7485 7486 7487 7488 7489 |
} else if (d > -0.0) {
goto unChanged;
}
Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
return TCL_OK;
}
| < < < < < < < < < < < < < < < < | 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 7495 7496 |
} else if (d > -0.0) {
goto unChanged;
}
Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
return TCL_OK;
}
if (type == TCL_NUMBER_BIG) {
if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
mp_neg(&big, &big);
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
} else {
|
| ︙ | ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | ︙ | |||
1576 1577 1578 1579 1580 1581 1582 |
if (strict) {
result = 0;
} else {
string1 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
} else if (((index == STR_IS_TRUE) &&
| | | < < | 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 |
if (strict) {
result = 0;
} else {
string1 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
} else if (((index == STR_IS_TRUE) &&
objPtr->internalRep.wideValue == 0)
|| ((index == STR_IS_FALSE) &&
objPtr->internalRep.wideValue != 0)) {
result = 0;
}
break;
case STR_IS_CONTROL:
chcomp = Tcl_UniCharIsControl;
break;
case STR_IS_DIGIT:
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
/* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
(objPtr->typePtr == &tclWideIntType) ||
(objPtr->typePtr == &tclBignumType)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
|
| ︙ | ︙ | |||
1629 1630 1631 1632 1633 1634 1635 |
case STR_IS_INT:
if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
break;
}
goto failedIntParse;
case STR_IS_ENTIER:
if ((objPtr->typePtr == &tclIntType) ||
| < < | 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 |
case STR_IS_INT:
if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
break;
}
goto failedIntParse;
case STR_IS_ENTIER:
if ((objPtr->typePtr == &tclIntType) ||
(objPtr->typePtr == &tclWideIntType) ||
(objPtr->typePtr == &tclBignumType)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
result = 0;
|
| ︙ | ︙ |
Changes to generic/tclDisassemble.c.
| ︙ | ︙ | |||
793 794 795 796 797 798 799 |
Tcl_Obj *
TclNewInstNameObj(
unsigned char inst)
{
Tcl_Obj *objPtr = Tcl_NewObj();
objPtr->typePtr = &tclInstNameType;
| | | | | 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 |
Tcl_Obj *
TclNewInstNameObj(
unsigned char inst)
{
Tcl_Obj *objPtr = Tcl_NewObj();
objPtr->typePtr = &tclInstNameType;
objPtr->internalRep.wideValue = (long) inst;
objPtr->bytes = NULL;
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfInstName --
*
* Update the string representation for an instruction name object.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
int inst = objPtr->internalRep.wideValue;
char *s, buf[20];
int len;
if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
sprintf(buf, "inst_%d", inst);
s = buf;
} else {
s = (char *) tclInstructionTable[objPtr->internalRep.wideValue].name;
}
len = strlen(s);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, s, len + 1);
objPtr->length = len;
}
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
499 500 501 502 503 504 505 |
*/
#ifdef TCL_WIDE_INT_IS_LONG
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(tPtr) = TCL_NUMBER_LONG, \
*(ptrPtr) = (ClientData) \
| | | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 |
*/
#ifdef TCL_WIDE_INT_IS_LONG
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(tPtr) = TCL_NUMBER_LONG, \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
((objPtr)->typePtr == &tclDoubleType) \
? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(tPtr) = TCL_NUMBER_LONG, \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
((objPtr)->typePtr == &tclWideIntType) \
? (*(tPtr) = TCL_NUMBER_WIDE, \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
((objPtr)->typePtr == &tclDoubleType) \
? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
|
| ︙ | ︙ | |||
541 542 543 544 545 546 547 |
* MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* int *boolPtr);
*/
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
((((objPtr)->typePtr == &tclIntType) \
|| ((objPtr)->typePtr == &tclBooleanType)) \
| | | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 |
* MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* int *boolPtr);
*/
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
((((objPtr)->typePtr == &tclIntType) \
|| ((objPtr)->typePtr == &tclBooleanType)) \
? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
/*
* Macro used to make the check for type overflow more mnemonic. This works by
* comparing sign bits; the rest of the word is irrelevant. The ANSI C
* "prototype" (where inttype_t is any integer type) is:
*
|
| ︙ | ︙ | |||
572 573 574 575 576 577 578 | #define IsErroringNaNType(type) 0 #endif /* * Auxiliary tables used to compute powers of small integers. */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 572 573 574 575 576 577 578 579 580 581 582 583 584 585 |
#define IsErroringNaNType(type) 0
#endif
/*
* Auxiliary tables used to compute powers of small integers.
*/
/*
* Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
* Tcl_WideInt.
*/
static const Tcl_WideInt MaxBase64[] = {
(Tcl_WideInt)46340*65536+62259, /* 3037000499 == isqrt(2**63-1) */
|
| ︙ | ︙ | |||
709 710 711 712 713 714 715 |
(Tcl_WideInt)100000*100000*100000*10*10*10,
(Tcl_WideInt)161051*161051*161051*11*11,
(Tcl_WideInt)161051*161051*161051*11*11*11,
(Tcl_WideInt)248832*248832*248832*12*12,
(Tcl_WideInt)371293*371293*371293*13*13
};
static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
| < | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 |
(Tcl_WideInt)100000*100000*100000*10*10*10,
(Tcl_WideInt)161051*161051*161051*11*11,
(Tcl_WideInt)161051*161051*161051*11*11*11,
(Tcl_WideInt)248832*248832*248832*12*12,
(Tcl_WideInt)371293*371293*371293*13*13
};
static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
/*
* Markers for ExecuteExtendedBinaryMathOp.
*/
#define DIVIDED_BY_ZERO ((Tcl_Obj *) -1)
#define EXPONENT_OF_ZERO ((Tcl_Obj *) -2)
|
| ︙ | ︙ | |||
1873 1874 1875 1876 1877 1878 1879 |
*/
TclGetIntFromObj(interp, incrPtr, &type1);
Tcl_AddErrorInfo(interp, "\n (reading increment)");
return TCL_ERROR;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 |
*/
TclGetIntFromObj(interp, incrPtr, &type1);
Tcl_AddErrorInfo(interp, "\n (reading increment)");
return TCL_ERROR;
}
if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
/*
* Produce error message (reparse?!)
*/
return TclGetIntFromObj(interp, valuePtr, &type1);
}
if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
/*
* Produce error message (reparse?!)
*/
TclGetIntFromObj(interp, incrPtr, &type1);
Tcl_AddErrorInfo(interp, "\n (reading increment)");
return TCL_ERROR;
}
if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
Tcl_WideInt w1, w2, sum;
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, incrPtr, &w2);
sum = w1 + w2;
/*
* Check for overflow.
*/
if (!Overflowing(w1, w2, sum)) {
Tcl_SetWideIntObj(valuePtr, sum);
return TCL_OK;
}
}
Tcl_TakeBignumFromObj(interp, valuePtr, &value);
Tcl_GetBignumFromObj(interp, incrPtr, &incr);
mp_add(&value, &incr, &value);
mp_clear(&incr);
Tcl_SetBignumObj(valuePtr, &value);
return TCL_OK;
|
| ︙ | ︙ | |||
3622 3623 3624 3625 3626 3627 3628 |
* common execution code.
*/
/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
{
Tcl_Obj *incrPtr;
| < < | 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 |
* common execution code.
*/
/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
{
Tcl_Obj *incrPtr;
Tcl_WideInt w;
long increment;
case INST_INCR_SCALAR1:
case INST_INCR_ARRAY1:
case INST_INCR_ARRAY_STK:
case INST_INCR_SCALAR_STK:
case INST_INCR_STK:
|
| ︙ | ︙ | |||
3723 3724 3725 3726 3727 3728 3729 |
if (TclIsVarDirectModifyable(varPtr)) {
ClientData ptr;
int type;
objPtr = varPtr->value.objPtr;
if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
| | | | | | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 |
if (TclIsVarDirectModifyable(varPtr)) {
ClientData ptr;
int type;
objPtr = varPtr->value.objPtr;
if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) {
Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
Tcl_WideInt sum = augend + increment;
/*
* Overflow when (augend and sum have different sign) and
* (augend and increment have the same sign). This is
* encapsulated in the Overflowing macro.
*/
if (!Overflowing(augend, increment, sum)) {
TRACE(("%u %ld => ", opnd, increment));
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared. */
TclNewWideObj(objResultPtr, sum);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
} else {
objResultPtr = objPtr;
TclSetWideIntObj(objPtr, sum);
}
goto doneIncr;
}
w = (Tcl_WideInt)augend;
TRACE(("%u %ld => ", opnd, increment));
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared. */
objResultPtr = Tcl_NewWideIntObj(w+increment);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
} else {
objResultPtr = objPtr;
/*
* We know the sum value is outside the long range;
* use macro form that doesn't range test again.
*/
TclSetWideIntObj(objPtr, w+increment);
}
goto doneIncr;
} /* end if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) */
}
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared */
objResultPtr = Tcl_DuplicateObj(objPtr);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
} else {
|
| ︙ | ︙ | |||
5898 5899 5900 5901 5902 5903 5904 |
* -----------------------------------------------------------------
* Start of numeric operator instructions.
*/
{
ClientData ptr1, ptr2;
int type1, type2;
| | | | > < < | < < < < < > > > > | | 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 |
* -----------------------------------------------------------------
* Start of numeric operator instructions.
*/
{
ClientData ptr1, ptr2;
int type1, type2;
Tcl_WideInt w1, w2, wResult;
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
} else if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
/* value is between WIDE_MIN and WIDE_MAX */
/* [string is integer] is -UINT_MAX to UINT_MAX range */
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
int i;
if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
type1 = TCL_NUMBER_WIDE;
} else {
type1 = TCL_NUMBER_LONG;
}
} else if (type1 == TCL_NUMBER_BIG) {
/* value is an integer outside the WIDE_MIN to WIDE_MAX range */
/* [string is integer] is -UINT_MAX to UINT_MAX range */
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
int i;
Tcl_WideInt w;
if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
type1 = TCL_NUMBER_LONG;
} else if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
type1 = TCL_NUMBER_WIDE;
}
}
TclNewLongObj(objResultPtr, type1);
TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
NEXT_INST_F(1, 1, 1);
|
| ︙ | ︙ | |||
5964 5965 5966 5967 5968 5969 5970 |
iResult = (*pc == INST_NEQ);
goto foundResult;
}
if (valuePtr == value2Ptr) {
compare = MP_EQ;
goto convertComparison;
}
| | | | | | 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 |
iResult = (*pc == INST_NEQ);
goto foundResult;
}
if (valuePtr == value2Ptr) {
compare = MP_EQ;
goto convertComparison;
}
if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
} else {
compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
}
/*
* Turn comparison outcome into appropriate result for opcode.
*/
|
| ︙ | ︙ | |||
6043 6044 6045 6046 6047 6048 6049 | goto gotError; } /* * Check for common, simple case. */ | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < | 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 |
goto gotError;
}
/*
* Check for common, simple case.
*/
if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_MOD:
if (w2 == 0) {
TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
O2S(value2Ptr)));
goto divideByZero;
} else if ((w2 == 1) || (w2 == -1)) {
/*
* Div. by |1| always yields remainder of 0.
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
} else if (w1 == 0) {
/*
* 0 % (non-zero) always yields remainder of 0.
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
} else {
wResult = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
if ((wResult < 0 || (wResult == 0 &&
((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
(wResult * w2 != w1)) {
wResult -= 1;
}
wResult = w1 - w2*wResult;
goto wideResultOfArithmetic;
}
case INST_RSHIFT:
if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (w1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
} else {
/*
* Quickly force large right shifts to 0 or -1.
*/
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
/*
* We assume that INT_MAX is much larger than the
* number of bits in a long. This is a pretty safe
* assumption, given that the former is usually around
* 4e9 and the latter 32 or 64...
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (w1 > 0L) {
objResultPtr = TCONST(0);
} else {
TclNewLongObj(objResultPtr, -1);
}
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
/*
* Handle shifts within the native long range.
*/
wResult = w1 >> ((int) w2);
goto wideResultOfArithmetic;
}
case INST_LSHIFT:
if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (w1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
} else if (w2 > (Tcl_WideInt) INT_MAX) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1))
* in an mp_int, but since we're using mp_mul_2d() to do
* the work, and it takes only an int argument, that's a
* good place to draw the line.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"integer value too large to represent", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
"integer value too large to represent", NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else {
int shift = (int) w2;
/*
* Handle shifts within the native long range.
*/
if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0)
&& !((w1>0 ? w1 : ~w1) &
-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
wResult = w1 << shift;
goto wideResultOfArithmetic;
}
}
/*
* Too large; need to use the broken-out function.
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
break;
case INST_BITAND:
wResult = w1 & w2;
goto wideResultOfArithmetic;
case INST_BITOR:
wResult = w1 | w2;
goto wideResultOfArithmetic;
case INST_BITXOR:
wResult = w1 ^ w2;
goto wideResultOfArithmetic;
}
}
/*
* DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would
* encourage the compiler to inline ExecuteExtendedBinaryMathOp, which
* is highly undesirable due to the overall impact on size.
|
| ︙ | ︙ | |||
6292 6293 6294 6295 6296 6297 6298 | #endif /* * Handle (long,long) arithmetic as best we can without going out to * an external function. */ | | < < | | < < < < < < < < | | | | | | | | | | | | | | | | 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 |
#endif
/*
* Handle (long,long) arithmetic as best we can without going out to
* an external function.
*/
if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_ADD:
wResult = w1 + w2;
/*
* Check for overflow.
*/
if (Overflowing(w1, w2, wResult)) {
goto overflow;
}
goto wideResultOfArithmetic;
case INST_SUB:
wResult = w1 - w2;
/*
* Must check for overflow. The macro tests for overflows in
* sums by looking at the sign bits. As we have a subtraction
* here, we are adding -w2. As -w2 could in turn overflow, we
* test with ~w2 instead: it has the opposite sign bit to w2
* so it does the job. Note that the only "bad" case (w2==0)
* is irrelevant for this macro, as in that case w1 and
* wResult have the same sign and there is no overflow anyway.
*/
if (Overflowing(w1, ~w2, wResult)) {
goto overflow;
}
wideResultOfArithmetic:
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (Tcl_IsShared(valuePtr)) {
objResultPtr = Tcl_NewWideIntObj(wResult);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
Tcl_SetWideIntObj(valuePtr, wResult);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
case INST_DIV:
if (w2 == 0) {
TRACE(("%s %s => DIVIDE BY ZERO\n",
O2S(valuePtr), O2S(value2Ptr)));
goto divideByZero;
} else if ((w1 == LLONG_MIN) && (w2 == -1)) {
/*
* Can't represent (-LLONG_MIN) as a long.
*/
goto overflow;
}
wResult = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
if (((wResult < 0) || ((wResult == 0) &&
((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
((wResult * w2) != w1)) {
wResult -= 1;
}
goto wideResultOfArithmetic;
case INST_MULT:
if (((sizeof(long) >= 2*sizeof(int))
&& (w1 <= INT_MAX) && (w1 >= INT_MIN)
&& (w2 <= INT_MAX) && (w2 >= INT_MIN))
|| ((sizeof(long) >= 2*sizeof(short))
&& (w1 <= SHRT_MAX) && (w1 >= SHRT_MIN)
&& (w2 <= SHRT_MAX) && (w2 >= SHRT_MIN))) {
wResult = w1 * w2;
goto wideResultOfArithmetic;
}
}
/*
* Fall through with INST_EXPON, INST_DIV and large multiplies.
*/
}
|
| ︙ | ︙ | |||
6445 6446 6447 6448 6449 6450 6451 |
TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
CACHE_STACK_INFO();
goto gotError;
}
| | | | | | 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 |
TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
CACHE_STACK_INFO();
goto gotError;
}
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *) ptr1);
if (Tcl_IsShared(valuePtr)) {
TclNewWideObj(objResultPtr, ~w1);
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetWideIntObj(valuePtr, ~w1);
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
|
| ︙ | ︙ | |||
6483 6484 6485 6486 6487 6488 6489 |
}
switch (type1) {
case TCL_NUMBER_NAN:
/* -NaN => NaN */
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
case TCL_NUMBER_LONG:
| > | | | | | 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 |
}
switch (type1) {
case TCL_NUMBER_NAN:
/* -NaN => NaN */
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
w1 = *((const Tcl_WideInt *) ptr1);
if (w1 != LLONG_MIN) {
if (Tcl_IsShared(valuePtr)) {
TclNewWideObj(objResultPtr, -w1);
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetWideIntObj(valuePtr, -w1);
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
/* FALLTHROUGH */
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
|
| ︙ | ︙ | |||
6688 6689 6690 6691 6692 6693 6694 | /* * Increment the temp holding the loop iteration number. */ iterVarPtr = LOCAL(infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; | | | 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 | /* * Increment the temp holding the loop iteration number. */ iterVarPtr = LOCAL(infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; iterNum = valuePtr->internalRep.wideValue + 1; TclSetLongObj(valuePtr, iterNum); /* * Check whether all value lists are exhausted and we should stop the * loop. */ |
| ︙ | ︙ | |||
8120 8121 8122 8123 8124 8125 8126 |
ExecuteExtendedBinaryMathOp(
Tcl_Interp *interp, /* Where to report errors. */
int opcode, /* What operation to perform. */
Tcl_Obj **constants, /* The execution environment's constants. */
Tcl_Obj *valuePtr, /* The first operand on the stack. */
Tcl_Obj *value2Ptr) /* The second operand on the stack. */
{
| < < < < < < < < | 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 |
ExecuteExtendedBinaryMathOp(
Tcl_Interp *interp, /* Where to report errors. */
int opcode, /* What operation to perform. */
Tcl_Obj **constants, /* The execution environment's constants. */
Tcl_Obj *valuePtr, /* The first operand on the stack. */
Tcl_Obj *value2Ptr) /* The second operand on the stack. */
{
#define WIDE_RESULT(w) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewWideIntObj(w); \
} else { \
Tcl_SetWideIntObj(valuePtr, w); \
return NULL; \
}
|
| ︙ | ︙ | |||
8154 8155 8156 8157 8158 8159 8160 |
Tcl_SetDoubleObj(valuePtr, (d)); \
return NULL; \
}
int type1, type2;
ClientData ptr1, ptr2;
double d1, d2, dResult;
| < | | | | | < | 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 8061 |
Tcl_SetDoubleObj(valuePtr, (d)); \
return NULL; \
}
int type1, type2;
ClientData ptr1, ptr2;
double d1, d2, dResult;
Tcl_WideInt w1, w2, wResult;
mp_int big1, big2, bigResult, bigRemainder;
Tcl_Obj *objResultPtr;
int invalid, numPos, zero;
long shift;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
switch (opcode) {
case INST_MOD:
/* TODO: Attempts to re-use unshared operands on stack */
w2 = 0; /* silence gcc warning */
if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) {
w2 = *((const Tcl_WideInt *)ptr2);
if (w2 == 0) {
return DIVIDED_BY_ZERO;
}
if ((w2 == 1) || (w2 == -1)) {
/*
* Div. by |1| always yields remainder of 0.
*/
return constants[0];
}
}
if (type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *)ptr1);
if (type2 != TCL_NUMBER_BIG) {
Tcl_WideInt wQuotient, wRemainder;
Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
wQuotient = w1 / w2;
|
| ︙ | ︙ | |||
8227 8228 8229 8230 8231 8232 8233 | /* * Arguments are same sign; remainder is first operand. */ mp_clear(&big2); return NULL; } | < | 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 |
/*
* Arguments are same sign; remainder is first operand.
*/
mp_clear(&big2);
return NULL;
}
Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
mp_init(&bigResult);
mp_init(&bigRemainder);
mp_div(&big1, &big2, &bigResult, &bigRemainder);
if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
/*
|
| ︙ | ︙ | |||
8255 8256 8257 8258 8259 8260 8261 |
case INST_RSHIFT: {
/*
* Reject negative shift argument.
*/
switch (type2) {
case TCL_NUMBER_LONG:
| < < < < | | | | | | < < < < | | < | | < | 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 |
case INST_RSHIFT: {
/*
* Reject negative shift argument.
*/
switch (type2) {
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
break;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
invalid = (mp_cmp_d(&big2, 0) == MP_LT);
mp_clear(&big2);
break;
default:
/* Unused, here to silence compiler warning */
invalid = 0;
}
if (invalid) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
return GENERAL_ARITHMETIC_ERROR;
}
/*
* Zero shifted any number of bits is still zero.
*/
if ((type1==TCL_NUMBER_LONG || type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
return constants[0];
}
if (opcode == INST_LSHIFT) {
/*
* Large left shifts create integer overflow.
*
* BEWARE! Can't use Tcl_GetIntFromObj() here because that
* converts values in the (unsigned) range to their signed int
* counterparts, leading to incorrect results.
*/
if ((type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE)
|| (*((const Tcl_WideInt *)ptr2) > (long) INT_MAX)) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1)) in
* an mp_int, but since we're using mp_mul_2d() to do the
* work, and it takes only an int argument, that's a good
* place to draw the line.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"integer value too large to represent", -1));
return GENERAL_ARITHMETIC_ERROR;
}
shift = (int)(*((const Tcl_WideInt *)ptr2));
/*
* Handle shifts within the native wide range.
*/
if ((type1 != TCL_NUMBER_BIG)
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
TclGetWideIntFromObj(NULL, valuePtr, &w1);
if (!((w1>0 ? w1 : ~w1)
& -(((Tcl_WideInt)1)
<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
WIDE_RESULT(w1 << shift);
}
}
} else {
/*
* Quickly force large right shifts to 0 or -1.
*/
if ((type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE)
|| (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
/*
* Again, technically, the value to be shifted could be an
* mp_int so huge that a right shift by (INT_MAX+1) bits could
* not take us to the result of 0 or -1, but since we're using
* mp_div_2d to do the work, and it takes only an int
* argument, we draw the line there.
*/
switch (type1) {
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
break;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
zero = (mp_cmp_d(&big1, 0) == MP_GT);
mp_clear(&big1);
break;
default:
/* Unused, here to silence compiler warning. */
zero = 0;
}
if (zero) {
return constants[0];
}
WIDE_RESULT(-1);
}
shift = (int)(*(const Tcl_WideInt *)ptr2);
/*
* Handle shifts within the native wide range.
*/
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
w1 = *(const Tcl_WideInt *)ptr1;
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
if (w1 >= (Tcl_WideInt)0) {
return constants[0];
}
WIDE_RESULT(-1);
}
WIDE_RESULT(w1 >> shift);
}
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
mp_init(&bigResult);
if (opcode == INST_LSHIFT) {
mp_mul_2d(&big1, shift, &bigResult);
|
| ︙ | ︙ | |||
8545 8546 8547 8548 8549 8550 8551 | } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } | < | < | | | | | | | | | | | | < < < < < | | | | | | | | | | | < < < < | | < | < < < < | | < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | | | | | | 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 |
}
mp_clear(&big1);
mp_clear(&big2);
BIG_RESULT(&bigResult);
}
if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE)) {
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, value2Ptr, &w2);
switch (opcode) {
case INST_BITAND:
wResult = w1 & w2;
break;
case INST_BITOR:
wResult = w1 | w2;
break;
case INST_BITXOR:
wResult = w1 ^ w2;
break;
default:
/* Unused, here to silence compiler warning. */
wResult = 0;
}
WIDE_RESULT(wResult);
}
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
switch (opcode) {
case INST_BITAND:
wResult = w1 & w2;
break;
case INST_BITOR:
wResult = w1 | w2;
break;
case INST_BITXOR:
wResult = w1 ^ w2;
break;
default:
/* Unused, here to silence compiler warning. */
wResult = 0;
}
WIDE_RESULT(wResult);
case INST_EXPON: {
int oddExponent = 0, negativeExponent = 0;
unsigned short base;
if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
if (d1==0.0 && d2<0.0) {
return EXPONENT_OF_ZERO;
}
dResult = pow(d1, d2);
goto doubleResult;
}
w2 = 0;
if (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE) {
w2 = *((const Tcl_WideInt *) ptr2);
if (w2 == 0) {
/*
* Anything to the zero power is 1.
*/
return constants[1];
} else if (w2 == 1) {
/*
* Anything to the first power is itself
*/
return NULL;
}
}
switch (type2) {
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
negativeExponent = (w2 < 0);
oddExponent = (int) (w2 & (Tcl_WideInt)1);
break;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
mp_mod_2d(&big2, 1, &big2);
oddExponent = !mp_iszero(&big2);
mp_clear(&big2);
break;
}
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *)ptr1);
}
if (negativeExponent) {
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
switch (w1) {
case 0:
/*
* Zero to a negative power is div by zero error.
*/
return EXPONENT_OF_ZERO;
case -1:
if (oddExponent) {
WIDE_RESULT(-1);
}
/* fallthrough */
case 1:
/*
* 1 to any power is 1.
*/
return constants[1];
}
}
/*
* Integers with magnitude greater than 1 raise to a negative
* power yield the answer zero (see TIP 123).
*/
return constants[0];
}
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
switch (w1) {
case 0:
/*
* Zero to a positive power is zero.
*/
return constants[0];
case 1:
/*
* 1 to any power is 1.
*/
return constants[1];
case -1:
if (!oddExponent) {
return constants[1];
}
WIDE_RESULT(-1);
}
}
/*
* We refuse to accept exponent arguments that exceed one mp_digit
* which means the max exponent value is 2**28-1 = 0x0fffffff =
* 268435455, which fits into a signed 32 bit int which is within the
* range of the long int type. This means any numeric Tcl_Obj value
* not using TCL_NUMBER_LONG type must hold a value larger than we
* accept.
*/
if (type2 != TCL_NUMBER_LONG && type2 != TCL_NUMBER_WIDE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
if (w1 == 2) {
/*
* Reduce small powers of 2 to shifts.
*/
if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);
}
goto overflowExpon;
}
if (w1 == -2) {
int signum = oddExponent ? -1 : 1;
/*
* Reduce small powers of 2 to shifts.
*/
if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
}
goto overflowExpon;
}
}
if (type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *) ptr1);
} else {
goto overflowExpon;
}
if (w2 - 2 < (long)MaxBase64Size
&& w1 <= MaxBase64[w2 - 2]
&& w1 >= -MaxBase64[w2 - 2]) {
/*
* Small powers of integers whose result is wide.
*/
wResult = w1 * w1; /* b**2 */
switch (w2) {
case 2:
break;
case 3:
wResult *= w1; /* b**3 */
break;
case 4:
wResult *= wResult; /* b**4 */
break;
case 5:
wResult *= wResult; /* b**4 */
wResult *= w1; /* b**5 */
|
| ︙ | ︙ | |||
8911 8912 8913 8914 8915 8916 8917 | /* * Handle cases of powers > 16 that still fit in a 64-bit word by * doing table lookup. */ if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize | | | | | < | 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 8693 8694 8695 8696 8697 8698 8699 8700 8701 8702 8703 8704 8705 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 |
/*
* Handle cases of powers > 16 that still fit in a 64-bit word by
* doing table lookup.
*/
if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
&& w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
base = Exp64Index[w1 - 3]
+ (unsigned short) (w2 - 2 - MaxBase64Size);
if (base < Exp64Index[w1 - 2]) {
/*
* 64-bit number raised to intermediate power, done by
* table lookup.
*/
WIDE_RESULT(Exp64Value[base]);
}
}
if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
&& w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
base = Exp64Index[-w1 - 3]
+ (unsigned short) (w2 - 2 - MaxBase64Size);
if (base < Exp64Index[-w1 - 2]) {
/*
* 64-bit number raised to intermediate power, done by
* table lookup.
*/
wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
WIDE_RESULT(wResult);
}
}
overflowExpon:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if (big2.used > 1) {
mp_clear(&big2);
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
|
| ︙ | ︙ | |||
9018 9019 9020 9021 9022 9023 9024 |
if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, value2Ptr, &w2);
switch (opcode) {
case INST_ADD:
wResult = w1 + w2;
| < | < < | < | < | 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 |
if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, value2Ptr, &w2);
switch (opcode) {
case INST_ADD:
wResult = w1 + w2;
if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE))
{
/*
* Check for overflow.
*/
if (Overflowing(w1, w2, wResult)) {
goto overflowBasic;
}
}
break;
case INST_SUB:
wResult = w1 - w2;
if ((type1 == TCL_NUMBER_LONG || type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_LONG || type2 == TCL_NUMBER_WIDE))
{
/*
* Must check for overflow. The macro tests for overflows
* in sums by looking at the sign bits. As we have a
* subtraction here, we are adding -w2. As -w2 could in
* turn overflow, we test with ~w2 instead: it has the
* opposite sign bit to w2 so it does the job. Note that
* the only "bad" case (w2==0) is irrelevant for this
* macro, as in that case w1 and wResult have the same
* sign and there is no overflow anyway.
*/
if (Overflowing(w1, ~w2, wResult)) {
goto overflowBasic;
}
}
break;
case INST_MULT:
if ((w1 < INT_MIN) || (w1 > INT_MAX) || (w2 < INT_MIN) || (w2 > INT_MAX)) {
goto overflowBasic;
}
wResult = w1 * w2;
break;
case INST_DIV:
if (w2 == 0) {
|
| ︙ | ︙ | |||
9160 9161 9162 9163 9164 9165 9166 |
mp_int big;
Tcl_Obj *objResultPtr;
(void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
switch (opcode) {
case INST_BITNOT:
| < | < < < < < < < < < < | 8918 8919 8920 8921 8922 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 |
mp_int big;
Tcl_Obj *objResultPtr;
(void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
switch (opcode) {
case INST_BITNOT:
if (type == TCL_NUMBER_LONG || type == TCL_NUMBER_WIDE) {
w = *((const Tcl_WideInt *) ptr);
WIDE_RESULT(~w);
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
/* ~a = - a - 1 */
mp_neg(&big, &big);
mp_sub_d(&big, 1, &big);
BIG_RESULT(&big);
case INST_UMINUS:
switch (type) {
case TCL_NUMBER_DOUBLE:
DOUBLE_RESULT(-(*((const double *) ptr)));
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
w = *((const Tcl_WideInt *) ptr);
if (w != LLONG_MIN) {
WIDE_RESULT(-w);
}
TclInitBignumFromWideInt(&big, w);
break;
default:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
}
mp_neg(&big, &big);
BIG_RESULT(&big);
}
Tcl_Panic("unexpected opcode");
return NULL;
}
#undef WIDE_RESULT
#undef BIG_RESULT
#undef DOUBLE_RESULT
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
9233 9234 9235 9236 9237 9238 9239 |
Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr)
{
int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
ClientData ptr1, ptr2;
mp_int big1, big2;
double d1, d2, tmp;
| < < < > | < < < < < | < > | | | 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 |
Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr)
{
int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
ClientData ptr1, ptr2;
mp_int big1, big2;
double d1, d2, tmp;
Tcl_WideInt w1, w2;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
switch (type1) {
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
w1 = *((const Tcl_WideInt *)ptr1);
switch (type2) {
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
wideCompare:
return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
d1 = (double) w1;
/*
* If the double has a fractional part, or if the long can be
* converted to double without loss of precision, then compare as
* doubles.
*/
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1
|| modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
/*
* Otherwise, to make comparision based on full precision, need to
* convert the double to a suitably sized integer.
|
| ︙ | ︙ | |||
9288 9289 9290 9291 9292 9293 9294 |
if (d2 < (double)LONG_MIN) {
return MP_GT;
}
if (d2 > (double)LONG_MAX) {
return MP_LT;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 |
if (d2 < (double)LONG_MIN) {
return MP_GT;
}
if (d2 > (double)LONG_MAX) {
return MP_LT;
}
w2 = (Tcl_WideInt) d2;
goto wideCompare;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if (mp_cmp_d(&big2, 0) == MP_LT) {
compare = MP_GT;
} else {
compare = MP_LT;
}
mp_clear(&big2);
return compare;
}
case TCL_NUMBER_DOUBLE:
d1 = *((const double *)ptr1);
switch (type2) {
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
doubleCompare:
return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
|| w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
if (d1 < (double)LLONG_MIN) {
return MP_LT;
}
if (d1 > (double)LLONG_MAX) {
return MP_GT;
}
w1 = (Tcl_WideInt) d1;
goto wideCompare;
case TCL_NUMBER_BIG:
if (TclIsInfinite(d1)) {
return (d1 > 0.0) ? MP_GT : MP_LT;
}
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
if (mp_cmp_d(&big2, 0) == MP_LT) {
|
| ︙ | ︙ | |||
9406 9407 9408 9409 9410 9411 9412 |
Tcl_InitBignumFromDouble(NULL, d1, &big1);
goto bigCompare;
}
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
switch (type2) {
| < | < | | 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 |
Tcl_InitBignumFromDouble(NULL, d1, &big1);
goto bigCompare;
}
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
switch (type2) {
case TCL_NUMBER_LONG:
case TCL_NUMBER_WIDE:
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
if (TclIsInfinite(d2)) {
compare = (d2 > 0.0) ? MP_LT : MP_GT;
|
| ︙ | ︙ |
Changes to generic/tclGet.c.
| ︙ | ︙ | |||
138 139 140 141 142 143 144 |
obj.typePtr = NULL;
code = TclSetBooleanFromAny(interp, &obj);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
| | | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 |
obj.typePtr = NULL;
code = TclSetBooleanFromAny(interp, &obj);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
*boolPtr = obj.internalRep.wideValue;
}
return code;
}
/*
* Local Variables:
* mode: c
|
| ︙ | ︙ |
Changes to generic/tclInt.decls.
| ︙ | ︙ | |||
110 111 112 113 114 115 116 |
int *sizePtr, int *bracePtr)
}
declare 23 {
Proc *TclFindProc(Interp *iPtr, const char *procName)
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
| | | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 |
int *sizePtr, int *bracePtr)
}
declare 23 {
Proc *TclFindProc(Interp *iPtr, const char *procName)
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
int TclFormatInt(char *buffer, Tcl_WideInt n)
}
declare 25 {
void TclFreePackageInfo(Interp *iPtr)
}
# Removed in 8.1:
# declare 26 {
# char *TclGetCwd(Tcl_Interp *interp)
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
2449 2450 2451 2452 2453 2454 2455 |
* Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
*
* WARNING: these macros eval their args more than once.
*/
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType) \
| | | | | | | 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 |
* Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
*
* WARNING: these macros eval their args more than once.
*/
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#if (LONG_MAX == INT_MAX)
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(intPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#else
#define TclGetIntFromObj(interp, objPtr, intPtr) \
Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \
TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
#endif
/*
* Macro used to save a function call for common uses of
* Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
*
* MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* Tcl_WideInt *wideIntPtr);
*/
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(wideIntPtr) = (Tcl_WideInt) \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclWideIntType) \
? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
((objPtr)->typePtr == &tclIntType) \
? (*(wideIntPtr) = (Tcl_WideInt) \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */
/*
* Flag values for TclTraceDictPath().
*
* DICT_PATH_READ indicates that all entries on the path must exist but no
|
| ︙ | ︙ | |||
2716 2717 2718 2719 2720 2721 2722 | MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; | < < | 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 | MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; MODULE_SCOPE const Tcl_ObjType tclWideIntType; MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; /* * Variables denoting the hash key types defined in the core. */ |
| ︙ | ︙ | |||
4541 4542 4543 4544 4545 4546 4547 |
*----------------------------------------------------------------
*/
#define TclSetLongObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
| | | > > | 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 |
*----------------------------------------------------------------
*/
#define TclSetLongObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
(objPtr)->typePtr = &tclIntType; \
} while (0)
#ifdef TCL_WIDE_INT_IS_LONG
#define TclSetWideIntObj(objPtr, w) TclSetLongObj(objPtr, w)
#else
#define TclSetWideIntObj(objPtr, w) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
(objPtr)->typePtr = &tclWideIntType; \
} while (0)
|
| ︙ | ︙ | |||
4585 4586 4587 4588 4589 4590 4591 |
#ifndef TCL_MEM_DEBUG
#define TclNewLongObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
| | > > > > > > > > > > > > > > | 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 |
#ifndef TCL_MEM_DEBUG
#define TclNewLongObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
(objPtr)->typePtr = &tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#ifndef TCL_WIDE_INT_IS_LONG
#define TclNewWideObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
(objPtr)->typePtr = &tclWideIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else
#define TclNewWideObj(objPtr, i) TclNewLongObj(objPtr, i)
#endif
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.doubleValue = (double)(d); \
|
| ︙ | ︙ | |||
4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 |
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewLongObj(objPtr, l) \
(objPtr) = Tcl_NewLongObj(l)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
#define TclNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
| > > > | 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 |
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#else /* TCL_MEM_DEBUG */
#define TclNewLongObj(objPtr, l) \
(objPtr) = Tcl_NewLongObj(l)
#define TclNewWideObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
#define TclNewStringObj(objPtr, s, len) \
(objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
|
| ︙ | ︙ |
Changes to generic/tclIntDecls.h.
| ︙ | ︙ | |||
109 110 111 112 113 114 115 | const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ | | | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* 28 */ EXTERN Tcl_Channel TclpGetDefaultStdChannel(int type); /* Slot 29 is reserved */ |
| ︙ | ︙ | |||
664 665 666 667 668 669 670 |
void (*reserved17)(void);
void (*reserved18)(void);
void (*reserved19)(void);
void (*reserved20)(void);
void (*reserved21)(void);
int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
| | | 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 |
void (*reserved17)(void);
void (*reserved18)(void);
void (*reserved19)(void);
void (*reserved20)(void);
void (*reserved21)(void);
int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
void (*reserved26)(void);
void (*reserved27)(void);
Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
void (*reserved29)(void);
void (*reserved30)(void);
const char * (*tclGetExtension) (const char *name); /* 31 */
|
| ︙ | ︙ |
Changes to generic/tclObj.c.
| ︙ | ︙ | |||
206 207 208 209 210 211 212 | */ static int ParseBoolean(Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); | < < < < | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | */ static int ParseBoolean(Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int copy, mp_int *bignumValue); /* |
| ︙ | ︙ | |||
266 267 268 269 270 271 272 |
const Tcl_ObjType tclIntType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
| < | | < | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 |
const Tcl_ObjType tclIntType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclWideIntType = {
"wideInt", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
DupBignum, /* dupIntRepProc */
UpdateStringOfBignum, /* updateStringProc */
NULL /* setFromAnyProc */
};
|
| ︙ | ︙ | |||
403 404 405 406 407 408 409 |
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
| < < < | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 |
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced = 0;
tclObjsFreed = 0;
{
int i;
|
| ︙ | ︙ | |||
1806 1807 1808 1809 1810 1811 1812 |
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
| | | 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 |
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = (boolValue != 0);
objPtr->typePtr = &tclIntType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
|
| ︙ | ︙ | |||
1884 1885 1886 1887 1888 1889 1890 |
Tcl_GetBooleanFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get boolean. */
register int *boolPtr) /* Place to store resulting boolean. */
{
do {
if (objPtr->typePtr == &tclIntType) {
| | | | 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 |
Tcl_GetBooleanFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get boolean. */
register int *boolPtr) /* Place to store resulting boolean. */
{
do {
if (objPtr->typePtr == &tclIntType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBooleanType) {
*boolPtr = (int) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
/*
* Caution: Don't be tempted to check directly for the "double"
* Tcl_ObjType and then compare the intrep to 0.0. This isn't
* reliable because a "double" Tcl_ObjType can hold the NaN value.
|
| ︙ | ︙ | |||
1912 1913 1914 1915 1916 1917 1918 |
*boolPtr = (d != 0.0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
*boolPtr = 1;
return TCL_OK;
}
| < < | 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 |
*boolPtr = (d != 0.0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
*boolPtr = 1;
return TCL_OK;
}
if (objPtr->typePtr == &tclWideIntType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1956 1957 1958 1959 1960 1961 1962 |
* For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
* whether a boolean conversion is possible without generating the string
* rep.
*/
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType) {
| | < < | 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 |
* For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
* whether a boolean conversion is possible without generating the string
* rep.
*/
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType) {
switch (objPtr->internalRep.wideValue) {
case 0L: case 1L:
return TCL_OK;
}
goto badBoolean;
}
if (objPtr->typePtr == &tclBignumType) {
goto badBoolean;
}
if (objPtr->typePtr == &tclWideIntType) {
goto badBoolean;
}
if (objPtr->typePtr == &tclDoubleType) {
goto badBoolean;
}
}
if (ParseBoolean(objPtr) == TCL_OK) {
|
| ︙ | ︙ | |||
2103 2104 2105 2106 2107 2108 2109 |
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
goodBoolean:
TclFreeIntRep(objPtr);
| | | | 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 |
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
goodBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
numericBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2290 2291 2292 2293 2294 2295 2296 |
}
return TCL_ERROR;
}
*dblPtr = (double) objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
| | < < | 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 |
}
return TCL_ERROR;
}
*dblPtr = (double) objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*dblPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
mp_int big;
UNPACK_BIGNUM(objPtr, big);
*dblPtr = TclBignumToDouble(&big);
return TCL_OK;
}
if (objPtr->typePtr == &tclWideIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
} while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2534 2535 2536 2537 2538 2539 2540 |
*/
static int
SetIntFromAny(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
| < | | | 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 |
*/
static int
SetIntFromAny(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
Tcl_WideInt w;
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfInt --
*
|
| ︙ | ︙ | |||
2565 2566 2567 2568 2569 2570 2571 |
static void
UpdateStringOfInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
| | | 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 |
static void
UpdateStringOfInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.wideValue);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
/*
|
| ︙ | ︙ | |||
2675 2676 2677 2678 2679 2680 2681 |
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
| | | 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 |
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = longValue;
objPtr->typePtr = &tclIntType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
|
| ︙ | ︙ | |||
2755 2756 2757 2758 2759 2760 2761 |
Tcl_GetLongFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get a long. */
register long *longPtr) /* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType) {
| | < < | 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 |
Tcl_GetLongFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get a long. */
register long *longPtr) /* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType) {
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclWideIntType) {
/*
* We return any integer in the range -ULONG_MAX to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
* existing semantics for conversion of integers on input, but
* avoids inadvertent demotion of wide integers to 32-bit ones in
* the internal rep.
*/
Tcl_WideInt w = objPtr->internalRep.wideValue;
if (w >= -(Tcl_WideInt)(ULONG_MAX)
&& w <= (Tcl_WideInt)(ULONG_MAX)) {
*longPtr = Tcl_WideAsLong(w);
return TCL_OK;
}
goto tooLarge;
}
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", NULL);
}
|
| ︙ | ︙ | |||
2816 2817 2818 2819 2820 2821 2822 |
*longPtr = - (long) value;
} else {
*longPtr = (long) value;
}
return TCL_OK;
}
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 |
*longPtr = - (long) value;
} else {
*longPtr = (long) value;
}
return TCL_OK;
}
}
tooLarge:
if (interp != NULL) {
const char *s = "integer value too large to represent";
Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
Tcl_SetObjResult(interp, msg);
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
}
return TCL_ERROR;
}
} while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewWideIntObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
|
| ︙ | ︙ | |||
3027 3028 3029 3030 3031 3032 3033 |
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
}
if ((wideValue >= (Tcl_WideInt) LONG_MIN)
&& (wideValue <= (Tcl_WideInt) LONG_MAX)) {
| | < < < < < < < | 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 |
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
}
if ((wideValue >= (Tcl_WideInt) LONG_MIN)
&& (wideValue <= (Tcl_WideInt) LONG_MAX)) {
TclSetLongObj(objPtr, wideValue);
} else {
TclSetWideIntObj(objPtr, wideValue);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetWideIntFromObj --
|
| ︙ | ︙ | |||
3069 3070 3071 3072 3073 3074 3075 |
Tcl_GetWideIntFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* Object from which to get a wide int. */
register Tcl_WideInt *wideIntPtr)
/* Place to store resulting long. */
{
do {
| < < | | 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 |
Tcl_GetWideIntFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* Object from which to get a wide int. */
register Tcl_WideInt *wideIntPtr)
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclWideIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*wideIntPtr = (Tcl_WideInt) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
TclGetString(objPtr)));
|
| ︙ | ︙ | |||
3129 3130 3131 3132 3133 3134 3135 |
}
return TCL_ERROR;
}
} while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 |
}
return TCL_ERROR;
}
} while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* FreeBignum --
*
* This function frees the internal rep of a bignum.
|
| ︙ | ︙ | |||
3398 3399 3400 3401 3402 3403 3404 |
if (objPtr->bytes == NULL) {
TclInitStringRep(objPtr, &tclEmptyString, 0);
}
}
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
| | < < | 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 |
if (objPtr->bytes == NULL) {
TclInitStringRep(objPtr, &tclEmptyString, 0);
}
}
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
TclInitBignumFromLong(bignumValue, objPtr->internalRep.wideValue);
return TCL_OK;
}
if (objPtr->typePtr == &tclWideIntType) {
TclInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
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", NULL);
}
|
| ︙ | ︙ | |||
3647 3648 3649 3650 3651 3652 3653 |
*typePtr = TCL_NUMBER_NAN;
} else {
*typePtr = TCL_NUMBER_DOUBLE;
}
*clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
| | < < < < < < < | 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 |
*typePtr = TCL_NUMBER_NAN;
} else {
*typePtr = TCL_NUMBER_DOUBLE;
}
*clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclWideIntType) {
*typePtr = TCL_NUMBER_WIDE;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
(int) sizeof(mp_int));
UNPACK_BIGNUM(objPtr, *bigPtr);
*typePtr = TCL_NUMBER_BIG;
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
822 823 824 825 826 827 828 |
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
&& (level >= 0)) {
level = curLevel - level;
result = 1;
} else if (objPtr->typePtr == &levelReferenceType) {
| | | | 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 |
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
&& (level >= 0)) {
level = curLevel - level;
result = 1;
} else if (objPtr->typePtr == &levelReferenceType) {
level = (int) objPtr->internalRep.wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
TclFreeIntRep(objPtr);
objPtr->typePtr = &levelReferenceType;
objPtr->internalRep.wideValue = level;
result = 1;
} else {
result = -1;
}
} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
/*
* If this were an integer, we'd have succeeded already.
|
| ︙ | ︙ |
Changes to generic/tclStrToD.c.
| ︙ | ︙ | |||
1285 1286 1287 1288 1289 1290 1291 |
#endif
TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
| | | | 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 |
#endif
TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
- (long) octalSignificandWide;
} else {
objPtr->internalRep.wideValue =
(long) octalSignificandWide;
}
}
}
if (octalSignificandOverflow) {
if (signum) {
mp_neg(&octalSignificandBig, &octalSignificandBig);
|
| ︙ | ︙ | |||
1332 1333 1334 1335 1336 1337 1338 |
#endif
TclInitBignumFromWideUInt(&significandBig,
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
| | | | 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 |
#endif
TclInitBignumFromWideUInt(&significandBig,
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
- (long) significandWide;
} else {
objPtr->internalRep.wideValue =
(long) significandWide;
}
}
}
if (significandOverflow) {
if (signum) {
mp_neg(&significandBig, &significandBig);
|
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
| ︙ | ︙ | |||
240 241 242 243 244 245 246 |
) {
#ifdef TCL_MEM_DEBUG
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
| | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 |
) {
#ifdef TCL_MEM_DEBUG
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = (long) intValue;
objPtr->typePtr = &tclIntType;
return objPtr;
#else
return Tcl_NewIntObj(intValue);
#endif
}
#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
|
| ︙ | ︙ |
Changes to generic/tclTimer.c.
| ︙ | ︙ | |||
815 816 817 818 819 820 821 |
}
/*
* First lets see if the command was passed a number as the first argument.
*/
if (objv[1]->typePtr == &tclIntType
| < < | 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 |
}
/*
* First lets see if the command was passed a number as the first argument.
*/
if (objv[1]->typePtr == &tclIntType
|| objv[1]->typePtr == &tclWideIntType
|| objv[1]->typePtr == &tclBignumType
|| (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
&index) != TCL_OK)) {
index = -1;
if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
const char *arg = Tcl_GetString(objv[1]);
|
| ︙ | ︙ | |||
1041 1042 1043 1044 1045 1046 1047 |
if (Tcl_LimitCheck(interp) != TCL_OK) {
return TCL_ERROR;
}
}
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
| < < < < < | | | | | | | | | < < < < < | | | 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 |
if (Tcl_LimitCheck(interp) != TCL_OK) {
return TCL_ERROR;
}
}
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
diff = 1;
}
if (diff > 0) {
Tcl_Sleep((int) diff);
if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
break;
}
} else {
break;
}
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
if (diff > 0) {
Tcl_Sleep((int) diff);
}
if (Tcl_AsyncReady()) {
if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
return TCL_ERROR;
}
}
if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tcl_LimitCheck(interp) != TCL_OK) {
return TCL_ERROR;
}
}
Tcl_GetTime(&now);
} while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
3485 3486 3487 3488 3489 3490 3491 |
*----------------------------------------------------------------------
*/
int
TclFormatInt(
char *buffer, /* Points to the storage into which the
* formatted characters are written. */
| | | | 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 |
*----------------------------------------------------------------------
*/
int
TclFormatInt(
char *buffer, /* Points to the storage into which the
* formatted characters are written. */
Tcl_WideInt n) /* The integer to format. */
{
Tcl_WideInt intVal;
int i;
int numFormatted, j;
const char *digits = "0123456789";
/*
* Check first whether "n" is zero.
*/
|
| ︙ | ︙ | |||
3510 3511 3512 3513 3514 3515 3516 |
* Check whether "n" is the maximum negative value. This is -2^(m-1) for
* an m-bit word, and has no positive equivalent; negating it produces the
* same value.
*/
intVal = -n; /* [Bug 3390638] Workaround for*/
if (n == -n || intVal == n) { /* broken compiler optimizers. */
| | | 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 |
* Check whether "n" is the maximum negative value. This is -2^(m-1) for
* an m-bit word, and has no positive equivalent; negating it produces the
* same value.
*/
intVal = -n; /* [Bug 3390638] Workaround for*/
if (n == -n || intVal == n) { /* broken compiler optimizers. */
return sprintf(buffer, "%" TCL_LL_MODIFIER "d", n);
}
/*
* Generate the characters of the result backwards in the buffer.
*/
intVal = (n < 0? -n : n);
|
| ︙ | ︙ | |||
3594 3595 3596 3597 3598 3599 3600 |
if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
/*
* If the object is already an offset from the end of the list, or can
* be converted to one, use it.
*/
| | | 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 |
if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
/*
* If the object is already an offset from the end of the list, or can
* be converted to one, use it.
*/
*indexPtr = endValue + objPtr->internalRep.wideValue;
return TCL_OK;
}
bytes = TclGetString(objPtr);
length = objPtr->length;
/*
|
| ︙ | ︙ | |||
3686 3687 3688 3689 3690 3691 3692 |
UpdateStringOfEndOffset(
register Tcl_Obj *objPtr)
{
char buffer[TCL_INTEGER_SPACE + 5];
register int len = 3;
memcpy(buffer, "end", 4);
| | | | 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 |
UpdateStringOfEndOffset(
register Tcl_Obj *objPtr)
{
char buffer[TCL_INTEGER_SPACE + 5];
register int len = 3;
memcpy(buffer, "end", 4);
if (objPtr->internalRep.wideValue != 0) {
buffer[len++] = '-';
len += TclFormatInt(buffer+len, -(objPtr->internalRep.wideValue));
}
objPtr->bytes = ckalloc((unsigned) len+1);
memcpy(objPtr->bytes, buffer, (unsigned) len+1);
objPtr->length = len;
}
/*
|
| ︙ | ︙ | |||
3718 3719 3720 3721 3722 3723 3724 |
*/
static int
SetEndOffsetFromAny(
Tcl_Interp *interp, /* Tcl interpreter or NULL */
Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
| | | 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 |
*/
static int
SetEndOffsetFromAny(
Tcl_Interp *interp, /* Tcl interpreter or NULL */
Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
Tcl_WideInt offset; /* Offset in the "end-offset" expression */
register const char *bytes; /* String rep of the object */
int length; /* Length of the object's string rep */
/*
* If it's already the right type, we're fine.
*/
|
| ︙ | ︙ | |||
3754 3755 3756 3757 3758 3759 3760 |
*/
if (length <= 3) {
offset = 0;
} else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
/*
* This is our limited string expression evaluator. Pass everything
| | > | > > > > > > | 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 |
*/
if (length <= 3) {
offset = 0;
} else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
/*
* This is our limited string expression evaluator. Pass everything
* after "end-" to TclParseNumber.
*/
if (TclIsSpaceProc(bytes[4])) {
goto badIndexFormat;
}
if (TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL,
TCL_PARSE_INTEGER_ONLY) != TCL_OK) {
return TCL_ERROR;
}
if ((objPtr->typePtr != &tclIntType)
&& (objPtr->typePtr != &tclWideIntType)
) {
goto badIndexFormat;
}
offset = objPtr->internalRep.wideValue;
if (bytes[3] == '-') {
offset = -offset;
}
} else {
/*
* Conversion failed. Report the error.
*/
|
| ︙ | ︙ | |||
3786 3787 3788 3789 3790 3791 3792 |
/*
* The conversion succeeded. Free the old internal rep and set the new
* one.
*/
TclFreeIntRep(objPtr);
| | | 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 |
/*
* The conversion succeeded. Free the old internal rep and set the new
* one.
*/
TclFreeIntRep(objPtr);
objPtr->internalRep.wideValue = offset;
objPtr->typePtr = &tclEndOffsetType;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ |