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

Contents of /freeable.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations)
Mon Feb 20 18:55:20 2012 UTC (2 years, 1 month ago) by rklochkov
File size: 2373 byte(s)
Added array with variable length
1 ;;;; -*- Mode: lisp -*-
2 ;;;
3 ;;; freeable.lisp --- Interface for objects, that may be freed after use
4 ;;;
5 ;;; Copyright (C) 2011, Roman Klochkov <kalimehtar@mail.ru>
6 ;;;
7
8 (in-package #:cffi-objects)
9
10 (define-foreign-type freeable-base ()
11 ((free :accessor object-free :initarg :free :initform :no-transfer
12 :type (member :none :all :no-transfer :transfer :container)
13 :documentation "Free returned or sent value.
14 :NONE -- no free at all
15 :ALL -- free always (after sending to FFI, or after recieved translation)
16 :TRANSFER -- client frees, so free after recieve
17 :NO-TRANSFER -- host frees, so free after sending to FFI.
18 :CONTAINER -- the object is a container, ALL for container and NO-TRANSFER for
19 contained items
20 You should call FREE-RETURNED-IF-NEEDED and FREE-SENT-IF-NEEDED in
21 appropriate places of your CFFI translators")))
22
23 (defgeneric free-ptr (type ptr)
24 (:documentation "Called to free ptr, unless overriden free-sent-ptr or free-returned-ptr.")
25 (:method (type ptr)
26 (foreign-free ptr)))
27
28 (defgeneric free-sent-ptr (type ptr)
29 (:method ((type freeable-base) ptr)
30 (free-ptr type ptr)))
31
32 (defgeneric free-returned-ptr (type ptr)
33 (:method ((type freeable-base) ptr)
34 (free-ptr type ptr)))
35
36 (defun free-sent-if-needed (type ptr)
37 (when (member (object-free type) '(:all :container :no-transfer))
38 (free-sent-ptr type ptr)))
39
40 (defun free-returned-if-needed (type ptr)
41 (when (member (object-free type) '(:all :container :transfer))
42 (free-returned-ptr type ptr)))
43
44 (defclass freeable (freeable-base) ()
45 (:documentation "Mixing to auto-set translators"))
46
47 (defmethod free-translated-object :after (ptr (type freeable) param)
48 (declare (ignore param))
49 (free-sent-if-needed type ptr))
50
51 (defmethod translate-from-foreign :after (ptr (type freeable))
52 (free-returned-if-needed type ptr))
53
54 (define-foreign-type freeable-out (freeable)
55 ((out :accessor object-out :initarg :out :initform t
56 :documentation "This is out param (for fill in foreign side)"))
57 (:documentation "For returning data in out params.
58 To use translate-to-foreign MUST return (values ptr place)"))
59
60 (defgeneric copy-from-foreign (type ptr place)
61 (:documentation "Transfers data from pointer PTR to PLACE"))
62
63 (defmethod free-translated-object :before (ptr (type freeable-out) place)
64 (when (object-out type)
65 (copy-from-foreign type ptr place)))

  ViewVC Help
Powered by ViewVC 1.1.5