** --arch option can be used to specify the architecture to build for.
(Mainly useful for building 32-bit SBCL's on x86-64 hosts, not
full-blows cross-compilation.)
+ * optimization: the compiler is smarter about representation selection for
+ floating point constants used in full calls.
* bug fix: deadlock detection could report the same deadlock twice, for
two different threads. Now a single deadlock is reported exactly once.
* bug fix: interval-arithmetic division during type derivation did not
,@(nreverse clauses)))))
(frob)))
(tnify (index)
- (constant-tn (find-constant index))))
+ (emit-constant index)))
(let ((setter (compute-setter))
(length (length initial-contents)))
(dotimes (i length)
;;; If LEAF already has a constant TN, return that, otherwise make a
;;; TN for it.
-(defun constant-tn (leaf)
+(defun constant-tn (leaf boxedp)
(declare (type constant leaf))
- (or (leaf-info leaf)
- (setf (leaf-info leaf)
- (make-constant-tn leaf))))
+ ;; When convenient we can have both a boxed and unboxed TN for
+ ;; constant.
+ (if boxedp
+ (or (constant-boxed-tn leaf)
+ (setf (constant-boxed-tn leaf) (make-constant-tn leaf t)))
+ (or (leaf-info leaf)
+ (setf (leaf-info leaf) (make-constant-tn leaf nil)))))
;;; Return a TN that represents the value of LEAF, or NIL if LEAF
;;; isn't directly represented by a TN. ENV is the environment that
;;; the reference is done in.
-(defun leaf-tn (leaf env)
+(defun leaf-tn (leaf env boxedp)
(declare (type leaf leaf) (type physenv env))
(typecase leaf
(lambda-var
(unless (lambda-var-indirect leaf)
(find-in-physenv leaf env)))
- (constant (constant-tn leaf))
+ (constant (constant-tn leaf boxedp))
(t nil)))
;;; This is used to conveniently get a handle on a constant TN during
;;; IR2 conversion. It returns a constant TN representing the Lisp
;;; object VALUE.
(defun emit-constant (value)
- (constant-tn (find-constant value)))
+ (constant-tn (find-constant value) t))
+
+(defun boxed-ref-p (ref)
+ (let ((dest (lvar-dest (ref-lvar ref))))
+ (cond ((and (basic-combination-p dest) (eq :full (basic-combination-kind dest)))
+ t)
+ ;; Other cases?
+ (t
+ nil))))
;;; Convert a REF node. The reference must not be delayed.
(defun ir2-convert-ref (node block)
(vop ancestor-frame-ref node block tn (leaf-info leaf) res))))
(t (emit-move node block tn res)))))
(constant
- (emit-move node block (constant-tn leaf) res))
+ (emit-move node block (constant-tn leaf (boxed-ref-p node)) res))
(functional
(ir2-convert-closure node block leaf res))
(global-var
(ecase (ir2-lvar-kind 2lvar)
(:delayed
(let ((ref (lvar-uses lvar)))
- (leaf-tn (ref-leaf ref) (node-physenv ref))))
+ (leaf-tn (ref-leaf ref) (node-physenv ref) (boxed-ref-p ref))))
(:fixed
(aver (= (length (ir2-lvar-locs 2lvar)) 1))
(first (ir2-lvar-locs 2lvar)))))
for idx upfrom 0
do (vop sb!vm::more-arg node block
(lvar-tn node block context)
- (make-constant-tn (find-constant idx))
+ (emit-constant idx)
loc)))
(:unknown
(let ((locs (ir2-lvar-locs 2lvar)))
(defun clear-constant-info ()
(maphash (lambda (k v)
(declare (ignore k))
- (setf (leaf-info v) nil))
+ (setf (leaf-info v) nil)
+ (setf (constant-boxed-tn v) nil))
*constants*)
(maphash (lambda (k v)
(declare (ignore k))
(when (constant-p v)
- (setf (leaf-info v) nil)))
+ (setf (leaf-info v) nil)
+ (setf (constant-boxed-tn v) nil)))
*free-vars*)
(values))
(where-from :defined)))
(:include leaf))
;; the value of the constant
- (value (missing-arg) :type t))
+ (value (missing-arg) :type t)
+ ;; Boxed TN for this constant, if any.
+ (boxed-tn nil :type (or null tn)))
(defprinter (constant :identity t)
value)
;;; Create a constant TN. The implementation dependent
;;; IMMEDIATE-CONSTANT-SC function is used to determine whether the
;;; constant has an immediate representation.
-(defun make-constant-tn (constant)
+(defun make-constant-tn (constant boxedp)
(declare (type constant constant))
- (let* ((component (component-info *component-being-compiled*))
- (immed (immediate-constant-sc (constant-value constant)))
- (sc (svref *backend-sc-numbers*
- (or immed (sc-number-or-lose 'constant))))
- (res (make-tn 0 :constant (primitive-type (leaf-type constant)) sc)))
- (unless immed
- (let ((constants (ir2-component-constants component)))
- (setf (tn-offset res) (fill-pointer constants))
- (vector-push-extend constant constants)))
- (push-in tn-next res (ir2-component-constant-tns component))
- (setf (tn-leaf res) constant)
- res))
+ (let* ((immed (immediate-constant-sc (constant-value constant)))
+ (use-immed-p (and immed
+ (or (not boxedp)
+ (eql immed (sc-number-or-lose 'sb!vm::immediate))))))
+ (cond
+ ;; CONSTANT-TN uses two caches, one for boxed and one for unboxed uses.
+ ;;
+ ;; However, in the case of USE-IMMED-P we can have the same TN for both
+ ;; uses. The first two legs here take care of that by cross-pollinating the
+ ;; cached values.
+ ((and use-immed-p boxedp (leaf-info constant)))
+ ((and use-immed-p (not boxedp) (constant-boxed-tn constant)))
+ (t
+ (let* ((component (component-info *component-being-compiled*))
+ (sc (svref *backend-sc-numbers*
+ (if use-immed-p
+ immed
+ (sc-number-or-lose 'constant))))
+ (res (make-tn 0 :constant (primitive-type (leaf-type constant)) sc)))
+ (unless use-immed-p
+ (let ((constants (ir2-component-constants component)))
+ (setf (tn-offset res) (fill-pointer constants))
+ (vector-push-extend constant constants)))
+ (push-in tn-next res (ir2-component-constant-tns component))
+ (setf (tn-leaf res) constant)
+ res)))))
(defun make-load-time-value-tn (handle type)
(let* ((component (component-info *component-being-compiled*))
2d0)))
(assert (eql 2 q))
(assert (eql 0d0 r))))
+
+(with-test (:name :boxed-fp-constant-for-full-call)
+ (let ((fun (compile nil
+ `(lambda (x)
+ (declare (double-float x))
+ (unknown-fun 1.0d0 (+ 1.0d0 x))))))
+ (assert (equal '(1.0d0) (ctu:find-code-constants fun :type 'double-float)))))
projects / sbcl.git / commitdiff