Changeset 16622 for release


Ignore:
Timestamp:
Oct 15, 2015, 4:58:05 PM (3 years ago)
Author:
rme
Message:

Merge Objective-C bridge updates from trunk.

Location:
release/1.11/source
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/1.11/source

  • release/1.11/source/objc-bridge/bridge.lisp

    r15856 r16622  
    926926  (rlet ((s :objc_super #+(or apple-objc cocotron-objc) :receiver #+gnu-objc :self self
    927927            #+(or apple-objc-2.0 cocotron-objc) :super_class #-(or apple-objc-2.0 cocotron-objc) :class
    928             #+(or apple-objc-2.0 cocotron-objc) (#_class_getSuperclass (pref class :objc_class.isa))
     928            #+(or apple-objc-2.0 cocotron-objc) (#_class_getSuperclass (#_object_getClass class))
    929929            #-(or apple-objc-2.0 cocotron-objc) (pref (pref class #+apple-objc :objc_class.isa #+gnu-objc :objc_class.class_pointer) :objc_class.super_class)))
    930930    (let* ((siginfo (objc-method-signature-info sig))
     
    13041304                (let* ((meta-p (getf (objc-method-info-flags method-info) :class)))
    13051305                  (if meta-p
    1306                     (with-macptrs ((m (pref c :objc_class.isa)))
     1306                    (with-macptrs ((m (#_object_getClass c)))
    13071307                      (canonicalize-registered-metaclass m))
    13081308                    (canonicalize-registered-class c))))))))
  • release/1.11/source/objc-bridge/objc-clos.lisp

    r15617 r16622  
    196196(defun %set-objc-instance-type (p)
    197197  (unless (%null-ptr-p p)
    198     (let* ((parent (pref p :objc_object.isa))
     198    (let* ((parent (#_object_getClass p))
    199199           (id (objc-class-id parent)))
    200200      (when id
  • release/1.11/source/objc-bridge/objc-runtime.lisp

    r16123 r16622  
    264264                (let* ((id (assign-next-class-id))
    265265                       (class (%inc-ptr class 0))
    266                        (meta (pref class #+(or apple-objc cocotron-objc) :objc_class.isa #+gnu-objc :objc_class.class_pointer)))
     266                       (meta (#_object_getClass class)))
    267267                  (setf (gethash class objc-class-map) id)
    268268                  (setf (svref c id) class
     
    786786            (setf (gethash c class-map) i)
    787787            (unless (gethash m metaclass-map)
    788               (%setf-macptr m (pref c #+(or apple-objc cocotron-objc) :objc_class.isa
    789                                       #+gnu-objc :objc_class.class_pointer))
     788              (%setf-macptr m (#_object_getClass c))
    790789              (setf (gethash m metaclass-map) meta-id))
    791790            (note-class-protocols c)))))
     
    804803                 (m (id->objc-metaclass meta-id)))
    805804            (let* ((class (make-objc-class-pair super (make-cstring (objc-class-id-foreign-name i))))
    806                    (meta (pref class #+(or apple-objc cocotron-objc) :objc_class.isa
    807                                #+gnu-objc :objc-class.class_pointer)))
     805                   (meta (#_object_getClass class)))
    808806            (unless (gethash m metaclass-map)
    809807              (%revive-macptr m)
     
    910908                           "NS"))
    911909                         (meta-super
    912                           (if super (pref super #+(or apple-objc cocotron-objc) :objc_class.isa
    913                                           #+gnu-objc :objc_class.class_pointer))))
     910                          (if super (#_object_getClass super))))
    914911                    ;; It's important (here and when initializing the
    915912                    ;; class below) to use the "canonical"
     
    26722669              (safe-get-ptr p q)
    26732670              (not (%null-ptr-p q)))
    2674           (with-macptrs ((parent #+(or apple-objc cocotron-objc) (pref p :objc_object.isa)
    2675                                  #+gnu-objc (pref p :objc_object.class_pointer)))
     2671          (with-macptrs ((parent (#_object_getClass p)))
    26762672            (or
    26772673             (objc-class-id parent)
     
    27962792    (%add-objc-method
    27972793     (if (lisp-objc-method-class-p m)
    2798        (pref class #+(or apple-objc cocotron-objc) :objc_class.isa #+gnu-objc :objc_class.class_pointer)
     2794       (#_object_getClass class)        ;class methods go on the metaclass
    27992795       class)
    28002796     sel
     
    29842980                             #+(or apple-objc-2.0 cocotron-objc)
    29852981                             `((external-call "class_getSuperclass"
    2986                                 :address (pref (@class ,class-name) :objc_class.isa) :address))
     2982                                :address
     2983                                (external-call "object_getClass"
     2984                                               :address (@class ,class-name)
     2985                                               :address)))
    29872986                             #-(or apple-objc-2.0 cocotron-objc)
    29882987                             `((pref
  • release/1.11/source/objc-bridge/objc-support.lisp

    r16120 r16622  
    102102      (unless (%null-ptr-p protocols) (#_free protocols)))))
    103103           
     104(defloadvar *tagged-instance-class-indices* ())
     105
     106(defun %safe-get-objc-class (instance)
     107  (#_object_getClass instance))
     108
     109(defun lookup-tagged-instance-class (instance)
     110  (let* ((tag (tagged-objc-instance-p instance)))
     111    (if tag
     112      (let* ((class (%safe-get-objc-class instance)))
     113        (unless (%null-ptr-p class)
     114          (install-foreign-objc-class class nil)
     115          (let* ((idx (objc-class-or-private-class-id class)))
     116            (atomic-push-uvector-cell (symptr->symvector '*tagged-instance-class-indices*)
     117                                      target::symbol.vcell-cell
     118                                      (cons tag idx))
     119            idx))))))
     120
     121(defun objc-tagged-instance-class-index (instance tag)
     122  (or (cdr (assoc tag *tagged-instance-class-indices* :test #'eq))
     123      (lookup-tagged-instance-class instance)))
     124 
    104125
    105126(defun map-objc-classes (&optional (lookup-in-database-p t))
     
    725746  (objc-message-send instance "release"))
    726747
    727 (defloadvar *tagged-instance-class-indices* ())
    728 
    729 
    730 (defun %safe-get-objc-class (instance)
    731   (#_object_getClass instance))
    732 
    733 (defun lookup-tagged-instance-class (instance)
    734   (let* ((tag (tagged-objc-instance-p instance)))
    735     (if tag
    736       (let* ((class (%safe-get-objc-class instance)))
    737         (unless (%null-ptr-p class)
    738           (install-foreign-objc-class class nil)
    739           (let* ((idx (objc-class-or-private-class-id class)))
    740             (atomic-push-uvector-cell (symptr->symvector '*tagged-instance-class-indices*)
    741                                       target::symbol.vcell-cell
    742                                       (cons tag idx))
    743             idx))))))
    744 
    745      
    746 
    747 
    748 (defun objc-tagged-instance-class-index (instance tag)
    749   (or (cdr (assoc tag *tagged-instance-class-indices* :test #'eq))
    750       (lookup-tagged-instance-class instance)))
    751  
    752748
    753749
Note: See TracChangeset for help on using the changeset viewer.