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

Diff of /struct.lisp

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

revision 4 by rklochkov, Mon May 7 17:27:22 2012 UTC revision 5 by rklochkov, Sun Jul 29 15:15:41 2012 UTC
# Line 21  Struct may be used in OBJECT cffi-type o Line 21  Struct may be used in OBJECT cffi-type o
21  (defgeneric free-struct (class value)  (defgeneric free-struct (class value)
22    (:method (class value)    (:method (class value)
23      (declare (ignore class))      (declare (ignore class))
24     ;   (break)
25        (format t "Free ~a ~a~%" class value)
26      (foreign-free value)))      (foreign-free value)))
27    
28  (defmethod gconstructor ((struct struct) &key new-struct &allow-other-keys)  (defmethod gconstructor ((struct struct) &key new-struct &allow-other-keys)
# Line 28  Struct may be used in OBJECT cffi-type o Line 30  Struct may be used in OBJECT cffi-type o
30        (new-struct (class-name (class-of struct)))        (new-struct (class-name (class-of struct)))
31        (progn        (progn
32          (setf (slot-value struct 'value) nil)          (setf (slot-value struct 'value) nil)
33            (setf (slot-value struct 'free-after) nil)
34          (null-pointer))))          (null-pointer))))
35    
36  (defun pair (maybe-pair)  (defun pair (maybe-pair)
# Line 102  or may be cons (class-name . struct-name Line 105  or may be cons (class-name . struct-name
105        (pointer object)))        (pointer object)))
106    
107  (defun struct->clos (class struct &optional object)  (defun struct->clos (class struct &optional object)
108    (unless object    "Translates pointer STRUCT to object OBJECT (if not supplied, then to new
109      (return-from struct->clos  object).
110        (unless (null-pointer-p struct)    I suppose, that by default it should convert data from pointer to struct.
111          (make-instance class :pointer struct))))  Only exception is the presence of OBJECT with not boundp value"
112    (if (slot-boundp object 'value)    (let ((%object (or object
113        (progn                       (unless (null-pointer-p struct)
114          (setf (slot-value object 'value) nil)                         (make-instance class :pointer struct)))))
115          (mapc (lambda (slot)      (when %object
116                  (setf (getf (slot-value object 'value) slot)        (if (slot-boundp %object 'value)
117                        (foreign-slot-value struct class slot)))            (progn
118                (foreign-slot-names class)))              (setf (slot-value %object 'value) nil)
119        (setf (pointer object) struct))              (unless (null-pointer-p struct)
120    ;(break)                (dolist (slot (foreign-slot-names class))
121    object)                  (setf (getf (slot-value %object 'value) slot)
122                          (foreign-slot-value struct class slot)))))
123              (setf (pointer %object) struct))
124          %object)))
125    
126  (define-foreign-type cffi-struct (cffi-object freeable-out)  (define-foreign-type cffi-struct (cffi-object freeable-out)
127    ()    ()
# Line 127  or may be cons (class-name . struct-name Line 130  or may be cons (class-name . struct-name
130  (defmethod free-ptr ((type cffi-struct) ptr)  (defmethod free-ptr ((type cffi-struct) ptr)
131    (free-struct (object-class type) ptr))    (free-struct (object-class type) ptr))
132    
133    (defmethod free-sent-ptr ((type cffi-struct) ptr place)
134      (when (and (slot-boundp place 'value) (not (null-pointer-p ptr)))
135        (free-struct (object-class type) ptr)))
136    
137    
138  (defmethod foreign-type-size ((type cffi-struct))  (defmethod foreign-type-size ((type cffi-struct))
139    "Return the size in bytes of a foreign typedef."    "Return the size in bytes of a foreign typedef."
140    (foreign-type-size (object-class type)))    (foreign-type-size (object-class type)))
# Line 139  or may be cons (class-name . struct-name Line 147  or may be cons (class-name . struct-name
147    (or (object-class type) (class-name (class-of value))))    (or (object-class type) (class-name (class-of value))))
148    
149  (defmethod copy-from-foreign ((type cffi-object) ptr place)  (defmethod copy-from-foreign ((type cffi-object) ptr place)
150    (when (or (slot-boundp place 'value)    (when (slot-boundp place 'value)
             (member (object-free type) '(:all :transfer)))  
151      (struct->clos (%class type place) ptr place)))      (struct->clos (%class type place) ptr place)))
152    
153    ;; cffi-object is not tyoo. It is for use struct with object designator
154  (defmethod translate-to-foreign ((value struct) (type cffi-object))  (defmethod translate-to-foreign ((value struct) (type cffi-object))
155    (values (clos->new-struct (%class type value) value) value))    (values (clos->new-struct (%class type value) value) value))
156    

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

  ViewVC Help
Powered by ViewVC 1.1.5