From 151fa3c5d85e3fd4621f65ee9676822a73ffbb57 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Tue, 5 Nov 2013 19:56:00 +0400 Subject: [PATCH] Optimize raw-instance-slots-equalp for #-complex-float-vops. The comparer function for COMPLEX types wasn't properly optimized during cross-compilation because the types of REALPART and IMAGPART weren't derived by the cross-compiler on account of CROSS-FLOAT-INFINITY-KLUDGE, but the derivers do not actually perform any mathematical derivation, just (complex (double-float 10d0)) => (double-float 10d0). Enabling them during cross-compilation allows = on complex floats be optimized and avoids consing. --- src/code/defstruct.lisp | 165 ++++++++++++++++++++-------------------- src/code/target-defstruct.lisp | 13 +--- src/compiler/float-tran.lisp | 5 +- 3 files changed, 88 insertions(+), 95 deletions(-) diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 5591619..49e66ba 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -251,89 +251,88 @@ ;;; "A lie can travel halfway round the world while the truth is ;;; putting on its shoes." -- Mark Twain -(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) - - ;; information about how a slot of a given DSD-RAW-TYPE is to be accessed - (defstruct (raw-slot-data - (:copier nil) - (:predicate nil)) - ;; the raw slot type, or T for a non-raw slot - ;; - ;; (Non-raw slots are in the ordinary place you'd expect, directly - ;; indexed off the instance pointer. Raw slots are indexed from the end - ;; of the instance and skipped by GC.) - (raw-type (missing-arg) :type (or symbol cons) :read-only t) - ;; What operator is used to access a slot of this type? - (accessor-name (missing-arg) :type symbol :read-only t) - (init-vop (missing-arg) :type symbol :read-only t) - ;; How many words are each value of this type? - (n-words (missing-arg) :type (and index (integer 1)) :read-only t) - ;; Necessary alignment in units of words. Note that instances - ;; themselves are aligned by exactly two words, so specifying more - ;; than two words here would not work. - (alignment 1 :type (integer 1 2) :read-only t) - (comparer (missing-arg) :type function :read-only t)) - - (defvar *raw-slot-data-list* - (macrolet ((make-comparer (accessor-name) - `(lambda (index x y) - (= (,accessor-name x index) - (,accessor-name y index))))) - (let ((double-float-alignment - ;; white list of architectures that can load unaligned doubles: - #!+(or x86 x86-64 ppc) 1 - ;; at least sparc, mips and alpha can't: - #!-(or x86 x86-64 ppc) 2)) - (list - (make-raw-slot-data :raw-type 'sb!vm:word - :accessor-name '%raw-instance-ref/word - :init-vop 'sb!vm::raw-instance-init/word - :n-words 1 - :comparer (make-comparer %raw-instance-ref/word)) - (make-raw-slot-data :raw-type 'single-float - :accessor-name '%raw-instance-ref/single - :init-vop 'sb!vm::raw-instance-init/single - ;; KLUDGE: On 64 bit architectures, we - ;; could pack two SINGLE-FLOATs into the - ;; same word if raw slots were indexed - ;; using bytes instead of words. However, - ;; I don't personally find optimizing - ;; SINGLE-FLOAT memory usage worthwile - ;; enough. And the other datatype that - ;; would really benefit is (UNSIGNED-BYTE - ;; 32), but that is a subtype of FIXNUM, so - ;; we store it unraw anyway. :-( -- DFL - :n-words 1 - :comparer (make-comparer %raw-instance-ref/single)) - (make-raw-slot-data :raw-type 'double-float - :accessor-name '%raw-instance-ref/double - :init-vop 'sb!vm::raw-instance-init/double - :alignment double-float-alignment - :n-words (/ 8 sb!vm:n-word-bytes) - :comparer (make-comparer %raw-instance-ref/double)) - (make-raw-slot-data :raw-type 'complex-single-float - :accessor-name '%raw-instance-ref/complex-single - :init-vop 'sb!vm::raw-instance-init/complex-single - :n-words (/ 8 sb!vm:n-word-bytes) - :comparer (make-comparer %raw-instance-ref/complex-single)) - (make-raw-slot-data :raw-type 'complex-double-float - :accessor-name '%raw-instance-ref/complex-double - :init-vop 'sb!vm::raw-instance-init/complex-double - :alignment double-float-alignment - :n-words (/ 16 sb!vm:n-word-bytes) - :comparer (make-comparer %raw-instance-ref/complex-double)) - #!+long-float - (make-raw-slot-data :raw-type long-float - :accessor-name '%raw-instance-ref/long - :init-vop 'sb!vm::raw-instance-init/long - :n-words #!+x86 3 #!+sparc 4 - :comparer (make-comparer %raw-instance-ref/long)) - #!+long-float - (make-raw-slot-data :raw-type complex-long-float - :accessor-name '%raw-instance-ref/complex-long - :init-vop 'sb!vm::raw-instance-init/complex-long - :n-words #!+x86 6 #!+sparc 8 - :comparer (make-comparer %raw-instance-ref/complex-long))))))) +;; information about how a slot of a given DSD-RAW-TYPE is to be accessed +(defstruct (raw-slot-data + (:copier nil) + (:predicate nil)) + ;; the raw slot type, or T for a non-raw slot + ;; + ;; (Non-raw slots are in the ordinary place you'd expect, directly + ;; indexed off the instance pointer. Raw slots are indexed from the end + ;; of the instance and skipped by GC.) + (raw-type (missing-arg) :type (or symbol cons) :read-only t) + ;; What operator is used to access a slot of this type? + (accessor-name (missing-arg) :type symbol :read-only t) + (init-vop (missing-arg) :type symbol :read-only t) + ;; How many words are each value of this type? + (n-words (missing-arg) :type (and index (integer 1)) :read-only t) + ;; Necessary alignment in units of words. Note that instances + ;; themselves are aligned by exactly two words, so specifying more + ;; than two words here would not work. + (alignment 1 :type (integer 1 2) :read-only t) + (comparer (missing-arg) :type function :read-only t)) + +(defvar *raw-slot-data-list* + (macrolet ((make-comparer (accessor-name) + `(lambda (index x y) + (declare (optimize speed (safety 0))) + (= (,accessor-name x index) + (,accessor-name y index))))) + (let ((double-float-alignment + ;; white list of architectures that can load unaligned doubles: + #!+(or x86 x86-64 ppc) 1 + ;; at least sparc, mips and alpha can't: + #!-(or x86 x86-64 ppc) 2)) + (list + (make-raw-slot-data :raw-type 'sb!vm:word + :accessor-name '%raw-instance-ref/word + :init-vop 'sb!vm::raw-instance-init/word + :n-words 1 + :comparer (make-comparer %raw-instance-ref/word)) + (make-raw-slot-data :raw-type 'single-float + :accessor-name '%raw-instance-ref/single + :init-vop 'sb!vm::raw-instance-init/single + ;; KLUDGE: On 64 bit architectures, we + ;; could pack two SINGLE-FLOATs into the + ;; same word if raw slots were indexed + ;; using bytes instead of words. However, + ;; I don't personally find optimizing + ;; SINGLE-FLOAT memory usage worthwile + ;; enough. And the other datatype that + ;; would really benefit is (UNSIGNED-BYTE + ;; 32), but that is a subtype of FIXNUM, so + ;; we store it unraw anyway. :-( -- DFL + :n-words 1 + :comparer (make-comparer %raw-instance-ref/single)) + (make-raw-slot-data :raw-type 'double-float + :accessor-name '%raw-instance-ref/double + :init-vop 'sb!vm::raw-instance-init/double + :alignment double-float-alignment + :n-words (/ 8 sb!vm:n-word-bytes) + :comparer (make-comparer %raw-instance-ref/double)) + (make-raw-slot-data :raw-type 'complex-single-float + :accessor-name '%raw-instance-ref/complex-single + :init-vop 'sb!vm::raw-instance-init/complex-single + :n-words (/ 8 sb!vm:n-word-bytes) + :comparer (make-comparer %raw-instance-ref/complex-single)) + (make-raw-slot-data :raw-type 'complex-double-float + :accessor-name '%raw-instance-ref/complex-double + :init-vop 'sb!vm::raw-instance-init/complex-double + :alignment double-float-alignment + :n-words (/ 16 sb!vm:n-word-bytes) + :comparer (make-comparer %raw-instance-ref/complex-double)) + #!+long-float + (make-raw-slot-data :raw-type long-float + :accessor-name '%raw-instance-ref/long + :init-vop 'sb!vm::raw-instance-init/long + :n-words #!+x86 3 #!+sparc 4 + :comparer (make-comparer %raw-instance-ref/long)) + #!+long-float + (make-raw-slot-data :raw-type complex-long-float + :accessor-name '%raw-instance-ref/complex-long + :init-vop 'sb!vm::raw-instance-init/complex-long + :n-words #!+x86 6 #!+sparc 8 + :comparer (make-comparer %raw-instance-ref/complex-long)))))) (defun raw-slot-words (type) (let ((rsd (find type *raw-slot-data-list* :key #'raw-slot-data-raw-type))) diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 2295453..0e5742f 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -394,21 +394,14 @@ ;; all this with %RAW-INSTANCE-REF/WORD and bitwise comparisons, but ;; that'll fail in some cases. For example -0.0 and 0.0 are EQUALP ;; but have different bit patterns. -- JES, 2007-08-21 - (loop with i = 0 - for dsd in (dd-slots (layout-info layout)) + (loop for dsd in (dd-slots (layout-info layout)) for raw-type = (dsd-raw-type dsd) - for rsd = (when raw-type + for rsd = (unless (eql raw-type t) (find raw-type *raw-slot-data-list* :key 'raw-slot-data-raw-type)) always (or (not rsd) - (progn - #!-(or x86 x86-64 ppc) - (setf i (logandc2 (+ i (1- (raw-slot-data-alignment rsd))) - (1- (raw-slot-data-alignment rsd)))) - (prog1 - (funcall (raw-slot-data-comparer rsd) i x y) - (incf i (raw-slot-data-n-words rsd))))))) + (funcall (raw-slot-data-comparer rsd) (dsd-index dsd) x y)))) ;;; default PRINT-OBJECT method diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 51cf1dd..2ae1e33 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -1229,9 +1229,10 @@ :complexp :real :low (numeric-type-low type) :high (numeric-type-high 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) (let ((class (numeric-type-class type)) (format (numeric-type-format type))) @@ -1253,7 +1254,7 @@ :complexp :real :low (numeric-type-low type) :high (numeric-type-high type)))))) -#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.) + (defoptimizer (imagpart derive-type) ((num)) (one-arg-derive-type num #'imagpart-derive-type-aux #'imagpart)) -- 1.7.10.4