summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c181
1 files changed, 122 insertions, 59 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8bc83cc..3d75d97 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -652,6 +652,7 @@ static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
#define DIVIDED_BY_ZERO ((Tcl_Obj *) -1)
#define EXPONENT_OF_ZERO ((Tcl_Obj *) -2)
#define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3)
+#define OUT_OF_MEMORY ((Tcl_Obj *) -4)
/*
* Declarations for local procedures to this file:
@@ -1796,6 +1797,7 @@ TclIncrObj(
ClientData ptr1, ptr2;
int type1, type2;
mp_int value, incr;
+ mp_err err;
if (Tcl_IsShared(valuePtr)) {
Tcl_Panic("%s called with shared object", "TclIncrObj");
@@ -1854,8 +1856,11 @@ TclIncrObj(
Tcl_TakeBignumFromObj(interp, valuePtr, &value);
Tcl_GetBignumFromObj(interp, incrPtr, &incr);
- mp_add(&value, &incr, &value);
+ err = mp_add(&value, &incr, &value);
mp_clear(&incr);
+ if (err != MP_OKAY) {
+ return TCL_ERROR;
+ }
Tcl_SetBignumObj(valuePtr, &value);
return TCL_OK;
}
@@ -6149,6 +6154,9 @@ TEBCresume(
} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
TRACE_ERROR(interp);
goto gotError;
+ } else if (objResultPtr == OUT_OF_MEMORY) {
+ TRACE_APPEND(("OUT OF MEMORY\n"));
+ goto outOfMemory;
} else if (objResultPtr == NULL) {
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
@@ -7593,6 +7601,13 @@ TEBCresume(
CACHE_STACK_INFO();
goto gotError;
+ outOfMemory:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+
/*
* Exponentiation of zero by negative number in an expression. Control
* only reaches this point by "goto exponOfZero".
@@ -8032,6 +8047,7 @@ ExecuteExtendedBinaryMathOp(
Tcl_Obj *objResultPtr;
int invalid, zero;
long shift;
+ mp_err err;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
@@ -8093,9 +8109,14 @@ ExecuteExtendedBinaryMathOp(
* Arguments are opposite sign; remainder is sum.
*/
- mp_init_i64(&big1, w1);
- mp_add(&big2, &big1, &big2);
- mp_clear(&big1);
+ err = mp_init_i64(&big1, w1);
+ if (err == MP_OKAY) {
+ err = mp_add(&big2, &big1, &big2);
+ mp_clear(&big1);
+ }
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
BIG_RESULT(&big2);
}
@@ -8108,21 +8129,30 @@ ExecuteExtendedBinaryMathOp(
}
Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
- mp_init(&bigResult);
- mp_init(&bigRemainder);
- mp_div(&big1, &big2, &bigResult, &bigRemainder);
+ err = mp_init_multi(&bigResult, &bigRemainder, NULL);
+ if (err == MP_OKAY) {
+ err = mp_div(&big1, &big2, &bigResult, &bigRemainder);
+ }
if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
/*
* Convert to Tcl's integer division rules.
*/
- mp_sub_d(&bigResult, 1, &bigResult);
- mp_add(&bigRemainder, &big2, &bigRemainder);
+ err = mp_sub_d(&bigResult, 1, &bigResult);
+ if (err == MP_OKAY) {
+ err = mp_add(&bigRemainder, &big2, &bigRemainder);
+ }
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
}
- mp_copy(&bigRemainder, &bigResult);
+ err = mp_copy(&bigRemainder, &bigResult);
mp_clear(&bigRemainder);
mp_clear(&big1);
mp_clear(&big2);
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
BIG_RESULT(&bigResult);
case INST_LSHIFT:
@@ -8248,11 +8278,16 @@ ExecuteExtendedBinaryMathOp(
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
- mp_init(&bigResult);
- if (opcode == INST_LSHIFT) {
- mp_mul_2d(&big1, shift, &bigResult);
- } else {
- mp_signed_rsh(&big1, shift, &bigResult);
+ err = mp_init(&bigResult);
+ if (err == MP_OKAY) {
+ if (opcode == INST_LSHIFT) {
+ err = mp_mul_2d(&big1, shift, &bigResult);
+ } else {
+ err = mp_signed_rsh(&big1, shift, &bigResult);
+ }
+ }
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
}
mp_clear(&big1);
BIG_RESULT(&bigResult);
@@ -8265,20 +8300,25 @@ ExecuteExtendedBinaryMathOp(
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- mp_init(&bigResult);
+ err = mp_init(&bigResult);
- switch (opcode) {
- case INST_BITAND:
- mp_and(&big1, &big2, &bigResult);
- break;
+ if (err == MP_OKAY) {
+ switch (opcode) {
+ case INST_BITAND:
+ err = mp_and(&big1, &big2, &bigResult);
+ break;
- case INST_BITOR:
- mp_or(&big1, &big2, &bigResult);
- break;
+ case INST_BITOR:
+ err = mp_or(&big1, &big2, &bigResult);
+ break;
- case INST_BITXOR:
- mp_xor(&big1, &big2, &bigResult);
- break;
+ case INST_BITXOR:
+ err = mp_xor(&big1, &big2, &bigResult);
+ break;
+ }
+ }
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
}
mp_clear(&big1);
@@ -8341,8 +8381,8 @@ ExecuteExtendedBinaryMathOp(
} else {
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
negativeExponent = mp_isneg(&big2);
- mp_mod_2d(&big2, 1, &big2);
- oddExponent = !mp_iszero(&big2);
+ err = mp_mod_2d(&big2, 1, &big2);
+ oddExponent = (err == MP_OKAY) && !mp_iszero(&big2);
mp_clear(&big2);
}
@@ -8499,8 +8539,13 @@ ExecuteExtendedBinaryMathOp(
return GENERAL_ARITHMETIC_ERROR;
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
- mp_init(&bigResult);
- mp_expt_u32(&big1, (unsigned int)w2, &bigResult);
+ err = mp_init(&bigResult);
+ if (err == MP_OKAY) {
+ err = mp_expt_u32(&big1, (unsigned int)w2, &bigResult);
+ }
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
mp_clear(&big1);
BIG_RESULT(&bigResult);
}
@@ -8647,38 +8692,44 @@ ExecuteExtendedBinaryMathOp(
overflowBasic:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- mp_init(&bigResult);
+ err = mp_init(&bigResult);
+ if (err == MP_OKAY) {
switch (opcode) {
case INST_ADD:
- mp_add(&big1, &big2, &bigResult);
- break;
+ err = mp_add(&big1, &big2, &bigResult);
+ break;
case INST_SUB:
- mp_sub(&big1, &big2, &bigResult);
- break;
+ err = mp_sub(&big1, &big2, &bigResult);
+ break;
case INST_MULT:
- mp_mul(&big1, &big2, &bigResult);
- break;
+ err = mp_mul(&big1, &big2, &bigResult);
+ break;
case INST_DIV:
- if (mp_iszero(&big2)) {
- mp_clear(&big1);
- mp_clear(&big2);
- mp_clear(&bigResult);
- return DIVIDED_BY_ZERO;
- }
- mp_init(&bigRemainder);
- mp_div(&big1, &big2, &bigResult, &bigRemainder);
- /* TODO: internals intrusion */
- if (!mp_iszero(&bigRemainder)
- && (bigRemainder.sign != big2.sign)) {
- /*
- * Convert to Tcl's integer division rules.
- */
+ if (mp_iszero(&big2)) {
+ mp_clear(&big1);
+ mp_clear(&big2);
+ mp_clear(&bigResult);
+ return DIVIDED_BY_ZERO;
+ }
+ err = mp_init(&bigRemainder);
+ if (err == MP_OKAY) {
+ err = mp_div(&big1, &big2, &bigResult, &bigRemainder);
+ }
+ /* TODO: internals intrusion */
+ if (!mp_iszero(&bigRemainder)
+ && (bigRemainder.sign != big2.sign)) {
+ /*
+ * Convert to Tcl's integer division rules.
+ */
- mp_sub_d(&bigResult, 1, &bigResult);
- mp_add(&bigRemainder, &big2, &bigRemainder);
+ err = mp_sub_d(&bigResult, 1, &bigResult);
+ if (err == MP_OKAY) {
+ err = mp_add(&bigRemainder, &big2, &bigRemainder);
+ }
+ }
+ mp_clear(&bigRemainder);
+ break;
}
- mp_clear(&bigRemainder);
- break;
}
mp_clear(&big1);
mp_clear(&big2);
@@ -8699,6 +8750,7 @@ ExecuteExtendedUnaryMathOp(
Tcl_WideInt w;
mp_int big;
Tcl_Obj *objResultPtr;
+ mp_err err = MP_OKAY;
(void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
@@ -8710,8 +8762,13 @@ ExecuteExtendedUnaryMathOp(
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
/* ~a = - a - 1 */
- (void)mp_neg(&big, &big);
- mp_sub_d(&big, 1, &big);
+ err = mp_neg(&big, &big);
+ if (err == MP_OKAY) {
+ err = mp_sub_d(&big, 1, &big);
+ }
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
BIG_RESULT(&big);
case INST_UMINUS:
switch (type) {
@@ -8722,12 +8779,18 @@ ExecuteExtendedUnaryMathOp(
if (w != WIDE_MIN) {
WIDE_RESULT(-w);
}
- mp_init_i64(&big, w);
+ err = mp_init_i64(&big, w);
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
break;
default:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
}
- (void)mp_neg(&big, &big);
+ err = mp_neg(&big, &big);
+ if (err != MP_OKAY) {
+ return OUT_OF_MEMORY;
+ }
BIG_RESULT(&big);
}
generated by cgit v0.12 at 2024-09-20 13:37:15 (GMT)