<html lang='en'>
<head>
<meta content='text/html; charset=utf-8' http-equiv='Content-Type'>
<title>
GitLab
</title>
</meta>
</head>
<style>
img {
max-width: 100%;
height: auto;
}
p.details {
font-style:italic;
color:#777
}
.footer p {
font-size:small;
color:#777
}
pre.commit-message {
white-space: pre-wrap;
}
.file-stats a {
text-decoration: none;
}
.file-stats .new-file {
color: #090;
}
.file-stats .deleted-file {
color: #B00;
}
</style>
<body>
<div class='content'>
<h3>
Raymond Toy pushed to branch master
at <a href="https://gitlab.common-lisp.net/cmucl/cmucl">cmucl / cmucl</a>
</h3>
<h4>
Commits:
</h4>
<ul>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97f047bf38d13ea7">ddc980d5</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2016-01-16T14:34:19Z</i>
</div>
<pre class='commit-message'>Add bignum::%shld and bignum::%shrd
These are useful for multi-precision shifts. For x86, we can use the
shld and shrd instructions. For others, we just use basic logical
operations.</pre>
</li>
</ul>
<h4>3 changed files:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/bignum.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-1'>
src/compiler/generic/vm-fndb.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-2'>
src/compiler/x86/arith.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97f047bf38d13ea7#diff-0'>
<strong>
src/code/bignum.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/bignum.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/bignum.lisp
</span><span style="color: #aaaaaa">@@ -3697,3 +3697,29 @@ friends is working.
</span> (unless (= newlen len)
(%bignum-set-length result newlen))
result))
<span style="color: #000000;background-color: #ddffdd">+
+;; Shift X left by Shift bits, shifting in bits from Carry-in.
+;; Basically treat x:carry-in as a 64-bit value and shift it left,
+;; returning the top bignum-type bits.
+(defun %shld (x carry-in shift)
+ (declare (type bignum-element-type x carry-in)
+ (type (unsigned-byte 5) shift))
+ #+x86
+ (%shld x carry-in shift)
+ #-x86
+ (ldb (byte vm:word-bits 0)
+ (logior (ash x shift)
+ (ash carry-in (- shift vm:word-bits)))))
+
+;; Shift X right by Shift bits, shifting in bits from Carry-in.
+;; Basically treat carry-in:x as a 64-bit value and shift it right,
+;; returning the low bignum-type bits.
+(defun %shrd (x carry-in shift)
+ (declare (type bignum-element-type x carry-in)
+ (type (unsigned-byte 5) shift))
+ #+x86
+ (%shrd x carry-in shift)
+ #-x86
+ (ldb (byte vm:word-bits 0)
+ (logior (ash x (- shift))
+ (ash carry-in (- vm:word-bits shift)))))
</span></code></pre>
<br>
</li>
<li id='diff-1'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97f047bf38d13ea7#diff-1'>
<strong>
src/compiler/generic/vm-fndb.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/compiler/generic/vm-fndb.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/compiler/generic/vm-fndb.lisp
</span><span style="color: #aaaaaa">@@ -288,6 +288,13 @@
</span> (bignum-element-type (mod #+amd64 64 #-amd64 32)) bignum-element-type
(foldable flushable movable))
<span style="color: #000000;background-color: #ddffdd">+
+#+x86
+(defknown (bignum::%shld bignum::%shrd)
+ (bignum-element-type bignum-element-type (unsigned-byte 5))
+ bignum-element-type
+ (foldable flushable movable))
+
</span>
;;;; Bit-bashing routines.
</code></pre>
<br>
</li>
<li id='diff-2'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97f047bf38d13ea7#diff-2'>
<strong>
src/compiler/x86/arith.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/compiler/x86/arith.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/compiler/x86/arith.lisp
</span><span style="color: #aaaaaa">@@ -1579,6 +1579,86 @@
</span> (inst mov tmp y)
(inst shr tmp 18)
(inst xor y tmp)))
<span style="color: #000000;background-color: #ddffdd">+
+(define-vop (bignum-shld)
+ (:policy :fast-safe)
+ (:translate bignum::%shld)
+ (:args (x :scs (unsigned-reg) :target r)
+ (shift-in :scs (unsigned-reg))
+ (amount :scs (unsigned-reg) :target cl))
+ (:arg-types unsigned-num unsigned-num unsigned-num)
+ (:results (r :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
+ (:temporary (:sc unsigned-reg :offset ecx-offset
+ :from (:argument 2) :to (:result 0)) cl)
+ (:generator 4
+ (move cl amount)
+ (cond ((location= x r)
+ (inst shld x shift-in :cl))
+ (t
+ (move temp x)
+ (inst shld temp shift-in :cl)
+ (move r temp)))))
+
+(define-vop (bignum-shld-c)
+ (:policy :fast-safe)
+ (:translate bignum::%shld)
+ (:args (x :scs (unsigned-reg) :target r)
+ (shift-in :scs (unsigned-reg)))
+ (:info shift)
+ (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5)))
+ (:results (r :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
+ (:generator 3
+ (cond ((location= x r)
+ (inst shld x shift-in shift))
+ (t
+ (move temp x)
+ (inst shld temp shift-in shift)
+ (move r temp)))))
+
+(define-vop (bignum-shrd)
+ (:policy :fast-safe)
+ (:translate bignum::%shrd)
+ (:args (x :scs (unsigned-reg) :target r)
+ (shift-in :scs (unsigned-reg))
+ (amount :scs (unsigned-reg) :target cl))
+ (:arg-types unsigned-num unsigned-num unsigned-num)
+ (:results (r :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
+ (:temporary (:sc unsigned-reg :offset ecx-offset
+ :from (:argument 2) :to (:result 0)) cl)
+ (:generator 4
+ (move cl amount)
+ (cond ((location= x r)
+ (inst shrd x shift-in :cl))
+ (t
+ (move temp x)
+ (inst shrd temp shift-in :cl)
+ (move r temp)))))
+
+(define-vop (bignum-shrd-c)
+ (:policy :fast-safe)
+ (:translate bignum::%shrd)
+ (:args (x :scs (unsigned-reg))
+ (shift-in :scs (unsigned-reg)))
+ (:info shift)
+ (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5)))
+ (:results (r :scs (unsigned-reg)))
+ (:result-types unsigned-num)
+ (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
+ (:generator 3
+ (cond ((location= x r)
+ (inst shrd x shift-in shift))
+ (t
+ (move temp x)
+ (inst shrd temp shift-in shift)
+ (move r temp)))))
+
+
</span>
;;; Modular arithmetic
;;; logical operations
</code></pre>
<br>
</li>
</div>
<div class='footer' style='margin-top: 10px;'>
<p>
—
<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97f047bf38d13ea7">View it on GitLab</a>.
<br>
You're receiving this email because of your account on gitlab.common-lisp.net.
If you'd like to receive fewer emails, you can adjust your notification settings.
<script type="application/ld+json">{"@context":"http://schema.org","@type":"EmailMessage","action":{"@type":"ViewAction","name":"View Commit","url":"https://gitlab.common-lisp.net/cmucl/cmucl/commit/ddc980d5637cb21305e35c1a97f047bf38d13ea7"}}</script>
</p>
</div>
</body>
</html>