source: trunk/abcl/patches/abcl-static-vectors.patch

Last change on this file was 15310, checked in by Mark Evenson, 4 years ago

ci: test STATIC-VECTORS

Tests <​https://github.com/armedbear/static-vectors/tree/abcl/easye-20200603a>.
File size: 2.4 KB

  • src/impl-abcl.lisp 

    # HG changeset patch
# User Mark <evenson.not.org@gmail.com>
# Date 1591169635 -7200
#      Wed Jun 03 09:33:55 2020 +0200
# Node ID a7e933901bf6d37ef87076d55c9a89c64a8b8192
# Parent  21795eddcbc9156a5542e9deac1960a95c668317
abcl: "final" initial implementation

Conditionalize compilation under on the presence of :NIO in
CL:*FEATURES* additions available abcl-1.6.2-dev and the unreleased
abcl-1.7.0 See <https://github.com/armedbear/abcl/pull/221> ff.

diff -r 21795eddcbc9 -r a7e933901bf6 src/impl-abcl.lisp
    a b  
    55
    66(in-package :static-vectors)
    77
     8#-nio
     9(error "For allocating memory via malloc() we need the :NIO-BUFFER
     10argument to CL:MAKE-ARRAY available in abcl-1.6.2-dev and the upcoming
     11abcl-1.7.0.")
     12
    813(declaim (inline fill-foreign-memory))
    914(defun fill-foreign-memory (pointer length value)
    1015  (foreign-funcall "memset" :pointer pointer :int value size-t length :pointer)
    … …  
    2227
    2328(declaim (inline %allocate-static-vector))
    2429(defun %allocate-static-vector (length element-type)
    25   (flet ((size-of (element-type)
    26            ;; assume 8-bit bytes
    27            1))
     30  (let* ((type
     31          (first element-type))
     32         (bits-per-byte
     33           (second element-type))
     34         (bytes-per-element  ;; ehh, not going to work well for element type not of size 8, 16, or 32
     35           (ceiling bits-per-byte 8)))
     36    (unless (subtypep element-type
     37                      '(or (unsigned-byte 8) (unsigned-byte 16) (unsigned-byte 32)))
     38      (signal 'type-error :datum element-type
     39                          :expected-type '(or
     40                                           (unsigned-byte 8)
     41                                           (unsigned-byte 16)
     42                                           (unsigned-byte 32))))
    2843    (let* ((bytes
    29              (* length (size-of element-type)))
     44             (* length bytes-per-element))
    3045           (heap-pointer
    3146             (jss:new "com.sun.jna.Memory" bytes))
    3247           (bytebuffer
    3348             (#"getByteBuffer" heap-pointer 0 bytes))
    3449           (static-vector
    35              (ext:make-bytebuffer-byte-vector bytebuffer)))
     50             (make-array length :element-type element-type :nio-buffer bytebuffer)))
    3651      (setf (gethash static-vector *static-vector-pointer*)
    3752            heap-pointer)
    3853      (values
Note: See TracBrowser for help on using the repository browser.