From 4c7c37bcc5232db4e3be0ea41ec92f6561ace17a Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Tue, 5 Nov 2013 02:52:37 +0400 Subject: [PATCH] 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. --- NEWS | 2 + src/code/defstruct.lisp | 115 +++++++++++++++++++++++----------------- src/code/target-defstruct.lisp | 7 +-- 3 files changed, 69 insertions(+), 55 deletions(-) diff --git a/NEWS b/NEWS index a53c8e1..9510e5b 100644 --- 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 --- 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 --- 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))))))) ;;; default PRINT-OBJECT method -- 1.7.10.4