11:30 p.m.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# 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>
* 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>
+
+ * 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>
* 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