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