Ignore:
Timestamp:
Nov 25, 2008, 8:57:25 AM (11 years ago)
Author:
gb
Message:

Don't use splay-trees to map objc class pointers to info about them.
We've apparently never been locking around accesses to the
PRIVATE-OBJC-CLASSES map, and just doing a lookup on a splay tree
re-writes the tree. (It seems that the lockup described in ticket:381
has to do with two threads doing lookups - and therefore rewriting
parts of the tree - at the same time.)
Since most runtime accesses to these maps are lookups - and since
lock-free hash-tables provide fast concurrent lookups - use hash-tables
instead.

File:
1 edited

Legend:

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

    r11390 r11426  
    5454(eval-when (:compile-toplevel :load-toplevel :execute)
    5555  (require "OBJC-PACKAGE")
    56   (require "SPLAY-TREE")
    5756  (require "NAME-TRANSLATION")
    5857  (require "OBJC-CLOS"))
     
    154153       (%ptr-to-int Y))))
    155154
    156 (let* ((objc-class-map (make-splay-tree #'%ptr-eql #'%ptr<))
    157        (objc-metaclass-map (make-splay-tree #'%ptr-eql #'%ptr<))
     155(let* ((objc-class-map (make-hash-table :test #'eql :size 1024))
     156       (objc-metaclass-map (make-hash-table :test #'eql :size 1024))
    158157       ;;; These are NOT lisp classes; we mostly want to keep track
    159158       ;;; of them so that we can pretend that instances of them
    160159       ;;; are instances of some known (declared) superclass.
    161        (private-objc-classes (make-splay-tree #'%ptr-eql #'%ptr<))
     160       (private-objc-classes (make-hash-table :test #'eql :size 2048))
    162161       (objc-class-lock (make-lock))
    163162       (next-objc-class-id 0)
     
    166165       (c (make-array class-table-size))
    167166       (m (make-array class-table-size))
    168        (cw (make-array 1024 :initial-element nil))
    169        (mw (make-array 1024 :initial-element nil))
    170        (csv (make-array 1024))
    171        (msv (make-array 1024))
    172        (class-id->metaclass-id (make-array 1024 :initial-element nil))
    173        (class-foreign-names (make-array 1024))
    174        (metaclass-foreign-names (make-array 1024))
    175        (class-id->ordinal (make-array 1024 :initial-element nil))
    176        (metaclass-id->ordinal (make-array 1024 :initial-element nil))
     167       (cw (make-array class-table-size :initial-element nil))
     168       (mw (make-array class-table-size :initial-element nil))
     169       (csv (make-array class-table-size))
     170       (msv (make-array class-table-size))
     171       (class-id->metaclass-id (make-array class-table-size :initial-element nil))
     172       (class-foreign-names (make-array class-table-size))
     173       (metaclass-foreign-names (make-array class-table-size))
     174       (class-id->ordinal (make-array class-table-size :initial-element nil))
     175       (metaclass-id->ordinal (make-array class-table-size :initial-element nil))
    177176       )
    178177
     
    245244      (defun %clear-objc-class-maps ()
    246245        (with-lock-grabbed (objc-class-lock)
    247           (setf (splay-tree-root objc-class-map) nil
    248                 (splay-tree-root objc-metaclass-map) nil
    249                 (splay-tree-root private-objc-classes) nil
    250                 (splay-tree-count objc-class-map) 0
    251                 (splay-tree-count objc-metaclass-map) 0
    252                 (splay-tree-count private-objc-classes) 0)))
     246          (clrhash objc-class-map)
     247          (clrhash objc-metaclass-map)
     248          (clrhash private-objc-classes)))
    253249      (flet ((install-objc-metaclass (meta)
    254                (or (splay-tree-get objc-metaclass-map meta)
     250               (or (gethash meta objc-metaclass-map)
    255251                   (let* ((id (assign-next-metaclass-id))
    256252                          (meta (%inc-ptr meta 0)))
    257                      (splay-tree-put objc-metaclass-map meta id)
     253                     (setf (gethash meta objc-metaclass-map) id)
    258254                     (setf (svref m id) meta
    259255                           (svref msv id)
     
    266262          (with-lock-grabbed (objc-class-lock)
    267263            (ensure-objc-classptr-resolved class)
    268             (or (splay-tree-get objc-class-map class)
     264            (or (gethash class objc-class-map)
    269265                (let* ((id (assign-next-class-id))
    270266                       (class (%inc-ptr class 0))
    271267                       (meta (pref class #+apple-objc :objc_class.isa #+gnu-objc :objc_class.class_pointer)))
    272                   (splay-tree-put objc-class-map class id)
     268                  (setf (gethash class objc-class-map) id)
    273269                  (setf (svref c id) class
    274270                        (svref csv id)
     
    279275                  id)))))
    280276      (defun objc-class-id (class)
    281         (with-lock-grabbed (objc-class-lock)
    282           (splay-tree-get objc-class-map class)))
     277        (gethash class objc-class-map))
    283278      (defun objc-metaclass-id (meta)
    284         (with-lock-grabbed (objc-class-lock)
    285           (splay-tree-get objc-metaclass-map meta)))
     279        (gethash meta objc-metaclass-map))
    286280      (defun objc-class-id->objc-metaclass-id (class-id)
    287281        (svref class-id->metaclass-id class-id))
     
    301295      (defun %objc-metaclass-count () next-objc-metaclass-id)
    302296      (defun %register-private-objc-class (c name)
    303         (splay-tree-put private-objc-classes c (make-private-objc-class-info :name name)))
     297        (setf (gethash c private-objc-classes)
     298              (make-private-objc-class-info :name name)))
    304299      (defun %get-private-objc-class (c)
    305         (splay-tree-get private-objc-classes c))
    306       (defun (setf %get-private-objc-class) (public c)
    307         (let* ((node (binary-tree-get private-objc-classes c)))
    308           (if node
    309             (setf (tree-node-value node) public)
    310             (error "Private class ~s not found" c))))
     300        (gethash c private-objc-classes))
    311301      (defun private-objc-classes ()
    312302        private-objc-classes))))
     
    316306
    317307(defun do-all-objc-classes (f)
    318   (map-splay-tree (objc-class-map) #'(lambda (id)
    319                                        (funcall f (id->objc-class id)))))
     308  (maphash #'(lambda (ptr id) (declare (ignore ptr)) (funcall f (id->objc-class id)))
     309           (objc-class-map)))
    320310
    321311(defun canonicalize-registered-class (c)
     
    677667;;; those canonical classes (and metaclasses) will have had their type
    678668;;; changed (by SAVE-APPLICATION) to, CCL::DEAD-MACPTR and the addresses
    679 ;;; of those classes may be bogus.  The splay trees (objc-class/metaclass-map)
     669;;; of those classes may be bogus.  The hash tables (objc-class/metaclass-map)
    680670;;; should be empty.
    681671;;; For each class that -had- had an assigned ID, determine its ObjC
    682672;;; class name, and ask ObjC where (if anywhere) the class is now.
    683673;;; If we get a non-null answer, revive the class pointer and set its
    684 ;;; address appropriately, then add an entry to the splay tree; this
     674;;; address appropriately, then add an entry to the hash-table; this
    685675;;; means that classes that existed on both sides of SAVE-APPLICATION
    686676;;; will retain the same ID.
     
    712702          (%revive-macptr m)
    713703          (%setf-macptr m (%null-ptr)))
    714         (unless (splay-tree-get class-map c)
     704        (unless (gethash c class-map)
    715705          (%set-pointer-to-objc-class-address (objc-class-id-foreign-name i) c)
    716706          ;; If the class is valid and the metaclass is still
    717707          ;; unmapped, set the metaclass pointer's address and map it.
    718708          (unless (%null-ptr-p c)
    719             (splay-tree-put class-map c i)
    720             (unless (splay-tree-get metaclass-map m)
     709            (setf (gethash c class-map) i)
     710            (unless (gethash m metaclass-map)
    721711              (%setf-macptr m (pref c #+apple-objc :objc_class.isa
    722712                                      #+gnu-objc :objc_class.class_pointer))
    723               (splay-tree-put metaclass-map m meta-id))
     713              (setf (gethash m metaclass-map) meta-id))
    724714            (note-class-protocols c)))))
    725715    ;; Second pass: install class objects for user-defined classes,
     
    739729                   (meta (pref class #+apple-objc :objc_class.isa
    740730                               #+gnu-objc :objc-class.class_pointer)))
    741             (unless (splay-tree-get metaclass-map m)
     731            (unless (gethash m metaclass-map)
    742732              (%revive-macptr m)
    743733              (%setf-macptr m meta)
    744               (splay-tree-put metaclass-map m meta-id))
     734              (setf (gethash m metaclass-map) meta-id))
    745735            (%setf-macptr c class))
    746736            #+apple-objc-2.0
     
    752742                (%make-objc-ivars c)
    753743              (%add-objc-class c ivars instance-size))
    754             (splay-tree-put class-map c i)))))
     744            (setf (gethash c class-map) i)))))
    755745    ;; Finally, iterate over all classes in the runtime world.
    756746    ;; Register any class that's not found in the class map
Note: See TracChangeset for help on using the changeset viewer.