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

Contents of /freeable.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 12 - (show annotations)
Sun Oct 7 11:59:54 2012 UTC (18 months, 1 week ago) by rklochkov
File size: 2444 byte(s)
Fixed double free of object due to use of with-slots instead of setf (pointer object)
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 ;; Should we free after translating from foreign?
12 ((free-from-foreign :initarg :free-from-foreign
13 :reader fst-free-from-foreign-p
14 :initform nil :type boolean)
15 ;; Should we free after translating to foreign?
16 (free-to-foreign :initarg :free-to-foreign
17 :reader fst-free-to-foreign-p
18 :initform t :type boolean)))
19
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. TYPE should be specialized with EQL")
26 (:method (type ptr)
27 (foreign-free ptr)))
28
29 (defgeneric free-sent-ptr (cffi-type ptr param)
30 (:method ((cffi-type freeable-base) ptr param)
31 (unless (null-pointer-p ptr)
32 (free-ptr (type-of cffi-type) ptr))))
33
34 (defgeneric free-returned-ptr (cffi-type ptr)
35 (:method ((cffi-type freeable-base) ptr)
36 (unless (null-pointer-p ptr)
37 (free-ptr (type-of cffi-type) ptr))))
38
39 (defun free-sent-if-needed (cffi-type ptr param)
40 (when (fst-free-to-foreign-p cffi-type)
41 (free-sent-ptr cffi-type ptr param)))
42
43 (defun free-returned-if-needed (cffi-type ptr)
44 (when (fst-free-from-foreign-p cffi-type)
45 (free-returned-ptr cffi-type ptr)))
46
47 (defclass freeable (freeable-base) ()
48 (:documentation "Mixing to auto-set translators"))
49
50 (defmethod free-translated-object :after (ptr (type freeable) param)
51 (free-sent-if-needed type ptr param))
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 nil
58 :documentation "This is out param (for fill in foreign side)"))
59 (:documentation "For returning data in out params.
60 If OUT is t, then 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