Mercurial > hg > xemacs-beta
changeset 5388:fd5cd747075f
Automated merge with ssh://sperber-guest@hg.debian.org//hg/xemacs/xemacs
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Tue, 29 Mar 2011 23:28:14 +0100 |
parents | af961911bcb2 (current diff) 5f5d48053e86 (diff) |
children | f560f6608937 |
files | |
diffstat | 3 files changed, 58 insertions(+), 46 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Mar 29 15:59:56 2011 -0600 +++ b/lisp/ChangeLog Tue Mar 29 23:28:14 2011 +0100 @@ -1,3 +1,12 @@ +2011-03-29 Aidan Kehoe <kehoea@parhasard.net> + + * cl-extra.el (cl-finite-do, cl-float-limits): + Don't make these available as functions in the dumped image, since + they're only called at dump time. + * obsolete.el (cl-float-limits): + Make this an alias to #'identity (since it's called at dump time), + mark it as obsolete in 21.5. + 2011-03-29 Aidan Kehoe <kehoea@parhasard.net> * cl.el:
--- a/lisp/cl-extra.el Tue Mar 29 15:59:56 2011 -0600 +++ b/lisp/cl-extra.el Tue Mar 29 23:28:14 2011 +0100 @@ -365,52 +365,6 @@ (and (vectorp object) (= (length object) 4) (eq (aref object 0) 'cl-random-state-tag))) - -;; Implementation limits. - -(defun cl-finite-do (func a b) - (condition-case nil - (let ((res (funcall func a b))) ; check for IEEE infinity - (and (numberp res) (/= res (/ res 2)) res)) - (arith-error nil))) - -(defun cl-float-limits () - (or most-positive-float (not (numberp '2e1)) - (let ((x '2e0) y z) - ;; Find maximum exponent (first two loops are optimizations) - (while (cl-finite-do '* x x) (setq x (* x x))) - (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) - (while (cl-finite-do '+ x x) (setq x (+ x x))) - (setq z x y (/ x 2)) - ;; Now fill in 1's in the mantissa. - (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) - (setq x (+ x y) y (/ y 2))) - (setq most-positive-float x - most-negative-float (- x)) - ;; Divide down until mantissa starts rounding. - (setq x (/ x z) y (/ 16 z) x (* x y)) - (while (condition-case nil (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) - (arith-error nil)) - (setq x (/ x 2) y (/ y 2))) - (setq least-positive-normalized-float y - least-negative-normalized-float (- y)) - ;; Divide down until value underflows to zero. - (setq x (/ 1 z) y x) - (while (condition-case nil (> (/ x 2) 0) (arith-error nil)) - (setq x (/ x 2))) - (setq least-positive-float x - least-negative-float (- x)) - (setq x '1e0) - (while (/= (+ '1e0 x) '1e0) (setq x (/ x 2))) - (setq float-epsilon (* x 2)) - (setq x '1e0) - (while (/= (- '1e0 x) '1e0) (setq x (/ x 2))) - (setq float-negative-epsilon (* x 2)))) - nil) - -;; XEmacs; call cl-float-limits at dump time. -(cl-float-limits) - ;;; Sequence functions. ;; XEmacs; #'subseq is in C. @@ -693,6 +647,49 @@ ;; files to do the same, multiple times. (eval-when-compile (or (cl-compiling-file) (load "cl-macs"))) +;; Implementation limits. + +;; XEmacs; call cl-float-limits at dump time. +(labels + ((cl-finite-do (func a b) + (condition-case nil + (let ((res (funcall func a b))) ; check for IEEE infinity + (and (numberp res) (/= res (/ res 2)) res)) + (arith-error nil))) + (cl-float-limits () + (unless most-positive-float + (let ((x 2e0) y z) + ;; Find maximum exponent (first two loops are optimizations) + (while (cl-finite-do '* x x) (setq x (* x x))) + (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) + (while (cl-finite-do '+ x x) (setq x (+ x x))) + (setq z x y (/ x 2)) + ;; Now fill in 1's in the mantissa. + (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) + (setq x (+ x y) y (/ y 2))) + (setq most-positive-float x + most-negative-float (- x)) + ;; Divide down until mantissa starts rounding. + (setq x (/ x z) y (/ 16 z) x (* x y)) + (while (condition-case nil (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) + (arith-error nil)) + (setq x (/ x 2) y (/ y 2))) + (setq least-positive-normalized-float y + least-negative-normalized-float (- y)) + ;; Divide down until value underflows to zero. + (setq x (/ 1 z) y x) + (while (condition-case nil (> (/ x 2) 0) (arith-error nil)) + (setq x (/ x 2))) + (setq least-positive-float x + least-negative-float (- x)) + (setq x 1e0) + (while (/= (+ 1e0 x) 1e0) (setq x (/ x 2))) + (setq float-epsilon (* x 2)) + (setq x 1e0) + (while (/= (- 1e0 x) 1e0) (setq x (/ x 2))) + (setq float-negative-epsilon (* x 2)))))) + (cl-float-limits)) + (run-hooks 'cl-extra-load-hook) ;; XEmacs addition
--- a/lisp/obsolete.el Tue Mar 29 15:59:56 2011 -0600 +++ b/lisp/obsolete.el Tue Mar 29 23:28:14 2011 +0100 @@ -244,6 +244,12 @@ (define-compatible-function-alias 'cl-mapc 'mapc) +;; Various non-XEmacs code can call this, because it used not be +;; called automatically at dump time. +(define-function 'cl-float-limits 'ignore) +(make-obsolete 'cl-float-limits "this is called at dump time in 21.5 and \ +later, no need to call it in user code.") + ;; XEmacs; old compiler macros meant that this was called directly ;; from compiled code, and we need to provide a version of it for a ;; couple of years at least because of that. Aidan Kehoe, Mon Oct 4