summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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))))