X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=a4fb8fd9ba06b177849f85a7e6dad06d40edf02a;hb=2529c316d05494f2bcdeccf98c3a6298ecd08d7d;hp=86efb42b77e26ececea35f1d3174932563f004d5;hpb=6fa968aaa8051da23cc3153a1c0e67addbea85f6;p=sbcl.git diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 86efb42..a4fb8fd 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -33,7 +33,7 @@ '(if (< x 0) (- x) x)) ;;; We don't want to clutter the bignum code. -#!+x86 +#!+(or x86 x86-64) (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 @@ -45,7 +45,7 @@ `(sb!bignum:%bignum-ref-with-offset ,bignum (truly-the bignum-index ,index) 0)) -#!+x86 +#!+(or x86 x86-64) (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) @@ -65,7 +65,7 @@ (,fun-name thing index (,func off2 off1) ,@(when setter-p '(value)))))))) -#!+x86 +#!+(or x86 x86-64) (deftransform sb!bignum:%bignum-ref-with-offset ((bignum index offset) * * :node node) (fold-index-addressing 'sb!bignum:%bignum-ref-with-offset @@ -73,6 +73,31 @@ sb!vm:bignum-digits-offset index offset)) +#!+x86 +(progn +(define-source-transform sb!kernel:%vector-raw-bits (thing index) + `(sb!kernel:%raw-bits-with-offset ,thing ,index 2)) + +(define-source-transform sb!kernel:%raw-bits (thing index) + `(sb!kernel:%raw-bits-with-offset ,thing ,index 0)) + +(define-source-transform sb!kernel:%set-vector-raw-bits (thing index value) + `(sb!kernel:%set-raw-bits-with-offset ,thing ,index 2 ,value)) + +(define-source-transform sb!kernel:%set-raw-bits (thing index value) + `(sb!kernel:%set-raw-bits-with-offset ,thing ,index 0 ,value)) + +(deftransform sb!kernel:%raw-bits-with-offset ((thing index offset) * * :node node) + (fold-index-addressing 'sb!kernel:%raw-bits-with-offset + sb!vm:n-word-bits sb!vm:other-pointer-lowtag + 0 index offset)) + +(deftransform sb!kernel:%set-raw-bits-with-offset ((thing index offset value) * *) + (fold-index-addressing 'sb!kernel:%set-raw-bits-with-offset + sb!vm:n-word-bits sb!vm:other-pointer-lowtag + 0 index offset t)) +) ; PROGN + ;;; The layout is stored in slot 0. (define-source-transform %instance-layout (x) `(truly-the layout (%instance-ref ,x 0))) @@ -147,35 +172,26 @@ 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)) +;;; opportunities. On platforms that support DATA-VECTOR-REF-WITH-OFFSET +;;; DATA-VECTOR-REF is not supported at all. +#!+(or x86 x86-64) +(define-source-transform data-vector-ref (array index) + `(data-vector-ref-with-offset ,array ,index 0)) + +#!+(or x86 x86-64) +(deftransform data-vector-ref-with-offset ((array index offset)) (let ((array-type (lvar-type array))) - (unless (array-type-p array-type) + (when (or (not (array-type-p array-type)) + (eql (array-type-specialized-element-type array-type) + *wild-type*)) (give-up-ir1-transform)) + ;; It shouldn't be possible to get here with anything but a non-complex + ;; vector. + (aver (not (array-type-complexp array-type))) (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) + (saetp (find-saetp element-type))) + (when (< (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 @@ -241,34 +257,24 @@ ;;; 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)))) +#!+(or x86 x86-64) +(define-source-transform data-vector-set (array index new-value) + `(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)) +#!+(or x86 x86-64) +(deftransform data-vector-set-with-offset ((array index offset new-value)) (let ((array-type (lvar-type array))) - (unless (array-type-p array-type) + (when (or (not (array-type-p array-type)) + (eql (array-type-specialized-element-type array-type) + *wild-type*)) + ;; We don't yet know the exact element type, but will get that + ;; knowledge after some more type propagation. (give-up-ir1-transform)) + (aver (not (array-type-complexp array-type))) (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)) + (saetp (find-saetp element-type))) + (when (< (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) + (give-up-ir1-transform)) (fold-index-addressing 'data-vector-set-with-offset (sb!vm:saetp-n-bits saetp) sb!vm:other-pointer-lowtag @@ -593,7 +599,7 @@ ;; declare it in the DEFKNOWN too.) ((simple-unboxed-array (*)) (vector-sap thing))))) (declare (inline sapify)) - (without-gcing + (with-pinned-objects (dst src) (memmove (sap+ (sapify dst) dst-start) (sap+ (sapify src) src-start) (- dst-end dst-start)))