Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 5e32e79)
Intoduced _ecl_fix_times_fix, _ecl_big_ceiling and _ecl_big_floor.
authorJuan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Thu, 28 Jan 2010 22:08:16 +0000 (23:08 +0100)
committerJuan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Thu, 28 Jan 2010 22:08:16 +0000 (23:08 +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/c/num_co.d patch | blob | blame | history
src/cmp/sysfun.lsp patch | blob | blame | history
src/h/external.h patch | blob | blame | history
src/h/number.h patch | blob | blame | history
src/new-cmp/sysfun.lsp patch | blob | blame | history

diff --git a/src/c/big.d b/src/c/big.d
index 89198ec..70e9e49 100644 (file)
--- a/src/c/big.d
+++ b/src/c/big.d
@@ -146,24 +146,17 @@ static const limbs_per_fixnum = 1;
 static conts limbs_per_fixnum = (FIXNUM_BITS + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS;
 #endif
 
-#define WITH_TEMP_BIGNUM(name,n)                                        \
-        mp_limb_t name##data[n];                                        \
-        volatile struct ecl_bignum name##aux;                           \
-        const cl_object name = (name##aux.big_num->_mp_alloc = n,       \
-                                name##aux.big_num->_mp_size = 0,        \
-                                name##aux.big_num->_mp_d = name##data,  \
-                                (cl_object)(&name##aux))
 
 cl_object
 _ecl_fix_times_fix(cl_fixnum x, cl_fixnum y)
 {
 #if ECL_LONG_BITS >= FIXNUM_BITS
-        WITH_TEMP_BIGNUM(z,4);
+        ECL_WITH_TEMP_BIGNUM(z,4);
         mpz_set_si(z->big.big_num, x);
         mpz_mul_si(z->big.big_num, z->big.big_num, y);
 #else
-        WITH_TEMP_BIGNUM(z,4);
-        WITH_TEMP_BIGNUM(w,4);
+        ECL_WITH_TEMP_BIGNUM(z,4);
+        ECL_WITH_TEMP_BIGNUM(w,4);
         mpz_set_si(z->big.big_num, x);
         mpz_set_si(w->big.big_num, y);
         mpz_mu(z->big.big_num, z->big.big_num, w->big.big_num);
@@ -266,6 +259,55 @@ _ecl_big_negate(cl_object a)
         return big_normalize(z);
 }
 
+cl_object
+_ecl_big_divided_by_big(cl_object a, cl_object b)
+{
+        cl_object z;
+        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_fixnum size_z = size_a - size_b + 1;
+        if (size_z <= 0) size_z = 1;
+        z = _ecl_alloc_compact_bignum(size_z);
+        mpz_tdiv_q(z->big.big_num,a->big.big_num,b->big.big_num);
+        return big_normalize(z);
+}
+
+cl_object
+_ecl_big_divided_by_fix(cl_object x, cl_fixnum y)
+{
+        ECL_WITH_TEMP_BIGNUM(by, 2);
+        _ecl_big_set_fixnum(by, y);
+        return _ecl_big_divided_by_big(x, by);
+}
+
+cl_object
+_ecl_big_ceiling(cl_object a, cl_object b, cl_object *pr)
+{
+        cl_object q = _ecl_big_register0();
+        cl_object r = _ecl_big_register1();
+        mpz_cdiv_qr(q->big.big_num, r->big.big_num, a->big.big_num, b->big.big_num);
+        *pr = _ecl_big_register_normalize(r);
+        return _ecl_big_register_normalize(q);
+}
+
+cl_object
+_ecl_big_floor(cl_object a, cl_object b, cl_object *pr)
+{
+        cl_object q = _ecl_big_register0();
+        cl_object r = _ecl_big_register1();
+        mpz_fdiv_qr(q->big.big_num, r->big.big_num, a->big.big_num, b->big.big_num);
+        *pr = _ecl_big_register_normalize(r);
+        return _ecl_big_register_normalize(q);
+}
+
+cl_object
+_ecl_fix_divided_by_big(cl_fixnum x, cl_object y)
+{
+        ECL_WITH_TEMP_BIGNUM(bx, 2);
+        _ecl_big_set_fixnum(bx, x);
+        return _ecl_big_divided_by_big(bx, y);
+}
+
 static void *
 mp_alloc(size_t size)
 {
diff --git a/src/c/big_ll.d b/src/c/big_ll.d
index e13b9dc..e068deb 100644 (file)
--- a/src/c/big_ll.d
+++ b/src/c/big_ll.d
@@ -123,6 +123,7 @@ _ecl_big_plus_fix(cl_object x, cl_fixnum y)
         z->big.big_num = x->big.big_num + y;
        return big_normalize(z);
 }
+
 cl_object
 _ecl_fix_times_fix(cl_fixnum x, cl_fixnum y)
 {
@@ -131,6 +132,27 @@ _ecl_fix_times_fix(cl_fixnum x, cl_fixnum y)
        return big_normalize(z);
 }
 
+cl_object
+_ecl_big_ceiling(cl_object a, cl_object b, cl_object *pr)
+{
+        cl_object q = ecl_alloc_object(t_bignum);
+        cl_object r = ecl_alloc_object(t_bignum);
+        q->big.num = x->big.num / y->big.big_num;
+        r->big.num = x->big.num % y->big.big_num;
+        *pr = big_normalize(r);
+        return big_normalize(q);
+}
+
+cl_object
+_ecl_big_floor(cl_object a, cl_object b, cl_object *pr)
+{
+        cl_object q = ecl_alloc_object(t_bignum);
+        cl_object r = ecl_alloc_object(t_bignum);
+        q->big.num = x->big.num / y->big.big_num;
+        r->big.num = x->big.num % y->big.big_num;
+        *pr = big_normalize(r);
+        return big_normalize(q);
+}
 
 cl_object
 _ecl_big_negate(cl_object x)
diff --git a/src/c/num_arith.d b/src/c/num_arith.d
index 4021c4f..b190720 100644 (file)
--- a/src/c/num_arith.d
+++ b/src/c/num_arith.d
@@ -948,37 +948,20 @@ ecl_integer_divide(cl_object x, cl_object y)
                        if (y == MAKE_FIXNUM(0))
                                FEdivision_by_zero(x, y);
                        return MAKE_FIXNUM(fix(x) / fix(y));
-               }
-               if (ty == t_bignum) {
-                       /* The only number "x" which can be a bignum and be
-                        * as large as "-x" is -MOST_NEGATIVE_FIXNUM. However
-                        * in newer versions of ECL we will probably choose
-                        * MOST_NEGATIVE_FIXNUM = - MOST_POSITIVE_FIXNUM.
-                        */
-                       if (-MOST_NEGATIVE_FIXNUM > MOST_POSITIVE_FIXNUM) {
-                               if (_ecl_big_cmp_si(y, -fix(x)))
-                                       return MAKE_FIXNUM(0);
-                               else
-                                       return MAKE_FIXNUM(-1);
-                       } else {
-                               return MAKE_FIXNUM(0);
-                       }
-               }
-               FEtype_error_integer(y);
+               } else if (ty == t_bignum) {
+                        return _ecl_fix_divided_by_big(fix(x), y);
+               } else {
+                        FEtype_error_integer(y);
+                }
        }
        if (tx == t_bignum) {
-               cl_object q = _ecl_big_register0();
                if (ty == t_bignum) {
-                       _ecl_big_tdiv_q(q, x, y);
+                       return _ecl_big_divided_by_big(x, y);
                } else if (ty == t_fixnum) {
-                       long j = fix(y);
-                        _ecl_big_tdiv_q_ui(q, x, labs(j));
-                       if (j < 0)
-                               _ecl_big_complement(q, q);
+                        return _ecl_big_divided_by_fix(x, fix(y));
                } else {
                        FEtype_error_integer(y);
                }
-               return _ecl_big_register_normalize(q);
        }
        FEtype_error_integer(x);
 }
diff --git a/src/c/num_co.d b/src/c/num_co.d
index 67c7664..0156da3 100644 (file)
--- a/src/c/num_co.d
+++ b/src/c/num_co.d
@@ -226,18 +226,9 @@ ecl_floor2(cl_object x, cl_object y)
                   *    x = MOST_NEGATIVE_FIXNUM
                   *    y = - MOST_NEGATIVE_FIXNUM
                   */
-                 cl_object q = _ecl_big_register0();
-                 cl_object r = _ecl_big_register1();
-#ifdef WITH_GMP
-                 cl_object j = _ecl_big_register2();
-                 mpz_set_si(j->big.big_num, fix(x));
-                 mpz_fdiv_qr(q->big.big_num, r->big.big_num, j->big.big_num, y->big.big_num);
-#else  /* WITH_GMP */
-                  q->big.big_num = (big_num_t)fix(x) / y->big.big_num;
-                  r->big.big_num = (big_num_t)fix(x) % y->big.big_num;
-#endif /* WITH_GMP */
-                 v0 = _ecl_big_register_normalize(q);
-                 v1 = _ecl_big_register_normalize(r);
+                  ECL_WITH_TEMP_BIGNUM(bx,4);
+                  _ecl_big_set_fixnum(bx, fix(x));
+                  v0 = _ecl_big_floor(bx, y, &v1);
                  break;
                }
                case t_ratio:           /* FIX / RAT */
@@ -287,31 +278,13 @@ ecl_floor2(cl_object x, cl_object y)
        case t_bignum:
                switch(ty) {
                case t_fixnum: {        /* BIG / FIX */
-                 cl_object q = _ecl_big_register0();
-                 cl_object r = _ecl_big_register1();
-#ifdef WITH_GMP
-                 cl_object j = _ecl_big_register2();
-                 mpz_set_si(j->big.big_num, fix(y));
-                 mpz_fdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, j->big.big_num);
-#else  /* WITH_GMP */
-                  q->big.big_num = x->big.big_num / fix(y);
-                  r->big.big_num = x->big.big_num % fix(y);
-#endif /* WITH_GMP */
-                 v0 = _ecl_big_register_normalize(q);
-                 v1 = _ecl_big_register_normalize(r);
+                  ECL_WITH_TEMP_BIGNUM(by,4);
+                  _ecl_big_set_fixnum(by, fix(y));
+                  v0 = _ecl_big_floor(x, by, &v1);
                  break;
                }
                case t_bignum: {        /* BIG / BIG */
-                 cl_object q = _ecl_big_register0();
-                 cl_object r = _ecl_big_register1();
-#ifdef WITH_GMP
-                 mpz_fdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, y->big.big_num);
-#else  /* WITH_GMP */
-                  q = x->big.big_num / y->big.big_num;
-                  r = x->big.big_num % y->big.big_num;
-#endif /* WITH_GMP */
-                 v0 = _ecl_big_register_normalize(q);
-                 v1 = _ecl_big_register_normalize(r);
+                  v0 = _ecl_big_floor(x, y, &v1);
                  break;
                }
                case t_ratio:           /* BIG / RAT */
@@ -511,18 +484,9 @@ ecl_ceiling2(cl_object x, cl_object y)
                   *    x = MOST_NEGATIVE_FIXNUM
                   *    y = - MOST_NEGATIVE_FIXNUM
                   */
-                 cl_object q = _ecl_big_register0();
-                 cl_object r = _ecl_big_register1();
-#ifdef WITH_GMP
-                 cl_object j = _ecl_big_register2();
-                 mpz_set_si(j->big.big_num, fix(x));
-                 mpz_cdiv_qr(q->big.big_num, r->big.big_num, j->big.big_num, y->big.big_num);
-#else  /* WITH_GMP */
-                  q = (big_num_t)fix(x) / y->big.big_num;
-                  r = (big_num_t)fix(x) % y->big.big_num;
-#endif /* WITH_GMP */
-                 v0 = _ecl_big_register_normalize(q);
-                 v1 = _ecl_big_register_normalize(r);
+                  ECL_WITH_TEMP_BIGNUM(bx,4);
+                  _ecl_big_set_fixnum(bx, fix(x));
+                  v0 = _ecl_big_ceiling(bx, y, &v1);
                  break;
                }
                case t_ratio:           /* FIX / RAT */
@@ -572,31 +536,13 @@ ecl_ceiling2(cl_object x, cl_object y)
        case t_bignum:
                switch(type_of(y)) {
                case t_fixnum: {        /* BIG / FIX */
-                 cl_object q = _ecl_big_register0();
-                 cl_object r = _ecl_big_register1();
-#ifdef WITH_GMP
-                 cl_object j = _ecl_big_register2();
-                 mpz_set_si(j->big.big_num, fix(y));
-                 mpz_cdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, j->big.big_num);
-#else  /* WITH_GMP */
-                  q = x->big.big_num / fix(y);
-                  r = x->big.big_num % fix(y);
-#endif /* WITH_GMP */
-                 v0 = _ecl_big_register_normalize(q);
-                 v1 = _ecl_big_register_normalize(r);
+                  ECL_WITH_TEMP_BIGNUM(by,4);
+                  _ecl_big_set_fixnum(by, fix(y));
+                  v0 = _ecl_big_ceiling(x, by, &v1);
                  break;
                }
                case t_bignum: {        /* BIG / BIG */
-                 cl_object q = _ecl_big_register0();
-                 cl_object r = _ecl_big_register1();
-#ifdef WITH_GMP
-                 mpz_cdiv_qr(q->big.big_num, r->big.big_num, x->big.big_num, y->big.big_num);
-#else  /* WITH_GMP */
-                  q->big.big_num = x->big.big_num / y->big.big_num;
-                  r->big.big_num = x->big.big_num % y->big.big_num;
-#endif /* WITH_GMP */
-                 v0 = _ecl_big_register_normalize(q);
-                 v1 = _ecl_big_register_normalize(r);
+                  v0 = _ecl_big_ceiling(x, y, &v1);
                  break;
                }
                case t_ratio:           /* BIG / RAT */
diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp
index d00bb3b..e669cad 100644 (file)
--- a/src/cmp/sysfun.lsp
+++ b/src/cmp/sysfun.lsp
@@ -749,7 +749,7 @@
  "(double)(#0)*(double)(#1)" :exact-return-type t)
 (def-inline * :always (fixnum-float fixnum-float) :float
  "(float)(#0)*(float)(#1)" :exact-return-type t)
-(def-inline * :always (fixnum fixnum) t "fixnum_times(#0,#1)" :exact-return-type t)
+(def-inline * :always (fixnum fixnum) t "_ecl_fix_times_fix(#0,#1)" :exact-return-type t)
 (def-inline * :always (fixnum fixnum) :fixnum "(#0)*(#1)" :exact-return-type t)
 
 (proclaim-function / (t *) t :no-side-effects t)
diff --git a/src/h/external.h b/src/h/external.h
index 5f80bf7..ee18319 100755 (executable)
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -385,6 +385,11 @@ 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 cl_object _ecl_fix_divided_by_big(cl_fixnum x, cl_object y);
+extern ECL_API cl_object _ecl_big_divided_by_fix(cl_object x, cl_fixnum y);
+extern ECL_API cl_object _ecl_big_divided_by_big(cl_object x, cl_object y);
+extern ECL_API cl_object _ecl_big_ceiling(cl_object x, cl_object y, cl_object *r);
+extern ECL_API cl_object _ecl_big_floor(cl_object x, cl_object y, cl_object *r);
 extern ECL_API cl_object _ecl_big_negate(cl_object x);
 extern ECL_API void _ecl_big_register_free(cl_object x);
 extern ECL_API cl_object bignum1(cl_fixnum val);
diff --git a/src/h/number.h b/src/h/number.h
index 2e0fd3e..6e5d815 100644 (file)
--- a/src/h/number.h
+++ b/src/h/number.h
@@ -15,6 +15,13 @@
 
 #define ECL_BIG_REGISTER_SIZE  32
 #ifdef WITH_GMP
+#define ECL_WITH_TEMP_BIGNUM(name,n)                                    \
+        mp_limb_t name##data[n];                                        \
+        volatile struct ecl_bignum name##aux;                           \
+        const cl_object name = (name##aux.big_num->_mp_alloc = n,       \
+                                name##aux.big_num->_mp_size = 0,        \
+                                name##aux.big_num->_mp_d = name##data,  \
+                                (cl_object)(&name##aux))
 #if ECL_LONG_BITS >= FIXNUM_BITS
 #define _ecl_big_set_fixnum(x, f) mpz_set_si((x)->big.big_num,(f))
 #define _ecl_big_set_index(x, f) mpz_set_ui((x)->big.big_num,(f))
@@ -51,6 +58,10 @@ extern ECL_API _ecl_big_set_fixnum(cl_object x, cl_index f);
 
 #else  /* WITH_GMP */
 
+#define ECL_WITH_TEMP_BIGNUM(name,n)                                    \
+        volatile struct ecl_bignum name##aux;                           \
+        const cl_object name = (name##aux.big_num = 0,                  \
+                                (cl_object)(&name##aux))
 #define _ecl_big_set_fixnum(x,f) ((x)->big.big_num=(f))
 #define _ecl_big_set_index(x,f) ((x)->big.big_num=(f))
 #define _ecl_big_init2(x,size) ((x)->big.big_num=0)
diff --git a/src/new-cmp/sysfun.lsp b/src/new-cmp/sysfun.lsp
index cb1222e..574c10e 100644 (file)
--- a/src/new-cmp/sysfun.lsp
+++ b/src/new-cmp/sysfun.lsp
@@ -1592,7 +1592,7 @@
  "(double)(#0)*(double)(#1)" :exact-return-type t)
 (def-inline * :always (fixnum-float fixnum-float) :float
  "(float)(#0)*(float)(#1)" :exact-return-type t)
-(def-inline * :always (fixnum fixnum) t "fixnum_times(#0,#1)" :exact-return-type t)
+(def-inline * :always (fixnum fixnum) t "_ecl_fix_times_fix(#0,#1)" :exact-return-type t)
 (def-inline * :always (fixnum fixnum) :fixnum "(#0)*(#1)" :exact-return-type t)
 
 (def-inline / :always (t t) t "ecl_divide(#0,#1)")
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)