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

Diff of /array.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2 by rklochkov, Mon Feb 20 18:55:20 2012 UTC revision 15 by rklochkov, Tue Dec 25 01:10:43 2012 UTC
# Line 13  Line 13 
13    ((element-type :initarg :type :accessor element-type))    ((element-type :initarg :type :accessor element-type))
14    (:actual-type :pointer))    (:actual-type :pointer))
15    
16  (define-parse-method carray (type &key free)  (define-parse-method carray (type &rest rest)
17    (make-instance 'cffi-array :type type :free free))    (apply #'make-instance 'cffi-array :type type rest))
18    
19  (defmethod translate-to-foreign (value (cffi-array cffi-array))  (defmethod translate-to-foreign (value (cffi-array cffi-array))
20    (if (pointerp value)    (if (pointerp value)
# Line 22  Line 22 
22        (let* ((length (length value))        (let* ((length (length value))
23               (type (element-type cffi-array))               (type (element-type cffi-array))
24               (res (foreign-alloc type :count length)))               (res (foreign-alloc type :count length)))
25          (dotimes (i length (values res t))          (if (struct-p type)
26            (setf (mem-aref res type i) (elt value i)))              (dotimes (i length (values res t))
27          res)))                (clos->struct (second type) (elt value i) (mem-aptr res type i)))
28                (dotimes (i length (values res t))
29                  (setf (mem-aref res type i) (elt value i)))))))
30    
31  (defmethod translate-from-foreign (ptr (cffi-array cffi-array))  (defmethod translate-from-foreign (ptr (cffi-array cffi-array))
32    (let ((array-length (mem-ref *array-length* :uint)))    (let ((array-length (mem-ref *array-length* :uint)))
33      (let* ((res (make-array array-length))      (let* ((res (make-array array-length))
34             (el-type (element-type cffi-array)))             (type (element-type cffi-array)))
35        (dotimes (i array-length)        (if (struct-p type)
36          (setf (aref res i) (mem-aref ptr el-type i)))            (dotimes (i array-length res)
37        res)))              (setf (aref res i) (convert-from-foreign
38                                    (mem-aptr ptr (list :struct (second type)) i)
39                                    type)))
40              (dotimes (i array-length res)
41                (setf (aref res i) (mem-aref ptr type i)))))))
42    
43  (define-foreign-type cffi-null-array (freeable)  (define-foreign-type cffi-null-array (freeable)
44    ((element-type :initarg :type :accessor element-type))    ((element-type :initarg :type :accessor element-type))
45    (:actual-type :pointer))    (:actual-type :pointer))
46    
47  (define-parse-method null-array (type &key free)  (define-parse-method null-array (type &rest rest)
48    (make-instance 'cffi-null-array :type type :free free))    (apply #'make-instance 'cffi-null-array :type type rest))
49    
50  (defmethod translate-to-foreign (value (cffi-null-array cffi-null-array))  (defmethod translate-to-foreign (value (cffi-null-array cffi-null-array))
51    (if (pointerp value)    (if (pointerp value)
# Line 59  Line 65 
65        (push (mem-aref ptr el-type i) res))        (push (mem-aref ptr el-type i) res))
66      (coerce (nreverse res) 'array)))      (coerce (nreverse res) 'array)))
67    
 (defctype string-array (null-array :string) "Zero-terminated string array")  
68    (defctype string-array (null-array :string) "Zero-terminated string array")
69    

Legend:
Removed from v.2  
changed lines
  Added in v.15

  ViewVC Help
Powered by ViewVC 1.1.5