mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
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.
This commit is contained in:
Stas Boukarev
parent
498ec57f1f
commit
4c7c37bcc5
2
NEWS
2
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
||||
;;; default PRINT-OBJECT method
|
||||
|
|
|
|||
Loading…
Reference in a new issue