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

Diff of /freeable.lisp

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

revision 3 by rklochkov, Fri May 4 11:25:20 2012 UTC revision 4 by rklochkov, Mon May 7 17:27:22 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 28  appropriate places of your CFFI translat Line 28  appropriate places of your CFFI translat
28  (defgeneric free-sent-ptr (type ptr)  (defgeneric free-sent-ptr (type ptr)
29    (:method ((type freeable-base) ptr)    (:method ((type freeable-base) ptr)
30      (format t "Free-sent-ptr: ~a ~a ~%" type ptr)      (format t "Free-sent-ptr: ~a ~a ~%" type ptr)
31      (free-ptr type ptr)))      (unless (null-pointer-p ptr)
32          (free-ptr type ptr))))
33    
34  (defgeneric free-returned-ptr (type ptr)  (defgeneric free-returned-ptr (type ptr)
35    (:method ((type freeable-base) ptr)    (:method ((type freeable-base) ptr)
36      (format t "Free-returned-ptr: ~a ~a ~%" type ptr)      (format t "Free-returned-ptr: ~a ~a ~%" type ptr)
37      (free-ptr type ptr)))      (unless (null-pointer-p ptr)
38          (free-ptr type ptr))))
39    
40  (defun free-sent-if-needed (type ptr)  (defun free-sent-if-needed (type ptr)
41    (when (member (object-free type) '(:all :container :no-transfer))    (when (member (object-free type) '(t :all :container :no-transfer))
42      (free-sent-ptr type ptr)))      (free-sent-ptr type ptr)))
43    
44  (defun free-returned-if-needed (type ptr)  (defun free-returned-if-needed (type ptr)
45    (when (member (object-free type) '(:all :container :transfer))    (when (member (object-free type) '(t :all :container :transfer))
46      (free-returned-ptr type ptr)))      (free-returned-ptr type ptr)))
47    
48  (defclass freeable (freeable-base) ()  (defclass freeable (freeable-base) ()

Legend:
Removed from v.3  
changed lines
  Added in v.4

  ViewVC Help
Powered by ViewVC 1.1.5