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.

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 5591619..49e66ba 100644 (file)
--- 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 (file)
--- 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))))
 \f
 ;;; default PRINT-OBJECT method
 

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 51cf1dd..2ae1e33 100644 (file)
--- 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))