chiark - git - mdw - clg/blob - gffi/vectors.lisp

   1 ;; Common Lisp bindings for GTK+ 2.x
   2 ;; Copyright 1999-2006 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   4 ;; Permission is hereby granted, free of charge, to any person obtaining
   5 ;; a copy of this software and associated documentation files (the
   6 ;; "Software"), to deal in the Software without restriction, including
   7 ;; without limitation the rights to use, copy, modify, merge, publish,
   8 ;; distribute, sublicense, and/or sell copies of the Software, and to
   9 ;; permit persons to whom the Software is furnished to do so, subject to
  10 ;; the following conditions:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  22
  23 ;; $Id: vectors.lisp,v 1.1 2006-04-25 20:40:57 espen Exp $
  24
  25
  26 (in-package "GFFI")
  27
  28 ;;; Vector
  29
  30 (defun make-c-vector (type length &key content location temp)
  31   (let* ((element-size (size-of type))
  32          (location (or location (allocate-memory (* element-size length))))
  33          (writer (writer-function type :temp temp)))
  34     (etypecase content
  35       (vector
  36        (loop
  37         for element across content
  38         for i below length
  39         for offset by element-size
  40         do (funcall writer element location offset)))
  41       (list
  42        (loop
  43         for element in content
  44         for i below length
  45         for offset by element-size
  46         do (funcall writer element location offset))))
  47     location))
  48
  49
  50 (defun map-c-vector (seqtype function location element-type length
  51                      &optional (ref :read))
  52   (let ((reader (reader-function element-type :ref ref))
  53         (element-size (size-of element-type)))
  54     (case seqtype
  55      ((nil)
  56       (loop
  57        for i below length
  58        for offset by element-size
  59        do (funcall function (funcall reader location offset))))
  60      (list
  61       (loop
  62        for i below length
  63        for offset by element-size
  64        collect (funcall function (funcall reader location offset))))
  65      (t
  66       (loop
  67        with sequence = (make-sequence seqtype length)
  68        for i below length
  69        for offset by element-size
  70        do (setf
  71            (elt sequence i)
  72            (funcall function (funcall reader location offset)))
  73        finally (return sequence))))))
  74
  75
  76 (defun unset-c-vector (location element-type length &optional temp-p)
  77   (loop
  78    with destroy = (destroy-function element-type :temp temp-p)
  79    with element-size = (size-of element-type)
  80    for i below length
  81    for offset by element-size
  82    do (funcall destroy location offset)))
  83
  84
  85 (defun destroy-c-vector (location element-type length &optional temp-p)
  86   (unset-c-vector location element-type length temp-p)
  87   (deallocate-memory location))
  88
  89
  90 (defmacro with-c-vector (var type content &body body)
  91   (let ((length (make-symbol "LENGTH")))
  92     `(let ((,length (length ,content)))
  93        (with-memory (,var (* ,(size-of type) ,length))
  94          (make-c-vector ',type ,length :content ,content :location ,var :temp t)
  95          (unwind-protect
  96              (progn ,@body)
  97            (unset-c-vector ,var ',type ,length t))))))
  98
  99
 100 (define-type-method alien-type ((type vector))
 101   (declare (ignore type))
 102   (alien-type 'pointer))
 103
 104 (define-type-method size-of ((type vector) &key inlined)
 105   (if inlined
 106       (destructuring-bind (element-type &optional (length '*))
 107           (rest (type-expand-to 'vector type))
 108         (if (eq length '*)
 109             (error "Can't inline vector with variable size: ~A" type)
 110           (* (size-of element-type) length)))
 111     (size-of 'pointer)))
 112
 113 (define-type-method alien-arg-wrapper ((type vector) var vector style form &optional copy-in-p)
 114   (destructuring-bind (element-type &optional (length '*))
 115       (rest (type-expand-to 'vector type))
 116     (when (and (eq length '*) (out-arg-p style))
 117       (error "Can't use vector with variable size as return type"))
 118     (cond
 119       ((and (in-arg-p style) copy-in-p)
 120        `(with-pointer (,var `(make-c-vector ',element-type
 121                               ,(if (eq length '*) `(length ,vector) length)
 122                               :content ,vector))
 123          ,form))
 124       ((and (in-arg-p style) (not (out-arg-p style)))
 125        `(with-memory (,var ,(if (eq length '*)
 126                                 `(* ,(size-of element-type)
 127                                     (length ,vector))
 128                               `(* ,(size-of element-type) ,length)))
 129           (make-c-vector ',element-type
 130            ,(if (eq length '*) `(length ,vector) length)
 131            :content ,vector :location ,var :temp t)
 132           (unwind-protect
 133               ,form
 134             (unset-c-vector ,var ',element-type
 135              ,(if (eq length '*) `(length ,vector) length) t))))
 136       ((and (in-arg-p style) (out-arg-p style))
 137        (let ((c-vector (make-symbol "C-VECTOR")))
 138          `(with-memory (,c-vector (* ,(size-of element-type) length))
 139             (make-c-vector ',element-type ,length
 140              :content ,vector :location ,c-vector :temp t)
 141             (with-pointer (,var ,c-vector)
 142               (unwind-protect
 143                   ,form
 144                 (unset-c-vector ,c-vector ',element-type ,length t))))))
 145       ((and (out-arg-p style) (not (in-arg-p style)))
 146        `(with-pointer (,var)
 147           ,form)))))
 148
 149 ;; This will enable us specify vectors with variable length in C callbacks
 150 (define-type-method callback-wrapper ((type vector) var vector form)
 151   (funcall (find-applicable-type-method 'callback-wrapper t) type var vector form))
 152
 153 (define-type-method to-alien-form ((type vector) vector &optional copy-p)
 154   (declare (ignore copy-p))
 155   (destructuring-bind (element-type &optional (length '*))
 156       (rest (type-expand-to 'vector type))
 157     `(make-c-vector ',element-type
 158       ,(if (eq length '*) `(length ,vector) length) :content ,vector)))
 159
 160
 161 (define-type-method from-alien-form ((type vector) form &key (ref :free))
 162   (destructuring-bind (element-type &optional (length '*))
 163       (rest (type-expand-to 'vector type))
 164     (if (eq length '*)
 165         (error "Can't use vector of variable size as return type")
 166       `(let ((c-vector ,form))
 167          (prog1
 168              (map-c-vector 'vector #'identity c-vector ',element-type ,length
 169               ,(ecase ref (:free :get) ((:static :temp) :peek) (:copy :read)))
 170            ,(when (eq ref :free)
 171               `(deallocate-memory c-vector)))))))
 172
 173
 174 (define-type-method writer-function ((type vector) &key temp inlined)
 175   (destructuring-bind (element-type &optional (length '*))
 176       (rest (type-expand-to 'vector type))
 177     (if inlined
 178         (if (eq length '*)
 179             (error "Can't inline vector with variable size: ~A" type)
 180           #'(lambda (vector location &optional (offset 0))
 181               (make-c-vector element-type length
 182                :location (pointer+ location offset)
 183                :content vector :temp temp)))
 184       #'(lambda (vector location &optional (offset 0))
 185           (setf
 186            (ref-pointer location offset)
 187            (make-c-vector element-type length :content vector :temp temp))))))
 188
 189 (define-type-method reader-function ((type vector) &key (ref :read) inlined)
 190   (destructuring-bind (element-type &optional (length '*))
 191       (rest (type-expand-to 'vector type))
 192     (cond
 193      ((eq length '*)
 194       (error "Can't create reader function for vector with variable size"))
 195      (inlined
 196       #'(lambda (location &optional (offset 0))
 197           (map-c-vector 'vector #'identity (pointer+ location offset)
 198            element-type length ref)))
 199      (t
 200       (ecase ref
 201         ((:read :peek)
 202          #'(lambda (location &optional (offset 0))
 203              (unless (null-pointer-p (ref-pointer location offset))
 204                (map-c-vector 'vector #'identity (ref-pointer location offset)
 205                 element-type length ref))))
 206         (:get
 207          #'(lambda (location &optional (offset 0))
 208              (unless (null-pointer-p (ref-pointer location offset))
 209                (prog1
 210                    (map-c-vector 'vector #'identity
 211                     (ref-pointer location offset) element-type length :get)
 212                  (deallocate-memory (ref-pointer location offset))
 213                  (setf (ref-pointer location offset) (make-pointer 0)))))))))))
 214
 215 (define-type-method destroy-function ((type vector) &key temp inlined)
 216   (destructuring-bind (element-type &optional (length '*))
 217       (rest (type-expand-to 'vector type))
 218     (cond
 219      ((eq length '*)
 220       (error "Can't create destroy function for vector with variable size"))
 221      (inlined
 222       #'(lambda (location &optional (offset 0))
 223           (unset-c-vector (pointer+ location offset)
 224            element-type length temp)))
 225      (t
 226       #'(lambda (location &optional (offset 0))
 227           (unless (null-pointer-p (ref-pointer location offset))
 228             (destroy-c-vector (ref-pointer location offset)
 229              element-type length temp)
 230             (setf (ref-pointer location offset) (make-pointer 0))))))))
 231
 232 (define-type-method copy-function ((type vector) &key inlined)
 233   (destructuring-bind (element-type &optional (length '*))
 234       (rest (type-expand-to 'vector type))
 235     (cond
 236      ((eq length '*) (error "Can't copy vector with variable size: ~A" type))
 237      (inlined
 238       (let ((copy-element (copy-function element-type))
 239             (element-size (size-of element-type)))
 240         #'(lambda (from to &optional (offset 0))
 241             (loop
 242              repeat length
 243              for element from offset by element-size
 244              do (funcall copy-element from to element)))))
 245      (t
 246       (let ((size (* length (size-of element-type)))
 247             (copy-content (copy-function type :inlined t)))
 248         #'(lambda (from to &optional (offset 0))
 249             (unless (null-pointer-p (ref-pointer from offset))
 250               (let ((vector (allocate-memory size)))
 251                 (setf (ref-pointer to offset) vector)
 252                 (funcall copy-content (ref-pointer from offset) vector)))))))))
 253
 254
 255 ;;;; Null terminated vector
 256
 257 (defun make-0-vector (type &key content location temp)
 258   (let* ((element-size (size-of type))
 259          (length (length content))
 260          (location (or location (allocate-memory (* element-size (1+ length))))))
 261     (make-c-vector type length :content content :location location :temp temp)))
 262
 263
 264 (defun map-0-vector (seqtype function location element-type &optional (ref :read))
 265   (let ((reader (reader-function element-type :ref ref))
 266         (element-size (size-of element-type)))
 267     (case seqtype
 268      ((nil)
 269       (loop
 270        for offset by element-size
 271        until (memory-clear-p (pointer+ location offset) element-size)
 272        do (funcall function (funcall reader location offset))))
 273      (list
 274       (loop
 275        for offset by element-size
 276        until (memory-clear-p (pointer+ location offset) element-size)
 277        collect (funcall function (funcall reader location offset))))
 278      (t
 279       (coerce
 280        (loop
 281         for offset by element-size
 282         until (memory-clear-p (pointer+ location offset) element-size)
 283         collect (funcall function (funcall reader location offset)))
 284        seqtype)))))
 285
 286
 287 (defun unset-0-vector (location element-type &optional temp-p)
 288   (loop
 289    with destroy = (destroy-function element-type temp-p)
 290    with element-size = (size-of element-type)
 291    for offset by element-size
 292    until (memory-clear-p (pointer+ location offset) element-size)
 293    do (funcall destroy location offset)))
 294
 295 (defun destroy-0-vector (location element-type &optional temp-p)
 296   (unset-0-vector location element-type temp-p)
 297   (deallocate-memory location))
 298
 299
 300 (deftype vector0 (element-type) `(vector ,element-type))
 301 (deftype null-terminated-vector (element-type) `(vector0 ,element-type))
 302
 303 (define-type-method alien-type ((type vector0))
 304   (declare (ignore type))
 305   (alien-type 'pointer))
 306
 307 (define-type-method size-of ((type vector0) &key inlined)
 308   (assert-not-inlined type inlined)
 309   (size-of 'pointer))
 310
 311 (define-type-method alien-arg-wrapper ((type vector0) var vector style form &optional copy-in-p)
 312   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 313     (cond
 314       ((and (in-arg-p style) copy-in-p)
 315        `(with-pointer (,var (make-0-vector ',element-type :content ,vector))
 316           ,form))
 317       ((and (in-arg-p style) (not (out-arg-p style)))
 318        `(with-memory (,var (* ,(size-of element-type) (1+ (length ,vector))))
 319           (make-0-vector ',element-type :content ,vector :location ,var :temp t)
 320           (unwind-protect
 321               ,form
 322             (unset-0-vector ,var ',element-type t))))
 323       ((and (in-arg-p style) (out-arg-p style))
 324        (let ((c-vector (make-symbol "C-VECTOR")))
 325          `(with-memory (,c-vector (* ,(size-of element-type) (1+ (length ,vector))))
 326             (make-0-vector ',element-type :content ,vector :location ,c-vector :temp t)
 327             (with-pointer (,var ,c-vector)
 328               (unwind-protect
 329                   ,form
 330                 (unset-0-vector ,c-vector ',element-type t))))))
 331       ((and (out-arg-p style) (not (in-arg-p style)))
 332        `(with-pointer (,var)
 333           ,form)))))
 334
 335
 336 (define-type-method to-alien-form ((type vector0) vector &optional copy-p)
 337   (declare (ignore copy-p))
 338   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 339     `(make-0-vector ',element-type :content ,vector)))
 340
 341 (define-type-method from-alien-form ((type vector0) form  &key (ref :free))
 342   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 343     `(let ((c-vector ,form))
 344        (prog1
 345            (map-0-vector 'vector #'identity c-vector ',element-type
 346             ,(ecase ref (:free :get) ((:static :temp) :peek) (:copy :read)))
 347          ,(when (eq ref :free)
 348             `(deallocate-memory c-vector))))))
 349
 350
 351 (define-type-method writer-function ((type vector0) &key temp inlined)
 352   (assert-not-inlined type inlined)
 353   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 354     #'(lambda (vector location &optional (offset 0))
 355         (setf
 356          (ref-pointer location offset)
 357          (make-0-vector element-type :content vector :temp temp)))))
 358
 359 (define-type-method reader-function ((type vector0) &key (ref :read) inlined)
 360   (assert-not-inlined type inlined)
 361   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 362     (ecase ref
 363       ((:read :peek)
 364        #'(lambda (location &optional (offset 0))
 365            (unless (null-pointer-p (ref-pointer location offset))
 366              (map-0-vector 'vector #'identity (ref-pointer location offset)
 367               element-type ref))))
 368       (:get
 369        #'(lambda (location &optional (offset 0))
 370            (unless (null-pointer-p (ref-pointer location offset))
 371              (prog1
 372                  (map-0-vector 'vector #'identity (ref-pointer location offset)
 373                   element-type :get)
 374                (deallocate-memory (ref-pointer location offset))
 375                (setf (ref-pointer location offset) (make-pointer 0)))))))))
 376
 377
 378 (define-type-method destroy-function ((type vector0) &key temp inlined)
 379   (assert-not-inlined type inlined)
 380   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 381     #'(lambda (location &optional (offset 0))
 382           (unless (null-pointer-p (ref-pointer location offset))
 383             (destroy-0-vector
 384              (ref-pointer location offset) element-type temp)
 385             (setf (ref-pointer location offset) (make-pointer 0))))))
 386
 387 (define-type-method copy-function ((type vector0) &key inlined)
 388   (assert-not-inlined type inlined)
 389   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
 390     (let ((copy-element (copy-function element-type))
 391           (element-size (size-of element-type)))
 392       #'(lambda (from to &optional (offset 0))
 393           (unless (null-pointer-p (ref-pointer from offset))
 394             (let* ((from-vector (ref-pointer from offset))
 395                    (length
 396                     (loop
 397                      for length from 0
 398                      for element by element-size
 399                      until (memory-clear-p from-vector element-size element)
 400                      finally (return length)))
 401                    (to-vector (setf
 402                                (ref-pointer to offset)
 403                                (allocate-memory (* length element-size)))))
 404               (loop
 405                repeat length
 406                for element by element-size
 407                do (funcall copy-element from-vector to-vector element))))))))
 408
 409 (define-type-method unbound-value ((type vector0))
 410   (declare (ignore type))
 411   nil)
 412
 413
 414
 415 ;;;; Counted vector
 416
 417 (defun make-counted-vector (type &key content location (counter-type 'unsigned-int) temp)
 418   (let* ((element-size (size-of type))
 419          (length (length content))
 420          (location (or
 421                     location
 422                     (allocate-memory
 423                      (+ (size-of counter-type) (* element-size length))))))
 424     (funcall (writer-function counter-type :temp temp) length location)
 425     (make-c-vector type length :content content :location (pointer+ location (size-of counter-type)))
 426     location))
 427
 428 (defun map-counted-vector (seqtype function location element-type &optional (counter-type 'unsigned-int) (ref :read))
 429   (let ((length (funcall (reader-function counter-type) location :ref ref)))
 430     (map-c-vector
 431      seqtype function (pointer+ location (size-of counter-type))
 432      element-type length)))
 433
 434 (defun unset-counted-vector (location element-type &optional (counter-type 'unsigned-int) temp-p)
 435   (let ((length (funcall (reader-function counter-type) location)))
 436     (unset-c-vector
 437      (pointer+ location (size-of counter-type)) element-type length temp-p)))
 438
 439 (defun destroy-counted-vector (location element-type &optional (counter-type 'unsigned-int) temp-p)
 440   (unset-counted-vector location element-type counter-type temp-p)
 441   (deallocate-memory location))
 442
 443
 444 (deftype counted-vector (element-type &optional counter-type)
 445   (declare (ignore counter-type))
 446   `(vector ,element-type))
 447
 448 (define-type-method alien-type ((type counted-vector))
 449   (declare (ignore type))
 450   (alien-type 'pointer))
 451
 452 (define-type-method size-of ((type counted-vector) &key inlined)
 453   (assert-not-inlined type inlined)
 454   (size-of 'pointer))
 455
 456 (define-type-method alien-arg-wrapper ((type counted-vector) var vector style form &optional copy-in-p)
 457   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 458       (rest (type-expand-to 'counted-vector type))
 459     (cond
 460       ((and (in-arg-p style) copy-in-p)
 461        `(with-pointer (,var (make-counted-vector ',element-type
 462                              :content ,vector :counter-type ',counter-type))
 463           ,form))
 464       ((and (in-arg-p style) (not (out-arg-p style)))
 465        `(with-memory (,var (+ (* ,(size-of element-type) (length ,vector)) ,(size-of counter-type)))
 466           (make-counted-vector ',element-type :content ,vector
 467            :location ,var :counter-type ',counter-type :temp t)
 468           (unwind-protect
 469               ,form
 470             (unset-counted-vector ,var ',element-type ',counter-type t))))
 471       ((and (in-arg-p style) (out-arg-p style))
 472        (let ((c-vector (make-symbol "C-VECTOR")))
 473          `(with-memory (,c-vector (+ (* ,(size-of element-type) (length ,vector)) ,(size-of counter-type)))
 474             (make-counted-vector ',element-type :content ,vector ,c-vector
 475              :counter-type ',counter-type :temp t)
 476             (with-pointer (,var ,c-vector)
 477               (unwind-protect
 478                   ,form
 479                 (unset-counted-vector ,c-vector ',element-type ',counter-type t))))))
 480       ((and (out-arg-p style) (not (in-arg-p style)))
 481        `(with-pointer (,var)
 482           ,form)))))
 483
 484
 485 (define-type-method to-alien-form ((type counted-vector) vector &optional copy-p)
 486   (declare (ignore copy-p))
 487   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 488       (rest (type-expand-to 'counted-vector type))
 489     `(make-counted-vector ',element-type
 490       :content ,vector :counter-type ',counter-type)))
 491
 492 (define-type-method from-alien-form ((type counted-vector) form  &key (ref :free))
 493   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 494       (rest (type-expand-to 'counted-vector type))
 495     `(let ((c-vector ,form))
 496        (prog1
 497            (map-counted-vector 'vector #'identity c-vector ',element-type ',counter-type
 498             ,(ecase ref (:free :get) ((:static :temp) :peek) (:copy :read)))
 499          ,(when (eq ref :free)
 500             `(deallocate c-vector))))))
 501
 502 (define-type-method writer-function ((type counted-vector) &key temp inlined)
 503   (assert-not-inlined type inlined)
 504   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 505       (rest (type-expand-to 'counted-vector type))
 506     #'(lambda (vector location &optional (offset 0))
 507         (setf
 508          (ref-pointer location offset)
 509          (make-counted-vector element-type :content vector
 510           :counter-type counter-type :temp temp)))))
 511
 512 (define-type-method reader-function ((type counted-vector) &key (ref :read) inlined)
 513   (assert-not-inlined type inlined)
 514   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 515       (rest (type-expand-to 'counted-vector type))
 516     (ecase ref
 517       ((:read :peek)
 518        #'(lambda (location &optional (offset 0))
 519            (unless (null-pointer-p (ref-pointer location offset))
 520              (map-counted-vector 'vector #'identity
 521               (ref-pointer location offset) element-type counter-type ref))))
 522       (:get
 523        #'(lambda (location &optional (offset 0))
 524            (unless (null-pointer-p (ref-pointer location offset))
 525              (prog1
 526                  (map-counted-vector 'vector #'identity
 527                   (ref-pointer location offset) element-type counter-type :get)
 528                (deallocate-memory (ref-pointer location offset))
 529                (setf (ref-pointer location offset) (make-pointer 0)))))))))
 530
 531 (define-type-method destroy-function ((type counted-vector) &key temp inlined)
 532   (assert-not-inlined type inlined)
 533   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 534       (rest (type-expand-to 'counted-vector type))
 535     #'(lambda (location &optional (offset 0))
 536         (unless (null-pointer-p (ref-pointer location offset))
 537           (destroy-counted-vector (ref-pointer location offset)
 538            element-type counter-type temp)
 539           (setf (ref-pointer location offset) (make-pointer 0))))))
 540
 541 (define-type-method copy-function ((type counted-vector) &key inlined)
 542   (assert-not-inlined type inlined)
 543   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
 544       (rest (type-expand-to 'counted-vector type))
 545     (let ((vector-length (reader-function counter-type))
 546           (counter-size (size-of counter-type))
 547           (copy-element (copy-function element-type))
 548           (element-size (size-of element-type)))
 549       #'(lambda (from to &optional (offset 0))
 550           (unless (null-pointer-p (ref-pointer from offset))
 551             (let* ((from-vector (ref-pointer from offset))
 552                    (length (funcall vector-length from-vector))
 553                    (to-vector  (setf
 554                                 (ref-pointer to offset)
 555                                 (allocate-memory (+ counter-size (* length element-size))))))
 556               (copy-memory from-vector counter-size to-vector)
 557               (loop
 558                repeat length
 559                for element from counter-size by element-size
 560                do (funcall copy-element from-vector to-vector element))))))))