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

Contents of /freeable.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Fri May 4 11:25:20 2012 UTC (23 months, 2 weeks ago) by rklochkov
File size: 2477 byte(s)
Fixes with GC

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 2 :type (member :none :all :no-transfer :transfer :container)
13 rklochkov 1 :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 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 1 (free-ptr type ptr)))
32    
33     (defgeneric free-returned-ptr (type ptr)
34     (:method ((type freeable-base) ptr)
35 rklochkov 3 (format t "Free-returned-ptr: ~a ~a ~%" type ptr)
36 rklochkov 1 (free-ptr type ptr)))
37    
38     (defun free-sent-if-needed (type ptr)
39 rklochkov 2 (when (member (object-free type) '(:all :container :no-transfer))
40 rklochkov 1 (free-sent-ptr type ptr)))
41    
42     (defun free-returned-if-needed (type ptr)
43 rklochkov 2 (when (member (object-free type) '(:all :container :transfer))
44 rklochkov 1 (free-returned-ptr type ptr)))
45    
46     (defclass freeable (freeable-base) ()
47     (:documentation "Mixing to auto-set translators"))
48    
49     (defmethod free-translated-object :after (ptr (type freeable) param)
50     (declare (ignore param))
51     (free-sent-if-needed type ptr))
52    
53     (defmethod translate-from-foreign :after (ptr (type freeable))
54     (free-returned-if-needed type ptr))
55    
56     (define-foreign-type freeable-out (freeable)
57     ((out :accessor object-out :initarg :out :initform t
58     :documentation "This is out param (for fill in foreign side)"))
59     (:documentation "For returning data in out params.
60     To use translate-to-foreign MUST return (values ptr place)"))
61    
62     (defgeneric copy-from-foreign (type ptr place)
63     (:documentation "Transfers data from pointer PTR to PLACE"))
64    
65     (defmethod free-translated-object :before (ptr (type freeable-out) place)
66     (when (object-out type)
67     (copy-from-foreign type ptr place)))

  ViewVC Help
Powered by ViewVC 1.1.5