diff options
| -rw-r--r-- | Lisp/class-definition.lisp | 47 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 11 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 3 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 8 |
4 files changed, 35 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))) diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h index c2e2fac..b5cefce 100644 --- a/Objective-C/libobjcl.h +++ b/Objective-C/libobjcl.h @@ -59,6 +59,9 @@ extern id objcl_current_exception; extern NSRecursiveLock *objcl_current_exception_lock; +void * +objcl_memmove (void *dest, void *src, unsigned long length); + void objcl_initialise_runtime (void); diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m index f244e50..646dccd 100644 --- a/Objective-C/libobjcl.m +++ b/Objective-C/libobjcl.m @@ -25,6 +25,7 @@ #import "Foundation/Foundation.h" #include <stdarg.h> +#include <string.h> #include <sys/mman.h> #include <objc/objc-api.h> @@ -68,6 +69,13 @@ static NSMutableSet *lisp_backed_classes = nil; static int init_count = 0; +void * +objcl_memmove (void *dest, void *src, unsigned long length) +{ + return memmove (dest, src, length); +} + + void objcl_initialise_runtime (void) { |