Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: c8f14d6)
New functions for adding, subtracting and multiplying bignums.
authorJuan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Thu, 28 Jan 2010 16:25:59 +0000 (17:25 +0100)
committerJuan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Thu, 28 Jan 2010 16:25:59 +0000 (17:25 +0100)
src/c/big.d patch | blob | blame | history
src/c/big_ll.d patch | blob | blame | history
src/c/num_arith.d patch | blob | blame | history
src/h/external.h patch | blob | blame | history

diff --git a/src/c/big.d b/src/c/big.d
index 56dbb3a..86bb43b 100644 (file)
--- a/src/c/big.d
+++ b/src/c/big.d
@@ -32,15 +32,29 @@ _ecl_big_register_free(cl_object x)
 }
 
 static cl_object
+_ecl_alloc_compact_bignum(cl_index limbs)
+{
+#if 0
+        cl_index bytes = limbs * sizeof(mp_limb_t);
+        cl_object new_big = ecl_alloc_compact_object(t_bignum, bytes);
+        new_big->big.big_limbs = ECL_COMPACT_OBJECT_EXTRA(new_big);
+        new_big->big.big_size = 0;
+        new_big->big.big_dim = limbs;
+#else
+        cl_object new_big = ecl_alloc_object(t_bignum);
+        mpz_init2(new_big->big.big_num, limbs * GMP_LIMB_BITS);
+#endif
+        return new_big;
+}
+
+static cl_object
 _ecl_big_copy(cl_object old)
 {
         cl_fixnum size = old->big.big_size;
         cl_index dim = (size < 0)? (-size) : size;
         cl_index bytes = dim * sizeof(mp_limb_t);
-        cl_object new_big = ecl_alloc_compact_object(t_bignum, bytes);
-        new_big->big.big_limbs = ECL_COMPACT_OBJECT_EXTRA(new_big);
+        cl_object new_big = _ecl_alloc_compact_bignum(dim);
         new_big->big.big_size = size;
-        new_big->big.big_dim = dim;
         memcpy(new_big->big.big_limbs, old->big.big_limbs, bytes);
         return new_big;
 }
@@ -53,6 +67,24 @@ _ecl_big_register_copy(cl_object old)
        return new_big;
 }
 
+static cl_object
+big_normalize(cl_object x)
+{
+       int s = x->big.big_size;
+       if (s == 0)
+                return(MAKE_FIXNUM(0));
+       if (s == 1) {
+                mp_limb_t y = x->big.big_limbs[0];
+                if (y <= MOST_POSITIVE_FIXNUM)
+                        return MAKE_FIXNUM(y);
+       } else if (s == -1) {
+                mp_limb_t y = x->big.big_limbs[0];
+                if (y <= -MOST_NEGATIVE_FIXNUM)
+                        return MAKE_FIXNUM(-y);
+       }
+       return x;
+}
+
 cl_object
 _ecl_big_register_normalize(cl_object x)
 {
@@ -108,6 +140,100 @@ _ecl_big_set_index(cl_object x, cl_index f)
 # endif
 #endif /* ECL_LONG_BITS >= FIXNUM_BITS */
 
+#if GMP_LIMB_BITS >= FIXNUM_BITS
+static const limbs_per_fixnum = 1;
+#else
+static conts limbs_per_fixnum = (FIXNUM_BITS + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS;
+#endif
+
+cl_object
+_ecl_big_times_big(cl_object a, cl_object b)
+{
+        cl_index size_a = (a->big.big_size < 0)? -a->big.big_size : a->big.big_size;
+        cl_index size_b = (b->big.big_size < 0)? -b->big.big_size : b->big.big_size;
+       cl_index size = size_a + size_b;
+        cl_object z = _ecl_alloc_compact_bignum(size);
+        _ecl_big_mul(z, a, b);
+       return z;
+}
+
+
+cl_object
+_ecl_big_times_fix(cl_object b, cl_fixnum i)
+{
+        cl_index size;
+       cl_object z;
+
+        if (i == 0)
+                return MAKE_FIXNUM(0);
+       if (i == 1)
+               return b;
+        size = (b->big.big_size < 0)? -b->big.big_size : b->big.big_size;
+        size += limbs_per_fixnum;
+        z = _ecl_alloc_compact_bignum(size);
+        _ecl_big_mul_si(z, b, i);
+        return z;
+}
+
+cl_object
+_ecl_big_plus_fix(cl_object a, cl_fixnum b)
+{
+        cl_object z;
+       if (b == 0) {
+               return a;
+        } else {
+                cl_index size_a = (a->big.big_size < 0)? -a->big.big_size
+                        : a->big.big_size;
+                cl_index size_z = size_a + limbs_per_fixnum;
+                cl_object z = _ecl_alloc_compact_bignum(size_z);
+                if (b < 0) {
+                        _ecl_big_sub_ui(z, a, b);
+                } else {
+                        _ecl_big_add_ui(z, a, b);
+                }
+                return big_normalize(z);
+        }
+}
+
+cl_object
+_ecl_big_plus_big(cl_object a, cl_object b)
+{
+        cl_index size_a = (a->big.big_size < 0)? -a->big.big_size : a->big.big_size;
+        cl_index size_b = (b->big.big_size < 0)? -b->big.big_size : b->big.big_size;
+        cl_index size_z = (size_a < size_b)? (size_b + 1) : (size_a + 1);
+        cl_object z = _ecl_alloc_compact_bignum(size_z);
+        _ecl_big_add(z, a, b);
+        return big_normalize(z);
+}
+
+cl_object
+_ecl_big_minus_big(cl_object a, cl_object b)
+{
+        cl_index size_a = (a->big.big_size < 0)? -a->big.big_size : a->big.big_size;
+        cl_index size_b = (b->big.big_size < 0)? -b->big.big_size : b->big.big_size;
+        cl_index size_z = (size_a < size_b)? (size_b + 1) : (size_a + 1);
+        cl_object z = _ecl_alloc_compact_bignum(size_z);
+        mpz_sub(z->big.big_num, a->big.big_num, b->big.big_num);
+        return big_normalize(z);
+}
+
+cl_object
+_ecl_fix_minus_big(cl_fixnum a, cl_object b)
+{
+        cl_object z;
+       if (a == 0) {
+               return ecl_negate(b);
+        } else {
+                cl_index size_b = (b->big.big_size < 0)? -b->big.big_size
+                        : b->big.big_size;
+                cl_index size_z = size_b + limbs_per_fixnum;
+                cl_object z = _ecl_alloc_compact_bignum(size_z);
+                mpz_set_si(z->big.big_num, a);
+                mpz_sub(z->big.big_num, z->big.big_num, b->big.big_num);
+                return big_normalize(z);
+        }
+}
+
 static void *
 mp_alloc(size_t size)
 {
diff --git a/src/c/big_ll.d b/src/c/big_ll.d
index 5d58ee2..a40f890 100644 (file)
--- a/src/c/big_ll.d
+++ b/src/c/big_ll.d
@@ -27,6 +27,16 @@ _ecl_big_register_copy(cl_object old)
        return new_big;
 }
 
+static cl_object
+big_normalize(cl_object x)
+{
+       if (x->big.big_num == 0ll)
+                return(MAKE_FIXNUM(0));
+        if (x->big.big_num <= MOST_POSITIVE_FIXNUM && x->big.big_num >= MOST_NEGATIVE_FIXNUM)
+                return(MAKE_FIXNUM(x->big.big_num));
+        return x;
+}
+
 cl_object
 _ecl_big_register_normalize(cl_object x)
 {
@@ -82,6 +92,38 @@ _ecl_big_num_t_sgn(big_num_t x)
        return ( x == (big_num_t)0 ) ? 0 : (x < (big_num_t)0) ? -1 : 1;
 }
 
+cl_object
+_ecl_big_times_big(cl_object x, cl_object y)
+{
+        cl_object z = ecl_alloc_object(t_bignum);
+        z->big.big_num = x->big.big_num * y->big.big_num;
+       return z;
+}
+
+cl_object
+_ecl_big_times_fix(cl_object x, cl_fixnum y)
+{
+       cl_object z = ecl_alloc_object(t_bignum);
+        z->big.big_num = x->big.big_num * y;
+       return big_normalize(z);
+}
+
+cl_object
+_ecl_big_plus_big(cl_object x, cl_object y)
+{
+        cl_object z = ecl_alloc_object(t_bignum);
+        z->big.big_num = x->big.big_num + y->big.big_num;
+       return z;
+}
+
+cl_object
+_ecl_big_plus_fix(cl_object x, cl_fixnum y)
+{
+       cl_object z = ecl_alloc_object(t_bignum);
+        z->big.big_num = x->big.big_num + y;
+       return big_normalize(z);
+}
+
 void
 init_big(void)
 {
diff --git a/src/c/num_arith.d b/src/c/num_arith.d
index 9b5e1fd..519e61a 100644 (file)
--- a/src/c/num_arith.d
+++ b/src/c/num_arith.d
@@ -40,31 +40,6 @@ fixnum_times(cl_fixnum i, cl_fixnum j)
        return _ecl_big_register_normalize(x);
 }
 
-static cl_object
-_ecl_big_times_fix(cl_object b, cl_fixnum i)
-{
-       cl_object z;
-
-       if (i == 1)
-               return b;
-       z = _ecl_big_register0();
-       if (i == -1) {
-                _ecl_big_complement(z, b);
-        } else {
-                _ecl_big_mul_si(z, b, i);
-        }
-       return _ecl_big_register_normalize(z);
-}
-
-static cl_object
-_ecl_big_times_big(cl_object x, cl_object y)
-{
-       cl_object z;
-       z = _ecl_big_register0();
-        _ecl_big_mul(z, x, y);
-       return _ecl_big_register_normalize(z);
-}
-
 cl_object
 ecl_times(cl_object x, cl_object y)
 {
diff --git a/src/h/external.h b/src/h/external.h
index 485f7ac..3d3daa8 100755 (executable)
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -378,6 +378,12 @@ extern ECL_API void ecl_clear_compiler_properties(cl_object sym);
 #define _ecl_big_register2()   ecl_process_env()->big_register[2]
 extern ECL_API cl_object _ecl_big_register_copy(cl_object x);
 extern ECL_API cl_object _ecl_big_register_normalize(cl_object x);
+extern ECL_API cl_object _ecl_big_times_fix(cl_object x, cl_fixnum y);
+extern ECL_API cl_object _ecl_big_times_big(cl_object x, cl_object y);
+extern ECL_API cl_object _ecl_big_plus_fix(cl_object x, cl_fixnum y);
+extern ECL_API cl_object _ecl_big_plus_big(cl_object x, cl_object y);
+extern ECL_API cl_object _ecl_fix_minus_big(cl_fixnum x, cl_object y);
+extern ECL_API cl_object _ecl_big_minus_big(cl_object x, cl_object y);
 extern ECL_API void _ecl_big_register_free(cl_object x);
 extern ECL_API cl_object bignum1(cl_fixnum val);
 
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)