summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-17 18:00:17 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-17 18:00:17 +0100
commitc36553fe8b000e6d2d353aa4f803210f60fa1955 (patch)
treeefea79818b554b9c5c88c6156bc6cee8532f880a /Lisp
parent17a432d4b02cc3df7f5697d9f4c6f1fce926e436 (diff)
Implement setting of foreign slots.
darcs-hash:acea0207a1c3d97c6caf8c515cae332275fc06e7
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/class-definition.lisp31
1 files changed, 19 insertions, 12 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index dcb27d5..83d85e2 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -169,18 +169,25 @@
;; FIXME: What to do about memory management here? Strings are
;; possibly the most problematic case here.
;;
- ;; FIXME: This won't work at all right now, because
- ;; %OBJCL-SET-SLOT-VALUE expects a pointer to the value that it
- ;; should store as an argument, not the value itself. For structs
- ;; and related things that can't be reasonably passed by value,
- ;; this is good news. For everything else, it means just a bit
- ;; more work.
- (cerror "Do nothing" "FIXME")
- #+(or)
- (%objcl-set-slot-value
- instance
- foreign-name
- (cffi:convert-to-foreign value (typespec->c-type foreign-type))))))
+ ;; Note: %OBJCL-SET-SLOT-VALUE expects a pointer to the value that
+ ;; it should store as an argument, not the value itself. For
+ ;; structs and related things that can't be reasonably passed by
+ ;; value, this is good news. For everything else, it means just a
+ ;; bit more work.
+ (case (typespec-primary-type foreign-type)
+ ((struct union id class)
+ (%objcl-set-slot-value (pointer-to instance)
+ foreign-name
+ (typecase value
+ (c-pointer value)
+ (t (pointer-to value)))))
+ (otherwise
+ (with-foreign-object (slot-cell (typespec->c-type foreign-type))
+ (setf (mem-ref slot-cell (typespec->c-type foreign-type))
+ value)
+ (%objcl-set-slot-value (pointer-to instance)
+ foreign-name
+ slot-cell)))))))
(defmethod c2mop:slot-boundp-using-class ((class objective-c-class)