X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=49e66bacae7f4aae461243bc7ee3a85655b98e2c;hb=54da325f13fb41669869aea688ae195426c0e231;hp=9ff1cb91cf60397db1761ffbdd5f14b6512d38f1;hpb=d8422b9967f465801891907396bcc5bfde0f3297;p=sbcl.git diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 9ff1cb9..49e66ba 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -251,37 +251,44 @@ ;;; "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 - ;; 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)) - - (defvar *raw-slot-data-list* +;; 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)) + ;; 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) + :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 @@ -295,31 +302,38 @@ ;; would really benefit is (UNSIGNED-BYTE ;; 32), but that is a subtype of FIXNUM, so ;; we store it unraw anyway. :-( -- DFL - :n-words 1) + :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)) + :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)) + :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)) + :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) + :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))))) + :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 @@ -527,10 +541,6 @@ ((not inherited) (stuff `(declaim (inline ,name ,@(unless (dsd-read-only slot) `((setf ,name)))))) - ;; FIXME: The arguments in the next two DEFUNs should - ;; be gensyms. (Otherwise e.g. if NEW-VALUE happened to - ;; be the name of a special variable, things could get - ;; weird.) (stuff `(defun ,name (structure) (declare (type ,ltype structure)) (the ,slot-type (elt structure ,index))))