Changeset 14821


Ignore:
Timestamp:
Jun 12, 2011, 4:38:20 AM (8 years ago)
Author:
gb
Message:

Move along. Nothing to see here.

Location:
trunk/source/objc-bridge
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/objc-bridge/objc-runtime.lisp

    r14643 r14821  
    26112611      (objc-private-class-id classptr)))
    26122612
     2613;;; The World's Most Advanced Operating System keeps getting better!
     2614#+(or apple-objc-2.0 apple-objc)
     2615(defun objc-hidden-class-id (classptr)
     2616  ;; This should only be called on something for which OBJC-CLASS-ID and OBJC-PRIVATE-CLASS-ID
     2617  ;; both return false.
     2618  ;; If CLASSPTR looks enough like an ObjC class, register it as a private class and return
     2619  ;; the private class ID.
     2620  ;; This wouldn't be necessary if the ObjC class hierarchy wasn't broken.
     2621  (unless (%null-ptr-p classptr)
     2622    (with-macptrs (meta metameta)
     2623      (safe-get-ptr classptr meta)
     2624      (unless (%null-ptr-p meta)
     2625        (safe-get-ptr meta metameta)
     2626        (when (and (eql metameta (find-class 'ns::+ns-object nil))
     2627                   (%objc-metaclass-p meta))
     2628          (let* ((classptr (%inc-ptr classptr 0)))
     2629            (install-foreign-objc-class classptr nil)
     2630            (objc-private-class-id classptr)))))))
     2631
     2632(defun tagged-objc-instance-p (p)
     2633  (let* ((tag (logand (the natural (%ptr-to-int p)) #xf)))
     2634    (declare (fixnum tag))
     2635    (if (logbitp 0 tag)
     2636      tag)))
    26132637
    26142638(defun %objc-instance-class-index (p)
    26152639  (unless (%null-ptr-p p)
    2616     (if (with-macptrs (q)
    2617           (safe-get-ptr p q)
    2618           (not (%null-ptr-p q)))
    2619       (with-macptrs ((parent #+(or apple-objc cocotron-objc) (pref p :objc_object.isa)
    2620                              #+gnu-objc (pref p :objc_object.class_pointer)))
    2621         (or
    2622          (objc-class-id parent)
    2623          (objc-private-class-id parent))))))
     2640    (let* ((tag (tagged-objc-instance-p p)))
     2641      (if tag
     2642        (objc-tagged-instance-class-index tag)
     2643        (if (with-macptrs (q)
     2644              (safe-get-ptr p q)
     2645              (not (%null-ptr-p q)))
     2646          (with-macptrs ((parent #+(or apple-objc cocotron-objc) (pref p :objc_object.isa)
     2647                                 #+gnu-objc (pref p :objc_object.class_pointer)))
     2648            (or
     2649             (objc-class-id parent)
     2650             (objc-private-class-id parent)
     2651             #+(or apple-objc-2.0 apple-objc)
     2652             (objc-hidden-class-id parent))))))))
    26242653
    26252654
  • trunk/source/objc-bridge/objc-support.lisp

    r14698 r14821  
    88(defun allocate-objc-object (class)
    99  (#/alloc class))
     10
     11
    1012
    1113(defun conforms-to-protocol (thing protocol)
     
    665667  (objc-message-send instance "release"))
    666668
     669(defloadvar *tagged-instance-class-indices*
     670  (let* ((alist ()))
     671    ;; There should be a better way of doing this.  (A much better way.)
     672      (let* ((instance (#/initWithInt: (#/alloc ns:ns-number) 0))
     673             (tag (tagged-objc-instance-p instance)))
     674        (if tag
     675          (let* ((class (objc-message-send instance "class")))
     676            (unless (%null-ptr-p class)
     677              (install-foreign-objc-class class nil)
     678              (push (cons tag (objc-class-or-private-class-id class)) alist)))
     679          (#/release instance)))
     680      alist))
     681
     682(defun objc-tagged-instance-class-index (tag)
     683  (cdr (assoc tag *tagged-instance-class-indices* :test #'eq)))
     684
    667685
    668686(provide "OBJC-SUPPORT")
Note: See TracChangeset for help on using the changeset viewer.