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