[gtk-cffi-cvs] CVS gtk-cffi/cffi

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi
In directory tiger.common-lisp.net:/tmp/cvs-serv6570/cffi

Modified Files:
	struct.lisp 
Log Message:
Several fixes for struct memory management.
Now we can use cffi-object:struct lisp values in place for cffi-object:pobject
when we don't rerturn value. When you need to fill pointer slot for struct,
just describe it as (object smth) in defcfun



--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp	2011/09/18 18:10:47	1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp	2011/09/21 12:03:46	1.8
@@ -14,8 +14,12 @@
   (:documentation "If value bound, use it, else use pointer.
 Struct may be used in OBJECT cffi-type or STRUCT cffi-type"))
 
-(defmethod gconstructor ((struct struct) &key &allow-other-keys)
-  (null-pointer))
+(defmethod gconstructor ((struct struct) &key new-struct &allow-other-keys)
+  (if new-struct 
+      (new-struct (class-name (class-of struct)))
+      (progn 
+        (setf (slot-value struct 'value) nil)
+        (null-pointer))))
 
 (defmacro save-setter (class name)
   "Use this to register setters for SETF-INIT and INIT-SLOTS macro"
@@ -119,11 +123,13 @@
     (foreign-free value)))
 
 (defun clos->new-struct (class object)
-  (if (slot-value object 'value)
+  (if (slot-boundp object 'value)
       (let ((res (new-struct class)))
-        (mapc (lambda (slot) (setf (foreign-slot-value res class slot)
-                                   (cdr (assoc slot 
-                                               (slot-value object 'value)))))
+;        (format t "Allocated ~a~%" res)
+        (mapc (lambda (slot) 
+                (let ((val (cdr (assoc slot (slot-value object 'value)))))
+                  (when val ;; FIXME: I think, that allocated struct zero-filled
+                    (setf (foreign-slot-value res class slot) val))))
               (foreign-slot-names class))
         res)
       (slot-value object 'pointer)))
@@ -171,6 +177,7 @@
 
 (defmethod free-translated-object (value (type cffi-struct) param)
   (let ((class (obj-class type)))
+;    (format t "In free: ~a~%" value)
     (when (obj-out type)
       (struct->clos class value param))
     (free-struct class value)))
@@ -181,6 +188,15 @@
         (struct->clos class value)
       (free-if-needed type value))))
 
+;;; for use with pobject designator
+
+(defmethod translate-to-foreign ((value struct) (type cffi-object))
+  (values (clos->new-struct (class-name (class-of value)) value) value))
+
+(defmethod free-translated-object (value (type cffi-object) (param struct))
+  (let ((class (class-name (class-of type))))
+    (free-struct class value)))
+
 ;; This is needed to get correct mem-aref, when used on array of structs
 (eval-when (:compile-toplevel :load-toplevel :execute) 
   (unless (get 'mem-ref 'struct)