- `(progn
- (defstruct ,name
- ,@(iter (for (name type &key initarg) in slots)
- (collect (list name initarg))))
- (defcstruct ,(generated-cstruct-name name)
- ,@(iter (for (name type &key initarg) in slots)
- (collect `(,name ,type))))
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (get ',name 'g-boxed-foreign-info)
- (make-g-boxed-cstruct-wrapper-info :name ',name
- :g-type ,g-type-name
- :cstruct ',(generated-cstruct-name name)
- :slots ',(iter (for (name type &key initarg) in slots)
- (collect name)))
- (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
- (get ',name 'g-boxed-foreign-info)))))
-
-(defmethod boxed-proxy-to-native ((type g-boxed-cstruct-wrapper-info) proxy)
- (let* ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type))
- (native-structure (foreign-alloc native-structure-type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (foreign-slot-value native-structure native-structure-type slot)
- (slot-value proxy slot)))
- (prog1 (g-boxed-copy (g-boxed-info-g-type type) native-structure)
- (foreign-free native-structure))))
-
-(defmethod boxed-native-to-proxy ((type g-boxed-cstruct-wrapper-info) native-structure)
- (let* ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type))
- (proxy-structure-type (g-boxed-info-name type))
- (proxy (make-instance proxy-structure-type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (slot-value proxy slot)
- (foreign-slot-value native-structure native-structure-type slot)))
- proxy))
-
-(defmethod boxed-read-values-from-native ((type g-boxed-cstruct-wrapper-info) proxy native-structure)
- (let ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (slot-value proxy slot)
- (foreign-slot-value native-structure native-structure-type slot)))))
-
-(defmethod boxed-write-values-to-native-and-free ((type g-boxed-cstruct-wrapper-info) proxy native-structure)
- (let ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (foreign-slot-value native-structure native-structure-type slot)
- (slot-value proxy slot)))))
+ (let ((cstruct-description (parse-cstruct-definition name slots)))
+ `(progn
+ (defstruct ,name
+ ,@(iter (for slot in (cstruct-description-slots cstruct-description))
+ (for name = (cstruct-slot-description-name slot))
+ (for initform = (cstruct-slot-description-initform slot))
+ (collect (list name initform))))
+ (defcstruct ,(generated-cstruct-name name)
+ ,@(iter (for slot in (cstruct-description-slots cstruct-description))
+ (for name = (cstruct-slot-description-name slot))
+ (for type = (cstruct-slot-description-type slot))
+ (for count = (cstruct-slot-description-count slot))
+ (collect `(,name ,type ,@(when count `(:count ,count))))))
+ (defcunion ,(generated-cunion-name name)
+ (,name ,(generated-cstruct-name name)))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (get ',name 'g-boxed-foreign-info)
+ (make-g-boxed-cstruct-wrapper-info :name ',name
+ :g-type ,g-type-name
+ :cstruct-description ,cstruct-description)
+ (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
+ (get ',name 'g-boxed-foreign-info))))))
+
+(defmethod make-foreign-type ((info g-boxed-cstruct-wrapper-info) &key return-p)
+ (make-instance 'boxed-cstruct-foreign-type :info info :return-p return-p))
+
+(defun memcpy (target source bytes)
+ (iter (for i from 0 below bytes)
+ (setf (mem-aref target :uchar i)
+ (mem-aref source :uchar i))))
+
+(defmethod boxed-copy-fn ((info g-boxed-cstruct-wrapper-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-copy (g-boxed-info-g-type info) native)
+ (let ((copy (foreign-alloc (generated-cstruct-name (g-boxed-info-name info)))))
+ (memcpy copy native (foreign-type-size (generated-cstruct-name (g-boxed-info-name info))))
+ copy)))
+
+(defmethod boxed-free-fn ((info g-boxed-cstruct-wrapper-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-free (g-boxed-info-g-type info) native)
+ (foreign-free native)))
+
+(defun copy-slots-to-native (proxy native cstruct-description)
+ (iter (with cstruct-type = (generated-cstruct-name (cstruct-description-name cstruct-description)))
+ (for slot in (cstruct-description-slots cstruct-description))
+ (for slot-name = (cstruct-slot-description-name slot))
+ (cond
+ ((cstruct-slot-description-count slot)
+ (iter (with ptr = (foreign-slot-pointer native cstruct-type slot-name))
+ (with array = (slot-value proxy slot-name))
+ (for i from 0 below (cstruct-slot-description-count slot))
+ (setf (mem-aref ptr (cstruct-slot-description-type slot) i)
+ (aref array i))))
+ ((cstruct-slot-description-inline-p slot)
+ (let ((info (get-g-boxed-foreign-info (cstruct-inline-slot-description-boxed-type-name slot))))
+ (copy-slots-to-native (slot-value proxy slot-name)
+ (foreign-slot-pointer native cstruct-type slot-name)
+ (g-boxed-cstruct-wrapper-info-cstruct-description info))))
+ (t
+ (setf (foreign-slot-value native cstruct-type slot-name)
+ (slot-value proxy slot-name))))))
+
+(defun copy-slots-to-proxy (proxy native cstruct-description)
+ (iter (with cstruct-type = (generated-cstruct-name (cstruct-description-name cstruct-description)))
+ (for slot in (cstruct-description-slots cstruct-description))
+ (for slot-name = (cstruct-slot-description-name slot))
+ (cond
+ ((cstruct-slot-description-count slot)
+ (setf (slot-value proxy slot-name) (make-array (list (cstruct-slot-description-count slot))))
+ (iter (with ptr = (foreign-slot-pointer native cstruct-type slot-name))
+ (with array = (slot-value proxy slot-name))
+ (for i from 0 below (cstruct-slot-description-count slot))
+ (setf (aref array i)
+ (mem-aref ptr (cstruct-slot-description-type slot) i))))
+ ((cstruct-slot-description-inline-p slot)
+ (let ((info (get-g-boxed-foreign-info (cstruct-inline-slot-description-boxed-type-name slot))))
+ (setf (slot-value proxy slot-name) (make-instance (cstruct-inline-slot-description-boxed-type-name slot)))
+ (copy-slots-to-proxy (slot-value proxy slot-name)
+ (foreign-slot-pointer native cstruct-type slot-name)
+ (g-boxed-cstruct-wrapper-info-cstruct-description info))))
+ (t (setf (slot-value proxy slot-name)
+ (foreign-slot-value native cstruct-type slot-name))))))
+
+(defmethod translate-to-foreign (proxy (type boxed-cstruct-foreign-type))
+ (if (null proxy)
+ (null-pointer)
+ (let* ((info (g-boxed-foreign-info type))
+ (native-structure-type (generated-cstruct-name (g-boxed-info-name info))))
+ (with-foreign-object (native-structure native-structure-type)
+ (copy-slots-to-native proxy native-structure (g-boxed-cstruct-wrapper-info-cstruct-description info))
+ (values (boxed-copy-fn info native-structure) proxy)))))
+
+(defmethod free-translated-object (native-structure (type boxed-cstruct-foreign-type) proxy)
+ (when proxy
+ (let ((info (g-boxed-foreign-info type)))
+ (copy-slots-to-proxy proxy native-structure (g-boxed-cstruct-wrapper-info-cstruct-description info))
+ (boxed-free-fn info native-structure))))
+
+(defmethod translate-from-foreign (native-structure (type boxed-cstruct-foreign-type))
+ (unless (null-pointer-p native-structure)
+ (let* ((info (g-boxed-foreign-info type))
+ (proxy-structure-type (g-boxed-info-name info))
+ (proxy (make-instance proxy-structure-type)))
+ (copy-slots-to-proxy proxy native-structure (g-boxed-cstruct-wrapper-info-cstruct-description info))
+ (when (g-boxed-foreign-return-p type)
+ (boxed-free-fn info native-structure))
+ proxy)))
+
+(defmethod cleanup-translated-object-for-callback ((type boxed-cstruct-foreign-type) proxy native-structure)
+ (when proxy
+ (let ((info (g-boxed-foreign-info type)))
+ (copy-slots-to-native proxy native-structure (g-boxed-cstruct-wrapper-info-cstruct-description info)))))