0.8.14.13: Step SBCL, step!

[sbcl.git] / src / compiler / alpha / array.lisp

diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp
index ccd1880..ec52659 100644 (file)
--- a/src/compiler/alpha/array.lisp
+++ b/src/compiler/alpha/array.lisp
@@ -1,24 +1,17 @@
-;;; -*- Package: ALPHA -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-
-;;;
-;;; **********************************************************************
-;;;
-;;;    This file contains the Alpha definitions for array operations.
-;;;
-;;; Written by William Lott
-;;; Conversion by Sean Hallgren
-;;; Complex-float support by Douglas Crosher 1998.
-;;;
-(in-package "SB!VM")
+;;;; the Alpha definitions for array operations

 
 

+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.

 
 

+(in-package "SB!VM")

 \f
 \f

-;;;; Allocator for the array header.
+;;;; allocator for the array header

 
 (define-vop (make-array-header)
   (:policy :fast-safe)
 
 (define-vop (make-array-header)
   (:policy :fast-safe)

@@ -30,56 +23,44 @@
   (:temporary (:scs (non-descriptor-reg)) header)
   (:results (result :scs (descriptor-reg)))
   (:generator 13
   (:temporary (:scs (non-descriptor-reg)) header)
   (:results (result :scs (descriptor-reg)))
   (:generator 13

-    (inst addq rank (+ (* array-dimensions-offset word-bytes)
+    (inst addq rank (+ (* array-dimensions-offset n-word-bytes)

                       lowtag-mask)
          bytes)
     (inst li (lognot lowtag-mask) header)
     (inst and bytes header bytes)
     (inst addq rank (fixnumize (1- array-dimensions-offset)) header)
                       lowtag-mask)
          bytes)
     (inst li (lognot lowtag-mask) header)
     (inst and bytes header bytes)
     (inst addq rank (fixnumize (1- array-dimensions-offset)) header)

-    (inst sll header type-bits header)
+    (inst sll header n-widetag-bits header)

     (inst bis header type header)
     (inst bis header type header)

-    (inst srl header 2 header)
+    (inst srl header n-fixnum-tag-bits header)

     (pseudo-atomic ()
     (pseudo-atomic ()

-      (inst bis alloc-tn other-pointer-type result)
-      (storew header result 0 other-pointer-type)
+      (inst bis alloc-tn other-pointer-lowtag result)
+      (storew header result 0 other-pointer-lowtag)

       (inst addq alloc-tn bytes alloc-tn))))
 
 
 \f
       (inst addq alloc-tn bytes alloc-tn))))
 
 
 \f

-;;;; Additional accessors and setters for the array header.
-
-(defknown sb!impl::%array-dimension (t index) index
-  (flushable))
-(defknown sb!impl::%set-array-dimension (t index index) index
-  ())
-
+;;;; additional accessors and setters for the array header

 (define-full-reffer %array-dimension *
 (define-full-reffer %array-dimension *

-  array-dimensions-offset other-pointer-type
-  (any-reg) positive-fixnum sb!impl::%array-dimension)
+  array-dimensions-offset other-pointer-lowtag
+  (any-reg) positive-fixnum sb!kernel:%array-dimension)

 
 (define-full-setter %set-array-dimension *
 
 (define-full-setter %set-array-dimension *

-  array-dimensions-offset other-pointer-type
-  (any-reg) positive-fixnum sb!impl::%set-array-dimension #+gengc nil)
-
-
-(defknown sb!impl::%array-rank (t) index (flushable))
+  array-dimensions-offset other-pointer-lowtag
+  (any-reg) positive-fixnum sb!kernel:%set-array-dimension #!+gengc nil)

 
 (define-vop (array-rank-vop)
 
 (define-vop (array-rank-vop)

-  (:translate sb!impl::%array-rank)
+  (:translate sb!kernel:%array-rank)

   (:policy :fast-safe)
   (:args (x :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:results (res :scs (any-reg descriptor-reg)))
   (:generator 6
   (:policy :fast-safe)
   (:args (x :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:results (res :scs (any-reg descriptor-reg)))
   (:generator 6

-    (loadw temp x 0 other-pointer-type)
-    (inst sra temp type-bits temp)
+    (loadw temp x 0 other-pointer-lowtag)
+    (inst sra temp n-widetag-bits temp)

     (inst subq temp (1- array-dimensions-offset) temp)
     (inst subq temp (1- array-dimensions-offset) temp)

-    (inst sll temp 2 res)))
-
-
+    (inst sll temp n-fixnum-tag-bits res)))

 \f
 \f

-;;;; Bounds checking routine.
-
+;;;; bounds checking routine

 
 (define-vop (check-bound)
   (:translate %check-bound)
 
 (define-vop (check-bound)
   (:translate %check-bound)

@@ -97,37 +78,40 @@
       (inst cmpult index bound temp)
       (inst beq temp error)
       (move index result))))
       (inst cmpult index bound temp)
       (inst beq temp error)
       (move index result))))

-
-

 \f
 \f

-;;;; Accessors/Setters
-
-;;; Variants built on top of word-index-ref, etc.  I.e. those vectors whos
-;;; elements are represented in integer registers and are built out of
-;;; 8, 16, or 32 bit elements.
+;;;; accessors/setters

 
 

+;;; Variants built on top of word-index-ref, etc. I.e. those vectors
+;;; whose elements are represented in integer registers and are built
+;;; out of 8, 16, or 32 bit elements.

 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
              `(progn
 (macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
              `(progn

-                (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type
-                  vector-data-offset other-pointer-type
-                  ,(remove-if #'(lambda (x) (member x '(null zero))) scs)
+                (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
+                 ,type
+                  vector-data-offset other-pointer-lowtag
+                  ,(remove-if (lambda (x) (member x '(null zero))) scs)

                   ,element-type
                   data-vector-ref)
                   ,element-type
                   data-vector-ref)

-                (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type
-                  vector-data-offset other-pointer-type ,scs ,element-type
-                  data-vector-set #+gengc ,(if (member 'descriptor-reg scs) t nil))))
+                (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
+                 ,type
+                  vector-data-offset other-pointer-lowtag ,scs ,element-type
+                  data-vector-set #+gengc ,(if (member 'descriptor-reg scs)
+                                              t
+                                              nil))))

 
            (def-partial-data-vector-frobs
              (type element-type size signed &rest scs)
              `(progn
 
            (def-partial-data-vector-frobs
              (type element-type size signed &rest scs)
              `(progn

-                (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type
-                  ,size ,signed vector-data-offset other-pointer-type ,scs
+                (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
+                 ,type
+                  ,size ,signed vector-data-offset other-pointer-lowtag ,scs

                   ,element-type data-vector-ref)
                   ,element-type data-vector-ref)

-                (define-partial-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type
-                  ,size vector-data-offset other-pointer-type ,scs
+                (define-partial-setter ,(symbolicate "DATA-VECTOR-SET/" type)
+                 ,type
+                  ,size vector-data-offset other-pointer-lowtag ,scs

                   ,element-type data-vector-set)))
            (def-small-data-vector-frobs (type bits)
                   ,element-type data-vector-set)))
            (def-small-data-vector-frobs (type bits)

-             (let* ((elements-per-word (floor word-bits bits))
+             (let* ((elements-per-word (floor n-word-bits bits))

                     (bit-shift (1- (integer-length elements-per-word))))
                `(progn
                   (define-vop (,(symbolicate 'data-vector-ref/ type))
                     (bit-shift (1- (integer-length elements-per-word))))
                `(progn
                   (define-vop (,(symbolicate 'data-vector-ref/ type))

@@ -140,21 +124,23 @@
                     (:results (value :scs (any-reg)))
                     (:result-types positive-fixnum)
                     (:temporary (:scs (interior-reg)) lip)
                     (:results (value :scs (any-reg)))
                     (:result-types positive-fixnum)
                     (:temporary (:scs (interior-reg)) lip)

-                    (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result)
+                    (:temporary (:scs (non-descriptor-reg) :to (:result 0))
+                               temp result)

                     (:generator 20
                                 (inst srl index ,bit-shift temp)
                     (:generator 20
                                 (inst srl index ,bit-shift temp)

-                                (inst sll temp 2 temp)
+                                (inst sll temp n-fixnum-tag-bits temp)

                                 (inst addq object temp lip)
                                 (inst ldl result
                                 (inst addq object temp lip)
                                 (inst ldl result

-                                      (- (* vector-data-offset word-bytes)
-                                         other-pointer-type)
+                                      (- (* vector-data-offset n-word-bytes)
+                                         other-pointer-lowtag)

                                       lip)
                                 (inst and index ,(1- elements-per-word) temp)
                                 ,@(unless (= bits 1)
                                       lip)
                                 (inst and index ,(1- elements-per-word) temp)
                                 ,@(unless (= bits 1)

-                                    `((inst sll temp ,(1- (integer-length bits)) temp)))
+                                    `((inst sll temp
+                                           ,(1- (integer-length bits)) temp)))

                                 (inst srl result temp result)
                                 (inst and result ,(1- (ash 1 bits)) result)
                                 (inst srl result temp result)
                                 (inst and result ,(1- (ash 1 bits)) result)

-                                (inst sll result 2 value)))
+                                (inst sll result n-fixnum-tag-bits value)))

                   (define-vop (,(symbolicate 'data-vector-ref-c/ type))
                     (:translate data-vector-ref)
                     (:policy :fast-safe)
                   (define-vop (,(symbolicate 'data-vector-ref-c/ type))
                     (:translate data-vector-ref)
                     (:policy :fast-safe)

@@ -163,47 +149,55 @@
                                 (:constant
                                  (integer 0
                                           ,(1- (* (1+ (- (floor (+ #x7fff
                                 (:constant
                                  (integer 0
                                           ,(1- (* (1+ (- (floor (+ #x7fff

-                                                                   other-pointer-type)
-                                                                word-bytes)
+                                                                   other-pointer-lowtag)
+                                                                n-word-bytes)

                                                          vector-data-offset))
                                                   elements-per-word)))))
                     (:info index)
                     (:results (result :scs (unsigned-reg)))
                     (:result-types positive-fixnum)
                     (:generator 15
                                                          vector-data-offset))
                                                   elements-per-word)))))
                     (:info index)
                     (:results (result :scs (unsigned-reg)))
                     (:result-types positive-fixnum)
                     (:generator 15

-                                (multiple-value-bind (word extra) (floor index ,elements-per-word)
-                                  (loadw result object (+ word vector-data-offset) 
-                                         other-pointer-type)
+                                (multiple-value-bind (word extra)
+                                   (floor index ,elements-per-word)
+                                  (loadw result object (+ word
+                                                         vector-data-offset) 
+                                         other-pointer-lowtag)

                                   (unless (zerop extra)
                                     (inst srl result (* extra ,bits) result))
                                   (unless (= extra ,(1- elements-per-word))
                                   (unless (zerop extra)
                                     (inst srl result (* extra ,bits) result))
                                   (unless (= extra ,(1- elements-per-word))

-                                    (inst and result ,(1- (ash 1 bits)) result)))))
+                                    (inst and result ,(1- (ash 1 bits))
+                                         result)))))

                   (define-vop (,(symbolicate 'data-vector-set/ type))
                     (:note "inline array store")
                     (:translate data-vector-set)
                     (:policy :fast-safe)
                     (:args (object :scs (descriptor-reg))
                            (index :scs (unsigned-reg) :target shift)
                   (define-vop (,(symbolicate 'data-vector-set/ type))
                     (:note "inline array store")
                     (:translate data-vector-set)
                     (:policy :fast-safe)
                     (:args (object :scs (descriptor-reg))
                            (index :scs (unsigned-reg) :target shift)

-                           (value :scs (unsigned-reg zero immediate) :target result))
+                           (value :scs (unsigned-reg zero immediate)
+                                 :target result))

                     (:arg-types ,type positive-fixnum positive-fixnum)
                     (:results (result :scs (unsigned-reg)))
                     (:result-types positive-fixnum)
                     (:temporary (:scs (interior-reg)) lip)
                     (:temporary (:scs (non-descriptor-reg)) temp old)
                     (:arg-types ,type positive-fixnum positive-fixnum)
                     (:results (result :scs (unsigned-reg)))
                     (:result-types positive-fixnum)
                     (:temporary (:scs (interior-reg)) lip)
                     (:temporary (:scs (non-descriptor-reg)) temp old)

-                    (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
+                    (:temporary (:scs (non-descriptor-reg)
+                                     :from (:argument 1)) shift)

                     (:generator 25
                                 (inst srl index ,bit-shift temp)
                     (:generator 25
                                 (inst srl index ,bit-shift temp)

-                                (inst sll temp 2 temp)
+                                (inst sll temp n-fixnum-tag-bits temp)

                                 (inst addq object temp lip)
                                 (inst ldl old
                                 (inst addq object temp lip)
                                 (inst ldl old

-                                      (- (* vector-data-offset word-bytes)
-                                         other-pointer-type)
+                                      (- (* vector-data-offset n-word-bytes)
+                                         other-pointer-lowtag)

                                       lip)
                                 (inst and index ,(1- elements-per-word) shift)
                                 ,@(unless (= bits 1)
                                       lip)
                                 (inst and index ,(1- elements-per-word) shift)
                                 ,@(unless (= bits 1)

-                                    `((inst sll shift ,(1- (integer-length bits)) shift)))
+                                    `((inst sll shift ,(1- (integer-length
+                                                           bits))
+                                           shift)))

                                 (unless (and (sc-is value immediate)
                                 (unless (and (sc-is value immediate)

-                                             (= (tn-value value) ,(1- (ash 1 bits))))
+                                             (= (tn-value value)
+                                               ,(1- (ash 1 bits))))

                                   (inst li ,(1- (ash 1 bits)) temp)
                                   (inst sll temp shift temp)
                                   (inst not temp temp)
                                   (inst li ,(1- (ash 1 bits)) temp)
                                   (inst sll temp shift temp)
                                   (inst not temp temp)

@@ -211,14 +205,19 @@
                                 (unless (sc-is value zero)
                                   (sc-case value
                                            (immediate
                                 (unless (sc-is value zero)
                                   (sc-case value
                                            (immediate

-                                            (inst li (logand (tn-value value) ,(1- (ash 1 bits))) temp))
+                                            (inst li
+                                                 (logand (tn-value value)
+                                                         ,(1- (ash 1 bits)))
+                                                 temp))

                                            (unsigned-reg
                                            (unsigned-reg

-                                            (inst and value ,(1- (ash 1 bits)) temp)))
+                                            (inst and value
+                                                 ,(1- (ash 1 bits))
+                                                 temp)))

                                   (inst sll temp shift temp)
                                   (inst bis old temp old))
                                 (inst stl old
                                   (inst sll temp shift temp)
                                   (inst bis old temp old))
                                 (inst stl old

-                                      (- (* vector-data-offset word-bytes)
-                                         other-pointer-type)
+                                      (- (* vector-data-offset n-word-bytes)
+                                         other-pointer-lowtag)

                                       lip)
                                 (sc-case value
                                          (immediate
                                       lip)
                                 (sc-case value
                                          (immediate

@@ -231,13 +230,14 @@
                     (:translate data-vector-set)
                     (:policy :fast-safe)
                     (:args (object :scs (descriptor-reg))
                     (:translate data-vector-set)
                     (:policy :fast-safe)
                     (:args (object :scs (descriptor-reg))

-                           (value :scs (unsigned-reg zero immediate) :target result))
+                           (value :scs (unsigned-reg zero immediate)
+                                 :target result))

                     (:arg-types ,type
                                 (:constant
                                  (integer 0
                                           ,(1- (* (1+ (- (floor (+ #x7fff
                     (:arg-types ,type
                                 (:constant
                                  (integer 0
                                           ,(1- (* (1+ (- (floor (+ #x7fff

-                                                                   other-pointer-type)
-                                                                word-bytes)
+                                                                   other-pointer-lowtag)
+                                                                n-word-bytes)

                                                          vector-data-offset))
                                                   elements-per-word))))
                                 positive-fixnum)
                                                          vector-data-offset))
                                                   elements-per-word))))
                                 positive-fixnum)

@@ -246,37 +246,49 @@
                     (:result-types positive-fixnum)
                     (:temporary (:scs (non-descriptor-reg)) temp old)
                     (:generator 20
                     (:result-types positive-fixnum)
                     (:temporary (:scs (non-descriptor-reg)) temp old)
                     (:generator 20

-                                (multiple-value-bind (word extra) (floor index ,elements-per-word)
-                                  (inst ldl object
-                                        (- (* (+ word vector-data-offset) word-bytes)
-                                           other-pointer-type)
-                                        old)
+                                (multiple-value-bind (word extra)
+                                   (floor index ,elements-per-word)
+                                  (inst ldl old
+                                        (- (* (+ word vector-data-offset)
+                                             n-word-bytes)
+                                           other-pointer-lowtag)
+                                        object)

                                   (unless (and (sc-is value immediate)
                                   (unless (and (sc-is value immediate)

-                                               (= (tn-value value) ,(1- (ash 1 bits))))
+                                               (= (tn-value value)
+                                                 ,(1- (ash 1 bits))))

                                     (cond ((= extra ,(1- elements-per-word))
                                            (inst sll old ,bits old)
                                            (inst srl old ,bits old))
                                           (t
                                            (inst li
                                     (cond ((= extra ,(1- elements-per-word))
                                            (inst sll old ,bits old)
                                            (inst srl old ,bits old))
                                           (t
                                            (inst li

-                                                 (lognot (ash ,(1- (ash 1 bits)) (* extra ,bits)))
+                                                 (lognot (ash ,(1- (ash 1
+                                                                       bits))
+                                                             (* extra ,bits)))

                                                  temp)
                                            (inst and old temp old))))
                                   (sc-case value
                                            (zero)
                                            (immediate
                                                  temp)
                                            (inst and old temp old))))
                                   (sc-case value
                                            (zero)
                                            (immediate

-                                            (let ((value (ash (logand (tn-value value) ,(1- (ash 1 bits)))
-                                                              (* extra ,bits))))
-                                              (cond ((< value #x10000)
+                                            (let ((value
+                                                  (ash (logand (tn-value
+                                                                value)
+                                                               ,(1- (ash 1
+                                                                         bits)))
+                                                              (* extra
+                                                                ,bits))))
+                                              (cond ((< value #x100)

                                                      (inst bis old value old))
                                                     (t
                                                      (inst li value temp)
                                                      (inst bis old temp old)))))
                                            (unsigned-reg
                                                      (inst bis old value old))
                                                     (t
                                                      (inst li value temp)
                                                      (inst bis old temp old)))))
                                            (unsigned-reg

-                                            (inst sll value (* extra ,bits) temp)
+                                            (inst sll value (* extra ,bits)
+                                                 temp)

                                             (inst bis old temp old)))
                                   (inst stl old
                                             (inst bis old temp old)))
                                   (inst stl old

-                                        (- (* (+ word vector-data-offset) word-bytes)
-                                           other-pointer-type)
+                                        (- (* (+ word vector-data-offset)
+                                             n-word-bytes)
+                                           other-pointer-lowtag)

                                         object)
                                   (sc-case value
                                            (immediate
                                         object)
                                   (sc-case value
                                            (immediate

@@ -288,15 +300,21 @@
   (def-full-data-vector-frobs simple-vector *
     descriptor-reg any-reg null zero)
   
   (def-full-data-vector-frobs simple-vector *
     descriptor-reg any-reg null zero)
   

-  (def-partial-data-vector-frobs simple-string base-char :byte nil
+  (def-partial-data-vector-frobs simple-base-string base-char :byte nil

     base-char-reg)
   
     base-char-reg)
   

+  (def-partial-data-vector-frobs simple-array-unsigned-byte-7 positive-fixnum
+    :byte nil unsigned-reg signed-reg)

   (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
     :byte nil unsigned-reg signed-reg)
   
   (def-partial-data-vector-frobs simple-array-unsigned-byte-8 positive-fixnum
     :byte nil unsigned-reg signed-reg)
   

+  (def-partial-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum
+    :short nil unsigned-reg signed-reg)

   (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
     :short nil unsigned-reg signed-reg)
   
   (def-partial-data-vector-frobs simple-array-unsigned-byte-16 positive-fixnum
     :short nil unsigned-reg signed-reg)
   

+  (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+    unsigned-reg)

   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
   
   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
   

@@ -306,21 +324,19 @@
   (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num
     :short t signed-reg)
   
   (def-partial-data-vector-frobs simple-array-signed-byte-16 tagged-num
     :short t signed-reg)
   

+  (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum any-reg)  

   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
   
   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
   

-  (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg)
+  (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
+    signed-reg)

   
   

-  ;; Integer vectors whos elements are smaller than a byte.  I.e. bit, 2-bit,
-  ;; and 4-bit vectors.
-  ;;
-
+  ;; Integer vectors whos elements are smaller than a byte. I.e. bit,
+  ;; 2-bit, and 4-bit vectors.

   (def-small-data-vector-frobs simple-bit-vector 1)
   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
   (def-small-data-vector-frobs simple-bit-vector 1)
   (def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
   (def-small-data-vector-frobs simple-array-unsigned-byte-4 4))

-  

 
 

-;;; And the float variants.
-;;; 
+;;; and the float variants..

 
 (define-vop (data-vector-ref/simple-array-single-float)
   (:note "inline array access")
 
 (define-vop (data-vector-ref/simple-array-single-float)
   (:note "inline array access")

@@ -335,8 +351,8 @@
   (:generator 20
     (inst addq object index lip)
     (inst lds value
   (:generator 20
     (inst addq object index lip)
     (inst lds value

-         (- (* vector-data-offset word-bytes)
-            other-pointer-type)
+         (- (* vector-data-offset n-word-bytes)
+            other-pointer-lowtag)

           lip)))
 
 (define-vop (data-vector-set/simple-array-single-float)
           lip)))
 
 (define-vop (data-vector-set/simple-array-single-float)

@@ -353,8 +369,8 @@
   (:generator 20
     (inst addq object index lip)
     (inst sts value
   (:generator 20
     (inst addq object index lip)
     (inst sts value

-         (- (* vector-data-offset word-bytes)
-            other-pointer-type)
+         (- (* vector-data-offset n-word-bytes)
+            other-pointer-lowtag)

          lip)
     (unless (location= result value)
       (inst fmove value result))))
          lip)
     (unless (location= result value)
       (inst fmove value result))))

@@ -373,8 +389,8 @@
     (inst addq object index lip)
     (inst addq lip index lip)
     (inst ldt value
     (inst addq object index lip)
     (inst addq lip index lip)
     (inst ldt value

-         (- (* vector-data-offset word-bytes)
-            other-pointer-type)
+         (- (* vector-data-offset n-word-bytes)
+            other-pointer-lowtag)

          lip)))
 
 (define-vop (data-vector-set/simple-array-double-float)
          lip)))
 
 (define-vop (data-vector-set/simple-array-double-float)

@@ -392,13 +408,12 @@
     (inst addq object index lip)
     (inst addq lip index lip)
     (inst stt value
     (inst addq object index lip)
     (inst addq lip index lip)
     (inst stt value

-         (- (* vector-data-offset word-bytes)
-            other-pointer-type) lip)
+         (- (* vector-data-offset n-word-bytes)
+            other-pointer-lowtag) lip)

     (unless (location= result value)
       (inst fmove value result))))
     (unless (location= result value)
       (inst fmove value result))))

-

 \f
 \f

-;;; Complex float arrays.
+;;; complex float arrays

 
 (define-vop (data-vector-ref/simple-array-complex-single-float)
   (:note "inline array access")
 
 (define-vop (data-vector-ref/simple-array-complex-single-float)
   (:note "inline array access")

@@ -415,11 +430,11 @@
       (inst addq object index lip)
       (inst addq lip index lip)
       (inst lds real-tn
       (inst addq object index lip)
       (inst addq lip index lip)
       (inst lds real-tn

-           (- (* vector-data-offset word-bytes) other-pointer-type)
+           (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)

            lip))
     (let ((imag-tn (complex-single-reg-imag-tn value)))
       (inst lds imag-tn
            lip))
     (let ((imag-tn (complex-single-reg-imag-tn value)))
       (inst lds imag-tn

-           (- (* (1+ vector-data-offset) word-bytes) other-pointer-type)
+           (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag)

            lip))))
 
 (define-vop (data-vector-set/simple-array-complex-single-float)
            lip))))
 
 (define-vop (data-vector-set/simple-array-complex-single-float)

@@ -440,14 +455,14 @@
       (inst addq object index lip)
       (inst addq lip index lip)
       (inst sts value-real
       (inst addq object index lip)
       (inst addq lip index lip)
       (inst sts value-real

-           (- (* vector-data-offset word-bytes) other-pointer-type)
+           (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)

            lip)
       (unless (location= result-real value-real)
        (inst fmove value-real result-real)))
     (let ((value-imag (complex-single-reg-imag-tn value))
          (result-imag (complex-single-reg-imag-tn result)))
       (inst sts value-imag
            lip)
       (unless (location= result-real value-real)
        (inst fmove value-real result-real)))
     (let ((value-imag (complex-single-reg-imag-tn value))
          (result-imag (complex-single-reg-imag-tn result)))
       (inst sts value-imag

-           (- (* (1+ vector-data-offset) word-bytes) other-pointer-type)
+           (- (* (1+ vector-data-offset) n-word-bytes) other-pointer-lowtag)

            lip)
       (unless (location= result-imag value-imag)
        (inst fmove value-imag result-imag)))))
            lip)
       (unless (location= result-imag value-imag)
        (inst fmove value-imag result-imag)))))

@@ -469,11 +484,11 @@
       (inst addq lip index lip)
       (inst addq lip index lip)
       (inst ldt real-tn
       (inst addq lip index lip)
       (inst addq lip index lip)
       (inst ldt real-tn

-           (- (* vector-data-offset word-bytes) other-pointer-type)
+           (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)

            lip))
     (let ((imag-tn (complex-double-reg-imag-tn value)))
       (inst ldt imag-tn
            lip))
     (let ((imag-tn (complex-double-reg-imag-tn value)))
       (inst ldt imag-tn

-           (- (* (+ vector-data-offset 2) word-bytes) other-pointer-type)
+           (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag)

            lip))))
 
 (define-vop (data-vector-set/simple-array-complex-double-float)
            lip))))
 
 (define-vop (data-vector-set/simple-array-complex-double-float)

@@ -496,73 +511,68 @@
       (inst addq lip index lip)
       (inst addq lip index lip)
       (inst stt value-real
       (inst addq lip index lip)
       (inst addq lip index lip)
       (inst stt value-real

-           (- (* vector-data-offset word-bytes) other-pointer-type)
+           (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)

            lip)
       (unless (location= result-real value-real)
        (inst fmove value-real result-real)))
     (let ((value-imag (complex-double-reg-imag-tn value))
          (result-imag (complex-double-reg-imag-tn result)))
       (inst stt value-imag
            lip)
       (unless (location= result-real value-real)
        (inst fmove value-real result-real)))
     (let ((value-imag (complex-double-reg-imag-tn value))
          (result-imag (complex-double-reg-imag-tn result)))
       (inst stt value-imag

-           (- (* (+ vector-data-offset 2) word-bytes) other-pointer-type)
+           (- (* (+ vector-data-offset 2) n-word-bytes) other-pointer-lowtag)

            lip)
       (unless (location= result-imag value-imag)
        (inst fmove value-imag result-imag)))))
 
 \f
            lip)
       (unless (location= result-imag value-imag)
        (inst fmove value-imag result-imag)))))
 
 \f

-;;; These VOPs are used for implementing float slots in structures (whose raw
-;;; data is an unsigned-32 vector.
+;;; These VOPs are used for implementing float slots in structures
+;;; (whose raw data is an unsigned-32 vector).

 ;;;
 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
   (:translate %raw-ref-single)
 ;;;
 (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
   (:translate %raw-ref-single)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+  (:arg-types sb!c::raw-vector positive-fixnum))

 ;;;
 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
   (:translate %raw-set-single)
 ;;;
 (define-vop (raw-set-single data-vector-set/simple-array-single-float)
   (:translate %raw-set-single)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
+  (:arg-types sb!c::raw-vector positive-fixnum single-float))

 ;;;
 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
   (:translate %raw-ref-double)
 ;;;
 (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
   (:translate %raw-ref-double)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+  (:arg-types sb!c::raw-vector positive-fixnum))

 ;;;
 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
   (:translate %raw-set-double)
 ;;;
 (define-vop (raw-set-double data-vector-set/simple-array-double-float)
   (:translate %raw-set-double)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
+  (:arg-types sb!c::raw-vector positive-fixnum double-float))

 
 (define-vop (raw-ref-complex-single
             data-vector-ref/simple-array-complex-single-float)
   (:translate %raw-ref-complex-single)
 
 (define-vop (raw-ref-complex-single
             data-vector-ref/simple-array-complex-single-float)
   (:translate %raw-ref-complex-single)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+  (:arg-types sb!c::raw-vector positive-fixnum))

 ;;;
 (define-vop (raw-set-complex-single
             data-vector-set/simple-array-complex-single-float)
   (:translate %raw-set-complex-single)
 ;;;
 (define-vop (raw-set-complex-single
             data-vector-set/simple-array-complex-single-float)
   (:translate %raw-set-complex-single)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum
-             complex-single-float))
+  (:arg-types sb!c::raw-vector positive-fixnum complex-single-float))

 ;;;
 (define-vop (raw-ref-complex-double
             data-vector-ref/simple-array-complex-double-float)
   (:translate %raw-ref-complex-double)
 ;;;
 (define-vop (raw-ref-complex-double
             data-vector-ref/simple-array-complex-double-float)
   (:translate %raw-ref-complex-double)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
+  (:arg-types sb!c::raw-vector positive-fixnum))

 ;;;
 (define-vop (raw-set-complex-double
             data-vector-set/simple-array-complex-double-float)
   (:translate %raw-set-complex-double)
 ;;;
 (define-vop (raw-set-complex-double
             data-vector-set/simple-array-complex-double-float)
   (:translate %raw-set-complex-double)

-  (:arg-types simple-array-unsigned-byte-32 positive-fixnum
-             complex-double-float))
-
+  (:arg-types sb!c::raw-vector positive-fixnum complex-double-float))

 
 ;;; These vops are useful for accessing the bits of a vector irrespective of
 ;;; what type of vector it is.
 
 ;;; 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-type (unsigned-reg) unsigned-num
+;;;
+(define-full-reffer raw-bits * 0 other-pointer-lowtag (unsigned-reg) unsigned-num

   %raw-bits)
   %raw-bits)

-(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg)
+(define-full-setter set-raw-bits * 0 other-pointer-lowtag (unsigned-reg)

   unsigned-num %set-raw-bits #+gengc nil)
 
   unsigned-num %set-raw-bits #+gengc nil)
 

-

 \f
 \f

-;;;; Misc. Array VOPs.
+;;;; misc. array VOPs

 
 (define-vop (get-vector-subtype get-header-data))
 (define-vop (set-vector-subtype set-header-data))
 
 (define-vop (get-vector-subtype get-header-data))
 (define-vop (set-vector-subtype set-header-data))