/[emacs]/emacs/lisp/calc/calc-bin.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-bin.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:01:51 2001 UTC
# Line 1  Line 1 
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.
# Line 37  Line 37 
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")
# Line 46  Line 45 
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")
# Line 55  Line 53 
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")
# Line 64  Line 61 
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")
# Line 73  Line 69 
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")
# Line 83  Line 78 
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")
# Line 93  Line 87 
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")
# Line 103  Line 96 
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")
# Line 113  Line 105 
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")
# Line 123  Line 114 
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")
# Line 132  Line 122 
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")
# Line 155  Line 144 
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    
# Line 173  Line 161 
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")
# Line 205  Line 188 
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))
# Line 228  Line 210 
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)
# Line 249  Line 230 
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    
# Line 273  Line 253 
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))
# Line 282  Line 261 
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)
# Line 312  Line 290 
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
# Line 322  Line 299 
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)
# Line 341  Line 317 
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)
# Line 351  Line 326 
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)
# Line 370  Line 344 
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)
# Line 380  Line 353 
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)
# Line 399  Line 371 
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
# Line 409  Line 380 
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)
# Line 426  Line 396 
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)))
# Line 437  Line 406 
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)
# Line 462  Line 430 
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)
# Line 497  Line 463 
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)
# Line 525  Line 489 
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)
# Line 552  Line 515 
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)))
# Line 564  Line 527 
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)
# Line 580  Line 539 
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)
# Line 597  Line 555 
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"
# Line 614  Line 571 
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"])
# Line 628  Line 584 
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")
# Line 639  Line 594 
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")
# Line 651  Line 605 
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")
# Line 663  Line 616 
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")
# Line 674  Line 626 
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.
# Line 690  Line 641 
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))
# Line 798  Line 748 
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))))
# Line 811  Line 760 
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)
# Line 841  Line 790 
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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26