src/code/bit-bash.lisp

   1 ;;;; functions to implement bitblt-ish operations
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13 \f
  14 ;;;; constants and types
  15
  16 ;;; the number of bits to process at a time
  17 (defconstant unit-bits sb!vm:word-bits)
  18
  19 ;;; the maximum number of bits that can be dealt with in a single call
  20 (defconstant max-bits (ash most-positive-fixnum -2))
  21
  22 (eval-when (:compile-toplevel :load-toplevel :execute)
  23
  24 ;;; FIXME: Do we really need EVAL-WHEN around the DEFTYPEs?
  25 (deftype unit ()
  26   `(unsigned-byte ,unit-bits))
  27
  28 (deftype offset ()
  29   `(integer 0 ,max-bits))
  30
  31 (deftype bit-offset ()
  32   `(integer 0 (,unit-bits)))
  33
  34 (deftype bit-count ()
  35   `(integer 1 (,unit-bits)))
  36
  37 (deftype word-offset ()
  38   `(integer 0 (,(ceiling max-bits unit-bits))))
  39
  40 ) ; EVAL-WHEN
  41 \f
  42 ;;;; support routines
  43
  44 ;;; A particular implementation must offer either VOPs to translate
  45 ;;; these, or DEFTRANSFORMs to convert them into something supported
  46 ;;; by the architecture.
  47 (macrolet ((def-frob (name &rest args)
  48              `(defun ,name ,args
  49                 (,name ,@args))))
  50   (def-frob 32bit-logical-not x)
  51   (def-frob 32bit-logical-and x y)
  52   (def-frob 32bit-logical-or x y)
  53   (def-frob 32bit-logical-xor x y)
  54   (def-frob 32bit-logical-nor x y)
  55   (def-frob 32bit-logical-eqv x y)
  56   (def-frob 32bit-logical-nand x y)
  57   (def-frob 32bit-logical-andc1 x y)
  58   (def-frob 32bit-logical-andc2 x y)
  59   (def-frob 32bit-logical-orc1 x y)
  60   (def-frob 32bit-logical-orc2 x y))
  61
  62 ;;; Shift NUMBER by the low-order bits of COUNTOID, adding zero bits
  63 ;;; at the "end" and removing bits from the "start". On big-endian
  64 ;;; machines this is a left-shift and on little-endian machines this
  65 ;;; is a right-shift.
  66 (defun shift-towards-start (number countoid)
  67   (declare (type unit number) (fixnum countoid))
  68   (let ((count (ldb (byte (1- (integer-length unit-bits)) 0) countoid)))
  69     (declare (type bit-offset count))
  70     (if (zerop count)
  71         number
  72         (ecase sb!c:*backend-byte-order*
  73           (:big-endian
  74            (ash (ldb (byte (- unit-bits count) 0) number) count))
  75           (:little-endian
  76            (ash number (- count)))))))
  77
  78 ;;; Shift NUMBER by COUNT bits, adding zero bits at the "start" and
  79 ;;; removing bits from the "end". On big-endian machines this is a
  80 ;;; right-shift and on little-endian machines this is a left-shift.
  81 (defun shift-towards-end (number count)
  82   (declare (type unit number) (fixnum count))
  83   (let ((count (ldb (byte (1- (integer-length unit-bits)) 0) count)))
  84     (declare (type bit-offset count))
  85     (if (zerop count)
  86         number
  87         (ecase sb!c:*backend-byte-order*
  88           (:big-endian
  89            (ash number (- count)))
  90           (:little-endian
  91            (ash (ldb (byte (- unit-bits count) 0) number) count))))))
  92
  93 #!-sb-fluid (declaim (inline start-mask end-mask fix-sap-and-offset))
  94
  95 ;;; Produce a mask that contains 1's for the COUNT "start" bits and
  96 ;;; 0's for the remaining "end" bits. Only the lower 5 bits of COUNT
  97 ;;; are significant (KLUDGE: because of hardwired implicit dependence
  98 ;;; on 32-bit word size -- WHN 2001-03-19).
  99 (defun start-mask (count)
 100   (declare (fixnum count))
 101   (shift-towards-start (1- (ash 1 unit-bits)) (- count)))
 102
 103 ;;; Produce a mask that contains 1's for the COUNT "end" bits and 0's
 104 ;;; for the remaining "start" bits. Only the lower 5 bits of COUNT are
 105 ;;; significant (KLUDGE: because of hardwired implicit dependence on
 106 ;;; 32-bit word size -- WHN 2001-03-19).
 107 (defun end-mask (count)
 108   (declare (fixnum count))
 109   (shift-towards-end (1- (ash 1 unit-bits)) (- count)))
 110
 111 ;;; Align the SAP to a word boundary, and update the offset accordingly.
 112 (defun fix-sap-and-offset (sap offset)
 113   (declare (type system-area-pointer sap)
 114            (type index offset)
 115            (values system-area-pointer index))
 116   (let ((address (sap-int sap)))
 117     (values (int-sap #!-alpha (32bit-logical-andc2 address 3)
 118                      #!+alpha (ash (ash address -2) 2))
 119             (+ (* (logand address 3) byte-bits) offset))))
 120
 121 #!-sb-fluid (declaim (inline word-sap-ref %set-word-sap-ref))
 122 (defun word-sap-ref (sap offset)
 123   (declare (type system-area-pointer sap)
 124            (type index offset)
 125            (values (unsigned-byte 32))
 126            (optimize (speed 3) (safety 0) #-sb-xc-host (inhibit-warnings 3)))
 127   (sap-ref-32 sap (the index (ash offset 2))))
 128 (defun %set-word-sap-ref (sap offset value)
 129   (declare (type system-area-pointer sap)
 130            (type index offset)
 131            (type (unsigned-byte 32) value)
 132            (values (unsigned-byte 32))
 133            (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
 134   (setf (sap-ref-32 sap (the index (ash offset 2))) value))
 135 \f
 136 ;;;; DO-CONSTANT-BIT-BASH
 137
 138 ;;; Fill DST with VALUE starting at DST-OFFSET and continuing for
 139 ;;; LENGTH bits.
 140 #!-sb-fluid (declaim (inline do-constant-bit-bash))
 141 (defun do-constant-bit-bash (dst dst-offset length value dst-ref-fn dst-set-fn)
 142   (declare (type offset dst-offset) (type unit value)
 143            (type function dst-ref-fn dst-set-fn))
 144   (multiple-value-bind (dst-word-offset dst-bit-offset)
 145       (floor dst-offset unit-bits)
 146     (declare (type word-offset dst-word-offset)
 147              (type bit-offset dst-bit-offset))
 148     (multiple-value-bind (words final-bits)
 149         (floor (+ dst-bit-offset length) unit-bits)
 150       (declare (type word-offset words) (type bit-offset final-bits))
 151       (if (zerop words)
 152           (unless (zerop length)
 153             (funcall dst-set-fn dst dst-word-offset
 154                      (if (= length unit-bits)
 155                          value
 156                          (let ((mask (shift-towards-end (start-mask length)
 157                                                         dst-bit-offset)))
 158                            (declare (type unit mask))
 159                            (32bit-logical-or
 160                             (32bit-logical-and value mask)
 161                             (32bit-logical-andc2
 162                              (funcall dst-ref-fn dst dst-word-offset)
 163                              mask))))))
 164           (let ((interior (floor (- length final-bits) unit-bits)))
 165             (unless (zerop dst-bit-offset)
 166               (let ((mask (end-mask (- dst-bit-offset))))
 167                 (declare (type unit mask))
 168                 (funcall dst-set-fn dst dst-word-offset
 169                          (32bit-logical-or
 170                           (32bit-logical-and value mask)
 171                           (32bit-logical-andc2
 172                            (funcall dst-ref-fn dst dst-word-offset)
 173                            mask))))
 174               (incf dst-word-offset))
 175             (dotimes (i interior)
 176               (funcall dst-set-fn dst dst-word-offset value)
 177               (incf dst-word-offset))
 178             (unless (zerop final-bits)
 179               (let ((mask (start-mask final-bits)))
 180                 (declare (type unit mask))
 181                 (funcall dst-set-fn dst dst-word-offset
 182                          (32bit-logical-or
 183                           (32bit-logical-and value mask)
 184                           (32bit-logical-andc2
 185                            (funcall dst-ref-fn dst dst-word-offset)
 186                            mask)))))))))
 187   (values))
 188 \f
 189 ;;;; DO-UNARY-BIT-BASH
 190
 191 #!-sb-fluid (declaim (inline do-unary-bit-bash))
 192 (defun do-unary-bit-bash (src src-offset dst dst-offset length
 193                               dst-ref-fn dst-set-fn src-ref-fn)
 194   (declare (type offset src-offset dst-offset length)
 195            (type function dst-ref-fn dst-set-fn src-ref-fn))
 196   (multiple-value-bind (dst-word-offset dst-bit-offset)
 197       (floor dst-offset unit-bits)
 198     (declare (type word-offset dst-word-offset)
 199              (type bit-offset dst-bit-offset))
 200     (multiple-value-bind (src-word-offset src-bit-offset)
 201         (floor src-offset unit-bits)
 202       (declare (type word-offset src-word-offset)
 203                (type bit-offset src-bit-offset))
 204       (cond
 205        ((<= (+ dst-bit-offset length) unit-bits)
 206         ;; We are only writing one word, so it doesn't matter what order
 207         ;; we do it in. But we might be reading from multiple words, so take
 208         ;; care.
 209         (cond
 210          ((zerop length)
 211           ;; Actually, we aren't even writing one word. This is really easy.
 212           )
 213          ((= length unit-bits)
 214           ;; DST-BIT-OFFSET must be equal to zero, or we would be writing
 215           ;; multiple words. If SRC-BIT-OFFSET is also zero, then we
 216           ;; just transfer the single word. Otherwise we have to extract bits
 217           ;; from two src words.
 218           (funcall dst-set-fn dst dst-word-offset
 219                    (if (zerop src-bit-offset)
 220                        (funcall src-ref-fn src src-word-offset)
 221                        (32bit-logical-or
 222                         (shift-towards-start
 223                          (funcall src-ref-fn src src-word-offset)
 224                          src-bit-offset)
 225                         (shift-towards-end
 226                          (funcall src-ref-fn src (1+ src-word-offset))
 227                          (- src-bit-offset))))))
 228          (t
 229           ;; We are only writing some portion of the dst word, so we need to
 230           ;; preserve the extra bits. Also, we still don't know whether we need
 231           ;; one or two source words.
 232           (let ((mask (shift-towards-end (start-mask length) dst-bit-offset))
 233                 (orig (funcall dst-ref-fn dst dst-word-offset))
 234                 (value
 235                  (if (> src-bit-offset dst-bit-offset)
 236                      ;; The source starts further into the word than does
 237                      ;; the dst, so the source could extend into the next
 238                      ;; word. If it does, we have to merge the two words,
 239                      ;; and if not, we can just shift the first word.
 240                      (let ((src-bit-shift (- src-bit-offset dst-bit-offset)))
 241                        (if (> (+ src-bit-offset length) unit-bits)
 242                            (32bit-logical-or
 243                             (shift-towards-start
 244                              (funcall src-ref-fn src src-word-offset)
 245                              src-bit-shift)
 246                             (shift-towards-end
 247                              (funcall src-ref-fn src (1+ src-word-offset))
 248                              (- src-bit-shift)))
 249                            (shift-towards-start
 250                             (funcall src-ref-fn src src-word-offset)
 251                             src-bit-shift)))
 252                      ;; The dst starts further into the word than does the
 253                      ;; source, so we know the source can not extend into
 254                      ;; a second word (or else the dst would too, and we
 255                      ;; wouldn't be in this branch.
 256                      (shift-towards-end
 257                       (funcall src-ref-fn src src-word-offset)
 258                       (- dst-bit-offset src-bit-offset)))))
 259             (declare (type unit mask orig value))
 260             ;; Replace the dst word.
 261             (funcall dst-set-fn dst dst-word-offset
 262                      (32bit-logical-or
 263                       (32bit-logical-and value mask)
 264                       (32bit-logical-andc2 orig mask)))))))
 265        ((= src-bit-offset dst-bit-offset)
 266         ;; The source and dst are aligned, so we don't need to shift
 267         ;; anything. But we have to pick the direction of the loop
 268         ;; in case the source and dst are really the same thing.
 269         (multiple-value-bind (words final-bits)
 270             (floor (+ dst-bit-offset length) unit-bits)
 271           (declare (type word-offset words) (type bit-offset final-bits))
 272           (let ((interior (floor (- length final-bits) unit-bits)))
 273             (declare (type word-offset interior))
 274             (cond
 275              ((<= dst-offset src-offset)
 276               ;; We need to loop from left to right
 277               (unless (zerop dst-bit-offset)
 278                 ;; We are only writing part of the first word, so mask off the
 279                 ;; bits we want to preserve.
 280                 (let ((mask (end-mask (- dst-bit-offset)))
 281                       (orig (funcall dst-ref-fn dst dst-word-offset))
 282                       (value (funcall src-ref-fn src src-word-offset)))
 283                   (declare (type unit mask orig value))
 284                   (funcall dst-set-fn dst dst-word-offset
 285                            (32bit-logical-or (32bit-logical-and value mask)
 286                                              (32bit-logical-andc2 orig mask))))
 287                 (incf src-word-offset)
 288                 (incf dst-word-offset))
 289               ;; Just copy the interior words.
 290               (dotimes (i interior)
 291                 (funcall dst-set-fn dst dst-word-offset
 292                          (funcall src-ref-fn src src-word-offset))
 293                 (incf src-word-offset)
 294                 (incf dst-word-offset))
 295               (unless (zerop final-bits)
 296                 ;; We are only writing part of the last word.
 297                 (let ((mask (start-mask final-bits))
 298                       (orig (funcall dst-ref-fn dst dst-word-offset))
 299                       (value (funcall src-ref-fn src src-word-offset)))
 300                   (declare (type unit mask orig value))
 301                   (funcall dst-set-fn dst dst-word-offset
 302                            (32bit-logical-or
 303                             (32bit-logical-and value mask)
 304                             (32bit-logical-andc2 orig mask))))))
 305              (t
 306               ;; We need to loop from right to left.
 307               (incf dst-word-offset words)
 308               (incf src-word-offset words)
 309               (unless (zerop final-bits)
 310                 (let ((mask (start-mask final-bits))
 311                       (orig (funcall dst-ref-fn dst dst-word-offset))
 312                       (value (funcall src-ref-fn src src-word-offset)))
 313                   (declare (type unit mask orig value))
 314                   (funcall dst-set-fn dst dst-word-offset
 315                            (32bit-logical-or
 316                             (32bit-logical-and value mask)
 317                             (32bit-logical-andc2 orig mask)))))
 318               (dotimes (i interior)
 319                 (decf src-word-offset)
 320                 (decf dst-word-offset)
 321                 (funcall dst-set-fn dst dst-word-offset
 322                          (funcall src-ref-fn src src-word-offset)))
 323               (unless (zerop dst-bit-offset)
 324                 (decf src-word-offset)
 325                 (decf dst-word-offset)
 326                 (let ((mask (end-mask (- dst-bit-offset)))
 327                       (orig (funcall dst-ref-fn dst dst-word-offset))
 328                       (value (funcall src-ref-fn src src-word-offset)))
 329                   (declare (type unit mask orig value))
 330                   (funcall dst-set-fn dst dst-word-offset
 331                            (32bit-logical-or
 332                             (32bit-logical-and value mask)
 333                             (32bit-logical-andc2 orig mask))))))))))
 334        (t
 335         ;; They aren't aligned.
 336         (multiple-value-bind (words final-bits)
 337             (floor (+ dst-bit-offset length) unit-bits)
 338           (declare (type word-offset words) (type bit-offset final-bits))
 339           (let ((src-shift (mod (- src-bit-offset dst-bit-offset) unit-bits))
 340                 (interior (floor (- length final-bits) unit-bits)))
 341             (declare (type bit-offset src-shift)
 342                      (type word-offset interior))
 343             (cond
 344              ((<= dst-offset src-offset)
 345               ;; We need to loop from left to right
 346               (let ((prev 0)
 347                     (next (funcall src-ref-fn src src-word-offset)))
 348                 (declare (type unit prev next))
 349                 (flet ((get-next-src ()
 350                          (setf prev next)
 351                          (setf next (funcall src-ref-fn src
 352                                              (incf src-word-offset)))))
 353                   (declare (inline get-next-src))
 354                   (unless (zerop dst-bit-offset)
 355                     (when (> src-bit-offset dst-bit-offset)
 356                       (get-next-src))
 357                     (let ((mask (end-mask (- dst-bit-offset)))
 358                           (orig (funcall dst-ref-fn dst dst-word-offset))
 359                           (value (32bit-logical-or
 360                                   (shift-towards-start prev src-shift)
 361                                   (shift-towards-end next (- src-shift)))))
 362                       (declare (type unit mask orig value))
 363                       (funcall dst-set-fn dst dst-word-offset
 364                                (32bit-logical-or
 365                                 (32bit-logical-and value mask)
 366                                 (32bit-logical-andc2 orig mask)))
 367                       (incf dst-word-offset)))
 368                   (dotimes (i interior)
 369                     (get-next-src)
 370                     (let ((value (32bit-logical-or
 371                                   (shift-towards-end next (- src-shift))
 372                                   (shift-towards-start prev src-shift))))
 373                       (declare (type unit value))
 374                       (funcall dst-set-fn dst dst-word-offset value)
 375                       (incf dst-word-offset)))
 376                   (unless (zerop final-bits)
 377                     (let ((value
 378                            (if (> (+ final-bits src-shift) unit-bits)
 379                                (progn
 380                                  (get-next-src)
 381                                  (32bit-logical-or
 382                                   (shift-towards-end next (- src-shift))
 383                                   (shift-towards-start prev src-shift)))
 384                                (shift-towards-start next src-shift)))
 385                           (mask (start-mask final-bits))
 386                           (orig (funcall dst-ref-fn dst dst-word-offset)))
 387                       (declare (type unit mask orig value))
 388                       (funcall dst-set-fn dst dst-word-offset
 389                                (32bit-logical-or
 390                                 (32bit-logical-and value mask)
 391                                 (32bit-logical-andc2 orig mask))))))))
 392              (t
 393               ;; We need to loop from right to left.
 394               (incf dst-word-offset words)
 395               (incf src-word-offset
 396                     (1- (ceiling (+ src-bit-offset length) unit-bits)))
 397               (let ((next 0)
 398                     (prev (funcall src-ref-fn src src-word-offset)))
 399                 (declare (type unit prev next))
 400                 (flet ((get-next-src ()
 401                          (setf next prev)
 402                          (setf prev (funcall src-ref-fn src
 403                                              (decf src-word-offset)))))
 404                   (declare (inline get-next-src))
 405                   (unless (zerop final-bits)
 406                     (when (> final-bits (- unit-bits src-shift))
 407                       (get-next-src))
 408                     (let ((value (32bit-logical-or
 409                                   (shift-towards-end next (- src-shift))
 410                                   (shift-towards-start prev src-shift)))
 411                           (mask (start-mask final-bits))
 412                           (orig (funcall dst-ref-fn dst dst-word-offset)))
 413                       (declare (type unit mask orig value))
 414                       (funcall dst-set-fn dst dst-word-offset
 415                                (32bit-logical-or
 416                                 (32bit-logical-and value mask)
 417                                 (32bit-logical-andc2 orig mask)))))
 418                   (decf dst-word-offset)
 419                   (dotimes (i interior)
 420                     (get-next-src)
 421                     (let ((value (32bit-logical-or
 422                                   (shift-towards-end next (- src-shift))
 423                                   (shift-towards-start prev src-shift))))
 424                       (declare (type unit value))
 425                       (funcall dst-set-fn dst dst-word-offset value)
 426                       (decf dst-word-offset)))
 427                   (unless (zerop dst-bit-offset)
 428                     (if (> src-bit-offset dst-bit-offset)
 429                         (get-next-src)
 430                         (setf next prev prev 0))
 431                     (let ((mask (end-mask (- dst-bit-offset)))
 432                           (orig (funcall dst-ref-fn dst dst-word-offset))
 433                           (value (32bit-logical-or
 434                                   (shift-towards-start prev src-shift)
 435                                   (shift-towards-end next (- src-shift)))))
 436                       (declare (type unit mask orig value))
 437                       (funcall dst-set-fn dst dst-word-offset
 438                                (32bit-logical-or
 439                                 (32bit-logical-and value mask)
 440                                 (32bit-logical-andc2 orig mask)))))))))))))))
 441   (values))
 442 \f
 443 ;;;; the actual bashers
 444
 445 (defun bit-bash-fill (value dst dst-offset length)
 446   (declare (type unit value) (type offset dst-offset length))
 447   (locally
 448    (declare (optimize (speed 3) (safety 0)))
 449    (do-constant-bit-bash dst dst-offset length value
 450                          #'%raw-bits #'%set-raw-bits)))
 451
 452 (defun system-area-fill (value dst dst-offset length)
 453   (declare (type unit value) (type offset dst-offset length))
 454   (locally
 455    (declare (optimize (speed 3) (safety 0)))
 456    (multiple-value-bind (dst dst-offset) (fix-sap-and-offset dst dst-offset)
 457      (do-constant-bit-bash dst dst-offset length value
 458                            #'word-sap-ref #'%set-word-sap-ref))))
 459
 460 (defun bit-bash-copy (src src-offset dst dst-offset length)
 461   (declare (type offset src-offset dst-offset length))
 462   (locally
 463    (declare (optimize (speed 3) (safety 0))
 464             (inline do-unary-bit-bash))
 465    (do-unary-bit-bash src src-offset dst dst-offset length
 466                       #'%raw-bits #'%set-raw-bits #'%raw-bits)))
 467
 468 (defun system-area-copy (src src-offset dst dst-offset length)
 469   (declare (type offset src-offset dst-offset length))
 470   (locally
 471    (declare (optimize (speed 3) (safety 0)))
 472    (multiple-value-bind (src src-offset) (fix-sap-and-offset src src-offset)
 473      (declare (type system-area-pointer src))
 474      (multiple-value-bind (dst dst-offset) (fix-sap-and-offset dst dst-offset)
 475        (declare (type system-area-pointer dst))
 476        (do-unary-bit-bash src src-offset dst dst-offset length
 477                           #'word-sap-ref #'%set-word-sap-ref
 478                           #'word-sap-ref)))))
 479
 480 (defun copy-to-system-area (src src-offset dst dst-offset length)
 481   (declare (type offset src-offset dst-offset length))
 482   (locally
 483    (declare (optimize (speed 3) (safety 0)))
 484    (multiple-value-bind (dst dst-offset) (fix-sap-and-offset dst dst-offset)
 485      (do-unary-bit-bash src src-offset dst dst-offset length
 486                         #'word-sap-ref #'%set-word-sap-ref #'%raw-bits))))
 487
 488 (defun copy-from-system-area (src src-offset dst dst-offset length)
 489   (declare (type offset src-offset dst-offset length))
 490   (locally
 491    (declare (optimize (speed 3) (safety 0)))
 492    (multiple-value-bind (src src-offset) (fix-sap-and-offset src src-offset)
 493      (do-unary-bit-bash src src-offset dst dst-offset length
 494                         #'%raw-bits #'%set-raw-bits #'word-sap-ref))))
 495
 496 ;;; a common idiom for calling COPY-TO-SYSTEM-AREA
 497 ;;;
 498 ;;; Copy the entire contents of the vector V to memory starting at SAP+OFFSET.
 499 (defun copy-byte-vector-to-system-area (bv sap &optional (offset 0))
 500   ;; FIXME: There should be a type like SB!VM:BYTE so that we can write this
 501   ;; type as (SIMPLE-ARRAY SB!VM:BYTE 1). Except BYTE is an external symbol of
 502   ;; package CL; so maybe SB!VM:VM-BYTE?
 503   (declare (type (simple-array (unsigned-byte 8) 1) bv))
 504   (declare (type sap sap))
 505   (declare (type fixnum offset))
 506   ;; FIXME: Actually it looks as though this, and most other calls
 507   ;; to COPY-TO-SYSTEM-AREA, could be written more concisely with BYTE-BLT.
 508   ;; Except that the DST-END-DST-START convention for the length is confusing.
 509   ;; Perhaps I could rename BYTE-BLT to BYTE-BLIT and replace the
 510   ;; DST-END argument with an N-BYTES argument?
 511   (copy-to-system-area bv
 512                        (* sb!vm:vector-data-offset sb!vm:word-bits)
 513                        sap
 514                        offset
 515                        (* (length bv) sb!vm:byte-bits)))