1 |
;; Calculator for GNU Emacs, part II [calc-bin.el] |
;; Calculator for GNU Emacs, part II [calc-bin.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
37 |
(calc-enter-result 2 "and" |
(calc-enter-result 2 "and" |
38 |
(append '(calcFunc-and) |
(append '(calcFunc-and) |
39 |
(calc-top-list-n 2) |
(calc-top-list-n 2) |
40 |
(and n (list (prefix-numeric-value n)))))) |
(and n (list (prefix-numeric-value n))))))) |
|
) |
|
41 |
|
|
42 |
(defun calc-or (n) |
(defun calc-or (n) |
43 |
(interactive "P") |
(interactive "P") |
45 |
(calc-enter-result 2 "or" |
(calc-enter-result 2 "or" |
46 |
(append '(calcFunc-or) |
(append '(calcFunc-or) |
47 |
(calc-top-list-n 2) |
(calc-top-list-n 2) |
48 |
(and n (list (prefix-numeric-value n)))))) |
(and n (list (prefix-numeric-value n))))))) |
|
) |
|
49 |
|
|
50 |
(defun calc-xor (n) |
(defun calc-xor (n) |
51 |
(interactive "P") |
(interactive "P") |
53 |
(calc-enter-result 2 "xor" |
(calc-enter-result 2 "xor" |
54 |
(append '(calcFunc-xor) |
(append '(calcFunc-xor) |
55 |
(calc-top-list-n 2) |
(calc-top-list-n 2) |
56 |
(and n (list (prefix-numeric-value n)))))) |
(and n (list (prefix-numeric-value n))))))) |
|
) |
|
57 |
|
|
58 |
(defun calc-diff (n) |
(defun calc-diff (n) |
59 |
(interactive "P") |
(interactive "P") |
61 |
(calc-enter-result 2 "diff" |
(calc-enter-result 2 "diff" |
62 |
(append '(calcFunc-diff) |
(append '(calcFunc-diff) |
63 |
(calc-top-list-n 2) |
(calc-top-list-n 2) |
64 |
(and n (list (prefix-numeric-value n)))))) |
(and n (list (prefix-numeric-value n))))))) |
|
) |
|
65 |
|
|
66 |
(defun calc-not (n) |
(defun calc-not (n) |
67 |
(interactive "P") |
(interactive "P") |
69 |
(calc-enter-result 1 "not" |
(calc-enter-result 1 "not" |
70 |
(append '(calcFunc-not) |
(append '(calcFunc-not) |
71 |
(calc-top-list-n 1) |
(calc-top-list-n 1) |
72 |
(and n (list (prefix-numeric-value n)))))) |
(and n (list (prefix-numeric-value n))))))) |
|
) |
|
73 |
|
|
74 |
(defun calc-lshift-binary (n) |
(defun calc-lshift-binary (n) |
75 |
(interactive "P") |
(interactive "P") |
78 |
(calc-enter-result hyp "lsh" |
(calc-enter-result hyp "lsh" |
79 |
(append '(calcFunc-lsh) |
(append '(calcFunc-lsh) |
80 |
(calc-top-list-n hyp) |
(calc-top-list-n hyp) |
81 |
(and n (list (prefix-numeric-value n))))))) |
(and n (list (prefix-numeric-value n)))))))) |
|
) |
|
82 |
|
|
83 |
(defun calc-rshift-binary (n) |
(defun calc-rshift-binary (n) |
84 |
(interactive "P") |
(interactive "P") |
87 |
(calc-enter-result hyp "rsh" |
(calc-enter-result hyp "rsh" |
88 |
(append '(calcFunc-rsh) |
(append '(calcFunc-rsh) |
89 |
(calc-top-list-n hyp) |
(calc-top-list-n hyp) |
90 |
(and n (list (prefix-numeric-value n))))))) |
(and n (list (prefix-numeric-value n)))))))) |
|
) |
|
91 |
|
|
92 |
(defun calc-lshift-arith (n) |
(defun calc-lshift-arith (n) |
93 |
(interactive "P") |
(interactive "P") |
96 |
(calc-enter-result hyp "ash" |
(calc-enter-result hyp "ash" |
97 |
(append '(calcFunc-ash) |
(append '(calcFunc-ash) |
98 |
(calc-top-list-n hyp) |
(calc-top-list-n hyp) |
99 |
(and n (list (prefix-numeric-value n))))))) |
(and n (list (prefix-numeric-value n)))))))) |
|
) |
|
100 |
|
|
101 |
(defun calc-rshift-arith (n) |
(defun calc-rshift-arith (n) |
102 |
(interactive "P") |
(interactive "P") |
105 |
(calc-enter-result hyp "rash" |
(calc-enter-result hyp "rash" |
106 |
(append '(calcFunc-rash) |
(append '(calcFunc-rash) |
107 |
(calc-top-list-n hyp) |
(calc-top-list-n hyp) |
108 |
(and n (list (prefix-numeric-value n))))))) |
(and n (list (prefix-numeric-value n)))))))) |
|
) |
|
109 |
|
|
110 |
(defun calc-rotate-binary (n) |
(defun calc-rotate-binary (n) |
111 |
(interactive "P") |
(interactive "P") |
114 |
(calc-enter-result hyp "rot" |
(calc-enter-result hyp "rot" |
115 |
(append '(calcFunc-rot) |
(append '(calcFunc-rot) |
116 |
(calc-top-list-n hyp) |
(calc-top-list-n hyp) |
117 |
(and n (list (prefix-numeric-value n))))))) |
(and n (list (prefix-numeric-value n)))))))) |
|
) |
|
118 |
|
|
119 |
(defun calc-clip (n) |
(defun calc-clip (n) |
120 |
(interactive "P") |
(interactive "P") |
122 |
(calc-enter-result 1 "clip" |
(calc-enter-result 1 "clip" |
123 |
(append '(calcFunc-clip) |
(append '(calcFunc-clip) |
124 |
(calc-top-list-n 1) |
(calc-top-list-n 1) |
125 |
(and n (list (prefix-numeric-value n)))))) |
(and n (list (prefix-numeric-value n))))))) |
|
) |
|
126 |
|
|
127 |
(defun calc-word-size (n) |
(defun calc-word-size (n) |
128 |
(interactive "P") |
(interactive "P") |
144 |
calc-leading-zeros))) |
calc-leading-zeros))) |
145 |
(if (< n 0) |
(if (< n 0) |
146 |
(message "Binary word size is %d bits (2's complement)." (- n)) |
(message "Binary word size is %d bits (2's complement)." (- n)) |
147 |
(message "Binary word size is %d bits." n))) |
(message "Binary word size is %d bits." n)))) |
|
) |
|
148 |
|
|
149 |
|
|
150 |
|
|
161 |
;; also change global value so minibuffer sees it |
;; also change global value so minibuffer sees it |
162 |
(setq-default calc-number-radix calc-number-radix)) |
(setq-default calc-number-radix calc-number-radix)) |
163 |
(setq n calc-number-radix)) |
(setq n calc-number-radix)) |
164 |
(message "Number radix is %d." n)) |
(message "Number radix is %d." n))) |
|
) |
|
165 |
|
|
166 |
(defun calc-decimal-radix () |
(defun calc-decimal-radix () |
167 |
(interactive) |
(interactive) |
168 |
(calc-radix 10) |
(calc-radix 10)) |
|
) |
|
169 |
|
|
170 |
(defun calc-binary-radix () |
(defun calc-binary-radix () |
171 |
(interactive) |
(interactive) |
172 |
(calc-radix 2) |
(calc-radix 2)) |
|
) |
|
173 |
|
|
174 |
(defun calc-octal-radix () |
(defun calc-octal-radix () |
175 |
(interactive) |
(interactive) |
176 |
(calc-radix 8) |
(calc-radix 8)) |
|
) |
|
177 |
|
|
178 |
(defun calc-hex-radix () |
(defun calc-hex-radix () |
179 |
(interactive) |
(interactive) |
180 |
(calc-radix 16) |
(calc-radix 16)) |
|
) |
|
181 |
|
|
182 |
(defun calc-leading-zeros (n) |
(defun calc-leading-zeros (n) |
183 |
(interactive "P") |
(interactive "P") |
188 |
(math-compute-max-digits (math-abs calc-word-size) |
(math-compute-max-digits (math-abs calc-word-size) |
189 |
calc-number-radix)) |
calc-number-radix)) |
190 |
calc-number-radix) |
calc-number-radix) |
191 |
(message "Omitting leading zeros on integers."))) |
(message "Omitting leading zeros on integers.")))) |
|
) |
|
192 |
|
|
193 |
|
|
194 |
(defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024)) |
(defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024)) |
210 |
(let ((po2 (math-ipow 2 n))) |
(let ((po2 (math-ipow 2 n))) |
211 |
(setq math-big-power-of-2-cache |
(setq math-big-power-of-2-cache |
212 |
(cons (cons n po2) math-big-power-of-2-cache)) |
(cons (cons n po2) math-big-power-of-2-cache)) |
213 |
po2)))) |
po2))))) |
|
) |
|
214 |
|
|
215 |
(defun math-integer-log2 (n) ; [I I] [Public] |
(defun math-integer-log2 (n) ; [I I] [Public] |
216 |
(let ((i 0) |
(let ((i 0) |
230 |
n) |
n) |
231 |
(setq i (1+ i))) |
(setq i (1+ i))) |
232 |
(and (equal val n) |
(and (equal val n) |
233 |
i))) |
i)))) |
|
) |
|
234 |
|
|
235 |
|
|
236 |
|
|
253 |
(t (math-clip (cons 'bigpos |
(t (math-clip (cons 'bigpos |
254 |
(math-and-bignum (math-binary-arg a w) |
(math-and-bignum (math-binary-arg a w) |
255 |
(math-binary-arg b w))) |
(math-binary-arg b w))) |
256 |
w))) |
w)))) |
|
) |
|
257 |
|
|
258 |
(defun math-binary-arg (a w) |
(defun math-binary-arg (a w) |
259 |
(if (not (Math-integerp a)) |
(if (not (Math-integerp a)) |
261 |
(if (Math-integer-negp a) |
(if (Math-integer-negp a) |
262 |
(math-not-bignum (cdr (math-bignum-test (math-sub -1 a))) |
(math-not-bignum (cdr (math-bignum-test (math-sub -1 a))) |
263 |
(math-abs (if w (math-trunc w) calc-word-size))) |
(math-abs (if w (math-trunc w) calc-word-size))) |
264 |
(cdr (Math-bignum-test a))) |
(cdr (Math-bignum-test a)))) |
|
) |
|
265 |
|
|
266 |
(defun math-binary-modulo-args (f a b w) |
(defun math-binary-modulo-args (f a b w) |
267 |
(let (mod) |
(let (mod) |
290 |
(math-make-mod (if b |
(math-make-mod (if b |
291 |
(funcall f a b w) |
(funcall f a b w) |
292 |
(funcall f a w)) |
(funcall f a w)) |
293 |
mod))) |
mod)))) |
|
) |
|
294 |
|
|
295 |
(defun math-and-bignum (a b) ; [l l l] |
(defun math-and-bignum (a b) ; [l l l] |
296 |
(and a b |
(and a b |
299 |
(math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa)) |
(math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa)) |
300 |
(math-norm-bignum (car qb))) |
(math-norm-bignum (car qb))) |
301 |
512 |
512 |
302 |
(logand (cdr qa) (cdr qb))))) |
(logand (cdr qa) (cdr qb)))))) |
|
) |
|
303 |
|
|
304 |
(defun calcFunc-or (a b &optional w) ; [I I I] [Public] |
(defun calcFunc-or (a b &optional w) ; [I I I] [Public] |
305 |
(cond ((Math-messy-integerp w) |
(cond ((Math-messy-integerp w) |
317 |
(t (math-clip (cons 'bigpos |
(t (math-clip (cons 'bigpos |
318 |
(math-or-bignum (math-binary-arg a w) |
(math-or-bignum (math-binary-arg a w) |
319 |
(math-binary-arg b w))) |
(math-binary-arg b w))) |
320 |
w))) |
w)))) |
|
) |
|
321 |
|
|
322 |
(defun math-or-bignum (a b) ; [l l l] |
(defun math-or-bignum (a b) ; [l l l] |
323 |
(and (or a b) |
(and (or a b) |
326 |
(math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa)) |
(math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa)) |
327 |
(math-norm-bignum (car qb))) |
(math-norm-bignum (car qb))) |
328 |
512 |
512 |
329 |
(logior (cdr qa) (cdr qb))))) |
(logior (cdr qa) (cdr qb)))))) |
|
) |
|
330 |
|
|
331 |
(defun calcFunc-xor (a b &optional w) ; [I I I] [Public] |
(defun calcFunc-xor (a b &optional w) ; [I I I] [Public] |
332 |
(cond ((Math-messy-integerp w) |
(cond ((Math-messy-integerp w) |
344 |
(t (math-clip (cons 'bigpos |
(t (math-clip (cons 'bigpos |
345 |
(math-xor-bignum (math-binary-arg a w) |
(math-xor-bignum (math-binary-arg a w) |
346 |
(math-binary-arg b w))) |
(math-binary-arg b w))) |
347 |
w))) |
w)))) |
|
) |
|
348 |
|
|
349 |
(defun math-xor-bignum (a b) ; [l l l] |
(defun math-xor-bignum (a b) ; [l l l] |
350 |
(and (or a b) |
(and (or a b) |
353 |
(math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa)) |
(math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa)) |
354 |
(math-norm-bignum (car qb))) |
(math-norm-bignum (car qb))) |
355 |
512 |
512 |
356 |
(logxor (cdr qa) (cdr qb))))) |
(logxor (cdr qa) (cdr qb)))))) |
|
) |
|
357 |
|
|
358 |
(defun calcFunc-diff (a b &optional w) ; [I I I] [Public] |
(defun calcFunc-diff (a b &optional w) ; [I I I] [Public] |
359 |
(cond ((Math-messy-integerp w) |
(cond ((Math-messy-integerp w) |
371 |
(t (math-clip (cons 'bigpos |
(t (math-clip (cons 'bigpos |
372 |
(math-diff-bignum (math-binary-arg a w) |
(math-diff-bignum (math-binary-arg a w) |
373 |
(math-binary-arg b w))) |
(math-binary-arg b w))) |
374 |
w))) |
w)))) |
|
) |
|
375 |
|
|
376 |
(defun math-diff-bignum (a b) ; [l l l] |
(defun math-diff-bignum (a b) ; [l l l] |
377 |
(and a |
(and a |
380 |
(math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa)) |
(math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa)) |
381 |
(math-norm-bignum (car qb))) |
(math-norm-bignum (car qb))) |
382 |
512 |
512 |
383 |
(logand (cdr qa) (lognot (cdr qb)))))) |
(logand (cdr qa) (lognot (cdr qb))))))) |
|
) |
|
384 |
|
|
385 |
(defun calcFunc-not (a &optional w) ; [I I] [Public] |
(defun calcFunc-not (a &optional w) ; [I I] [Public] |
386 |
(cond ((Math-messy-integerp w) |
(cond ((Math-messy-integerp w) |
396 |
(t (math-normalize |
(t (math-normalize |
397 |
(cons 'bigpos |
(cons 'bigpos |
398 |
(math-not-bignum (math-binary-arg a w) |
(math-not-bignum (math-binary-arg a w) |
399 |
w))))) |
w)))))) |
|
) |
|
400 |
|
|
401 |
(defun math-not-bignum (a w) ; [l l] |
(defun math-not-bignum (a w) ; [l l] |
402 |
(let ((q (math-div-bignum-digit a 512))) |
(let ((q (math-div-bignum-digit a 512))) |
406 |
(math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) |
(math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) |
407 |
(- w 9)) |
(- w 9)) |
408 |
512 |
512 |
409 |
(logxor (cdr q) 511)))) |
(logxor (cdr q) 511))))) |
|
) |
|
410 |
|
|
411 |
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public] |
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public] |
412 |
(setq a (math-trunc a) |
(setq a (math-trunc a) |
430 |
((< n 0) |
((< n 0) |
431 |
(math-quotient (math-clip a w) (math-power-of-2 (- n)))) |
(math-quotient (math-clip a w) (math-power-of-2 (- n)))) |
432 |
(t |
(t |
433 |
(math-clip (math-mul a (math-power-of-2 n)) w))))) |
(math-clip (math-mul a (math-power-of-2 n)) w)))))) |
|
) |
|
434 |
|
|
435 |
(defun calcFunc-rsh (a &optional n w) ; [I I] [Public] |
(defun calcFunc-rsh (a &optional n w) ; [I I] [Public] |
436 |
(calcFunc-lsh a (math-neg (or n 1)) w) |
(calcFunc-lsh a (math-neg (or n 1)) w)) |
|
) |
|
437 |
|
|
438 |
(defun calcFunc-ash (a &optional n w) ; [I I] [Public] |
(defun calcFunc-ash (a &optional n w) ; [I I] [Public] |
439 |
(if (or (null n) |
(if (or (null n) |
463 |
(t (let ((two-to-n (math-power-of-2 (- n)))) |
(t (let ((two-to-n (math-power-of-2 (- n)))) |
464 |
(math-add (calcFunc-lsh (math-add two-to-n -1) |
(math-add (calcFunc-lsh (math-add two-to-n -1) |
465 |
(+ w n) w) |
(+ w n) w) |
466 |
sh)))))))) |
sh))))))))) |
|
) |
|
467 |
|
|
468 |
(defun calcFunc-rash (a &optional n w) ; [I I] [Public] |
(defun calcFunc-rash (a &optional n w) ; [I I] [Public] |
469 |
(calcFunc-ash a (math-neg (or n 1)) w) |
(calcFunc-ash a (math-neg (or n 1)) w)) |
|
) |
|
470 |
|
|
471 |
(defun calcFunc-rot (a &optional n w) ; [I I] [Public] |
(defun calcFunc-rot (a &optional n w) ; [I I] [Public] |
472 |
(setq a (math-trunc a) |
(setq a (math-trunc a) |
489 |
(calcFunc-rot a (math-mod n w) w)) |
(calcFunc-rot a (math-mod n w) w)) |
490 |
(t |
(t |
491 |
(math-add (calcFunc-lsh a (- n w) w) |
(math-add (calcFunc-lsh a (- n w) w) |
492 |
(calcFunc-lsh a n w)))))) |
(calcFunc-lsh a n w))))))) |
|
) |
|
493 |
|
|
494 |
(defun math-clip (a &optional w) ; [I I] [Public] |
(defun math-clip (a &optional w) ; [I I] [Public] |
495 |
(cond ((Math-messy-integerp w) |
(cond ((Math-messy-integerp w) |
515 |
(math-normalize |
(math-normalize |
516 |
(cons 'bigpos |
(cons 'bigpos |
517 |
(math-clip-bignum (cdr (math-bignum-test (math-trunc a))) |
(math-clip-bignum (cdr (math-bignum-test (math-trunc a))) |
518 |
w))))) |
w)))))) |
519 |
) |
|
520 |
(fset 'calcFunc-clip (symbol-function 'math-clip)) |
(defalias 'calcFunc-clip 'math-clip) |
521 |
|
|
522 |
(defun math-clip-bignum (a w) ; [l l] |
(defun math-clip-bignum (a w) ; [l l] |
523 |
(let ((q (math-div-bignum-digit a 512))) |
(let ((q (math-div-bignum-digit a 512))) |
527 |
(math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) |
(math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) |
528 |
(- w 9)) |
(- w 9)) |
529 |
512 |
512 |
530 |
(cdr q)))) |
(cdr q))))) |
|
) |
|
|
|
|
|
|
|
|
|
|
531 |
|
|
532 |
(defvar math-max-digits-cache nil) |
(defvar math-max-digits-cache nil) |
533 |
(defun math-compute-max-digits (w r) |
(defun math-compute-max-digits (w r) |
539 |
(digs (math-ceiling (math-div w (math-real-log2 r))))) |
(digs (math-ceiling (math-div w (math-real-log2 r))))) |
540 |
(setq math-max-digits-cache (cons (cons pair digs) |
(setq math-max-digits-cache (cons (cons pair digs) |
541 |
math-max-digits-cache)) |
math-max-digits-cache)) |
542 |
digs))) |
digs)))) |
|
) |
|
543 |
|
|
544 |
(defvar math-log2-cache (list '(2 . 1) |
(defvar math-log2-cache (list '(2 . 1) |
545 |
'(4 . 2) |
'(4 . 2) |
555 |
(calc-display-working-message nil) |
(calc-display-working-message nil) |
556 |
(log (calcFunc-log x 2))) |
(log (calcFunc-log x 2))) |
557 |
(setq math-log2-cache (cons (cons x log) math-log2-cache)) |
(setq math-log2-cache (cons (cons x log) math-log2-cache)) |
558 |
log))) |
log)))) |
|
) |
|
559 |
|
|
560 |
(defconst math-radix-digits ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" |
(defconst math-radix-digits ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" |
561 |
"A" "B" "C" "D" "E" "F" "G" "H" "I" "J" |
"A" "B" "C" "D" "E" "F" "G" "H" "I" "J" |
571 |
(while (> a 0) |
(while (> a 0) |
572 |
(setq s (concat (math-format-radix-digit (% a calc-number-radix)) s) |
(setq s (concat (math-format-radix-digit (% a calc-number-radix)) s) |
573 |
a (/ a calc-number-radix))) |
a (/ a calc-number-radix))) |
574 |
s)) |
s))) |
|
) |
|
575 |
|
|
576 |
(defconst math-binary-digits ["000" "001" "010" "011" |
(defconst math-binary-digits ["000" "001" "010" "011" |
577 |
"100" "101" "110" "111"]) |
"100" "101" "110" "111"]) |
584 |
(while (> a 7) |
(while (> a 7) |
585 |
(setq s (concat (aref math-binary-digits (% a 8)) s) |
(setq s (concat (aref math-binary-digits (% a 8)) s) |
586 |
a (/ a 8))) |
a (/ a 8))) |
587 |
(concat (math-format-radix a) s))) |
(concat (math-format-radix a) s)))) |
|
) |
|
588 |
|
|
589 |
(defun math-format-bignum-radix (a) ; [X L] |
(defun math-format-bignum-radix (a) ; [X L] |
590 |
(cond ((null a) "0") |
(cond ((null a) "0") |
594 |
(t |
(t |
595 |
(let ((q (math-div-bignum-digit a calc-number-radix))) |
(let ((q (math-div-bignum-digit a calc-number-radix))) |
596 |
(concat (math-format-bignum-radix (math-norm-bignum (car q))) |
(concat (math-format-bignum-radix (math-norm-bignum (car q))) |
597 |
(math-format-radix-digit (cdr q)))))) |
(math-format-radix-digit (cdr q))))))) |
|
) |
|
598 |
|
|
599 |
(defun math-format-bignum-binary (a) ; [X L] |
(defun math-format-bignum-binary (a) ; [X L] |
600 |
(cond ((null a) "0") |
(cond ((null a) "0") |
605 |
(concat (math-format-bignum-binary (math-norm-bignum (car q))) |
(concat (math-format-bignum-binary (math-norm-bignum (car q))) |
606 |
(aref math-binary-digits (/ (cdr q) 64)) |
(aref math-binary-digits (/ (cdr q) 64)) |
607 |
(aref math-binary-digits (% (/ (cdr q) 8) 8)) |
(aref math-binary-digits (% (/ (cdr q) 8) 8)) |
608 |
(aref math-binary-digits (% (cdr q) 8)))))) |
(aref math-binary-digits (% (cdr q) 8))))))) |
|
) |
|
609 |
|
|
610 |
(defun math-format-bignum-octal (a) ; [X L] |
(defun math-format-bignum-octal (a) ; [X L] |
611 |
(cond ((null a) "0") |
(cond ((null a) "0") |
616 |
(concat (math-format-bignum-octal (math-norm-bignum (car q))) |
(concat (math-format-bignum-octal (math-norm-bignum (car q))) |
617 |
(math-format-radix-digit (/ (cdr q) 64)) |
(math-format-radix-digit (/ (cdr q) 64)) |
618 |
(math-format-radix-digit (% (/ (cdr q) 8) 8)) |
(math-format-radix-digit (% (/ (cdr q) 8) 8)) |
619 |
(math-format-radix-digit (% (cdr q) 8)))))) |
(math-format-radix-digit (% (cdr q) 8))))))) |
|
) |
|
620 |
|
|
621 |
(defun math-format-bignum-hex (a) ; [X L] |
(defun math-format-bignum-hex (a) ; [X L] |
622 |
(cond ((null a) "0") |
(cond ((null a) "0") |
626 |
(let ((q (math-div-bignum-digit a 256))) |
(let ((q (math-div-bignum-digit a 256))) |
627 |
(concat (math-format-bignum-hex (math-norm-bignum (car q))) |
(concat (math-format-bignum-hex (math-norm-bignum (car q))) |
628 |
(math-format-radix-digit (/ (cdr q) 16)) |
(math-format-radix-digit (/ (cdr q) 16)) |
629 |
(math-format-radix-digit (% (cdr q) 16)))))) |
(math-format-radix-digit (% (cdr q) 16))))))) |
|
) |
|
630 |
|
|
631 |
;;; Decompose into integer and fractional parts, without depending |
;;; Decompose into integer and fractional parts, without depending |
632 |
;;; on calc-internal-prec. |
;;; on calc-internal-prec. |
641 |
(let ((qr (math-idivmod (nth 1 a) (math-scale-int 1 n)))) |
(let ((qr (math-idivmod (nth 1 a) (math-scale-int 1 n)))) |
642 |
(list (car qr) (math-make-float (cdr qr) (- n)) n))) |
(list (car qr) (math-make-float (cdr qr) (- n)) n))) |
643 |
(list (math-scale-rounding (nth 1 a) (nth 2 a)) |
(list (math-scale-rounding (nth 1 a) (nth 2 a)) |
644 |
'(float 0 0) 0)))) |
'(float 0 0) 0))))) |
|
) |
|
645 |
|
|
646 |
(defun math-format-radix-float (a prec) |
(defun math-format-radix-float (a prec) |
647 |
(let ((fmt (car calc-float-format)) |
(let ((fmt (car calc-float-format)) |
748 |
(> calc-number-radix 14)) |
(> calc-number-radix 14)) |
749 |
(format "%s*%d.^%s" str calc-number-radix estr) |
(format "%s*%d.^%s" str calc-number-radix estr) |
750 |
(format "%se%s" str estr))))))) |
(format "%se%s" str estr))))))) |
751 |
str) |
str)) |
|
) |
|
752 |
|
|
753 |
(defun math-convert-radix-digits (n &optional to-dec) |
(defun math-convert-radix-digits (n &optional to-dec) |
754 |
(let ((key (cons n (cons to-dec calc-number-radix)))) |
(let ((key (cons n (cons to-dec calc-number-radix)))) |
760 |
(cons (cons key (math-ceiling (if to-dec |
(cons (cons key (math-ceiling (if to-dec |
761 |
(math-mul n log) |
(math-mul n log) |
762 |
(math-div n log)))) |
(math-div n log)))) |
763 |
math-radix-digits-cache))))))) |
math-radix-digits-cache)))))))) |
764 |
) |
|
765 |
(setq math-radix-digits-cache nil) |
(setq math-radix-digits-cache nil) |
766 |
|
|
767 |
(defun math-radix-float-power (n) |
(defun math-radix-float-power (n) |
790 |
'(float 1 0) |
'(float 1 0) |
791 |
(math-float |
(math-float |
792 |
calc-number-radix)))))) |
calc-number-radix)))))) |
793 |
math-radix-float-cache))))))) |
math-radix-float-cache)))))))) |
794 |
) |
|
795 |
(setq math-radix-float-cache-tag nil) |
(setq math-radix-float-cache-tag nil) |
796 |
|
|
797 |
|
;;; calc-bin.el ends here |