From: Nikodemus Siivola Date: Mon, 5 Dec 2011 09:06:40 +0000 (+0200) Subject: use boxed constants for full calls X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=741d910ca6f69a115905872ea84258baba5392c7;p=sbcl.git use boxed constants for full calls If a constant is being used in a full call, use a boxed representation instead of an inline one which must then be boxed at runtime. Also arrange to have both an immediate unboxed and a boxed representation when advantageous. (There might be other cases besides full calls where we should prefer boxed representations, but that's for later.) --- diff --git a/NEWS b/NEWS index 25969ee..7a79191 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,8 @@ changes relative to sbcl-1.0.54: ** --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 diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 4254f3d..dae68f9 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -194,7 +194,7 @@ ,@(nreverse clauses))))) (frob))) (tnify (index) - (constant-tn (find-constant index)))) + (emit-constant index))) (let ((setter (compute-setter)) (length (length initial-contents))) (dotimes (i length) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 4a35b47..4386573 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -91,29 +91,41 @@ ;;; 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) @@ -141,7 +153,7 @@ (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 @@ -378,7 +390,7 @@ (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))))) @@ -1491,7 +1503,7 @@ 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))) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 84bfea7..6d1d03c 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -706,12 +706,14 @@ Examples: (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)) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 69bc295..852199e 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -676,7 +676,9 @@ (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) diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index 2fbfe46..cd2525a 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -199,20 +199,34 @@ ;;; 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*)) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 2388091..a7118fb 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4113,3 +4113,10 @@ 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)))))