Changeset 867


Ignore:
Timestamp:
Aug 30, 2004, 9:58:50 PM (16 years ago)
Author:
gb
Message:

set pointer types directly

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/objc-clos.lisp

    r814 r867  
    145145          (%set-macptr-type p idx))))))
    146146
     147(defun release-canonical-nsobject (object)
     148  object)
     149
     150 
     151
    147152(defun %objc-domain-class-of (p)
    148153  (let* ((type (%macptr-type p))
     
    192197      (#.objc-flag-metaclass (id->objc-metaclass-slots-vector index)))))
    193198         
    194 (register-foreign-object-domain :objc
     199(defloadvar *objc-object-domain*
     200    (register-foreign-object-domain :objc
    195201                                :recognize #'recognize-objc-object
    196202                                :class-of #'%objc-domain-class-of
     
    200206                                :class-own-wrapper
    201207                                #'%objc-domain-class-own-wrapper
    202                                 :slots-vector #'%objc-domain-slots-vector)
     208                                :slots-vector #'%objc-domain-slots-vector))
     209
     210;;; P is known to be a (possibly null!) instance of some ObjC class.
     211(defun %set-objc-instance-type (p)
     212  (unless (%null-ptr-p p)
     213    (let* ((parent (pref p :objc_object.isa))
     214           (id (objc-class-id parent)))
     215      (when id
     216        (%set-macptr-domain p *objc-object-domain*)
     217        (%set-macptr-type p id)))))
     218
     219;;; P is known to be of type :ID.  It may be null.
     220(defun %set-objc-id-type (p)
     221  (let* ((idx (objc-class-id p)))
     222    (if idx
     223      (progn
     224        (%set-macptr-domain p *objc-object-domain*)
     225        (%set-macptr-type p (dpb objc-flag-class objc-type-flags idx)))
     226      (if (setq idx (objc-metaclass-id p))
     227        (progn
     228          (%set-macptr-domain p *objc-object-domain*) 
     229          (%set-macptr-type p (dpb objc-flag-metaclass objc-type-flags idx)))
     230        (%set-objc-instance-type p)))))
    203231
    204232
Note: See TracChangeset for help on using the changeset viewer.