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

Diff of /freeable.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 5 by rklochkov, Sun Jul 29 15:15:41 2012 UTC
# Line 9  Line 9 
9    
10  (define-foreign-type freeable-base ()  (define-foreign-type freeable-base ()
11    ((free :accessor object-free :initarg :free :initform :no-transfer    ((free :accessor object-free :initarg :free :initform :no-transfer
12           :type (member :none :all :no-transfer :transfer :container)           :type (member nil :none t :all :no-transfer :transfer :container)
13           :documentation "Free returned or sent value.           :documentation "Free returned or sent value.
14  :NONE -- no free at all  :NONE, nil -- no free at all
15  :ALL -- free always (after sending to FFI, or after recieved translation)  :ALL, t -- free always (after sending to FFI, or after recieved translation)
16  :TRANSFER -- client frees, so free after recieve  :TRANSFER -- client frees, so free after recieve
17  :NO-TRANSFER -- host frees, so free after sending to FFI.  :NO-TRANSFER -- host frees, so free after sending to FFI.
18  :CONTAINER -- the object is a container, ALL for container and NO-TRANSFER for  :CONTAINER -- the object is a container, ALL for container and NO-TRANSFER for
# Line 21  You should call FREE-RETURNED-IF-NEEDED Line 21  You should call FREE-RETURNED-IF-NEEDED
21  appropriate places of your CFFI translators")))  appropriate places of your CFFI translators")))
22    
23  (defgeneric free-ptr (type ptr)  (defgeneric free-ptr (type ptr)
24    (:documentation "Called to free ptr, unless overriden free-sent-ptr or free-returned-ptr.")    (:documentation "Called to free ptr, unless overriden free-sent-ptr
25    or free-returned-ptr.")
26    (:method (type ptr)    (:method (type ptr)
27      (foreign-free ptr)))      (foreign-free ptr)))
28    
29  (defgeneric free-sent-ptr (type ptr)  (defgeneric free-sent-ptr (type ptr param)
30    (:method ((type freeable-base) ptr)    (:method ((type freeable-base) ptr param)
31      (free-ptr type ptr)))      (declare (ignore param))
32    ;    (format t "Free-sent-ptr: ~a ~a ~%" type ptr)
33        (unless (null-pointer-p ptr)
34          (free-ptr type ptr))))
35    
36  (defgeneric free-returned-ptr (type ptr)  (defgeneric free-returned-ptr (type ptr)
37    (:method ((type freeable-base) ptr)    (:method ((type freeable-base) ptr)
38      (free-ptr type ptr)))  ;    (format t "Free-returned-ptr: ~a ~a ~%" type ptr)
39        (unless (null-pointer-p ptr)
40  (defun free-sent-if-needed (type ptr)        (free-ptr type ptr))))
41    (when (member (object-free type) '(:all :container :no-transfer))  
42      (free-sent-ptr type ptr)))  (defun free-sent-if-needed (type ptr param)
43      (when (member (object-free type) '(t :all :container :no-transfer))
44        (free-sent-ptr type ptr param)))
45    
46  (defun free-returned-if-needed (type ptr)  (defun free-returned-if-needed (type ptr)
47    (when (member (object-free type) '(:all :container :transfer))    (when (member (object-free type) '(t :all :container :transfer))
48      (free-returned-ptr type ptr)))      (free-returned-ptr type ptr)))
49    
50  (defclass freeable (freeable-base) ()  (defclass freeable (freeable-base) ()
51    (:documentation "Mixing to auto-set translators"))    (:documentation "Mixing to auto-set translators"))
52    
53  (defmethod free-translated-object :after (ptr (type freeable) param)  (defmethod free-translated-object :after (ptr (type freeable) param)
54    (declare (ignore param))    (free-sent-if-needed type ptr param))
   (free-sent-if-needed type ptr))  
55    
56  (defmethod translate-from-foreign :after (ptr (type freeable))  (defmethod translate-from-foreign :after (ptr (type freeable))
57    (free-returned-if-needed type ptr))    (free-returned-if-needed type ptr))

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

  ViewVC Help
Powered by ViewVC 1.1.5