Permalink
Browse files

Misc. bugfixen, and no more note muffling

  • Loading branch information...
1 parent 69251c8 commit bccdbf5a6d7bcb7cbe2ad1fb303d5b2a98051637 @pkhuong committed Jun 13, 2013
Showing with 40 additions and 37 deletions.
  1. +40 −37 gmp.lisp
View
@@ -397,42 +397,45 @@ be (1+ COUNT)."
(__gmpz_add (addr result) (addr ga) (addr gb)))))
(defgmpfun mpz-sub (a b)
- (with-mpz-results ((result (1+ (max (%bignum-length a)
- (%bignum-length b)))))
+ (with-mpz-results ((result (1+ (max (blength a)
+ (blength b)))))
(with-mpz-vars ((a ga) (b gb))
(__gmpz_sub (addr result) (addr ga) (addr gb)))))
(defgmpfun mpz-mul (a b)
- (with-mpz-results ((result (+ (%bignum-length a)
- (%bignum-length b))))
+ (with-mpz-results ((result (+ (blength a)
+ (blength b))))
(with-mpz-vars ((a ga) (b gb))
(__gmpz_mul (addr result) (addr ga) (addr gb)))))
(defgmpfun mpz-mod (a b)
- (with-mpz-results ((result (1+ (max (%bignum-length a)
- (%bignum-length b)))))
+ (with-mpz-results ((result (1+ (max (blength a)
+ (blength b)))))
(with-mpz-vars ((a ga) (b gb))
- (__gmpz_mod (addr result) (addr ga) (addr gb)))))
+ (__gmpz_mod (addr result) (addr ga) (addr gb))
+ (when (and (minusp (slot gb 'mp_size))
+ (/= 0 (slot result 'mp_size)))
+ (__gmpz_add (addr result) (addr result) (addr gb))))))
(defgmpfun mpz-cdiv (n d)
- (let ((size (1+ (max (%bignum-length n)
- (%bignum-length d)))))
+ (let ((size (1+ (max (blength n)
+ (blength d)))))
(with-mpz-results ((quot size)
(rem size))
(with-mpz-vars ((n gn) (d gd))
(__gmpz_cdiv_qr (addr quot) (addr rem) (addr gn) (addr gd))))))
(defgmpfun mpz-fdiv (n d)
- (let ((size (1+ (max (%bignum-length n)
- (%bignum-length d)))))
+ (let ((size (1+ (max (blength n)
+ (blength d)))))
(with-mpz-results ((quot size)
(rem size))
(with-mpz-vars ((n gn) (d gd))
(__gmpz_fdiv_qr (addr quot) (addr rem) (addr gn) (addr gd))))))
(defgmpfun mpz-tdiv (n d)
- (let ((size (max (%bignum-length n)
- (%bignum-length d))))
+ (let ((size (max (blength n)
+ (blength d))))
(with-mpz-results ((quot size)
(rem size))
(with-mpz-vars ((n gn) (d gd))
@@ -447,24 +450,24 @@ be (1+ COUNT)."
(__gmpz_pow_ui (addr rop) (addr gbase) exp))))
(defgmpfun mpz-powm (base exp mod)
- (with-mpz-results ((rop (1+ (%bignum-length mod))))
+ (with-mpz-results ((rop (1+ (blength mod))))
(with-mpz-vars ((base gbase) (exp gexp) (mod gmod))
(__gmpz_powm (addr rop) (addr gbase) (addr gexp) (addr gmod)))))
(defgmpfun mpz-gcd (a b)
- (with-mpz-results ((result (min (%bignum-length a)
- (%bignum-length b))))
+ (with-mpz-results ((result (min (blength a)
+ (blength b))))
(with-mpz-vars ((a ga) (b gb))
(__gmpz_gcd (addr result) (addr ga) (addr gb)))))
(defgmpfun mpz-lcm (a b)
- (with-mpz-results ((result (+ (%bignum-length a)
- (%bignum-length b))))
+ (with-mpz-results ((result (+ (blength a)
+ (blength b))))
(with-mpz-vars ((a ga) (b gb))
(__gmpz_lcm (addr result) (addr ga) (addr gb)))))
(defgmpfun mpz-sqrt (a)
- (with-mpz-results ((result (1+ (ceiling (%bignum-length a) 2))))
+ (with-mpz-results ((result (1+ (ceiling (blength a) 2))))
(with-mpz-vars ((a ga))
(__gmpz_sqrt (addr result) (addr ga)))))
@@ -601,8 +604,7 @@ be (1+ COUNT)."
(defun rand-seed (state seed)
"Initialize a random STATE with SEED."
- (declare (optimize (speed 3) (space 3) (safety 0))
- (sb-ext:muffle-conditions sb-ext:compiler-note))
+ (declare (optimize (speed 3) (space 3) (safety 0)))
(check-type state gmp-rstate)
(let ((ref (gmp-rstate-ref state)))
(cond
@@ -635,9 +637,10 @@ be (1+ COUNT)."
;;; Rational functions
-(declaim (inline lsize))
-(defun lsize (minusp n)
+(declaim (inline %lsize))
+(defun %lsize (minusp n)
(declare (optimize (speed 3) (space 3) (safety 0)))
+ "n must be a (potentially denormalized) bignum"
(let ((length (%bignum-length n)))
(when (zerop (%bignum-ref n (1- length)))
(decf length))
@@ -647,8 +650,7 @@ be (1+ COUNT)."
`(progn
(declaim (sb-ext:maybe-inline name))
(defun ,name (a b)
- (declare (optimize (speed 3) (space 3) (safety 0))
- (sb-ext:muffle-conditions sb-ext:compiler-note))
+ (declare (optimize (speed 3) (space 3) (safety 0)))
(let ((size (+ (max (blength (numerator a))
(blength (denominator a)))
(max (blength (numerator b))
@@ -664,20 +666,20 @@ be (1+ COUNT)."
(setf (slot (slot r 'mp_den) 'mp_size) 0
(slot (slot r 'mp_den) 'mp_alloc) size
(slot (slot r 'mp_den) 'mp_d) (bignum-data-sap den))
- (let* ((asign (minusp a))
- (an (bassert (numerator a)))
+ (let* ((an (bassert (numerator a)))
(ad (bassert (denominator a)))
- (bsign (minusp b))
+ (asign (not (%bignum-0-or-plusp an (%bignum-length an))))
(bn (bassert (numerator b)))
- (bd (bassert (denominator b))))
+ (bd (bassert (denominator b)))
+ (bsign (not (%bignum-0-or-plusp bn (%bignum-length bn)))))
(when asign
(setf an (negate-bignum an nil)))
(when bsign
(setf bn (negate-bignum bn nil)))
- (let* ((anlen (lsize asign an))
- (adlen (lsize NIL ad))
- (bnlen (lsize bsign bn))
- (bdlen (lsize NIL bd)))
+ (let* ((anlen (%lsize asign an))
+ (adlen (%lsize NIL ad))
+ (bnlen (%lsize bsign bn))
+ (bdlen (%lsize NIL bd)))
(with-alien ((arga (struct gmprat))
(argb (struct gmprat)))
(sb-sys:with-pinned-objects (an ad bn bd)
@@ -698,10 +700,11 @@ be (1+ COUNT)."
(slot (slot argb 'mp_den) 'mp_d)
(bignum-data-sap bd))
(,gmpfun (addr r) (addr arga) (addr argb)))))
- (sb-kernel::build-ratio (if (minusp (slot (slot r 'mp_num) 'mp_size))
- (z-to-bignum-neg num size)
- (z-to-bignum num size))
- (z-to-bignum den size))))))))))
+ (locally (declare (optimize (speed 1)))
+ (sb-kernel::build-ratio (if (minusp (slot (slot r 'mp_num) 'mp_size))
+ (z-to-bignum-neg num size)
+ (z-to-bignum num size))
+ (z-to-bignum den size)))))))))))
(defmpqfun mpq-add __gmpq_add)
(defmpqfun mpq-sub __gmpq_sub)

0 comments on commit bccdbf5

Please sign in to comment.