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

Contents of /freeable.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5 - (show annotations)
Sun Jul 29 15:15:41 2012 UTC (20 months, 3 weeks ago) by rklochkov
File size: 2602 byte(s)
Fixed memory leaks
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 :type (member nil :none t :all :no-transfer :transfer :container)
13 :documentation "Free returned or sent value.
14 :NONE, nil -- no free at all
15 :ALL, t -- 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 :CONTAINER -- the object is a container, ALL for container and NO-TRANSFER for
19 contained items
20 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
25 or free-returned-ptr.")
26 (:method (type ptr)
27 (foreign-free ptr)))
28
29 (defgeneric free-sent-ptr (type ptr param)
30 (:method ((type freeable-base) ptr param)
31 (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)
37 (:method ((type freeable-base) ptr)
38 ; (format t "Free-returned-ptr: ~a ~a ~%" type ptr)
39 (unless (null-pointer-p ptr)
40 (free-ptr type ptr))))
41
42 (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)
47 (when (member (object-free type) '(t :all :container :transfer))
48 (free-returned-ptr type ptr)))
49
50 (defclass freeable (freeable-base) ()
51 (:documentation "Mixing to auto-set translators"))
52
53 (defmethod free-translated-object :after (ptr (type freeable) param)
54 (free-sent-if-needed type ptr param))
55
56 (defmethod translate-from-foreign :after (ptr (type freeable))
57 (free-returned-if-needed type ptr))
58
59 (define-foreign-type freeable-out (freeable)
60 ((out :accessor object-out :initarg :out :initform t
61 :documentation "This is out param (for fill in foreign side)"))
62 (:documentation "For returning data in out params.
63 To use translate-to-foreign MUST return (values ptr place)"))
64
65 (defgeneric copy-from-foreign (type ptr place)
66 (:documentation "Transfers data from pointer PTR to PLACE"))
67
68 (defmethod free-translated-object :before (ptr (type freeable-out) place)
69 (when (object-out type)
70 (copy-from-foreign type ptr place)))

  ViewVC Help
Powered by ViewVC 1.1.5