Changeset 14821
- Timestamp:
- Jun 12, 2011, 4:38:20 AM (10 years ago)
- Location:
- trunk/source/objc-bridge
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/objc-bridge/objc-runtime.lisp
r14643 r14821 2611 2611 (objc-private-class-id classptr))) 2612 2612 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))) 2613 2637 2614 2638 (defun %objc-instance-class-index (p) 2615 2639 (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)))))))) 2624 2653 2625 2654 -
trunk/source/objc-bridge/objc-support.lisp
r14698 r14821 8 8 (defun allocate-objc-object (class) 9 9 (#/alloc class)) 10 11 10 12 11 13 (defun conforms-to-protocol (thing protocol) … … 665 667 (objc-message-send instance "release")) 666 668 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 667 685 668 686 (provide "OBJC-SUPPORT")
Note: See TracChangeset
for help on using the changeset viewer.