(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
;; 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.
;;; 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)
'(%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)
;;; 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))
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)))
(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)))
(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
: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)
: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))
: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)
;;; 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))
(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))
(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))
: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))
`(,',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)))
;;;; 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.
: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
) ; PROGN
\f
-#!-sb-propagate-float-type
+#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defoptimizer (+ derive-type) ((x y))
(derive-integer-type
) ; 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)
;;; 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
: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)
(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))
(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)
(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
: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)
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
: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))
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)
;; 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)
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)
((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))
((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))
\f
(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))
) ; PROGN
-#!+sb-propagate-fun-type
+#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
(progn
(defun logand-derive-type-aux (x y &optional same-leaf)
;;;
;;; 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
`(,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
(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 '<))
\f
;;; 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"
projects / sbcl.git / commitdiff