Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/generic utils.lisp, 1.9, 1.10 vm-fndb.lisp, 1.38, 1.39 vm-tran.lisp, 1.71, 1.72
|
From: Nathan F. <nf...@us...> - 2007-01-27 03:45:57
|
Update of /cvsroot/sbcl/sbcl/src/compiler/generic In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv12188/src/compiler/generic Modified Files: utils.lisp vm-fndb.lisp vm-tran.lisp Log Message: 1.0.2.1: DATA-VECTOR-{REF,SET}-WITH-OFFSET for the x86 Compile calls of (AREF FOO (+ INDEX <constant>) more efficiently: ... turn DATA-VECTOR-{REF,SET} into DATA-VECTOR-{REF,SET}-WITH-OFFSET when the element type of FOO is at least 8 bits wide; ... introduce general mechanism for optimization of such calls; ... redo the x86 DATA-VECTOR-FOO VOPs, reducing the number of such VOPs in the process; ... do the same for BIGNUM-REF and SAP-REF-FOO. Upshot: 5-10% increase in performance on array-heavy code such as Ironclad; a 20% increase in performance has been observed on cellular automata codes. Some restrictions apply; see the KLUDGE in src/compiler/generic/vm-tran for an example. Index: utils.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/utils.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- utils.lisp 14 Jul 2005 18:35:36 -0000 1.9 +++ utils.lisp 27 Jan 2007 03:45:49 -0000 1.10 @@ -17,6 +17,16 @@ (if (fixnump num) (ash num (1- n-lowtag-bits)) (error "~W is too big for a fixnum." num))) + +;;; Determining whether a constant offset fits in an addressing mode. +#!+x86 +(defun foldable-constant-offset-p (element-size lowtag data-offset offset) + (if (< element-size n-byte-bits) + nil + (multiple-value-bind (min max) + (sb!impl::displacement-bounds lowtag element-size data-offset) + (<= min offset max)))) + ;;;; routines for dealing with static symbols Index: vm-fndb.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-fndb.lisp,v retrieving revision 1.38 retrieving revision 1.39 diff -u -d -r1.38 -r1.39 --- vm-fndb.lisp 5 Dec 2006 17:50:22 -0000 1.38 +++ vm-fndb.lisp 27 Jan 2007 03:45:49 -0000 1.39 @@ -284,10 +284,17 @@ (defknown %bignum-ref (bignum-type bignum-index) bignum-element-type (flushable)) +#!+x86 +(defknown %bignum-ref-with-offset (bignum-type bignum-index (signed-byte 24)) + bignum-element-type (flushable always-translatable)) (defknown %bignum-set (bignum-type bignum-index bignum-element-type) bignum-element-type (unsafe)) +#!+x86 +(defknown %bignum-set-with-offset + (bignum-type bignum-index (signed-byte 24) bignum-element-type) + bignum-element-type (unsafe always-translatable)) (defknown %digit-0-or-plusp (bignum-element-type) boolean (foldable flushable movable)) Index: vm-tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v retrieving revision 1.71 retrieving revision 1.72 diff -u -d -r1.71 -r1.72 --- vm-tran.lisp 13 Sep 2006 15:59:33 -0000 1.71 +++ vm-tran.lisp 27 Jan 2007 03:45:49 -0000 1.72 @@ -32,6 +32,48 @@ (deftransform abs ((x) (rational)) '(if (< x 0) (- x) x)) +;;; We don't want to clutter the bignum code. +#!+x86 +(define-source-transform sb!bignum:%bignum-ref (bignum index) + ;; KLUDGE: We use TRULY-THE here because even though the bignum code + ;; is (currently) compiled with (SAFETY 0), the compiler insists on + ;; inserting CAST nodes to ensure that INDEX is of the correct type. + ;; These CAST nodes do not generate any type checks, but they do + ;; interfere with the operation of FOLD-INDEX-ADDRESSING, below. + ;; This scenario is a problem for the more user-visible case of + ;; folding as well. --njf, 2006-12-01 + `(sb!bignum:%bignum-ref-with-offset ,bignum + (truly-the bignum-index ,index) 0)) + +#!+x86 +(defun fold-index-addressing (fun-name element-size lowtag data-offset + index offset &optional setter-p) + (multiple-value-bind (func index-args) (extract-fun-args index '(+ -) 2) + (destructuring-bind (x constant) index-args + (declare (ignorable x)) + (unless (constant-lvar-p constant) + (give-up-ir1-transform)) + (let ((value (lvar-value constant))) + (unless (and (integerp value) + (sb!vm::foldable-constant-offset-p + element-size lowtag data-offset + (funcall func value (lvar-value offset)))) + (give-up-ir1-transform "constant is too large for inlining")) + (splice-fun-args index func 2) + (format t "preparing to transform with ~A ~D~%" func value) + `(lambda (thing index off1 off2 ,@(when setter-p + '(value))) + (,fun-name thing index (,func off2 off1) ,@(when setter-p + '(value)))))))) + +#!+x86 +(deftransform sb!bignum:%bignum-ref-with-offset + ((bignum index offset) * * :node node) + (fold-index-addressing 'sb!bignum:%bignum-ref-with-offset + sb!vm:n-word-bits sb!vm:other-pointer-lowtag + sb!vm:bignum-digits-offset + index offset)) + ;;; The layout is stored in slot 0. (define-source-transform %instance-layout (x) `(truly-the layout (%instance-ref ,x 0))) @@ -57,10 +99,13 @@ ;; the other transform will kick in, so that's OK (give-up-ir1-transform) `(etypecase string - ((simple-array character (*)) (data-vector-ref string index)) + ((simple-array character (*)) + (data-vector-ref string index)) #!+sb-unicode - ((simple-array base-char (*)) (data-vector-ref string index)) - ((simple-array nil (*)) (data-vector-ref string index)))))) + ((simple-array base-char (*)) + (data-vector-ref string index)) + ((simple-array nil (*)) + (data-vector-ref string index)))))) (deftransform hairy-data-vector-ref ((array index) (array t) *) "avoid runtime dispatch on array element type" @@ -74,7 +119,7 @@ ;; WITH-ARRAY-DATA. Since WITH-ARRAY-DATA is implemented as a ;; macro, and macros aren't expanded in transform output, we have ;; to hand-expand it ourselves.) - (let ((element-type-specifier (type-specifier element-ctype))) + (let* ((element-type-specifier (type-specifier element-ctype))) `(multiple-value-bind (array index) (%data-vector-and-index array index) (declare (type (simple-array ,element-type-specifier 1) array)) @@ -86,8 +131,7 @@ ;;; Transform multi-dimensional array to one dimensional data vector ;;; access. -(deftransform data-vector-ref ((array index) - (simple-array t)) +(deftransform data-vector-ref ((array index) (simple-array t)) (let ((array-type (lvar-type array))) (unless (array-type-p array-type) (give-up-ir1-transform)) @@ -103,6 +147,42 @@ (%array-data-vector array)) index))))) +;;; Transform data vector access to a form that opens up optimization +;;; opportunities. +#!+x86 +(deftransform data-vector-ref ((array index) ((or simple-unboxed-array + simple-vector) + t)) + (let ((array-type (lvar-type array))) + (unless (array-type-p array-type) + (give-up-ir1-transform)) + (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) + (saetp (find element-type + sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-specifier :test #'equal))) + (unless (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) + (give-up-ir1-transform)) + `(data-vector-ref-with-offset array index 0)))) + +#!+x86 +(deftransform data-vector-ref-with-offset ((array index offset) + ((or simple-unboxed-array + simple-vector) + t t)) + (let ((array-type (lvar-type array))) + (unless (array-type-p array-type) + (give-up-ir1-transform)) + (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) + (saetp (find element-type + sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-specifier :test #'equal))) + (aver (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits)) + (fold-index-addressing 'data-vector-ref-with-offset + (sb!vm:saetp-n-bits saetp) + sb!vm:other-pointer-lowtag + sb!vm:vector-data-offset + index offset)))) + (deftransform hairy-data-vector-set ((string index new-value) (simple-string t t)) (let ((ctype (lvar-type string))) @@ -140,6 +220,8 @@ (the ,(type-specifier declared-element-ctype) new-value)))))))) +;;; Transform multi-dimensional array to one dimensional data vector +;;; access. (deftransform data-vector-set ((array index new-value) (simple-array t t)) (let ((array-type (lvar-type array))) @@ -158,6 +240,42 @@ index new-value))))) +;;; Transform data vector access to a form that opens up optimization +;;; opportunities. +#!+x86 +(deftransform data-vector-set ((array index new-value) + ((or simple-unboxed-array simple-vector) + t t)) + (let ((array-type (lvar-type array))) + (unless (array-type-p array-type) + (give-up-ir1-transform)) + (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) + (saetp (find element-type + sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-specifier :test #'equal))) + (unless (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) + (give-up-ir1-transform)) + `(data-vector-set-with-offset array index 0 new-value)))) + +#!+x86 +(deftransform data-vector-set-with-offset ((array index offset new-value) + ((or simple-unboxed-array + simple-vector) + t t t)) + (let ((array-type (lvar-type array))) + (unless (array-type-p array-type) + (give-up-ir1-transform)) + (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) + (saetp (find element-type + sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-specifier :test #'equal))) + (aver (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits)) + (fold-index-addressing 'data-vector-set-with-offset + (sb!vm:saetp-n-bits saetp) + sb!vm:other-pointer-lowtag + sb!vm:vector-data-offset + index offset t)))) + (defoptimizer (%data-vector-and-index derive-type) ((array index)) (let ((atype (lvar-type array))) (when (array-type-p atype) |