[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master cf40795 3/3: Calc: allow infinite binary word size (bug#43764)
|
From: |
Mattias Engdegård |
|
Subject: |
master cf40795 3/3: Calc: allow infinite binary word size (bug#43764) |
|
Date: |
Tue, 13 Oct 2020 05:34:05 -0400 (EDT) |
branch: master
commit cf407958886e46881216a510efebb8bc029de50c
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Calc: allow infinite binary word size (bug#43764)
Setting the word size ("b w") to 0 removes the word size clipping for
all bit operations (effectively as if a word size of -∞ had been set).
Rotation is disallowed; logical and arithmetic shifts behave
identically.
After a suggestion by Vincent Belaïche.
* lisp/calc/calc-bin.el (calc-word-size, math-binary-arg)
(math-binary-modulo-args, calcFunc-lsh, calcFunc-ash, calcFunc-rot)
(math-clip, math-format-twos-complement): Allow a word size of 0,
meaning -∞.
* test/lisp/calc/calc-tests.el
(calc-tests--not, calc-tests--and, calc-tests--or, calc-tests--xor)
(calc-tests--diff): New functions.
(calc-tests--clip, calc-tests--rot, calc-shift-binary): Extend to
cover word size 0.
(calc-bit-ops): New test.
* doc/misc/calc.texi (Binary Functions): Update manual.
* etc/NEWS: Announce the change.
---
doc/misc/calc.texi | 11 ++++++-
etc/NEWS | 7 +++++
lisp/calc/calc-bin.el | 32 +++++++++++++-------
test/lisp/calc/calc-tests.el | 70 ++++++++++++++++++++++++++++++++++++++------
4 files changed, 99 insertions(+), 21 deletions(-)
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index a356cec..6a6f585 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -18077,7 +18077,7 @@ zeros with @kbd{d z}. @xref{Radix Modes}.
@cindex Word size for binary operations
The Calculator maintains a current @dfn{word size} @expr{w}, an
-arbitrary positive or negative integer. For a positive word size, all
+arbitrary integer. For a positive word size, all
of the binary operations described here operate modulo @expr{2^w}. In
particular, negative arguments are converted to positive integers modulo
@expr{2^w} by all binary functions.
@@ -18092,6 +18092,9 @@ to
inclusive. Either mode accepts inputs in any range; the sign of
@expr{w} affects only the results produced.
+If the word size is zero, binary operations work on the entire number
+without clipping, as if the word size had been negative infinity.
+
@kindex b c
@pindex calc-clip
@tindex clip
@@ -18221,6 +18224,10 @@ and @samp{rash} operations is totally independent from
whether the word
size is positive or negative.) With a negative prefix argument, this
performs a standard left shift.
+When the word size is zero, logical and arithmetic shift operations
+are identical: a negative value shifted right remains negative, since
+there is an infinite supply of ones to shift in.
+
@kindex b t
@pindex calc-rotate-binary
@tindex rot
@@ -18230,6 +18237,8 @@ word size) is dropped off the left and shifted in on
the right. With a
numeric prefix argument, the number is rotated that many bits to the left
or right.
+Rotation is not possible with a zero word size.
+
@xref{Set Operations}, for the @kbd{b p} and @kbd{b u} commands that
pack and unpack binary integers into sets. (For example, @kbd{b u}
unpacks the number @samp{2#11001} to the set of bit-numbers
diff --git a/etc/NEWS b/etc/NEWS
index 79a8d11..aab96ca 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1101,6 +1101,13 @@ work more traditionally, with 'C-d' deleting the next
character.
Likewise, point isn't moved to the end of the string before inserting
digits.
++++
+*** Setting the word size to zero disables word clipping.
+The word size normally clips the results of certain bit-oriented
+operations such as shifts and bitwise XOR. A word size of zero, set
+by 'b w', makes the operation have effect on the whole argument values
+and the result is not truncated in any way.
+
** term-mode
---
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index 20dd1d4..60dd17e 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -145,9 +145,10 @@
(setq math-half-2-word-size (math-power-of-2 (1- (math-abs n))))
(calc-do-refresh)
(calc-refresh-evaltos)
- (if (< n 0)
- (message "Binary word size is %d bits (two's complement)" (- n))
- (message "Binary word size is %d bits" n))))
+ (cond
+ ((< n 0) (message "Binary word size is %d bits (two's complement)" (- n)))
+ ((> n 0) (message "Binary word size is %d bits" n))
+ (t (message "No fixed binary word size")))))
@@ -262,9 +263,10 @@
(defun math-binary-arg (a w)
(if (not (Math-integerp a))
(setq a (math-trunc a)))
- (if (< a 0)
- (logand a (1- (ash 1 (if w (math-trunc w) calc-word-size))))
- a))
+ (let ((w (if w (math-trunc w) calc-word-size)))
+ (if (and (< a 0) (not (zerop w)))
+ (logand a (1- (ash 1 w)))
+ a)))
(defun math-binary-modulo-args (f a b w)
(let (mod)
@@ -285,7 +287,7 @@
(let ((bits (math-integer-log2 mod)))
(if bits
(if w
- (if (/= w bits)
+ (if (and (/= w bits) (not (zerop w)))
(calc-record-why
"*Warning: Modulus inconsistent with word size"))
(setq w bits))
@@ -371,11 +373,12 @@
(math-clip (calcFunc-lsh a n (- w)) w)
(if (Math-integer-negp a)
(setq a (math-clip a w)))
- (cond ((or (Math-lessp n (- w))
- (Math-lessp w n))
+ (cond ((and (or (Math-lessp n (- w))
+ (Math-lessp w n))
+ (not (zerop w)))
0)
((< n 0)
- (math-quotient (math-clip a w) (math-power-of-2 (- n))))
+ (ash (math-clip a w) n))
(t
(math-clip (math-mul a (math-power-of-2 n)) w))))))
@@ -403,7 +406,8 @@
(setq a (math-clip a w)))
(let ((two-to-sizem1 (math-power-of-2 (1- w)))
(sh (calcFunc-lsh a n w)))
- (cond ((zerop (logand a two-to-sizem1))
+ (cond ((or (zerop w)
+ (zerop (logand a two-to-sizem1)))
sh)
((Math-lessp n (- 1 w))
(math-add (math-mul two-to-sizem1 2) -1))
@@ -421,6 +425,8 @@
(if (eq (car-safe a) 'mod)
(math-binary-modulo-args 'calcFunc-rot a n w)
(setq w (if w (math-trunc w) calc-word-size))
+ (when (zerop w)
+ (error "Rotation requires a nonzero word size"))
(or (integerp w)
(math-reject-arg w 'fixnump))
(or (Math-integerp a)
@@ -452,6 +458,8 @@
(if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
a
(math-sub a (math-power-of-2 (- w)))))
+ ((math-zerop w)
+ a)
((Math-negp a)
(math-binary-arg a w))
((integerp a)
@@ -682,6 +690,8 @@
(defun math-format-twos-complement (a)
"Format an integer in two's complement mode."
+ (when (zerop calc-word-size)
+ (error "Nonzero word size required"))
(let* (;(calc-leading-zeros t)
(num
(cond
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index fd16102..b59f4dc 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -569,15 +569,35 @@ 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:
+;; Reference implementations of bit operations:
(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)))))
+ (cond ((zerop w) x)
+ ((> w 0) (logand x (- (ash 1 w) 1)))
+ (t (let ((y (calc-tests--clip x (- w)))
+ (msb (ash 1 (- (- w) 1))))
+ (- y (ash (logand y msb) 1))))))
+
+(defun calc-tests--not (x w)
+ "Bitwise complement of X, word size W."
+ (calc-tests--clip (lognot x) w))
+
+(defun calc-tests--and (x y w)
+ "Bitwise AND of X and W, word size W."
+ (calc-tests--clip (logand x y) w))
+
+(defun calc-tests--or (x y w)
+ "Bitwise OR of X and Y, word size W."
+ (calc-tests--clip (logior x y) w))
+
+(defun calc-tests--xor (x y w)
+ "Bitwise XOR of X and Y, word size W."
+ (calc-tests--clip (logxor x y) w))
+
+(defun calc-tests--diff (x y w)
+ "Bitwise AND of X and NOT Y, word size W."
+ (calc-tests--clip (logand x (lognot y)) w))
(defun calc-tests--lsh (x n w)
"Logical shift left X by N steps, word size W."
@@ -611,6 +631,8 @@ An existing calc stack is reused, otherwise a new one is
created."
(defun calc-tests--rot (x n w)
"Rotate X left by N steps, word size W."
+ (when (zerop w)
+ (error "Undefined"))
(let* ((aw (abs w))
(y (calc-tests--clip x aw))
(steps (mod n aw)))
@@ -618,7 +640,7 @@ An existing calc stack is reused, otherwise a new one is
created."
w)))
(ert-deftest calc-shift-binary ()
- (dolist (w '(16 32 -16 -32))
+ (dolist (w '(16 32 -16 -32 0))
(dolist (x '(0 1 #x1234 #x8000 #xabcd #xffff
#x12345678 #xabcdef12 #x80000000 #xffffffff
#x1234567890ab #x1234967890ab
@@ -633,8 +655,38 @@ An existing calc stack is reused, otherwise a new one is
created."
(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)))))))
+ (unless (zerop w)
+ (should (equal (calcFunc-rot x n w)
+ (calc-tests--rot x n w)))))))
+ (should-error (calcFunc-rot 1 1 0)))
+
+(ert-deftest calc-bit-ops ()
+ (dolist (w '(16 32 -16 -32 0))
+ (dolist (x '(0 1 #x1234 #x8000 #xabcd #xffff
+ #x12345678 #xabcdef12 #x80000000 #xffffffff
+ #x1234567890ab #x1234967890ab
+ -1 -14 #x-8000 #x-ffff #x-8001 #x-10000
+ #x-80000000 #x-ffffffff #x-80000001 #x-100000000))
+ (should (equal (calcFunc-not x w)
+ (calc-tests--not x w)))
+
+ (dolist (n '(0 1 4 16 32 -1 -4 -16 -32))
+ (equal (calcFunc-clip x n)
+ (calc-tests--clip x n)))
+
+ (dolist (y '(0 1 #x1234 #x8000 #xabcd #xffff
+ #x12345678 #xabcdef12 #x80000000 #xffffffff
+ #x1234567890ab #x1234967890ab
+ -1 -14 #x-8000 #x-ffff #x-8001 #x-10000
+ #x-80000000 #x-ffffffff #x-80000001 #x-100000000))
+ (should (equal (calcFunc-and x y w)
+ (calc-tests--and x y w)))
+ (should (equal (calcFunc-or x y w)
+ (calc-tests--or x y w)))
+ (should (equal (calcFunc-xor x y w)
+ (calc-tests--xor x y w)))
+ (should (equal (calcFunc-diff x y w)
+ (calc-tests--diff x y w)))))))
(ert-deftest calc-latex-input ()
;; Check precedence of "/" in LaTeX input mode.