summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 20:23:29 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 20:23:29 +0100
commit074be8bdfc44a29ae54497da0ee064117f5a1530 (patch)
tree16fc8215f5fa05a5eab711e25ce982a11753186e /Lisp
parent170159290c0c46685353cd3a54a968f203ddb795 (diff)
Add support for reading foreign slots.
darcs-hash:00abb78ca0134b8fa34830c9643986e046808c5e
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/class-definition.lisp31
-rw-r--r--Lisp/method-invocation.lisp3
2 files changed, 28 insertions, 6 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index 9229270..c44f556 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -148,7 +148,10 @@
instance
(effective-slot-definition
foreign-effective-slot-definition))
- (cerror "Continue" "FIXME"))
+ (with-slots (foreign-name foreign-type) effective-slot-definition
+ (cffi:convert-from-foreign
+ (%objcl-slot-value (pointer-to instance) foreign-name)
+ (typespec->c-type foreign-type))))
(defmethod (setf c2mop:slot-value-using-class) (value
@@ -156,8 +159,27 @@
instance
(effective-slot-definition
foreign-effective-slot-definition))
+ ;; If we are directed to set the slot to the default initform dummy
+ ;; value, we have probably been called during initialisation. In this
+ ;; case, do nothing. There may or may not be useful information
+ ;; present in the foreign slot at this time.
(unless (eq value *objcl-foreign-default-initform*)
- (cerror "Continue" "FIXME")))
+ (with-slots (foreign-name foreign-type) effective-slot-definition
+ ;; 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))))))
(defmethod c2mop:slot-boundp-using-class ((class objective-c-class)
@@ -200,9 +222,8 @@
(push (list
:name slot-name
:foreign-name (objcl-slot-name objc-slot)
- :foreign-type (typespec->c-type
- (parse-typespec
- (objcl-slot-type objc-slot))))
+ :foreign-type (parse-typespec
+ (objcl-slot-type objc-slot)))
(getf key-args :direct-slots)))))
(apply #'call-next-method class key-args)))
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 08e0dac..3170670 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -386,7 +386,8 @@ easier to use with __apply__.
(defun typespec->c-type (typespec)
(case (car typespec)
- ((:pointer struct union id objective-c-class exception array selector)
+ ((:pointer pointer struct union id objective-c-class exception array
+ selector)
:pointer)
((:string) :string)
(otherwise (car typespec))))