ref: 24d0b8e902aa60cb0202b2fc928411e29fc40cd3
parent: d55d343e9d3cf26932a5ce3e441805cc7a8791a5
parent: ef7ebf3be36e594d802d555cde11913e26b3d468
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Jul 4 16:46:27 EDT 2023
Merge remote-tracking branch 'mag/bignum' into merge
--- a/builtins.c
+++ b/builtins.c
@@ -226,6 +226,14 @@
FL_T : FL_F;
}
+BUILTIN("bignum?", bignump)+{+ argcount(nargs, 1);
+ value_t v = args[0];
+ return (iscvalue(v) && cp_numtype((cprim_t*)ptr(v)) == T_MPINT) ?
+ FL_T : FL_F;
+}
+
BUILTIN("fixnum", fixnum) {argcount(nargs, 1);
--- a/cvalues.c
+++ b/cvalues.c
@@ -3,12 +3,13 @@
#include "operators.h"
#include "cvalues.h"
#include "types.h"
+#include "overflows.h"
// trigger unconditional GC after this many bytes are allocated
#define ALLOC_LIMIT_TRIGGER 67108864
value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
-value_t int64sym, uint64sym, mpintsym;
+value_t int64sym, uint64sym, bignumsym;
value_t longsym, ulongsym, bytesym, wcharsym;
value_t floatsym, doublesym;
value_t gftypesym, stringtypesym, wcstringtypesym;
@@ -335,7 +336,7 @@
return 0;
}
-/* */ BUILTIN("mpint", mpint)+BUILTIN("bignum", bignum) { if(nargs == 0){PUSH(fixnum(0));
@@ -347,6 +348,7 @@
return cv;
}
+
value_t
mk_mpint(mpint *n)
{@@ -970,7 +972,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;
@@ -996,12 +1000,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);
@@ -1052,9 +1080,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);
}
@@ -1528,7 +1565,7 @@
accum = ((int64_t)numval(a))<<n;
return fits_fixnum(accum) ? fixnum(accum) : return_from_int64(accum);
}
- if(iscprim(a)){+ if(iscprim(a) || iscvalue(a)){if(n == 0)
return a;
cp = ptr(a);
@@ -1546,6 +1583,7 @@
case T_INT64: return mk_int64((*(int64_t *)aptr) >> n);
case T_UINT64: return mk_uint64((*(uint64_t*)aptr) >> n);
case T_MPINT:
+ aptr = cv_data(cp);
mp = mpnew(0);
mpright(*(mpint**)aptr, n, mp);
return mk_mpint(mp);
@@ -1552,8 +1590,9 @@
}
}
if(ta == T_MPINT){+ aptr = cv_data(cp);
mp = mpnew(0);
- mpleft(*(mpint**)aptr, n, nil);
+ mpleft(*(mpint**)aptr, n, mp);
return mk_mpint(mp);
}
if(ta == T_UINT64)
@@ -1626,8 +1665,8 @@
mk_primtype(float, float);
mk_primtype(double, double);
- ctor_cv_intern(mpint, T_MPINT, mpint*);
- mpinttype = get_type(mpintsym);
+ ctor_cv_intern(bignum, T_MPINT, mpint*);
+ mpinttype = get_type(bignumsym);
mpinttype->init = cvalue_mpint_init;
mpinttype->vtable = &mpint_vtable;
--- a/cvalues.h
+++ b/cvalues.h
@@ -16,7 +16,7 @@
#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
-extern value_t int64sym, uint64sym, mpintsym;
+extern value_t int64sym, uint64sym, bignumsym;
extern value_t longsym, ulongsym, bytesym, wcharsym;
extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
extern value_t stringtypesym, wcstringtypesym, emptystringsym;
--- /dev/null
+++ b/overflows.h
@@ -1,0 +1,29 @@
+
+#define addof_int64(c,a,b) ( \
+ (b < 1)? \
+ ((INT64_MIN-(b) <= (a))?((c=(a)+(b))?0:1):1): \
+ ((INT64_MAX-(b) >= (a))?((c=(a)+(b))?0:1):1) \
+)
+
+#define subof_int64(c,a,b) ( \
+ (b < 1)? \
+ ((INT64_MAX+(b) >= (a))?((c=(a)-(b))?0:1):1): \
+ ((INT64_MIN+(b) <= (a))?((c=(a)-(b))?0:1):1) \
+)
+
+#define addof_uint64(c,a,b) ( \
+ (b < 1)? \
+ ((-(b) <= (a))?((c=(a)+(b))?0:1):1): \
+ ((UINT64_MAX-(b) >= (a))?((c=(a)+(b))?0:1):1) \
+)
+
+#define subof_uint64(c,a,b) ( \
+ (b < 1)? \
+ ((UINT64_MAX+(b) >= (a))?((c=(a)-(b))?0:1):1): \
+ (((b) <= (a))?((c=(a)-(b))?0:1):1) \
+)
+
+#define mulof(c,a,b) ( \
+ (((a) != 0) && ((c=(a)*(b))/(a) != (b)))?1:0 \
+)
+
--- a/print.c
+++ b/print.c
@@ -723,7 +723,7 @@
HPOS += ios_printf(f, "%"PRIu64, ui64);
else
HPOS += ios_printf(f, "#%s(%"PRIu64")", symbol_name(type), ui64);
- }else if(type == mpintsym){+ }else if(type == bignumsym){mpint *i = *(mpint**)data;
char *s = mptoa(i, 10, nil, 0);
if(weak || print_princ)
--- /dev/null
+++ b/test/number-boundaries.lsp
@@ -1,0 +1,97 @@
+
+; NUMBER BOUNDARIES ------------------------------------------------------------
+(define-macro (half-max-signed numtype)
+ (list 'ash (list numtype 1)
+ (list '- (list '* 8 (list 'sizeof (list 'quote numtype))) 2)))
+
+(define-macro (high-border-signed numtype)
+ (list '+ (list '- (list 'half-max-signed numtype) 1)
+ (list 'half-max-signed numtype)))
+
+(define-macro (low-border-signed numtype)
+ (list '- -1 (list 'high-border-signed numtype)))
+
+(define-macro (low-border numtype)
+ (list 'if (list '< (list numtype -1) 1)
+ (list 'low-border-signed numtype)
+ (list numtype 0)))
+
+(define-macro (high-border numtype)
+ (list 'lognot (list 'low-border numtype)))
+ ;(list numtype (list 'lognot (list 'low-border numtype))))
+
+(define-macro (number-borders numtype)
+ (list 'cons (list 'low-border numtype)
+ (list 'high-border numtype)))
+
+; TESTS ------------------------------------------------------------------------
+(princ "---\n")
+(princ "int8 : " (number-borders int8) "\n")
+(princ "int16 : " (number-borders int16) "\n")
+(princ "int32 : " (number-borders int32) "\n")
+(princ "int64 : " (number-borders int64) "\n")
+(princ "uint8 : " (number-borders uint8) "\n")
+(princ "uint16 : " (number-borders uint16) "\n")
+(princ "uint32 : " (number-borders uint32) "\n")
+(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 (= 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 (= 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))))
+
+; 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
@@ -6,10 +6,10 @@
(define (every-int n)
(list (fixnum n) (int8 n) (uint8 n) (int16 n) (uint16 n) (int32 n) (uint32 n)
- (int64 n) (uint64 n)))
+ (int64 n) (uint64 n) (bignum n)))
(define (every-sint n)
- (list (fixnum n) (int8 n) (int16 n) (int32 n) (int64 n)))
+ (list (fixnum n) (int8 n) (int16 n) (int32 n) (int64 n) (bignum n)))
(define (each f l)
(if (atom? l) ()
@@ -82,8 +82,35 @@
(assert (> 9223372036854775808 9223372036854775807))
-; mpint
+; 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) 1))))
+(assert (bignum? 1606938044258990275541962092341162602522202993782792835301376))
+(assert (bignum? 0xfffffffffffffffff))
+(assert (not (bignum? 0xfffffffffffffff)))
+
+(assert (= 4764984380238568507752444984131552966909
+ (* 66405897020462343733 71755440315342536873)))
+(assert (= 71755440315342536873
+ (div 4764984380238568507752444984131552966909 66405897020462343733)))
+(assert (= 3203431780337 (div 576460752303423487 179951)))
+(assert (= 3487 (mod 576460752303423487 18000)))
+(assert (= 7 (mod 576460752303423487 10)))
+
+(assert (= 0xfffffffffffffffff (logior 0xaaaaaaaaaaaaaaaaa 0x55555555555555555)))
+(assert (= 0xaaaaaaaaaaaaaaaaa (logxor 0xfffffffffffffffff 0x55555555555555555)))
+(assert (= 0xaaaaaaaaaaaaaaaaa (logxor 0xfffffffffffffffff 0x55555555555555555)))
+(assert (= 0xaaaaaaaaa (logand 0xaaaaaaaaaaaaaaaaa 0x55555555fffffffff)))
+(assert (= 0 (logand 0 0x55555555555555555)))
+(assert (= 602394779747 (ash 11112222333344445555666677778888 -64)))
+(assert (= 204984321473364576635441321909950327706185271083008
+ (ash 11112222333344445555666677778888 64)))
; NaNs
(assert (equal? +nan.0 +nan.0))