Changeset 13137


Ignore:
Timestamp:
Oct 30, 2009, 10:13:23 PM (10 years ago)
Author:
gz
Message:

Merge r13099 (thread safety in type cache)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-typesys.lisp

    r13070 r13137  
    14871487  (logand (sxhash spec) type-cache-mask))
    14881488
     1489
    14891490(let* ((type-cache-specs (make-array type-cache-size))
    14901491       (type-cache-ctypes (make-array type-cache-size))
     
    14921493       (hits 0)
    14931494       (ncleared 0)
    1494        (locked nil))
     1495       (locked nil)
     1496       (lock (make-lock)))
    14951497 
    14961498  (defun clear-type-cache ()
    1497     (%init-misc 0 type-cache-specs)
    1498     (%init-misc 0 type-cache-ctypes)
    1499     (incf ncleared)
     1499    (with-lock-grabbed (lock)
     1500      (%init-misc 0 type-cache-specs)
     1501      (%init-misc 0 type-cache-ctypes)
     1502      (incf ncleared))
    15001503    nil)
    15011504
     
    15041507      (let* ((class-ctype (%class.ctype spec)))
    15051508        (or (class-ctype-translation class-ctype) class-ctype))
    1506       (if locked
    1507         (or (values-specifier-type-internal spec env)
    1508             (make-unknown-ctype :specifier spec))
    1509         (unwind-protect
    1510           (progn
    1511             (setq locked t)
    1512             (if (or (symbolp spec)
    1513                     (and (consp spec)
    1514                          (symbolp (car spec))
    1515                          ;; hashing scheme uses equal, so only use when equivalent to eql
    1516                          (not (and (eq (car spec) 'member)
    1517                                    (some (lambda (x)
    1518                                            (typep x '(or cons string bit-vector pathname)))
    1519                                          (cdr spec))))))
    1520               (let* ((idx (hash-type-specifier spec)))
    1521                 (incf probes)
    1522                 (if (equal (svref type-cache-specs idx) spec)
    1523                   (progn
    1524                     (incf hits)
    1525                     (svref type-cache-ctypes idx))
    1526                   (let* ((ctype (values-specifier-type-internal spec env)))
    1527                     (if ctype
    1528                       (progn
    1529                         (when (cacheable-ctype-p ctype)
    1530                           (setf (svref type-cache-specs idx) (copy-tree spec)       ; in case it was stack-consed
    1531                                 (svref type-cache-ctypes idx) ctype))
    1532                         ctype)
    1533                       (make-unknown-ctype :specifier spec)))))
    1534               (values-specifier-type-internal spec env)))
    1535           (setq locked nil)))))
     1509      (handler-case
     1510          (with-lock-grabbed (lock)
     1511            (if locked
     1512              (or (values-specifier-type-internal spec env)
     1513                  (make-unknown-ctype :specifier spec))
     1514              (unwind-protect
     1515                   (progn
     1516                     (setq locked t)
     1517                     (if (or (symbolp spec)
     1518                             (and (consp spec)
     1519                                  (symbolp (car spec))
     1520                                  ;; hashing scheme uses equal, so only use when equivalent to eql
     1521                                  (not (and (eq (car spec) 'member)
     1522                                            (some (lambda (x)
     1523                                                    (typep x '(or cons string bit-vector pathname)))
     1524                                                  (cdr spec))))))
     1525                       (let* ((idx (hash-type-specifier spec)))
     1526                         (incf probes)
     1527                         (if (equal (svref type-cache-specs idx) spec)
     1528                           (progn
     1529                             (incf hits)
     1530                             (svref type-cache-ctypes idx))
     1531                           (let* ((ctype (values-specifier-type-internal spec env)))
     1532                             (if ctype
     1533                               (progn
     1534                                 (when (cacheable-ctype-p ctype)
     1535                                   (setf (svref type-cache-specs idx) (copy-tree spec) ; in case it was stack-consed
     1536                                         (svref type-cache-ctypes idx) ctype))
     1537                                 ctype)
     1538                               (make-unknown-ctype :specifier spec)))))
     1539                       (values-specifier-type-internal spec env)))
     1540                (setq locked nil))))
     1541        (error (condition) (error condition)))))
    15361542 
    15371543  (defun type-cache-hit-rate ()
     
    15431549  (defun lock-type-cache ()
    15441550    (setq locked t)))
    1545 
    15461551                   
    15471552
Note: See TracChangeset for help on using the changeset viewer.