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

Contents of /array.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations)
Mon Feb 20 18:55:20 2012 UTC (2 years, 2 months ago) by rklochkov
File size: 2162 byte(s)
Added array with variable length
1 ;;;
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 (define-parse-method carray (type &key free)
17 (make-instance 'cffi-array :type type :free free))
18
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 (dotimes (i length (values res t))
26 (setf (mem-aref res type i) (elt value i)))
27 res)))
28
29 (defmethod translate-from-foreign (ptr (cffi-array cffi-array))
30 (let ((array-length (mem-ref *array-length* :uint)))
31 (let* ((res (make-array array-length))
32 (el-type (element-type cffi-array)))
33 (dotimes (i array-length)
34 (setf (aref res i) (mem-aref ptr el-type i)))
35 res)))
36
37 (define-foreign-type cffi-null-array (freeable)
38 ((element-type :initarg :type :accessor element-type))
39 (:actual-type :pointer))
40
41 (define-parse-method null-array (type &key free)
42 (make-instance 'cffi-null-array :type type :free free))
43
44 (defmethod translate-to-foreign (value (cffi-null-array cffi-null-array))
45 (if (pointerp value)
46 value
47 (let* ((length (length value))
48 (type (element-type cffi-null-array))
49 (res (foreign-alloc type :count (+ 1 length))))
50 (dotimes (i length (values res t))
51 (setf (mem-aref res type i) (elt value i)))
52 (setf (mem-aref res :pointer length) (null-pointer))
53 res)))
54
55 (defmethod translate-from-foreign (ptr (cffi-null-array cffi-null-array))
56 (let* ((res nil)
57 (el-type (element-type cffi-null-array)))
58 (do ((i 0 (+ i 1))) ((null-pointer-p (mem-aref ptr :pointer i)))
59 (push (mem-aref ptr el-type i) res))
60 (coerce (nreverse res) 'array)))
61
62 (defctype string-array (null-array :string) "Zero-terminated string array")

  ViewVC Help
Powered by ViewVC 1.1.5