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

Diff of /freeable.lisp

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

revision 5 by rklochkov, Sun Jul 29 15:15:41 2012 UTC revision 8 by rklochkov, Sun Aug 12 17:36:30 2012 UTC
# Line 8  Line 8 
8  (in-package #:cffi-objects)  (in-package #:cffi-objects)
9    
10  (define-foreign-type freeable-base ()  (define-foreign-type freeable-base ()
11    ((free :accessor object-free :initarg :free :initform :no-transfer     ;; Should we free after translating from foreign?
12           :type (member nil :none t :all :no-transfer :transfer :container)     ((free-from-foreign :initarg :free-from-foreign
13           :documentation "Free returned or sent value.                        :reader fst-free-from-foreign-p
14  :NONE, nil -- no free at all                        :initform nil :type boolean)
15  :ALL, t -- free always (after sending to FFI, or after recieved translation)     ;; Should we free after translating to foreign?
16  :TRANSFER -- client frees, so free after recieve      (free-to-foreign :initarg :free-to-foreign
17  :NO-TRANSFER -- host frees, so free after sending to FFI.                       :reader fst-free-to-foreign-p
18  :CONTAINER -- the object is a container, ALL for container and NO-TRANSFER for                       :initform t :type boolean)))
19  contained items  
20  You should call FREE-RETURNED-IF-NEEDED and FREE-SENT-IF-NEEDED in  ;; You should call FREE-RETURNED-IF-NEEDED and FREE-SENT-IF-NEEDED in
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    (:documentation "Called to free ptr, unless overriden free-sent-ptr
# Line 29  or free-returned-ptr.") Line 29  or free-returned-ptr.")
29  (defgeneric free-sent-ptr (type ptr param)  (defgeneric free-sent-ptr (type ptr param)
30    (:method ((type freeable-base) ptr param)    (:method ((type freeable-base) ptr param)
31      (declare (ignore param))      (declare (ignore param))
 ;    (format t "Free-sent-ptr: ~a ~a ~%" type ptr)  
32      (unless (null-pointer-p ptr)      (unless (null-pointer-p ptr)
33        (free-ptr type ptr))))        (free-ptr type ptr))))
34    
35  (defgeneric free-returned-ptr (type ptr)  (defgeneric free-returned-ptr (type ptr)
36    (:method ((type freeable-base) ptr)    (:method ((type freeable-base) ptr)
 ;    (format t "Free-returned-ptr: ~a ~a ~%" type ptr)  
37      (unless (null-pointer-p ptr)      (unless (null-pointer-p ptr)
38        (free-ptr type ptr))))        (free-ptr type ptr))))
39    
40  (defun free-sent-if-needed (type ptr param)  (defun free-sent-if-needed (type ptr param)
41    (when (member (object-free type) '(t :all :container :no-transfer))    (when (fst-free-to-foreign-p type)
42      (free-sent-ptr type ptr param)))      (free-sent-ptr type ptr param)))
43    
44  (defun free-returned-if-needed (type ptr)  (defun free-returned-if-needed (type ptr)
45    (when (member (object-free type) '(t :all :container :transfer))    (when (fst-free-from-foreign-p type)
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.5  
changed lines
  Added in v.8

  ViewVC Help
Powered by ViewVC 1.1.5