APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1301437666 -3600 # Node ID 5f5d48053e8600a407bf9f9ee6501b23c1495028 # Parent 436e67ca8c790dd9214e1a5eb72d4ab9a050df4b Drop #'cl-finite-do, defalias #'cl-float-limits to #'ignore in dumped XEmacs 2011-03-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-extra.el (cl-finite-do, cl-float-limits): Don't make these available as functions in the dumped image (let them be garbage-collected), 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. diff -r 436e67ca8c79 -r 5f5d48053e86 lisp/ChangeLog --- a/lisp/ChangeLog Tue Mar 29 17:28:34 2011 +0100 +++ b/lisp/ChangeLog Tue Mar 29 23:27:46 2011 +0100 ＠＠ -1,3 +1,12 ＠＠ +2011-03-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * cl.el: diff -r 436e67ca8c79 -r 5f5d48053e86 lisp/cl-extra.el --- a/lisp/cl-extra.el Tue Mar 29 17:28:34 2011 +0100 +++ b/lisp/cl-extra.el Tue Mar 29 23:27:46 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 diff -r 436e67ca8c79 -r 5f5d48053e86 lisp/obsolete.el --- a/lisp/obsolete.el Tue Mar 29 17:28:34 2011 +0100 +++ b/lisp/obsolete.el Tue Mar 29 23:27:46 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 -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches