/[cffi-objects]/array.lisp
ViewVC logotype

Contents of /array.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (hide annotations)
Sat Dec 29 14:39:56 2012 UTC (15 months, 2 weeks ago) by rklochkov
File size: 2554 byte(s)
Added support of older CFFI versions (<= 10.7)
1 rklochkov 2 ;;;
2     ;;; array.lisp --- array
3     ;;;
4     ;;; Copyright (C) 2012, Roman Klochkov <monk@slavsoft.surgut.ru>
5     ;;;
6    
7     (in-package #:cffi-objects)
8    
9     (defvar *array-length* (foreign-alloc :uint))
10    
11     ;; TODO: add with-pointer-to-vector-data optimization
12     (define-foreign-type cffi-array (freeable)
13     ((element-type :initarg :type :accessor element-type))
14     (:actual-type :pointer))
15    
16 rklochkov 8 (define-parse-method carray (type &rest rest)
17     (apply #'make-instance 'cffi-array :type type rest))
18 rklochkov 2
19     (defmethod translate-to-foreign (value (cffi-array cffi-array))
20     (if (pointerp value)
21     value
22     (let* ((length (length value))
23     (type (element-type cffi-array))
24     (res (foreign-alloc type :count length)))
25 rklochkov 13 (if (struct-p type)
26     (dotimes (i length (values res t))
27 rklochkov 16 (clos->struct (second type) (elt value i)
28     (ptr-struct res type i)))
29 rklochkov 13 (dotimes (i length (values res t))
30     (setf (mem-aref res type i) (elt value i)))))))
31 rklochkov 2
32     (defmethod translate-from-foreign (ptr (cffi-array cffi-array))
33     (let ((array-length (mem-ref *array-length* :uint)))
34     (let* ((res (make-array array-length))
35 rklochkov 13 (type (element-type cffi-array)))
36     (if (struct-p type)
37     (dotimes (i array-length res)
38 rklochkov 16 (setf (aref res i) (convert-from-foreign (ptr-struct ptr type i)
39     type)))
40 rklochkov 13 (dotimes (i array-length res)
41     (setf (aref res i) (mem-aref ptr type i)))))))
42 rklochkov 2
43     (define-foreign-type cffi-null-array (freeable)
44     ((element-type :initarg :type :accessor element-type))
45     (:actual-type :pointer))
46    
47 rklochkov 8 (define-parse-method null-array (type &rest rest)
48     (apply #'make-instance 'cffi-null-array :type type rest))
49 rklochkov 2
50     (defmethod translate-to-foreign (value (cffi-null-array cffi-null-array))
51     (if (pointerp value)
52     value
53     (let* ((length (length value))
54     (type (element-type cffi-null-array))
55     (res (foreign-alloc type :count (+ 1 length))))
56     (dotimes (i length (values res t))
57     (setf (mem-aref res type i) (elt value i)))
58     (setf (mem-aref res :pointer length) (null-pointer))
59     res)))
60    
61     (defmethod translate-from-foreign (ptr (cffi-null-array cffi-null-array))
62     (let* ((res nil)
63     (el-type (element-type cffi-null-array)))
64     (do ((i 0 (+ i 1))) ((null-pointer-p (mem-aref ptr :pointer i)))
65     (push (mem-aref ptr el-type i) res))
66     (coerce (nreverse res) 'array)))
67    
68 rklochkov 13 (defctype string-array (null-array :string) "Zero-terminated string array")
69    

  ViewVC Help
Powered by ViewVC 1.1.5