Optimize EQUALP on structures with raw slots.

Add a comparer slot to raw-slot-data, which is defined as
(lambda (index x y)
  (= (%raw-instance-ref/double x index)
     (%raw-instance-ref/double y index)))

Which is both faster than calling %raw-instance-ref/double out of
line and does not cons.

diff --git a/NEWS b/NEWS
index a53c8e1..9510e5b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,8 @@ changes relative to sbcl-1.1.13:
   * optimization: complicated TYPEP tests are less opaque to the type
     propagation pass. (lp#1229340)
   * optimization: [N]BUTLAST perform a single pass over the list. (lp#1245697)
+  * optimization: EQUALP on structures with raw slots (double-float/complex)
+    no longer conses and is faster.
   * enhancement: Top-level defmethod without defgeneric no longer causes
     undefined-function warnings in subsequent forms. (lp#503095)
   * bug fix: EQUALP now compares correctly structures with raw slots larger

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index a2ee93a..5591619 100644 (file)
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -254,7 +254,9 @@
 (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
+  (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
@@ -269,57 +271,70 @@
     ;; 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))
+    (alignment 1 :type (integer 1 2) :read-only t)
+    (comparer (missing-arg) :type function :read-only t))
 
   (defvar *raw-slot-data-list*
-    (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)
-       (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)
-       (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))
-       (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))
-       (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))
-       #!+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)
-       #!+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)))))
+    (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)))))))
+
 (defun raw-slot-words (type)
   (let ((rsd (find type *raw-slot-data-list* :key #'raw-slot-data-raw-type)))
     (if rsd

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 23de7d4..2295453 100644 (file)
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -401,16 +401,13 @@
                     (find raw-type
                           *raw-slot-data-list*
                           :key 'raw-slot-data-raw-type))
-        for accessor = (when rsd
-                         (raw-slot-data-accessor-name rsd))
-        always (or (not accessor)
+        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
-                         (equalp (funcall accessor x i)
-                                 (funcall accessor y i))
+                         (funcall (raw-slot-data-comparer rsd) i x y)
                        (incf i (raw-slot-data-n-words rsd)))))))
 \f
 ;;; default PRINT-OBJECT method