Changeset 15573


Ignore:
Timestamp:
Jan 8, 2013, 5:36:44 PM (6 years ago)
Author:
gb
Message:

[Should have been part of r15572.]

Try to use this mechanism to recognize tagged ObjC instances. (Part
of that process involves sending -[NSObject class] to something that
may or may not be an ObjC instance, and if the instance isn't valid
that message will likely generate a memory fault.)

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

Legend:

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

    r15558 r15573  
    26632663    (let* ((tag (tagged-objc-instance-p p)))
    26642664      (if tag
    2665         (objc-tagged-instance-class-index tag)
     2665        (objc-tagged-instance-class-index p tag)
    26662666        (if (with-macptrs (q)
    26672667              (safe-get-ptr p q)
  • trunk/source/objc-bridge/objc-support.lisp

    r15563 r15573  
    722722  (objc-message-send instance "release"))
    723723
    724 (defloadvar *tagged-instance-class-indices*
    725   (let* ((alist ()))
    726     ;; There should be a better way of doing this.  (A much better way.)
    727       (let* ((instance (#/initWithInt: (#/alloc ns:ns-number) 0))
    728              (tag (tagged-objc-instance-p instance)))
    729         (if tag
    730           (let* ((class (objc-message-send instance "class")))
    731             (unless (%null-ptr-p class)
    732               (install-foreign-objc-class class nil)
    733               (push (cons tag (objc-class-or-private-class-id class)) alist)))
    734           (#/release instance)))
    735       alist))
    736 
    737 (defun objc-tagged-instance-class-index (tag)
    738   (cdr (assoc tag *tagged-instance-class-indices* :test #'eq)))
     724(defloadvar *tagged-instance-class-indices* ())
     725
     726(defun %safe-get-objc-class (instance)
     727  (let* ((tcr (%current-tcr)))
     728    (without-interrupts
     729     (unwind-protect
     730          (progn
     731            (setf (%fixnum-ref tcr target::tcr.safe-ref-address) 1)
     732            (objc-message-send instance "class"))
     733       (setf (%fixnum-ref tcr target::tcr.safe-ref-address) 0)))))
     734
     735(defun lookup-tagged-instance-class (instance)
     736  (let* ((tag (tagged-objc-instance-p instance)))
     737    (if tag
     738      (let* ((class (%safe-get-objc-class instance)))
     739        (unless (%null-ptr-p class)
     740          (install-foreign-objc-class class nil)
     741          (let* ((idx (objc-class-or-private-class-id class)))
     742            (atomic-push-uvector-cell (symptr->symvector '*tagged-instance-class-indices*)
     743                                      target::symbol.vcell-cell
     744                                      (cons tag idx))
     745            idx))))))
     746
     747     
     748
     749
     750(defun objc-tagged-instance-class-index (instance tag)
     751  (or (cdr (assoc tag *tagged-instance-class-indices* :test #'eq))
     752      (lookup-tagged-instance-class instance)))
     753 
     754
    739755
    740756
Note: See TracChangeset for help on using the changeset viewer.