Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
This is an archived project. Repository and other project resources are read-only.
Show more breadcrumbs
Jon Boone
cmucl
Commits
d652bd09
Commit
d652bd09
authored
6 years ago
by
Raymond Toy
Browse files
Options
Downloads
Patches
Plain Diff
Rename functions to use the new version by default.
Update tests to reflect the change in names.
parent
3af22f92
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
src/code/bignum.lisp
+42
-21
42 additions, 21 deletions
src/code/bignum.lisp
tests/bignum.lisp
+6
-6
6 additions, 6 deletions
tests/bignum.lisp
with
48 additions
and
27 deletions
src/code/bignum.lisp
+
42
−
21
View file @
d652bd09
...
@@ -884,7 +884,12 @@ down to individual words.")
...
@@ -884,7 +884,12 @@ down to individual words.")
(
negate-bignum-in-place
result
))
(
negate-bignum-in-place
result
))
(
%normalize-bignum
result
(
1+
(
*
2
n
))))))))
(
%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
))
(
declare
(
type
bignum-type
a
b
))
(
let*
((
a-plusp
(
%bignum-0-or-plusp
a
(
%bignum-length
a
)))
(
let*
((
a-plusp
(
%bignum-0-or-plusp
a
(
%bignum-length
a
)))
(
b-plusp
(
%bignum-0-or-plusp
b
(
%bignum-length
b
)))
(
b-plusp
(
%bignum-0-or-plusp
b
(
%bignum-length
b
)))
...
@@ -916,16 +921,29 @@ down to individual words.")
...
@@ -916,16 +921,29 @@ down to individual words.")
(
when
negate-res
(
negate-bignum-in-place
res
))
(
when
negate-res
(
negate-bignum-in-place
res
))
(
%normalize-bignum
res
len-res
)))
(
%normalize-bignum
res
len-res
)))
;; Pretend the bignums are actually unsigned, do an unsigned multiply
;; Classical multiplication of bignums using Knuth's algorithm
;; and then correct the result. This is based on the algorithm in
;; modified to handle signed bignums. Pretend the bignums are
;; Hacker's Delight.
;; actually unsigned, do an unsigned multiply and then correct the
(
defun
classical-multiply-bignum-hd
(
a
b
)
;; 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
))
(
declare
(
type
bignum-type
a
b
))
(
let*
((
len-a
(
%bignum-length
a
))
(
let*
((
len-a
(
%bignum-length
a
))
(
len-b
(
%bignum-length
b
))
(
len-b
(
%bignum-length
b
))
(
len-res
(
+
len-a
len-b
))
(
len-res
(
+
len-a
len-b
))
(
res
(
%allocate-bignum
len-res
)))
(
res
(
%allocate-bignum
len-res
)))
(
negate-res
(
not
(
eq
a-plusp
b-plusp
))))
(
declare
(
type
bignum-index
len-a
len-b
len-res
))
(
declare
(
type
bignum-index
len-a
len-b
len-res
))
;; Unsigned multiply
;; Unsigned multiply
(
dotimes
(
i
len-a
)
(
dotimes
(
i
len-a
)
...
@@ -937,36 +955,39 @@ down to individual words.")
...
@@ -937,36 +955,39 @@ down to individual words.")
(
type
bignum-element-type
carry-digit
x
))
(
type
bignum-element-type
carry-digit
x
))
(
dotimes
(
j
len-b
)
(
dotimes
(
j
len-b
)
(
multiple-value-bind
(
big-carry
res-digit
)
(
multiple-value-bind
(
big-carry
res-digit
)
(
%multiply-and-add
x
(
%bignum-ref
b
j
)
(
%multiply-and-add
x
(
%bignum-ref
b
j
)
(
%bignum-ref
res
k
)
(
%bignum-ref
res
k
)
carry-digit
)
carry-digit
)
(
declare
(
type
bignum-element-type
big-carry
res-digit
))
(
declare
(
type
bignum-element-type
big-carry
res-digit
))
(
setf
(
%bignum-ref
res
k
)
res-digit
)
(
setf
(
%bignum-ref
res
k
)
res-digit
)
(
setf
carry-digit
big-carry
)
(
setf
carry-digit
big-carry
)
(
incf
k
)))
(
incf
k
)))
(
setf
(
%bignum-ref
res
k
)
carry-digit
)))
(
setf
(
%bignum-ref
res
k
)
carry-digit
)))
;; Apply corrections if either of the arguments is negative.
;; 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
len-a
)
(
unless
(
%bignum-0-or-plusp
a
)
(
let
((
borrow
1
))
(
let
((
borrow
1
))
(
dotimes
(
j
len-b
)
(
dotimes
(
j
len-b
)
(
declare
(
type
bignum-index
j
))
(
let
((
index
(
+
j
len-a
)))
(
let
((
index
(
+
j
len-a
)))
(
declare
(
type
bignum-index
index
))
(
multiple-value-bind
(
d
borrow-out
)
(
multiple-value-bind
(
d
borrow-out
)
(
%subtract-with-borrow
(
bignum-ref
res
index
)
(
%subtract-with-borrow
(
%
bignum-ref
res
index
)
(
bignum-ref
b
j
)
(
%
bignum-ref
b
j
)
borrow
)
borrow
)
(
setf
(
bignum-ref
res
index
)
d
)
(
setf
(
%
bignum-ref
res
index
)
d
)
(
setf
borrow
borrow-out
))))))
(
setf
borrow
borrow-out
))))))
(
unless
(
%bignum-0-or-plusp
b
)
(
unless
(
%bignum-0-or-plusp
b
len-b
)
(
let
((
borrow
1
))
(
let
((
borrow
1
))
(
dotimes
(
j
len-a
)
(
dotimes
(
j
len-a
)
(
declare
(
type
bignum-index
j
))
(
let
((
index
(
+
j
len-b
)))
(
let
((
index
(
+
j
len-b
)))
(
multiple-value-bind
(
d
borrow-out
)
(
declare
(
type
bignum-index
index
))
(
%subtract-with-borrow
(
bignum-ref
res
index
)
(
multiple-value-bind
(
d
borrow-out
)
(
bignum-ref
a
j
)
(
%subtract-with-borrow
(
%bignum-ref
res
index
)
borrow
)
(
%bignum-ref
a
j
)
(
setf
(
bignum-ref
res
index
)
d
)
borrow
)
(
setf
borrow
borrow-out
)))))
(
setf
(
%bignum-ref
res
index
)
d
)
(
setf
borrow
borrow-out
))))))
(
%normalize-bignum
res
len-res
)))
(
%normalize-bignum
res
len-res
)))
(
defparameter
*min-karatsuba-bits*
512
(
defparameter
*min-karatsuba-bits*
512
...
...
This diff is collapsed.
Click to expand it.
tests/bignum.lisp
+
6
−
6
View file @
d652bd09
...
@@ -21,8 +21,8 @@
...
@@ -21,8 +21,8 @@
(
dotimes
(
k
100
)
(
dotimes
(
k
100
)
(
let*
((
r1
(
gen-bignum
range
(
random
2
rng
)))
(
let*
((
r1
(
gen-bignum
range
(
random
2
rng
)))
(
r2
(
gen-bignum
range
(
random
2
rng
)))
(
r2
(
gen-bignum
range
(
random
2
rng
)))
(
prod-knuth
(
bignum::classical-multiply-bignums
r1
r2
))
(
prod-knuth
(
bignum::classical-multiply-bignums
-knuth
r1
r2
))
(
prod-hd
(
bignum::classical-multiply-bignum
-hd
r1
r2
)))
(
prod-hd
(
bignum::classical-multiply-bignum
s
r1
r2
)))
(
assert-equal
prod-knuth
prod-hd
r1
r2
))))))
(
assert-equal
prod-knuth
prod-hd
r1
r2
))))))
...
@@ -45,12 +45,12 @@
...
@@ -45,12 +45,12 @@
(
r2
(
gen-bignum
range
1
))
res
)
(
r2
(
gen-bignum
range
1
))
res
)
(
time
(
time
(
dotimes
(
k
reps
)
(
dotimes
(
k
reps
)
(
declare
(
fixnum
k
))
(
setf
res
(
declare
(
fixnum
k
))
(
bignum::classical-multiply-bignums
r1
r2
))))
(
setf
res
(
bignum::classical-multiply-bignums
-knuth
r1
r2
))))
(
print
res
)
(
print
res
)
(
time
(
time
(
dotimes
(
k
reps
)
(
dotimes
(
k
reps
)
(
declare
(
fixnum
k
))
(
setf
res
(
declare
(
fixnum
k
))
(
bignum::classical-multiply-bignum
-hd
r1
r2
))))
(
setf
res
(
bignum::classical-multiply-bignum
s
r1
r2
))))
(
print
res
)))))
(
print
res
)))))
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment