[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 35478f3: Calc: fix arithmetic right shift sign bit detection
From: |
Mattias Engdegård |
Subject: |
master 35478f3: Calc: fix arithmetic right shift sign bit detection |
Date: |
Fri, 9 Oct 2020 05:26:47 -0400 (EDT) |
branch: master
commit 35478f3f76d55f640372028889c570647432859c
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Calc: fix arithmetic right shift sign bit detection
Arithmetic right shift didn't compute the bit to shift in correctly.
For example, #x600000000 right-shifted 8 steps (with 32 bit word size)
resulted in #xff000000 rather than 0. (Bug#43764)
* lisp/calc/calc-bin.el (calcFunc-ash): Fix condition.
* test/lisp/calc/calc-tests.el (calc-tests--clip, calc-tests--lsh)
(calc-tests--rsh, calc-tests--ash, calc-tests--rash, calc-tests--rot):
New.
(calc-shift-binary): New test.
---
lisp/calc/calc-bin.el | 2 +-
test/lisp/calc/calc-tests.el | 62 ++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 63 insertions(+), 1 deletion(-)
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index 33fd1af..aa10d55 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -403,7 +403,7 @@
(setq a (math-clip a w)))
(let ((two-to-sizem1 (math-power-of-2 (1- w)))
(sh (calcFunc-lsh a n w)))
- (cond ((Math-natnum-lessp a two-to-sizem1)
+ (cond ((zerop (logand a two-to-sizem1))
sh)
((Math-lessp n (- 1 w))
(math-add (math-mul two-to-sizem1 2) -1))
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 0df96a0..4bced28 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -574,6 +574,68 @@ An existing calc stack is reused, otherwise a new one is
created."
86400))))
(should (equal (math-format-date d-1991-01-09-0600) "663400800")))))
+;; Reference implementations of binary shift functions:
+
+(defun calc-tests--clip (x w)
+ "Clip X to W bits, signed if W is negative, otherwise unsigned."
+ (if (>= w 0)
+ (logand x (- (ash 1 w) 1))
+ (let ((y (calc-tests--clip x (- w)))
+ (msb (ash 1 (- (- w) 1))))
+ (- y (ash (logand y msb) 1)))))
+
+(defun calc-tests--lsh (x n w)
+ "Logical shift left X by N steps, word size W."
+ (if (< n 0)
+ (calc-tests--rsh x (- n) w)
+ (calc-tests--clip (ash x n) w)))
+
+(defun calc-tests--rsh (x n w)
+ "Logical shift right X by N steps, word size W."
+ (if (< n 0)
+ (calc-tests--lsh x (- n) w)
+ (ash (calc-tests--clip x w) (- n))))
+
+(defun calc-tests--ash (x n w)
+ "Arithmetic shift left X by N steps, word size W."
+ (if (< n 0)
+ (calc-tests--rash x (- n) w)
+ (calc-tests--clip (ash x n) w)))
+
+(defun calc-tests--rash (x n w)
+ "Arithmetic shift right X by N steps, word size W."
+ (if (< n 0)
+ (calc-tests--ash x (- n) w)
+ ;; First sign-extend, then shift.
+ (let ((x-sext (calc-tests--clip x (- (abs w)))))
+ (calc-tests--clip (ash x-sext (- n)) w))))
+
+(defun calc-tests--rot (x n w)
+ "Rotate X left by N steps, word size W."
+ (let* ((aw (abs w))
+ (y (calc-tests--clip x aw))
+ (steps (mod n aw)))
+ (calc-tests--clip (logior (ash y steps) (ash y (- steps aw)))
+ w)))
+
+(ert-deftest calc-shift-binary ()
+ (dolist (w '(16 32))
+ (dolist (x '(0 1 #x1234 #x8000 #xabcd #xffff
+ #x12345678 #xabcdef12 #x80000000 #xffffffff
+ #x1234567890ab #x1234967890ab
+ -1 -14))
+ (dolist (n '(0 1 4 16 32 -1 -4 -16 -32))
+ (should (equal (calcFunc-lsh x n w)
+ (calc-tests--lsh x n w)))
+ (should (equal (calcFunc-rsh x n w)
+ (calc-tests--rsh x n w)))
+ (should (equal (calcFunc-ash x n w)
+ (calc-tests--ash x n w)))
+ (should (equal (calcFunc-rash x n w)
+ (calc-tests--rash x n w)))
+ (should (equal (calcFunc-rot x n w)
+ (calc-tests--rot x n w)))))))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 35478f3: Calc: fix arithmetic right shift sign bit detection,
Mattias Engdegård <=