summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Lisp/class-definition.lisp61
-rw-r--r--Lisp/internal-utilities.lisp16
-rw-r--r--Lisp/libobjcl.lisp12
-rw-r--r--Objective-C/libobjcl.m8
4 files changed, 32 insertions, 65 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index 28e97dd..61648a6 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -217,7 +217,7 @@
(let ((key-args (copy-list args)))
(cond
((or (null pointer) (null-pointer-p pointer))
- (setf (slot-value class 'registered-p) nil)
+ (setf (foreign-class-registered-p class) nil)
(let* ((ivars (remove-if-not #'(lambda (c)
(typep c 'foreign-direct-slot-definition))
direct-slots))
@@ -238,7 +238,7 @@
ivars))))
(setf (getf key-args :pointer) new-class-pointer)))
(t
- (setf (slot-value class 'registered-p) t)
+ (setf (foreign-class-registered-p class) t)
;; We scavenge the class and its superclasses for foreign slots and
;; add them to our :DIRECT-SLOTS keyword argument.
(dolist (objc-slot (objcl-class-direct-slots/pointer pointer))
@@ -250,56 +250,6 @@
:key #'(lambda (slotd) (getf slotd :name))))))
(apply #'call-next-method class key-args)))
-(defmethod initialize-instance ((class objective-c-class)
- &key documentation
- name
- plist
- direct-superclasses
- direct-slots
- direct-default-initargs
- pointer
- wrapped-foreign-class)
- (declare (ignore documentation name plist direct-superclasses direct-slots
- direct-default-initargs pointer wrapped-foreign-class))
- (call-next-method))
-
-(defmethod reinitialize-instance ((class objective-c-class)
- &key documentation
- name
- plist
- direct-superclasses
- direct-slots
- direct-default-initargs
- pointer
- wrapped-foreign-class)
- (declare (ignore documentation name plist direct-superclasses direct-slots
- direct-default-initargs pointer wrapped-foreign-class))
- (call-next-method))
-
-(defmethod initialize-instance ((class objective-c-meta-class)
- &key documentation
- name
- plist
- direct-superclasses
- direct-slots
- direct-default-initargs
- pointer)
- (declare (ignore documentation name plist direct-superclasses direct-slots
- direct-default-initargs pointer))
- (call-next-method))
-
-(defmethod reinitialize-instance ((class objective-c-meta-class)
- &key documentation
- name
- plist
- direct-superclasses
- direct-slots
- direct-default-initargs
- pointer)
- (declare (ignore documentation name plist direct-superclasses direct-slots
- direct-default-initargs pointer))
- (call-next-method))
-
(defmethod make-instance :before ((class objective-c-class)
&key
@@ -308,8 +258,11 @@
(defun foreign-class-ensure-registered (class)
- ;; FIXME
- )
+ (with-exclusive-access (class)
+ (unless (foreign-class-registered-p class)
+ (setf (foreign-class-registered-p class) t)
+ (%objcl-finalise-class (pointer-to class))))
+ class)
;;;; (@* "Quick tests")
diff --git a/Lisp/internal-utilities.lisp b/Lisp/internal-utilities.lisp
index 87746b9..92b003b 100644
--- a/Lisp/internal-utilities.lisp
+++ b/Lisp/internal-utilities.lisp
@@ -18,26 +18,26 @@
(in-package #:mulk.objective-cl)
+(defvar *global-lock* (cons nil nil))
+
+
(defmacro atomically (&body body)
- ;; FIXME
- `(progn ,@body)
- #+(or)
- `(prog2
- (objcl-acquire-global-lock)
- ,@body
- (objcl-release-global-lock)))
+ `(with-exclusive-access (*global-lock*)
+ ,@body))
(defmacro with-exclusive-access ((&rest objects) &body body)
(etypecase objects
(null `(progn ,@body))
(cons `(with-lock ,(first objects)
- (with-exclusive-access (,(rest objects))
+ (with-exclusive-access ,(rest objects)
,@body)))))
(defmacro with-lock (object &body body)
;; FIXME: Implement LOCK-FOR-OBJECT.
+ `(progn ,@body)
+ #+(or)
(let ((lock (gensym "LOCK")))
`(let ((,lock (lock-for-object ,object)))
(prog2
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 727bfc5..2308b60 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -309,8 +309,12 @@ conventional case for namespace identifiers in Objective-C."
(if (objc-pointer-null class-ptr)
nil
(let ((class-name (objc-class-name->symbol class-name-string))
- (superclass (or (objcl-class-superclass/pointer class-ptr)
- (find-class 'id))))
+ (superclass (let ((potential-superclass
+ (objcl-class-superclass/pointer class-ptr)))
+ (if potential-superclass
+ (foreign-class-ensure-registered
+ potential-superclass)
+ (find-class 'id)))))
(or (find-class class-name nil)
(c2mop:ensure-class class-name
:metaclass (class-name
@@ -365,7 +369,9 @@ conventional case for namespace identifiers in Objective-C."
(superclass (if non-meta-superclass
(find-objc-meta-class
(%objcl-class-name
- (pointer-to non-meta-superclass)))
+ (pointer-to
+ (foreign-class-ensure-registered
+ non-meta-superclass))))
(find-class 'objective-c-class)))
;; If there is no superclass, we are the root metaclass.
;; As we cannot assign ourselves as our own metaclass
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index d02e58b..dc44c2d 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -499,6 +499,14 @@ objcl_get_slot_value (id obj, const char *ivar_name, void *value_out)
value_out is actually a (void *) rather than a (void **).
Likewise, the result that is copied to value_out is the slot value
itself, not a pointer to it. */
+
+ /* NOTE UPDATE: Actually, it's trickier than that. The docs for
+ NeXTstep 3.3 say: ``These functions cannot reliably be used to set
+ and get instance variables that are not pointers.'' This makes the
+ behaviour and documentation a bit less confusing, because it means
+ that value_out is, in fact, assigned a pointer to the value of the
+ slot under the assumption that the slot itself references its value
+ via a pointer. */
object_getInstanceVariable (obj, ivar_name, value_out);
}