cmucl-cvs July 2018

cmucl-cvs@common-lisp.net

1 participants
18 discussions

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] Disable test issue.41.1
by Raymond Toy 15 Jul '18

15 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: cb6e99a3 by Raymond Toy at 2018-07-15T16:01:01-07:00 Disable test issue.41.1 - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -397,6 +397,10 @@ (sleep 5) (assert-eql :exited (ext:process-status p))))) +;; For some reason this used to work linux CI but not doesn't. But +;; this test passes on my Fedora and debian systesm. +;; See issue #64. +#-linux (define-test issue.41.1 (:tag :issues) (issue-41-tester unix:sigstop)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/cb6e99a302be745711615f3b3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/cb6e99a302be745711615f3b3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] Refactor common code into a routine
by Raymond Toy 15 Jul '18

15 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: 228359b6 by Raymond Toy at 2018-07-15T13:47:44-07:00 Refactor common code into a routine The code for applying the correction is pretty much identical for each negative operant, so add a routine to do that. - - - - - 1 changed file: - src/code/bignum.lisp Changes: ===================================== src/code/bignum.lisp ===================================== --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -963,31 +963,29 @@ down to individual words.") (setf carry-digit big-carry) (incf k))) (setf (%bignum-ref res k) carry-digit))) - ;; Apply corrections if either of the arguments is negative. - (unless (%bignum-0-or-plusp a len-a) - (let ((borrow 1)) - (dotimes (j len-b) - (declare (type bignum-index j)) - (let ((index (+ j len-a))) - (declare (type bignum-index index)) - (multiple-value-bind (d borrow-out) - (%subtract-with-borrow (%bignum-ref res index) - (%bignum-ref b j) - borrow) - (setf (%bignum-ref res index) d) - (setf borrow borrow-out)))))) - (unless (%bignum-0-or-plusp b len-b) - (let ((borrow 1)) - (dotimes (j len-a) - (declare (type bignum-index j)) - (let ((index (+ j len-b))) - (declare (type bignum-index index)) - (multiple-value-bind (d borrow-out) - (%subtract-with-borrow (%bignum-ref res index) - (%bignum-ref a j) - borrow) - (setf (%bignum-ref res index) d) - (setf borrow borrow-out)))))) + (flet ((apply-correction (neg-arg neg-len pos-arg pos-len) + ;; Applies the correction by basically subtracting out + ;; 2^M*b where M is the length (in bits) of b and b is + ;; the positive term in pos-arg. neg-arg is the negative + ;; arg. + (let ((borrow 1)) + (dotimes (j pos-len) + (declare (type bignum-index j)) + (let ((index (+ j neg-len))) + (declare (type bignum-index index)) + (multiple-value-bind (d borrow-out) + (%subtract-with-borrow (%bignum-ref res index) + (%bignum-ref pos-arg j) + borrow) + (setf (%bignum-ref res index) d) + (setf borrow borrow-out))))))) + ;; Apply corrections if either of the arguments is negative. + (unless (%bignum-0-or-plusp a len-a) + ;; A is negative + (apply-correction a len-a b len-b)) + (unless (%bignum-0-or-plusp b len-b) + ;; B is negative + (apply-correction b len-b a len-a))) (%normalize-bignum res len-res))) (defparameter *min-karatsuba-bits* 512 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/228359b66be83465dcbda3c1a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/228359b66be83465dcbda3c1a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] Add tests with fixed operands
by Raymond Toy 15 Jul '18

15 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: 0f0ac0b6 by Raymond Toy at 2018-07-15T10:45:08-07:00 Add tests with fixed operands - - - - - 1 changed file: - tests/bignum.lisp Changes: ===================================== tests/bignum.lisp ===================================== --- a/tests/bignum.lisp +++ b/tests/bignum.lisp @@ -5,9 +5,47 @@ (in-package #:bignum-tests) -(define-test hd-mult +(define-test hd-mult.same-size "Test bignum multiplier" (:tag :bignum-tests) + ;; x and y are randomly generated 128 integers. No particular reason + ;; for these values, except that they're bignums. + (let ((x 248090201001762284446997112921270181259) + (y 313102667534462314033767199170708979663) + (prod 77677703722812705876871716049945873590003455155145426220435549433670954735717)) + ;; Verify the we get the right results for various signed values of x and y. + (assert-equal prod (* x y)) + (assert-equal (- prod) (* (- x) y)) + (assert-equal (- prod) (* x (- y))) + (assert-equal prod (* (- x) (- y))) + ;; Nake sure it's commutative + (assert-equal prod (* y x)) + (assert-equal (- prod) (* y (- x))) + (assert-equal (- prod) (* (- y) x)) + (assert-equal prod (* (- y) (- x))))) + +(define-test hd-mult.diff-size + "Test bignum multiplier" + (:tag :bignum-tests) + ;; x is a randomly generated bignum. y is a small bignum. + (let ((x 248090201001762284446997112921270181259) + (y (1+ most-positive-fixnum)) + (prod 133192412470079431258262755675409306410924638208)) + ;; Verify the we get the right results for various signed values of x and y. + (assert-equal prod (* x y)) + (assert-equal (- prod) (* (- x) y)) + (assert-equal (- prod) (* x (- y))) + (assert-equal prod (* (- x) (- y))) + ;; Nake sure it's commutative + (assert-equal prod (* y x)) + (assert-equal (- prod) (* y (- x))) + (assert-equal (- prod) (* (- y) x)) + (assert-equal prod (* (- y) (- x))))) + + +(define-test hd-mult.random + "Test bignum multiplier with random values" + (:tag :bignum-tests) (let ((rng (kernel::make-random-object :state (kernel:init-random-state) :rand 0 :cached-p nil)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0f0ac0b63954f26de2a3ab916… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0f0ac0b63954f26de2a3ab916… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] Use Ubuntu 14.04
by Raymond Toy 07 Jul '18

07 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: 01fa37d8 by Raymond Toy at 2018-07-07T12:01:45-07:00 Use Ubuntu 14.04 Let's see if 14.04 works better. I don't feel like debugging the test failure in a VM right now. And I don't want to set up everything to use Fedora (which is what my linux box is running). - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,7 +3,7 @@ variables: version: "2018-03-x86" linux-runner: - image: ubuntu:16.04 + image: ubuntu:14.04 tags: - linux before_script: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/01fa37d8a5c6cdb6b3914e83a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/01fa37d8a5c6cdb6b3914e83a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] Use fixed ubuntu image
by Raymond Toy 07 Jul '18

07 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: be073d06 by Raymond Toy at 2018-07-07T10:41:33-07:00 Use fixed ubuntu image - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,6 +3,7 @@ variables: version: "2018-03-x86" linux-runner: + image: ubuntu:16.04 tags: - linux before_script: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/be073d061d49a3d14999b04fa… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/be073d061d49a3d14999b04fa… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] Rename functions to use the new version by default.
by Raymond Toy 04 Jul '18

04 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: d652bd09 by Raymond Toy at 2018-07-04T13:31:21-07:00 Rename functions to use the new version by default. Update tests to reflect the change in names. - - - - - 2 changed files: - src/code/bignum.lisp - tests/bignum.lisp Changes: ===================================== src/code/bignum.lisp ===================================== --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -884,7 +884,12 @@ down to individual words.") (negate-bignum-in-place result)) (%normalize-bignum result (1+ (* 2 n)))))))) -(defun classical-multiply-bignums (a b) +;; Bignum multiply using Knuth's algorithm. We keep this around for +;; now so we can compare the new algorithm against this to make sure +;; this are working. +;; +;; TODO: Remove this eventually? +(defun classical-multiply-bignums-knuth (a b) (declare (type bignum-type a b)) (let* ((a-plusp (%bignum-0-or-plusp a (%bignum-length a))) (b-plusp (%bignum-0-or-plusp b (%bignum-length b))) @@ -916,16 +921,29 @@ down to individual words.") (when negate-res (negate-bignum-in-place res)) (%normalize-bignum res len-res))) -;; Pretend the bignums are actually unsigned, do an unsigned multiply -;; and then correct the result. This is based on the algorithm in -;; Hacker's Delight. -(defun classical-multiply-bignum-hd (a b) +;; Classical multiplication of bignums using Knuth's algorithm +;; modified to handle signed bignums. Pretend the bignums are +;; actually unsigned, do an unsigned multiply and then correct the +;; result. This is based on the algorithm in Hacker's Delight. +;; +;; Let a[n] and b[n] represent the individual bits of each bignum with +;; M being the number of bits in a and N being the number of bits in +;; b. If these are interpreted as an unsigned number, then we are +;; multiplying numbers +;; +;; (a + 2^M*a[M-1})*(b + 2^N*b[N-1]) +;; = a*b + 2^M*u[M-1]*b + 2^N*b[N-1]*a + 2^(M+N)*a[M-1]*b[M-1] +;; +;; To get the desired result, we need to subtract out the term +;; 2^M*u[M-1]*b + 2^N*b[N-1]*a from the product. The last term +;; doesn't need to subtracted because we know the product fits in M+N +;; bits and this term is beyond that. +(defun classical-multiply-bignums (a b) (declare (type bignum-type a b)) (let* ((len-a (%bignum-length a)) (len-b (%bignum-length b)) (len-res (+ len-a len-b)) (res (%allocate-bignum len-res))) - (negate-res (not (eq a-plusp b-plusp)))) (declare (type bignum-index len-a len-b len-res)) ;; Unsigned multiply (dotimes (i len-a) @@ -937,36 +955,39 @@ down to individual words.") (type bignum-element-type carry-digit x)) (dotimes (j len-b) (multiple-value-bind (big-carry res-digit) - (%multiply-and-add x (%bignum-ref b j) - (%bignum-ref res k) - carry-digit) + (%multiply-and-add x (%bignum-ref b j) + (%bignum-ref res k) + carry-digit) (declare (type bignum-element-type big-carry res-digit)) (setf (%bignum-ref res k) res-digit) (setf carry-digit big-carry) (incf k))) (setf (%bignum-ref res k) carry-digit))) ;; Apply corrections if either of the arguments is negative. - ;; If a < 0, subtract b*2^M from the result - (unless(%bignum-0-or-plusp a) + (unless (%bignum-0-or-plusp a len-a) (let ((borrow 1)) (dotimes (j len-b) + (declare (type bignum-index j)) (let ((index (+ j len-a))) + (declare (type bignum-index index)) (multiple-value-bind (d borrow-out) - (%subtract-with-borrow (bignum-ref res index) - (bignum-ref b j) + (%subtract-with-borrow (%bignum-ref res index) + (%bignum-ref b j) borrow) - (setf (bignum-ref res index) d) + (setf (%bignum-ref res index) d) (setf borrow borrow-out)))))) - (unless (%bignum-0-or-plusp b) + (unless (%bignum-0-or-plusp b len-b) (let ((borrow 1)) (dotimes (j len-a) + (declare (type bignum-index j)) (let ((index (+ j len-b))) - (multiple-value-bind (d borrow-out) - (%subtract-with-borrow (bignum-ref res index) - (bignum-ref a j) - borrow) - (setf (bignum-ref res index) d) - (setf borrow borrow-out))))) + (declare (type bignum-index index)) + (multiple-value-bind (d borrow-out) + (%subtract-with-borrow (%bignum-ref res index) + (%bignum-ref a j) + borrow) + (setf (%bignum-ref res index) d) + (setf borrow borrow-out)))))) (%normalize-bignum res len-res))) (defparameter *min-karatsuba-bits* 512 ===================================== tests/bignum.lisp ===================================== --- a/tests/bignum.lisp +++ b/tests/bignum.lisp @@ -21,8 +21,8 @@ (dotimes (k 100) (let* ((r1 (gen-bignum range (random 2 rng))) (r2 (gen-bignum range (random 2 rng))) - (prod-knuth (bignum::classical-multiply-bignums r1 r2)) - (prod-hd (bignum::classical-multiply-bignum-hd r1 r2))) + (prod-knuth (bignum::classical-multiply-bignums-knuth r1 r2)) + (prod-hd (bignum::classical-multiply-bignums r1 r2))) (assert-equal prod-knuth prod-hd r1 r2)))))) @@ -45,12 +45,12 @@ (r2 (gen-bignum range 1)) res) (time (dotimes (k reps) - (declare (fixnum k)) (setf res - (bignum::classical-multiply-bignums r1 r2)))) + (declare (fixnum k)) + (setf res (bignum::classical-multiply-bignums-knuth r1 r2)))) (print res) (time (dotimes (k reps) - (declare (fixnum k)) (setf res - (bignum::classical-multiply-bignum-hd r1 r2)))) + (declare (fixnum k)) + (setf res (bignum::classical-multiply-bignums r1 r2)))) (print res))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d652bd096516a2217e9c273da… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d652bd096516a2217e9c273da… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-bignum-mult-less-consing] 2 commits: Add simple test
by Raymond Toy 04 Jul '18

04 Jul '18

Raymond Toy pushed to branch rtoy-bignum-mult-less-consing at cmucl / cmucl Commits: e6b95b82 by Raymond Toy at 2018-07-04T12:21:25-07:00 Add simple test - - - - - 3af22f92 by Raymond Toy at 2018-07-04T12:40:30-07:00 Add some timing code, but not for tests. - - - - - 1 changed file: - + tests/bignum.lisp Changes: ===================================== tests/bignum.lisp ===================================== --- /dev/null +++ b/tests/bignum.lisp @@ -0,0 +1,56 @@ +;;; Tests for the bignum operations + +(defpackage :bignum-tests + (:use :cl :lisp-unit)) + +(in-package #:bignum-tests) + +(define-test hd-mult + "Test bignum multiplier" + (:tag :bignum-tests) + (let ((rng (kernel::make-random-object :state (kernel:init-random-state) + :rand 0 + :cached-p nil)) + (range (ash 1 128))) + (flet ((gen-bignum (x sign) + (do ((r (random x rng) (random x rng))) + ((typep r 'bignum) + (if (zerop sign) + r + (- r)))))) + (dotimes (k 100) + (let* ((r1 (gen-bignum range (random 2 rng))) + (r2 (gen-bignum range (random 2 rng))) + (prod-knuth (bignum::classical-multiply-bignums r1 r2)) + (prod-hd (bignum::classical-multiply-bignum-hd r1 r2))) + (assert-equal prod-knuth prod-hd r1 r2)))))) + + +;; Just for simple timing tests so we can redo the timing tests if needed. +#+nil +(define-test hd-timing + "Test execution time" + (:tag :bignum-tests) + (let ((rng (kernel::make-random-object :state + (kernel:init-random-state) + :rand 0 :cached-p nil)) + (range (ash 1 128)) + (reps 10000)) + (flet ((gen-bignum (x sign) + (do ((r (random x rng) (random x rng))) + ((typep r 'bignum) + (if (zerop sign) + r (- r)))))) + (let* ((r1 (gen-bignum range 1)) + (r2 (gen-bignum range 1)) res) + (time + (dotimes (k reps) + (declare (fixnum k)) (setf res + (bignum::classical-multiply-bignums r1 r2)))) + (print res) + (time + (dotimes (k reps) + (declare (fixnum k)) (setf res + (bignum::classical-multiply-bignum-hd r1 r2)))) + (print res))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/90d8b4b5f6bf1e612f3e7c24… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/90d8b4b5f6bf1e612f3e7c24… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-bignum-mult-less-consing
by Raymond Toy 04 Jul '18

04 Jul '18

Raymond Toy pushed new branch rtoy-bignum-mult-less-consing at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-bignum-mult-less-consi… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs July 2018