summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-19 13:22:41 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-19 13:22:41 +0100
commitfedbfff7c5f7091e5e2b2d29d6ebf1a20349f60f (patch)
treeeb16eb2cfcc7e3fada9ac227c92468d909118449 /Lisp
parent619b17ce5eb96b3cfd5f2d94174270a31e46871c (diff)
Reimplement slot writing.
darcs-hash:54a65f96e6367f42013fef524eeddbeb4b8889ec
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/class-definition.lisp47
-rw-r--r--Lisp/libobjcl.lisp11
2 files changed, 24 insertions, 34 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index e228c56..0d95cc4 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -170,38 +170,23 @@
;; present in the foreign slot at this time.
(unless (eq value *objcl-foreign-default-initform*)
(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.
- ;;
- ;; 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 array)
- (%objcl-set-slot-value (pointer-to instance)
- foreign-name
- (typecase value
+ (let* ((slot-offset
+ (%objcl-get-slot-offset
+ (%objcl-get-slot (pointer-to class) foreign-name)))
+ (slot-cell (inc-pointer (pointer-to instance) slot-offset)))
+ (case (typespec-primary-type foreign-type)
+ ((struct union array)
+ (let ((value-pointer (typecase value
(c-pointer value)
- (t (pointer-to value)))))
- ((:pointer)
- ;; FIXME: Does this make sense? No. Does it work? Must
- ;; check.
- (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)))
- (otherwise
- ;; BIG RED FIXME: WTF is _wrong_ with this
- ;; object_getInstanceVariable stuff?
- ;;
- ;; Pure lossage!
- (%objcl-set-slot-value (pointer-to instance)
- foreign-name
- (make-pointer value)))))))
+ (c-pointer-wrapper (pointer-to value)))))
+ (memmove slot-cell value-pointer (sizeof foreign-type))))
+ (otherwise
+ ;; FIXME: What to do about memory management here? Strings are
+ ;; possibly the most problematic case.
+ ;;
+ ;; Also, should we do ID conversion as for method arguments
+ ;; here?
+ (setf (mem-ref slot-cell (typespec->c-type foreign-type)) value)))))))
(defmethod c2mop:slot-boundp-using-class ((class objective-c-class)
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index f28d4b8..f68838c 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -33,6 +33,11 @@
(use-foreign-library libobjcl)
+(defcfun ("objcl_memmove" memmove) :pointer
+ (destination :pointer)
+ (source :pointer)
+ (length :unsigned-long))
+
(defcfun ("objcl_initialise_runtime" %initialise-runtime) :void)
(defcfun ("objcl_shutdown_runtime" %shutdown-runtime) :void)
@@ -873,13 +878,13 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
;;;; (@* "Helper functions")
(defun sizeof (typespec)
- (%objcl-sizeof-type typespec))
+ (%objcl-sizeof-type (print-typespec-to-string typespec)))
(defun alignof (typespec)
- (%objcl-alignof-type typespec))
+ (%objcl-alignof-type (print-typespec-to-string typespec)))
(defun return-type-sizeof (typespec)
- (%objcl-sizeof-return-type typespec))
+ (%objcl-sizeof-return-type (print-typespec-to-string typespec)))
(defun runtime-type ()
(let ((runtime (%objcl-get-runtime-type)))