Changeset 867

Timestamp:

Aug 30, 2004, 2:58:50 PM (20 years ago)

Author:

Gary Byers

Message:

set pointer types directly

File:

• trunk/ccl/examples/objc-clos.lisp (modified) (3 diffs)

trunk/ccl/examples/objc-clos.lisp

@@ -145 +145 @@
           (%set-macptr-type p idx))))))
 
+(defun release-canonical-nsobject (object)
+  object)
+
+  
+
 (defun %objc-domain-class-of (p)
   (let* ((type (%macptr-type p))
@@ -192 +197 @@
       (#.objc-flag-metaclass (id->objc-metaclass-slots-vector index)))))
           
-(register-foreign-object-domain :objc
+(defloadvar *objc-object-domain*
+    (register-foreign-object-domain :objc
                                 :recognize #'recognize-objc-object
                                 :class-of #'%objc-domain-class-of
@@ -200 +206 @@
                                 :class-own-wrapper
                                 #'%objc-domain-class-own-wrapper
-                                :slots-vector #'%objc-domain-slots-vector)
+                                :slots-vector #'%objc-domain-slots-vector))
+
+;;; P is known to be a (possibly null!) instance of some ObjC class.
+(defun %set-objc-instance-type (p)
+  (unless (%null-ptr-p p)
+    (let* ((parent (pref p :objc_object.isa))
+           (id (objc-class-id parent)))
+      (when id
+        (%set-macptr-domain p *objc-object-domain*)
+        (%set-macptr-type p id)))))
+
+;;; P is known to be of type :ID.  It may be null.
+(defun %set-objc-id-type (p)
+  (let* ((idx (objc-class-id p)))
+    (if idx
+      (progn
+        (%set-macptr-domain p *objc-object-domain*)
+        (%set-macptr-type p (dpb objc-flag-class objc-type-flags idx)))
+      (if (setq idx (objc-metaclass-id p))
+        (progn
+          (%set-macptr-domain p *objc-object-domain*)  
+          (%set-macptr-type p (dpb objc-flag-metaclass objc-type-flags idx)))
+        (%set-objc-instance-type p)))))