diff options
Diffstat (limited to 'lisp/calc/calc-bin.el')
| -rw-r--r-- | lisp/calc/calc-bin.el | 58 |
1 files changed, 35 insertions, 23 deletions
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index 49d54999b15..c58d0addd77 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -32,6 +32,17 @@ (require 'calc-ext) (require 'calc-macs) +;;; Some useful numbers +(defconst math-bignum-logb-digit-size + (eval-when-compile (logb math-bignum-digit-size)) + "The logb of the size of a bignum digit. +This is the largest value of B such that 2^B is less than +the size of a Calc bignum digit.") + +(defconst math-bignum-digit-power-of-two + (eval-when-compile (expt 2 (logb math-bignum-digit-size))) + "The largest power of 2 less than the size of a Calc bignum digit.") + ;;; b-prefix binary commands. (defun calc-and (n) @@ -297,11 +308,11 @@ (defun math-and-bignum (a b) ; [l l l] (and a b - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logand (cdr qa) (cdr qb)))))) (defun calcFunc-or (a b &optional w) ; [I I I] [Public] @@ -324,11 +335,11 @@ (defun math-or-bignum (a b) ; [l l l] (and (or a b) - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logior (cdr qa) (cdr qb)))))) (defun calcFunc-xor (a b &optional w) ; [I I I] [Public] @@ -351,11 +362,11 @@ (defun math-xor-bignum (a b) ; [l l l] (and (or a b) - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logxor (cdr qa) (cdr qb)))))) (defun calcFunc-diff (a b &optional w) ; [I I I] [Public] @@ -378,11 +389,11 @@ (defun math-diff-bignum (a b) ; [l l l] (and a - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logand (cdr qa) (lognot (cdr qb))))))) (defun calcFunc-not (a &optional w) ; [I I] [Public] @@ -402,14 +413,15 @@ w)))))) (defun math-not-bignum (a w) ; [l l] - (let ((q (math-div-bignum-digit a 512))) - (if (<= w 9) + (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) + (if (<= w math-bignum-logb-digit-size) (list (logand (lognot (cdr q)) (1- (lsh 1 w)))) (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) - (- w 9)) - 512 - (logxor (cdr q) 511))))) + (- w math-bignum-logb-digit-size)) + math-bignum-digit-power-of-two + (logxor (cdr q) + (1- math-bignum-digit-power-of-two)))))) (defun calcFunc-lsh (a &optional n w) ; [I I] [Public] (setq a (math-trunc a) @@ -510,8 +522,8 @@ (math-sub a (math-power-of-2 (- w))))) ((Math-negp a) (math-normalize (cons 'bigpos (math-binary-arg a w)))) - ((and (integerp a) (< a 1000000)) - (if (>= w 20) + ((and (integerp a) (< a math-small-integer-size)) + (if (> w (logb math-small-integer-size)) a (logand a (1- (lsh 1 w))))) (t @@ -523,13 +535,13 @@ (defalias 'calcFunc-clip 'math-clip) (defun math-clip-bignum (a w) ; [l l] - (let ((q (math-div-bignum-digit a 512))) - (if (<= w 9) + (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) + (if (<= w math-bignum-logb-digit-size) (list (logand (cdr q) (1- (lsh 1 w)))) (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) - (- w 9)) - 512 + (- w math-bignum-logb-digit-size)) + math-bignum-digit-power-of-two (cdr q))))) (defvar math-max-digits-cache nil) |