From 08917ec0d00a781a1089922a5419b7f136cdf08f Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Fri, 8 May 2009 03:00:25 +0000 Subject: [PATCH] 1.0.28.28: delete %RAW-BITS and %SET-RAW-BITS %VECTOR-RAW-BITS and %SET-VECTOR-RAW-BITS are exactly the same functionality without the weird dancing with SB!VM:VECTOR-DATA-OFFSET. --- src/code/defsetfs.lisp | 2 - src/code/kernel.lisp | 9 --- src/code/sxhash.lisp | 9 ++- src/code/target-sxhash.lisp | 2 +- src/compiler/alpha/array.lisp | 4 -- src/compiler/generic/vm-fndb.lisp | 15 ----- src/compiler/generic/vm-tran.lisp | 124 ++++++++++++++----------------------- src/compiler/hppa/array.lisp | 4 -- src/compiler/mips/array.lisp | 4 -- src/compiler/ppc/array.lisp | 18 ------ src/compiler/sparc/array.lisp | 18 ------ src/compiler/x86-64/array.lisp | 4 -- src/compiler/x86/array.lisp | 8 +-- version.lisp-expr | 2 +- 14 files changed, 57 insertions(+), 166 deletions(-) diff --git a/src/code/defsetfs.lisp b/src/code/defsetfs.lisp index e066eca..dbd6db4 100644 --- a/src/code/defsetfs.lisp +++ b/src/code/defsetfs.lisp @@ -105,7 +105,6 @@ #-sb-xc-host (defsetf schar %scharset) #-sb-xc-host (defsetf sbit %sbitset) (defsetf %array-dimension %set-array-dimension) -(defsetf sb!kernel:%raw-bits sb!kernel:%set-raw-bits) (defsetf sb!kernel:%vector-raw-bits sb!kernel:%set-vector-raw-bits) #-sb-xc-host (defsetf symbol-value set) #-sb-xc-host (defsetf symbol-plist %set-symbol-plist) @@ -136,7 +135,6 @@ ;;; from kernel.lisp (in-package "SB!KERNEL") (defsetf code-header-ref code-header-set) -(defsetf %raw-bits %set-raw-bits) ;;; from serve-event.lisp (in-package "SB!IMPL") diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp index 70ca1b7..ad5d815 100644 --- a/src/code/kernel.lisp +++ b/src/code/kernel.lisp @@ -129,15 +129,6 @@ (defun code-header-set (code-obj index new) (code-header-set code-obj index new)) -(defun %raw-bits (object offset) - (declare (type index offset)) - (sb!kernel:%raw-bits object offset)) - -(defun %set-raw-bits (object offset value) - (declare (type index offset)) - (declare (type sb!vm:word value)) - (setf (sb!kernel:%raw-bits object offset) value)) - (defun %vector-raw-bits (object offset) (declare (type index offset)) (sb!kernel:%vector-raw-bits object offset)) diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp index dde2e15..abe8199 100644 --- a/src/code/sxhash.lisp +++ b/src/code/sxhash.lisp @@ -53,11 +53,10 @@ ((= length 0) (mix result (sxhash 0))) (t (mixf result (sxhash (length x))) - (do* ((i sb!vm:vector-data-offset (+ i 1)) + (do* ((i 0 (+ i 1)) ;; FIXME: should we respect DEPTHOID? SXHASH on ;; strings doesn't seem to... - (end-1 (+ sb!vm:vector-data-offset - (floor (1- length) sb!vm:n-word-bits)))) + (end-1 (floor (1- length) sb!vm:n-word-bits))) ((= i end-1) (let ((num (logand @@ -67,14 +66,14 @@ (:big-endian '(- sb!vm:n-word-bits (mod length sb!vm:n-word-bits))))) - (%raw-bits x i)))) + (%vector-raw-bits x i)))) (mix result ,(ecase sb!c:*backend-byte-order* (:little-endian '(logand num most-positive-fixnum)) (:big-endian '(ash num (- sb!vm:n-lowtag-bits))))))) (declare (type index i end-1)) - (let ((num (%raw-bits x i))) + (let ((num (%vector-raw-bits x i))) (mixf result ,(ecase sb!c:*backend-byte-order* (:little-endian '(logand num most-positive-fixnum)) diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index a3e09b4..943ed0c 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -200,7 +200,7 @@ ;; than this. The problem is that a non-SIMPLE ;; BIT-VECTOR could be displaced to another, with a ;; non-zero offset -- so that significantly more - ;; work needs to be done using the %RAW-BITS + ;; work needs to be done using the %VECTOR-RAW-BITS ;; approach. This will probably do for now. (sxhash-recurse (copy-seq x) depthoid)) (t (logxor 191020317 (sxhash (array-rank x)))))) diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index 936e3e5..07a8622 100644 --- a/src/compiler/alpha/array.lisp +++ b/src/compiler/alpha/array.lisp @@ -528,10 +528,6 @@ ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. ;;; -(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num - %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %set-raw-bits) (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag (unsigned-reg) unsigned-num %vector-raw-bits) (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 6cc6353..5be6630 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -157,21 +157,6 @@ (defknown %raw-instance-atomic-incf/word (instance index sb!vm:signed-word) sb!vm:word (unsafe always-translatable)) -;;; %RAW-{REF,SET}-FOO VOPs should be declared as taking a RAW-VECTOR -;;; as their first argument (clarity and to match these DEFKNOWNs). -;;; We declare RAW-VECTOR as a primitive type so the VOP machinery -;;; will accept our VOPs as legitimate. --njf, 2004-08-10 - -(defknown %raw-bits (t fixnum) sb!vm:word - (foldable flushable)) -#!+x86 -(defknown %raw-bits-with-offset (t fixnum fixnum) sb!vm:word - (flushable always-translatable)) -(defknown (%set-raw-bits) (t fixnum sb!vm:word) sb!vm:word - (unsafe)) -#!+x86 -(defknown (%set-raw-bits-with-offset) (t fixnum fixnum sb!vm:word) sb!vm:word - (unsafe always-translatable)) ;;; These two are mostly used for bit-bashing operations. (defknown %vector-raw-bits (t fixnum) sb!vm:word (flushable)) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 26d7855..3aef253 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -73,31 +73,6 @@ 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))) @@ -332,7 +307,7 @@ (:little-endian '(byte ,bits (* bit ,bits))) (:big-endian '(byte ,bits (- sb!vm:n-word-bits (* (1+ bit) ,bits))))) - (%raw-bits vector (+ word sb!vm:vector-data-offset))))) + (%vector-raw-bits vector word)))) (deftransform data-vector-set ((vector index new-value) (,type * *)) `(multiple-value-bind (word bit) @@ -342,7 +317,7 @@ (:big-endian '(byte ,bits (- sb!vm:n-word-bits (* (1+ bit) ,bits))))) - (%raw-bits vector (+ word sb!vm:vector-data-offset))) + (%vector-raw-bits vector word)) new-value))))))) (frob simple-bit-vector 1) (frob (simple-array (unsigned-byte 2) (*)) 2) @@ -380,24 +355,23 @@ ;; are handled by the (1- length), below. ;; CSR, 2002-04-24 result-bit-array - (do ((index sb!vm:vector-data-offset (1+ index)) - (end-1 (+ sb!vm:vector-data-offset - ;; bit-vectors of length 1-32 - ;; need precisely one (SETF - ;; %RAW-BITS), done here in the - ;; epilogue. - CSR, 2002-04-24 - (truncate (truly-the index (1- length)) - sb!vm:n-word-bits)))) + (do ((index 0 (1+ index)) + ;; bit-vectors of length 1-32 need + ;; precisely one (SETF %VECTOR-RAW-BITS), + ;; done here in the epilogue. - CSR, + ;; 2002-04-24 + (end-1 (truncate (truly-the index (1- length)) + sb!vm:n-word-bits))) ((>= index end-1) - (setf (%raw-bits result-bit-array index) - (,',wordfun (%raw-bits bit-array-1 index) - (%raw-bits bit-array-2 index))) + (setf (%vector-raw-bits result-bit-array index) + (,',wordfun (%vector-raw-bits bit-array-1 index) + (%vector-raw-bits bit-array-2 index))) result-bit-array) (declare (optimize (speed 3) (safety 0)) (type index index end-1)) - (setf (%raw-bits result-bit-array index) - (,',wordfun (%raw-bits bit-array-1 index) - (%raw-bits bit-array-2 index)))))))))) + (setf (%vector-raw-bits result-bit-array index) + (,',wordfun (%vector-raw-bits bit-array-1 index) + (%vector-raw-bits bit-array-2 index)))))))))) (def bit-and word-logical-and) (def bit-ior word-logical-or) (def bit-xor word-logical-xor) @@ -427,29 +401,27 @@ ;; n-word-bits cases are handled by the (1- length), below. ;; CSR, 2002-04-24 result-bit-array - (do ((index sb!vm:vector-data-offset (1+ index)) - (end-1 (+ sb!vm:vector-data-offset - ;; bit-vectors of length 1 to n-word-bits need - ;; precisely one (SETF %RAW-BITS), done here in - ;; the epilogue. - CSR, 2002-04-24 - (truncate (truly-the index (1- length)) - sb!vm:n-word-bits)))) + (do ((index 0 (1+ index)) + ;; bit-vectors of length 1 to n-word-bits need precisely + ;; one (SETF %VECTOR-RAW-BITS), done here in the + ;; epilogue. - CSR, 2002-04-24 + (end-1 (truncate (truly-the index (1- length)) + sb!vm:n-word-bits))) ((>= index end-1) - (setf (%raw-bits result-bit-array index) - (word-logical-not (%raw-bits bit-array index))) + (setf (%vector-raw-bits result-bit-array index) + (word-logical-not (%vector-raw-bits bit-array index))) result-bit-array) (declare (optimize (speed 3) (safety 0)) (type index index end-1)) - (setf (%raw-bits result-bit-array index) - (word-logical-not (%raw-bits bit-array index)))))))) + (setf (%vector-raw-bits result-bit-array index) + (word-logical-not (%vector-raw-bits bit-array index)))))))) (deftransform bit-vector-= ((x y) (simple-bit-vector simple-bit-vector)) `(and (= (length x) (length y)) (let ((length (length x))) (or (= length 0) - (do* ((i sb!vm:vector-data-offset (+ i 1)) - (end-1 (+ sb!vm:vector-data-offset - (floor (1- length) sb!vm:n-word-bits)))) + (do* ((i 0 (+ i 1)) + (end-1 (floor (1- length) sb!vm:n-word-bits))) ((>= i end-1) (let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits))) (mask (ash #.(1- (ash 1 sb!vm:n-word-bits)) @@ -461,7 +433,7 @@ (:little-endian 0) (:big-endian '(- sb!vm:n-word-bits extra)))) - (%raw-bits x i))) + (%vector-raw-bits x i))) (numy (logand (ash mask @@ -469,13 +441,13 @@ (:little-endian 0) (:big-endian '(- sb!vm:n-word-bits extra)))) - (%raw-bits y i)))) + (%vector-raw-bits y i)))) (declare (type (integer 1 #.sb!vm:n-word-bits) extra) (type sb!vm:word mask numx numy)) (= numx numy))) (declare (type index i end-1)) - (let ((numx (%raw-bits x i)) - (numy (%raw-bits y i))) + (let ((numx (%vector-raw-bits x i)) + (numy (%vector-raw-bits y i))) (declare (type sb!vm:word numx numy)) (unless (= numx numy) (return nil)))))))) @@ -485,11 +457,10 @@ `(let ((length (length sequence))) (if (zerop length) 0 - (do ((index sb!vm:vector-data-offset (1+ index)) + (do ((index 0 (1+ index)) (count 0) - (end-1 (+ sb!vm:vector-data-offset - (truncate (truly-the index (1- length)) - sb!vm:n-word-bits)))) + (end-1 (truncate (truly-the index (1- length)) + sb!vm:n-word-bits))) ((>= index end-1) (let* ((extra (1+ (mod (1- length) sb!vm:n-word-bits))) (mask (ash #.(1- (ash 1 sb!vm:n-word-bits)) @@ -499,7 +470,7 @@ (:little-endian 0) (:big-endian '(- sb!vm:n-word-bits extra)))) - (%raw-bits sequence index)))) + (%vector-raw-bits sequence index)))) (declare (type (integer 1 #.sb!vm:n-word-bits) extra)) (declare (type sb!vm:word mask bits)) (incf count (logcount bits)) @@ -512,7 +483,7 @@ count)))) (declare (type index index count end-1) (optimize (speed 3) (safety 0))) - (incf count (logcount (%raw-bits sequence index))))))) + (incf count (logcount (%vector-raw-bits sequence index))))))) (deftransform fill ((sequence item) (simple-bit-vector bit) * :policy (>= speed space)) @@ -525,19 +496,18 @@ (value ,value)) (if (= length 0) sequence - (do ((index sb!vm:vector-data-offset (1+ index)) - (end-1 (+ sb!vm:vector-data-offset - ;; bit-vectors of length 1 to n-word-bits need - ;; precisely one (SETF %RAW-BITS), done here - ;; in the epilogue. - CSR, 2002-04-24 - (truncate (truly-the index (1- length)) - sb!vm:n-word-bits)))) + (do ((index 0 (1+ index)) + ;; bit-vectors of length 1 to n-word-bits need precisely + ;; one (SETF %VECTOR-RAW-BITS), done here in the + ;; epilogue. - CSR, 2002-04-24 + (end-1 (truncate (truly-the index (1- length)) + sb!vm:n-word-bits))) ((>= index end-1) - (setf (%raw-bits sequence index) value) + (setf (%vector-raw-bits sequence index) value) sequence) (declare (optimize (speed 3) (safety 0)) (type index index end-1)) - (setf (%raw-bits sequence index) value)))))) + (setf (%vector-raw-bits sequence index) value)))))) (deftransform fill ((sequence item) (simple-base-string base-char) * :policy (>= speed space)) @@ -554,8 +524,8 @@ (value ,value)) (multiple-value-bind (times rem) (truncate length sb!vm:n-word-bytes) - (do ((index sb!vm:vector-data-offset (1+ index)) - (end (+ times sb!vm:vector-data-offset))) + (do ((index 0 (1+ index)) + (end times)) ((>= index end) (let ((place (* times sb!vm:n-word-bytes))) (declare (fixnum place)) @@ -564,7 +534,7 @@ (setf (schar sequence (the index (+ place j))) item)))) (declare (optimize (speed 3) (safety 0)) (type index index)) - (setf (%raw-bits sequence index) value)))))) + (setf (%vector-raw-bits sequence index) value)))))) ;;;; %BYTE-BLT diff --git a/src/compiler/hppa/array.lisp b/src/compiler/hppa/array.lisp index 672d164..67c76e0 100644 --- a/src/compiler/hppa/array.lisp +++ b/src/compiler/hppa/array.lisp @@ -377,10 +377,6 @@ ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. -(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num - %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %set-raw-bits) (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag (unsigned-reg) unsigned-num %vector-raw-bits) (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag diff --git a/src/compiler/mips/array.lisp b/src/compiler/mips/array.lisp index d16ea7e..2f06dd4 100644 --- a/src/compiler/mips/array.lisp +++ b/src/compiler/mips/array.lisp @@ -513,10 +513,6 @@ ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. -(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num - %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %set-raw-bits) (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag (unsigned-reg) unsigned-num %vector-raw-bits) (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index 0bdeb7d..81f79c0 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -478,24 +478,6 @@ ;;; what type of vector it is. ;;; -(define-vop (raw-bits word-index-ref) - (:note "raw-bits VOP") - (:translate %raw-bits) - (:results (value :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - -(define-vop (set-raw-bits word-index-set) - (:note "setf raw-bits VOP") - (:translate %set-raw-bits) - (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (unsigned-reg))) - (:arg-types * positive-fixnum unsigned-num) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - (define-vop (vector-raw-bits word-index-ref) (:note "vector-raw-bits VOP") (:translate %vector-raw-bits) diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index 8b8079f..6cd7ae5 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -608,24 +608,6 @@ ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. -(define-vop (raw-bits word-index-ref) - (:note "raw-bits VOP") - (:translate %raw-bits) - (:results (value :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - -(define-vop (set-raw-bits word-index-set) - (:note "setf raw-bits VOP") - (:translate %set-raw-bits) - (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (unsigned-reg))) - (:arg-types * tagged-num unsigned-num) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - (define-vop (vector-raw-bits word-index-ref) (:note "vector-raw-bits VOP") (:translate %vector-raw-bits) diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp index 504ef62..b1a2b1a 100644 --- a/src/compiler/x86-64/array.lisp +++ b/src/compiler/x86-64/array.lisp @@ -960,10 +960,6 @@ ;;; These vops are useful for accessing the bits of a vector ;;; irrespective of what type of vector it is. -(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %set-raw-bits) (define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag (unsigned-reg) unsigned-num %vector-raw-bits) (define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp index 22ab26c..b4a49f4 100644 --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -686,10 +686,10 @@ ;;; These vops are useful for accessing the bits of a vector ;;; irrespective of what type of vector it is. -(define-full-reffer+offset raw-bits-with-offset * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %raw-bits-with-offset) -(define-full-setter+offset set-raw-bits-with-offset * 0 other-pointer-lowtag (unsigned-reg) - unsigned-num %set-raw-bits-with-offset) +(define-full-reffer vector-raw-bits * vector-data-offset other-pointer-lowtag + (unsigned-reg) unsigned-num %vector-raw-bits) +(define-full-setter set-vector-raw-bits * vector-data-offset other-pointer-lowtag + (unsigned-reg) unsigned-num %set-vector-raw-bits) ;;;; miscellaneous array VOPs diff --git a/version.lisp-expr b/version.lisp-expr index 0503653..31346a0 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.28.27" +"1.0.28.28" -- 1.7.10.4