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

Contents of /freeable.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (hide annotations)
Mon May 7 17:27:22 2012 UTC (23 months, 2 weeks ago) by rklochkov
File size: 2567 byte(s)
Minor fixes
1 rklochkov 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 rklochkov 4 :type (member nil :none t :all :no-transfer :transfer :container)
13 rklochkov 1 :documentation "Free returned or sent value.
14 rklochkov 4 :NONE, nil -- no free at all
15     :ALL, t -- free always (after sending to FFI, or after recieved translation)
16 rklochkov 1 :TRANSFER -- client frees, so free after recieve
17     :NO-TRANSFER -- host frees, so free after sending to FFI.
18 rklochkov 2 :CONTAINER -- the object is a container, ALL for container and NO-TRANSFER for
19     contained items
20 rklochkov 1 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 rklochkov 3 (format t "Free-sent-ptr: ~a ~a ~%" type ptr)
31 rklochkov 4 (unless (null-pointer-p ptr)
32     (free-ptr type ptr))))
33 rklochkov 1
34     (defgeneric free-returned-ptr (type ptr)
35     (:method ((type freeable-base) ptr)
36 rklochkov 3 (format t "Free-returned-ptr: ~a ~a ~%" type ptr)
37 rklochkov 4 (unless (null-pointer-p ptr)
38     (free-ptr type ptr))))
39 rklochkov 1
40     (defun free-sent-if-needed (type ptr)
41 rklochkov 4 (when (member (object-free type) '(t :all :container :no-transfer))
42 rklochkov 1 (free-sent-ptr type ptr)))
43    
44     (defun free-returned-if-needed (type ptr)
45 rklochkov 4 (when (member (object-free type) '(t :all :container :transfer))
46 rklochkov 1 (free-returned-ptr type ptr)))
47    
48     (defclass freeable (freeable-base) ()
49     (:documentation "Mixing to auto-set translators"))
50    
51     (defmethod free-translated-object :after (ptr (type freeable) param)
52     (declare (ignore param))
53     (free-sent-if-needed type ptr))
54    
55     (defmethod translate-from-foreign :after (ptr (type freeable))
56     (free-returned-if-needed type ptr))
57    
58     (define-foreign-type freeable-out (freeable)
59     ((out :accessor object-out :initarg :out :initform t
60     :documentation "This is out param (for fill in foreign side)"))
61     (:documentation "For returning data in out params.
62     To use translate-to-foreign MUST return (values ptr place)"))
63    
64     (defgeneric copy-from-foreign (type ptr place)
65     (:documentation "Transfers data from pointer PTR to PLACE"))
66    
67     (defmethod free-translated-object :before (ptr (type freeable-out) place)
68     (when (object-out type)
69     (copy-from-foreign type ptr place)))

  ViewVC Help
Powered by ViewVC 1.1.5