ref: ef7ebf3be36e594d802d555cde11913e26b3d468
parent: 73063b8a1eb2647abff04cd4af49d04239a5222a
author: mag <mag-one@autistici.org>
date: Fri Jun 23 12:36:23 EDT 2023
fl_add_any: initial overflow handling
--- a/cvalues.c
+++ b/cvalues.c
@@ -1,4 +1,5 @@
#include "operators.c"
+#include "overflows.h"
#ifdef BITS64
#define NWORDS(sz) (((sz)+7)>>3)
@@ -974,7 +975,9 @@
fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn)
{uint64_t Uaccum = 0;
+ uint64_t Uresult = 0;
int64_t Saccum = carryIn;
+ int64_t Sresult = 0;
double Faccum = 0;
int32_t inexact = 0;
uint32_t i;
@@ -1000,12 +1003,36 @@
case T_UINT32: Uaccum += *(uint32_t*)a; break;
case T_INT64:
i64 = *(int64_t*)a;
- if(i64 > 0)
- Uaccum += (uint64_t)i64;
- else
- Saccum += i64;
+ if(i64 > 0){+ if(addof_uint64(Uresult, Uaccum, (uint64_t)i64)){+ if(Maccum == nil)
+ Maccum = mpnew(0);
+ x = uvtomp((uint64_t)i64, nil);
+ mpadd(Maccum, x, Maccum);
+ mpfree(x);
+ }else
+ Uaccum = Uresult;
+ }else{+ if(subof_int64(Sresult, Saccum, i64)){+ if(Maccum == nil)
+ Maccum = mpnew(0);
+ x = vtomp(i64, nil);
+ mpadd(Maccum, x, Maccum);
+ mpfree(x);
+ }else
+ Saccum += i64;
+ }
break;
- case T_UINT64: Uaccum += *(uint64_t*)a; break;
+ case T_UINT64:
+ if(addof_uint64(Uresult, Uaccum, *(uint64_t*)a)){+ if(Maccum == nil)
+ Maccum = mpnew(0);
+ x = uvtomp(*(uint64_t*)a, nil);
+ mpadd(Maccum, x, Maccum);
+ mpfree(x);
+ }else
+ Uaccum = Uresult;
+ break;
case T_MPINT:
if(Maccum == nil)
Maccum = mpnew(0);
@@ -1056,9 +1083,18 @@
}
Uaccum -= negpart;
}else{- Uaccum += (uint64_t)Saccum;
+ if(addof_uint64(Uresult, Uaccum, (uint64_t)Saccum)){+ if(Maccum == nil)
+ Maccum = mpnew(0);
+ x = vtomp(Saccum, nil);
+ mpadd(Maccum, x, Maccum);
+ x = uvtomp(Uaccum, x);
+ mpadd(Maccum, x, Maccum);
+ mpfree(x);
+ return mk_mpint(Maccum);
+ }else
+ Uaccum = Uresult;
}
- // return value in Uaccum
return return_from_uint64(Uaccum);
}
--- a/overflows.h
+++ b/overflows.h
@@ -11,13 +11,9 @@
((INT64_MIN+(b) <= (a))?((c=(a)-(b))?0:1):1) \
)
-#define mulof_int64(c,a,b) ( \
- (((a) != 0) && ((c=(a)*(b))/(a) != (b)))?1:0 \
-)
-
#define addof_uint64(c,a,b) ( \
(b < 1)? \
- ((0-(b) <= (a))?((c=(a)+(b))?0:1):1): \
+ ((-(b) <= (a))?((c=(a)+(b))?0:1):1): \
((UINT64_MAX-(b) >= (a))?((c=(a)+(b))?0:1):1) \
)
@@ -27,7 +23,7 @@
(((b) <= (a))?((c=(a)-(b))?0:1):1) \
)
-#define mulof_uint64(c,a,b) ( \
+#define mulof(c,a,b) ( \
(((a) != 0) && ((c=(a)*(b))/(a) != (b)))?1:0 \
)
--- a/test/number-boundaries.lsp
+++ b/test/number-boundaries.lsp
@@ -36,24 +36,62 @@
(princ "uint64 : " (number-borders uint64) "\n")
(princ "---\n")
+; add/sub signed
(assert (= 128 (+ (high-border int8) 1)))
+(assert (= 128 (+ 1 (high-border int8))))
(assert (= -129 (- (low-border int8) 1)))
+(assert (= 129 (- 1 (low-border int8))))
(assert (= 32768 (+ (high-border int16) 1)))
+(assert (= 32768 (+ 1 (high-border int16))))
(assert (= -32769 (- (low-border int16) 1)))
+(assert (= 32769 (- 1 (low-border int16))))
(assert (= 2147483648 (+ (high-border int32) 1)))
+(assert (= 2147483648 (+ 1 (high-border int32))))
(assert (= -2147483649 (- (low-border int32) 1)))
+(assert (= 2147483649 (- 1 (low-border int32))))
(assert (= 9223372036854775808 (+ (high-border int64) 1)))
-;(assert (= -9223372036854775809 (- (low-border int64) 1))) ;OVERFLOW
+(assert (= 9223372036854775808 (+ 1 (high-border int64))))
+(assert (= -9223372036854775809 (- (low-border int64) 1)))
+(assert (= 9223372036854775809 (- 1 (low-border int64))))
+(assert (= 27670116110564327421 (+ 9223372036854775807 9223372036854775807 9223372036854775807)))
+(assert (= -12297829382473033728 (+ -3074457345618258432 -3074457345618258432 -3074457345618258432 -3074457345618258432)))
+(assert (= 6148914691236516864 (- -3074457345618258432 -3074457345618258432 -3074457345618258432 -3074457345618258432)))
+; add/sub unsigned
(assert (= 256 (+ (high-border uint8) 1)))
+(assert (= 256 (+ 1 (high-border uint8))))
(assert (= -1 (- (low-border uint8) 1)))
+(assert (= 1 (- 1 (low-border uint8))))
(assert (= 65536 (+ (high-border uint16) 1)))
+(assert (= 65536 (+ 1 (high-border uint16))))
(assert (= -1 (- (low-border uint16) 1)))
+(assert (= 1 (- 1 (low-border uint16))))
(assert (= 4294967296 (+ (high-border uint32) 1)))
+(assert (= 4294967296 (+ 1 (high-border uint32))))
(assert (= -1 (- (low-border uint32) 1)))
-;(assert (= 18446744073709551616 (+ (high-border uint64) 1))) ;OVERFLOW
+(assert (= 1 (- 1 (low-border uint32))))
+(assert (= 18446744073709551616 (+ (high-border uint64) 1)))
+(assert (= 18446744073709551616 (+ 1 (high-border uint64))))
+(assert (= 36893488147419103230 (+ (high-border uint64) (high-border uint64))))
+(assert (= 36893488147419103231 (+ 1 (high-border uint64) (high-border uint64))))
+(assert (= 36893488147419103231 (+ (high-border uint64) 1 (high-border uint64))))
+(assert (= 36893488147419103231 (+ (high-border uint64) (high-border uint64) 1)))
(assert (= -1 (- (low-border uint64) 1)))
+(assert (= 1 (- 1 (low-border uint64))))
-(princ "all tests pass\n\n")
+; mul signed
+(assert (= 18446744073709551614 (* (high-border int64) 2)))
+;(assert (= -18446744073709551614 (* (high-border int64) -2)))
+(assert (= 18446744073709551614 (* 2 (high-border int64))))
+;(assert (= -18446744073709551616 (* (low-border int64) 2)))
+;(assert (= -18446744073709551616 (* 2 (low-border int64))))
+
+; mul unsigned
+;(assert (= 36893488147419103230 (* (high-border uint64) 2)))
+;(assert (= 36893488147419103230 (* 2 (high-border uint64))))
+;(assert (= -36893488147419103230 (* (high-border uint64) -2)))
+;(assert (= -36893488147419103230 (* -2 (high-border uint64))))
+
+(princ "all number boundaries tests pass\n\n")
#t
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -82,11 +82,14 @@
(assert (> 9223372036854775808 9223372036854775807))
+; number boundaries
+(load "number-boundaries.lsp")
+
; bignum
(assert (> 0x10000000000000000 0x8fffffffffffffff))
(assert (< 0x8fffffffffffffff 0x10000000000000000))
-(assert ((not bignum? (ash 2 60))))
+(assert (not (bignum? (ash 2 60))))
(assert (not (bignum? (- (ash 2 60) 1))))
(assert (bignum? 1606938044258990275541962092341162602522202993782792835301376))
(assert (bignum? 0xfffffffffffffffff))