From: William Harold Newman <william.newman@airmail.net>
Date: Wed, 29 Aug 2001 23:22:35 +0000 (+0000)
Subject: 0.pre7.24:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4a0ab5193096ca70dbbf43bb21418544f6d018b7;p=sbcl.git

0.pre7.24:
	got rid of :SB-PROPAGATE-FLOAT-TYPE and
		:SB-PROPAGATE-FUN-TYPE as separate target *FEATURES*
		options controlling the build, instead hardwiring
		them to always on; and rewrote
		CROSS-FLOAT-INFINITY-KLUDGE so that stuff like
			#!+sb-propagate-foo-type
		becomes
			#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
		instead; and similarly stuff like
			#!-sb-propagate-foo-type
		becomes
			#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
	--
	Remember to delete 'em from base-target-features.lisp-expr.
	Build SBCL with itself to test this change, since I had so
		much trouble with it.
	Document :SB-PROPAGATE-FOO-TYPE changes in NEWS.
	Crib "what is CROSS-FLOAT-INFINITY-KLUDGE" text.
---

diff --git a/NEWS b/NEWS
index 7882996..01d0e5b 100644
--- a/NEWS
+++ b/NEWS
@@ -847,6 +847,10 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13:
              (print (aref possiblybigthings i) stream)))))
   should truncate the logical block only at 50 lines, instead of 
   often truncating it at 8 lines.
+* :SB-CONSTRAIN-FLOAT-TYPE, :SB-PROPAGATE-FLOAT-TYPE, and
+  :SB-PROPAGATE-FUN-TYPE are no longer considered to be optional
+  features. Instead, the code that they used to control is always
+  built into the system.
 ?? lots of tidying up internally: renaming things so that names are
   more systematic and consistent, converting C macros to inline
   functions, systematizing indentation
diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr
index 391778f..da348e5 100644
--- a/base-target-features.lisp-expr
+++ b/base-target-features.lisp-expr
@@ -70,31 +70,6 @@
  ;; you are a developer.
  :sb-test
 
- ;; :SB-PROPAGATE-FLOAT-TYPE and :SB-PROPAGATE-FUN-TYPE enable
- ;; some numeric optimizer code in the target compiler. They 
- ;; correspond to the :PROPAGATE-FLOAT-TYPE and :PROPAGATE-FUN-TYPE
- ;; features in the original CMU CL code, and while documentation 
- ;; existed for those, it seemed a little inconsistent. Despite the
- ;; name, :SB-PROPAGATE-FLOAT-TYPE seems to control not only
- ;; floating point optimizations, but some integer optimizations as
- ;; well.
- ;; 
- ;; CROSS-FLOAT-INFINITY-KLUDGE:
- ;;   * Even when these target features are enabled, the optimizations 
- ;;     aren't enabled in the cross-compiler, because some of them
- ;;     depend on floating point infinities, which aren't in general
- ;;     supported on the cross-compilation host.
- ;;   * This is supported by hacking the features out of the 
- ;;     *SHEBANG-FEATURES* list while we're building the cross-compiler.
- ;;     This is ugly and confusing and weird, but all the alternatives
- ;;     that I could think of seem messy and error-prone. That doesn't
- ;;     mean there's not a better way, though. Suggestions are welcome;
- ;;     or if you'd like to submit patches to make this code work
- ;;     without requiring floating point infinities, so that the entire
- ;;     problem goes away, that might be even better! -- WHN 2001-03-22
- :sb-propagate-float-type
- :sb-propagate-fun-type
-
  ;; Make more debugging information available (for debugging SBCL
  ;; itself). If you aren't hacking or troubleshooting SBCL itself,
  ;; you probably don't want this set.
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 584f656..a646284 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -266,18 +266,12 @@
 ;;; Exactly the same as CONSTRAIN-INTEGER-TYPE, but for float numbers.
 (defun constrain-float-type (x y greater or-equal)
   (declare (type numeric-type x y))
-  ;; FIXME: The comment here used to say
-  ;;   Unless #!+SB-PROPAGATE-FLOAT-TYPE, then SB!C::BOUND-VALUE (used in
-  ;;   the code below) is not defined, so we just return X without
-  ;;   trying to calculate additional constraints.
-  ;; But as of sbcl-0.6.11.26, SB!C::BOUND-VALUE has been renamed to
-  ;; SB!INT:TYPE-BOUND-NUMBER and is always defined, so probably the
-  ;; conditionalization should go away.
-  #!-sb-propagate-float-type (declare (ignore greater or-equal))
+  (declare (ignorable x y)) ; for CROSS-FLOAT-INFINITY-KLUDGE
   (aver (eql (numeric-type-class x) 'float))
   (aver (eql (numeric-type-class y) 'float))
-  #!-sb-propagate-float-type x
-  #!+sb-propagate-float-type
+  #+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
+  x
+  #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
   (labels ((exclude (x)
 	     (cond ((not x) nil)
 		   (or-equal x)
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index ba12b8e..3d82e9f 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -166,9 +166,43 @@
       '(%scalbn f ex)
       '(scale-double-float f ex)))
 
+;;; What is the CROSS-FLOAT-INFINITY-KLUDGE?
+;;;
+;;; SBCL's own implementation of floating point supports floating
+;;; point infinities. Some of the old CMU CL :PROPAGATE-FLOAT-TYPE and
+;;; :PROPAGATE-FUN-TYPE code, like the DEFOPTIMIZERs below, uses this
+;;; floating point support. Thus, we have to avoid running it on the
+;;; cross-compilation host, since we're not guaranteed that the
+;;; cross-compilation host will support floating point infinities.
+;;;
+;;; If we wanted to live dangerously, we could conditionalize the code
+;;; with #+(OR SBCL SB-XC) instead. That way, if the cross-compilation
+;;; host happened to be SBCL, we'd be able to run the infinity-using
+;;; code. Pro:
+;;;   * SBCL itself gets built with more complete optimization.
+;;; Con:
+;;;   * You get a different SBCL depending on what your cross-compilation
+;;;     host is.
+;;; So far the pros and cons seem seem to be mostly academic, since
+;;; AFAIK (WHN 2001-08-28) the propagate-foo-type optimizations aren't
+;;; actually important in compiling SBCL itself. If this changes, then
+;;; we have to decide:
+;;;   * Go for simplicity, leaving things as they are.
+;;;   * Go for performance at the expense of conceptual clarity,
+;;;     using #+(OR SBCL SB-XC) and otherwise leaving the build
+;;;     process as is.
+;;;   * Go for performance at the expense of build time, using
+;;;     #+(OR SBCL SB-XC) and also making SBCL do not just
+;;;     make-host-1.sh and make-host-2.sh, but a third step
+;;;     make-host-3.sh where it builds itself under itself. (Such a
+;;;     3-step build process could also help with other things, e.g.
+;;;     using specialized arrays to represent debug information.)
+;;;   * Rewrite the code so that it doesn't depend on unportable
+;;;     floating point infinities.
+
 ;;; optimizers for SCALE-FLOAT. If the float has bounds, new bounds
 ;;; are computed for the result, if possible.
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 (defun scale-float-derive-type-aux (f ex same-arg)
@@ -278,7 +312,7 @@
 
 ;;; Derive the result to be float for argument types in the
 ;;; appropriate domain.
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (dolist (stuff '((asin (real -1.0 1.0))
 		 (acos (real -1.0 1.0))
 		 (acosh (real 1.0))
@@ -294,7 +328,7 @@
 			       type)
 		(specifier-type 'float)))))))
 
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (log derive-type) ((x &optional y))
   (when (and (csubtypep (continuation-type x)
 			(specifier-type '(real 0.0)))
@@ -455,11 +489,7 @@
        (float pi x)
        (float 0 x)))
 
-;; #!+(or propagate-float-type propagate-fun-type)
-(progn
-
 ;;; The number is of type REAL.
-#!-sb-fluid (declaim (inline numeric-type-real-p))
 (defun numeric-type-real-p (type)
   (and (numeric-type-p type)
        (eq (numeric-type-complexp type) :real)))
@@ -472,9 +502,7 @@
 	(list (coerce (car bound) type))
 	(coerce bound type))))
 
-) ; PROGN
-
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 ;;;; optimizers for elementary functions
@@ -1009,7 +1037,7 @@
 			      :complexp :real
 			      :low (numeric-type-low type)
 			      :high (numeric-type-high type))))))
-#!+(or sb-propagate-fun-type sb-propagate-float-type)
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (realpart derive-type) ((num))
   (one-arg-derive-type num #'realpart-derive-type-aux #'realpart))
 (defun imagpart-derive-type-aux (type)
@@ -1033,7 +1061,7 @@
 			      :complexp :real
 			      :low (numeric-type-low type)
 			      :high (numeric-type-high type))))))
-#!+(or sb-propagate-fun-type sb-propagate-float-type)
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (imagpart derive-type) ((num))
   (one-arg-derive-type num #'imagpart-derive-type-aux #'imagpart))
 
@@ -1075,7 +1103,7 @@
 					     :complex))))
       (specifier-type 'complex)))
 
-#!+(or sb-propagate-fun-type sb-propagate-float-type)
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (complex derive-type) ((re &optional im))
   (if im
       (two-arg-derive-type re im #'complex-derive-type-aux-2 #'complex)
@@ -1158,7 +1186,7 @@
 ;;; possible answer. This gets around the problem of doing range
 ;;; reduction correctly but still provides useful results when the
 ;;; inputs are union types.
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 (defun trig-derive-type-aux (arg domain fcn
 				 &optional def-lo def-hi (increasingp t))
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 684550e..986689d 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -249,12 +249,12 @@
 (defknown lcm (&rest integer) unsigned-byte
   (movable foldable flushable explicit-check))
 
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defknown exp (number) irrational
   (movable foldable flushable explicit-check recursive)
   :derive-type #'result-type-float-contagion)
 
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defknown exp (number) irrational
   (movable foldable flushable explicit-check recursive))
 
@@ -272,7 +272,7 @@
 (defknown cis (real) (complex float)
   (movable foldable flushable explicit-check))
 
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 (defknown (sin cos) (number)
   (or (float -1.0 1.0) (complex float))
@@ -289,7 +289,7 @@
   :derive-type #'result-type-float-contagion)
 ) ; PROGN
 
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 (defknown (sin cos) (number)
   (or (float -1.0 1.0) (complex float))
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 58585f4..adc6132 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -167,9 +167,9 @@
 		    `(,',fun ,x 1)))))
   (frob truncate)
   (frob round)
-  #!+sb-propagate-float-type
+  #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
   (frob floor)
-  #!+sb-propagate-float-type
+  #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
   (frob ceiling))
 
 (def-source-transform lognand (x y) `(lognot (logand ,x ,y)))
@@ -218,7 +218,7 @@
 ;;;; numeric-type has everything we want to know. Reason 2 wins for
 ;;;; now.
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 ;;; The basic interval type. It can handle open and closed intervals.
@@ -771,7 +771,7 @@
 			     :high high))
 	(numeric-contagion x y))))
 
-#!+(or sb-propagate-float-type sb-propagate-fun-type)
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 ;;; simple utility to flatten a list
@@ -1165,7 +1165,7 @@
 
 ) ; PROGN
 
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 (defoptimizer (+ derive-type) ((x y))
   (derive-integer-type
@@ -1216,7 +1216,7 @@
 
 ) ; PROGN
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 (defun +-derive-type-aux (x y same-arg)
   (if (and (numeric-type-real-p x)
@@ -1356,7 +1356,7 @@
 ;;; and it's hard to avoid that calculation in here.
 #-(and cmu sb-xc-host)
 (progn
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (ash derive-type) ((n shift))
   ;; Large resulting bounds are easy to generate but are not
   ;; particularly useful, so an open outer bound is returned for a
@@ -1439,7 +1439,7 @@
 					     :complexp :real)))))))))
       *universal-type*))
 
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defun ash-derive-type-aux (n-type shift same-arg)
   (declare (ignore same-arg))
   (flet ((ash-outer (n s)
@@ -1472,12 +1472,12 @@
                                             (ash-outer n-high s-high))))))
 	*universal-type*)))
 
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (ash derive-type) ((n shift))
   (two-arg-derive-type n shift #'ash-derive-type-aux #'ash))
 ) ; PROGN
 
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (macrolet ((frob (fun)
 	     `#'(lambda (type type2)
 		  (declare (ignore type2))
@@ -1491,7 +1491,7 @@
   (defoptimizer (lognot derive-type) ((int))
     (derive-integer-type int int (frob lognot))))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (lognot derive-type) ((int))
   (derive-integer-type int int
 		       (lambda (type type2)
@@ -1503,7 +1503,7 @@
 				   (numeric-type-class type)
 				   (numeric-type-format type))))))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (%negate derive-type) ((num))
   (flet ((negate-bound (b)
            (and b
@@ -1517,7 +1517,7 @@
 			    :high (negate-bound (numeric-type-low type))))
 			 #'-)))
 
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (abs derive-type) ((num))
   (let ((type (continuation-type num)))
     (if (and (numeric-type-p type)
@@ -1537,7 +1537,7 @@
 				       nil)))
 	(numeric-contagion type type))))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defun abs-derive-type-aux (type)
   (cond ((eq (numeric-type-complexp type) :complex)
 	 ;; The absolute value of a complex number is always a
@@ -1566,11 +1566,11 @@
 	    :high (coerce-numeric-bound
 		   (interval-high abs-bnd) bound-type))))))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (abs derive-type) ((num))
   (one-arg-derive-type num #'abs-derive-type-aux #'abs))
 
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (truncate derive-type) ((number divisor))
   (let ((number-type (continuation-type number))
 	(divisor-type (continuation-type divisor))
@@ -1590,7 +1590,7 @@
 					      divisor-low divisor-high))))
 	*universal-type*)))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 (defun rem-result-type (number-type divisor-type)
@@ -2168,7 +2168,7 @@
 	     ;; anything about the result.
 	     `integer)))))
 
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defun integer-rem-derive-type
        (number-low number-high divisor-low divisor-high)
   (if (and divisor-low divisor-high)
@@ -2198,7 +2198,7 @@
 		     0
 		     '*))))
 
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (random derive-type) ((bound &optional state))
   (let ((type (continuation-type bound)))
     (when (numeric-type-p type)
@@ -2214,7 +2214,7 @@
 		     ((or (consp high) (zerop high)) high)
 		     (t `(,high))))))))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defun random-derive-type-aux (type)
   (let ((class (numeric-type-class type))
 	(high (numeric-type-high type))
@@ -2228,7 +2228,7 @@
 		     ((or (consp high) (zerop high)) high)
 		     (t `(,high))))))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defoptimizer (random derive-type) ((bound &optional state))
   (one-arg-derive-type bound #'random-derive-type-aux nil))
 
@@ -2247,7 +2247,7 @@
 		(or (null min) (minusp min))))
       (values nil t t)))
 
-#!-sb-propagate-fun-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 (defoptimizer (logand derive-type) ((x y))
@@ -2361,7 +2361,7 @@
 
 ) ; PROGN
 
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (progn
 
 (defun logand-derive-type-aux (x y &optional same-leaf)
@@ -3159,7 +3159,7 @@
 ;;;
 ;;; FIXME: Why should constant argument be second? It would be nice to
 ;;; find out and explain.
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defun ir1-transform-< (x y first second inverse)
   (if (same-leaf-ref-p x y)
       nil
@@ -3178,7 +3178,7 @@
 	       `(,inverse y x))
 	      (t
 	       (give-up-ir1-transform))))))
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (defun ir1-transform-< (x y first second inverse)
   (if (same-leaf-ref-p x y)
       nil
@@ -3200,11 +3200,11 @@
 (deftransform > ((x y) (integer integer) * :when :both)
   (ir1-transform-< y x x y '<))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (deftransform < ((x y) (float float) * :when :both)
   (ir1-transform-< x y x y '>))
 
-#!+sb-propagate-float-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
 (deftransform > ((x y) (float float) * :when :both)
   (ir1-transform-< y x x y '<))
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 0428aa6..0628816 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.22"
+"0.pre7.24"