mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 02:51:31 -08:00
Code Issues Projects Releases Wiki Activity

Calc: allow infinite binary word size (bug#43764)

Browse source 
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.
This commit is contained in:
Mattias Engdegård 2020-10-10 18:02:49 +02:00
parent add1314195
commit cf40795888
4 changed files with 99 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

11
doc/misc/calc.texi
View file

@ -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

7
etc/NEWS
View file

@ -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
---

30
lisp/calc/calc-bin.el
View file

@ -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))
(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

64
test/lisp/calc/calc-tests.el
View file

@ -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)))
(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)))))
(- 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)))
(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.