X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=5591619dfad5d24c6e28b8aa0590000567fb5a1e;hb=4c7c37bcc5232db4e3be0ea41ec92f6561ace17a;hp=a2ee93a0a18cae810066818257ea0241c929ca22;hpb=498ec57f1f860fb09c998b7a413dbeaf9c0304e8;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index a2ee93a..5591619 100644
--- 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