Changeset 7722


Ignore:
Timestamp:
Nov 25, 2007, 2:26:16 AM (12 years ago)
Author:
gb
Message:

Locking changes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-0/l0-hash.lisp

    r7679 r7722  
    160160  (declaim (inline compute-hash-code))
    161161  (declaim (inline eq-hash-find eq-hash-find-for-put))
    162   (declaim (inline lock-hash-table unlock-hash-table)))
     162  (declaim (inline read-lock-hash-table write-lock-hash-table unlock-hash-table)))
    163163
    164164(defun %cons-hash-table (rehash-function keytrans-function compare-function vector
     
    570570(defvar *continue-from-readonly-hashtable-lock-error* nil)
    571571
    572 (defun signal-read-only-hash-table-error (hash write-p)
     572(defun signal-read-only-hash-table-error (hash)
    573573  (cond (*continue-from-readonly-hashtable-lock-error*
    574574         (cerror "Make the hash-table writable. DANGEROUS! CONTINUE ONLY IF YOU KNOW WHAT YOU'RE DOING!"
    575575                 "Hash-table ~s is readonly" hash)
    576576         (assert-hash-table-writeable hash)
    577          (lock-hash-table hash write-p))
     577         (write-lock-hash-table hash))
    578578        (t (error "Hash-table ~s is readonly" hash))))
    579579
    580 (defun lock-hash-table (hash write-p)
    581   (if (nhash.read-only hash)
    582     (if write-p
    583         (signal-read-only-hash-table-error hash write-p)
    584       :readonly)
    585     (let* ((lock (nhash.exclusion-lock hash)))
    586       (if lock
    587         (write-lock-rwlock lock)
    588         (progn (unless (eq (nhash.owner hash) *current-process*)
    589                  (error "Not owner of hash table ~s" hash)))))))
    590 
    591 (defun lock-hash-table-for-map (hash)
     580(defun read-lock-hash-table (hash)
    592581  (if (nhash.read-only hash)
    593582    :readonly
    594583    (let* ((lock (nhash.exclusion-lock hash)))
    595584      (if lock
     585        (read-lock-rwlock lock)
     586        (unless (eq (nhash.owner hash) *current-process*)
     587          (error "Not owner of hash table ~s" hash))))))
     588
     589(defun write-lock-hash-table (hash)
     590  (if (nhash.read-only hash)
     591    (signal-read-only-hash-table-error hash)
     592    (let* ((lock (nhash.exclusion-lock hash)))
     593      (if lock
    596594        (write-lock-rwlock lock)
    597         (progn (unless (eq (nhash.owner hash) *current-process*)
    598                  (error "Not owner of hash table ~s" hash)))))))
     595        (unless (eq (nhash.owner hash) *current-process*)
     596          (error "Not owner of hash table ~s" hash))))))
    599597
    600598
     
    613611    (report-bad-arg hash 'hash-table))
    614612  (with-lock-context
    615   (without-interrupts
    616    (lock-hash-table hash t)
    617    (let* ((vector (nhash.vector hash))
    618           (size (nhash.vector-size vector))
    619           (count (+ size size))
    620           (index $nhash.vector_overhead))
    621      (declare (fixnum size count index))
    622      (dotimes (i count)
    623        (setf (%svref vector index) (%unbound-marker))
    624        (incf index))
    625      (incf (the fixnum (nhash.grow-threshold hash))
    626            (the fixnum (+ (the fixnum (nhash.count hash))
    627                           (the fixnum (nhash.vector.deleted-count vector)))))
    628      (setf (nhash.count hash) 0
    629            (nhash.vector.cache-key vector) (%unbound-marker)
    630            (nhash.vector.cache-value vector) nil
    631            (nhash.vector.finalization-alist vector) nil
    632            (nhash.vector.free-alist vector) nil
    633            (nhash.vector.weak-deletions-count vector) 0
    634            (nhash.vector.deleted-count vector) 0
    635            (nhash.vector.flags vector) (logand $nhash_weak_flags_mask
    636                                                (nhash.vector.flags vector))))
    637    (unlock-hash-table hash nil)
    638    hash)))
     613    (without-interrupts
     614     (write-lock-hash-table hash)
     615     (let* ((vector (nhash.vector hash))
     616            (size (nhash.vector-size vector))
     617            (count (+ size size))
     618            (index $nhash.vector_overhead))
     619       (declare (fixnum size count index))
     620       (dotimes (i count)
     621         (setf (%svref vector index) (%unbound-marker))
     622         (incf index))
     623       (incf (the fixnum (nhash.grow-threshold hash))
     624             (the fixnum (+ (the fixnum (nhash.count hash))
     625                            (the fixnum (nhash.vector.deleted-count vector)))))
     626       (setf (nhash.count hash) 0
     627             (nhash.vector.cache-key vector) (%unbound-marker)
     628             (nhash.vector.cache-value vector) nil
     629             (nhash.vector.finalization-alist vector) nil
     630             (nhash.vector.free-alist vector) nil
     631             (nhash.vector.weak-deletions-count vector) 0
     632             (nhash.vector.deleted-count vector) 0
     633             (nhash.vector.flags vector) (logand $nhash_weak_flags_mask
     634                                                 (nhash.vector.flags vector))))
     635     (unlock-hash-table hash nil)
     636     hash)))
    639637
    640638(defun index->vector-index (index)
     
    703701    (with-lock-context
    704702      (without-interrupts
    705        (setq readonly (eq (lock-hash-table hash nil) :readonly))
     703       (setq readonly (eq #+notyet (read-lock-hash-table hash)
     704                          #-notyet (if (nhash.read-only hash)
     705                                     :readonly
     706                                     (write-lock-hash-table hash))
     707                          :readonly))
    706708       (let* ((vector (nhash.vector hash)))
    707709         (if (and (eq key (nhash.vector.cache-key vector))
     
    745747    (with-lock-context
    746748      (without-interrupts
    747        (lock-hash-table hash t)
     749       (write-lock-hash-table hash)
    748750       (%lock-gc-lock)
    749751       (when (%needs-rehashing-p hash)
     
    752754         (if (eq key (nhash.vector.cache-key vector))
    753755           (progn
    754              (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
    755                   ((null iterator))
    756                (unless (= (the fixnum (hti.index iterator))
    757                           (the fixnum (nhash.vector.cache-idx vector)))
    758                  (unlock-hash-table hash nil)
    759                  (%unlock-gc-lock)
    760                  (error "Can't remove key ~s during iteration on hash-table ~s"
    761                         key hash)))
    762756             (setf (nhash.vector.cache-key vector) free-hash-key-marker
    763757                   (nhash.vector.cache-value vector) nil)
     
    773767             (when (setq foundp (and (not (eq vector-key free-hash-key-marker))
    774768                                     (not (eq vector-key deleted-hash-key-marker))))
    775                (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
    776                     ((null iterator))
    777                  (unless (= (the fixnum (hti.index iterator))
    778                             (the fixnum (vector-index->index vector-index)))
    779                    (unlock-hash-table hash nil)
    780                    (%unlock-gc-lock)
    781                    (error "Can't remove key ~s during iteration on hash-table ~s"
    782                           key hash)))
    783769               ;; always clear the cache cause I'm too lazy to call the
    784770               ;; comparison function and don't want to keep a possibly
     
    821807     (block protected
    822808       (tagbody
    823           (lock-hash-table hash t)
     809          (write-lock-hash-table hash)
    824810        AGAIN
    825811          (%lock-gc-lock)
    826812          (when (%needs-rehashing-p hash)
    827813            (%rehash hash))
    828           (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
    829                ((null iterator))
    830             (let* ((vector (hti.vector iterator))
    831                    (index (index->vector-index (hti.index iterator)))
    832                    (test (hash-table-test hash)))
    833               (declare (fixnum index))
    834               (when (and (< index (the fixnum (uvsize vector)))
    835                          (not (funcall test (%svref vector index) key)))
    836                 (unlock-hash-table hash nil)
    837                 (%unlock-gc-lock)
    838                 (error "Can't add key ~s during iteration on hash-table ~s"
    839                        key hash))))
    840814          (let ((vector (nhash.vector  hash)))     
    841815            (when (eq key (nhash.vector.cache-key vector))
     
    17151689      (with-lock-context
    17161690        (without-interrupts
    1717          (lock-hash-table hash t)
     1691         (write-lock-hash-table hash)
    17181692         (let* ((flags (nhash.vector.flags (nhash.vector hash))))
    17191693           (declare (fixnum flags))
     
    17461720  (with-lock-context
    17471721    (without-interrupts
    1748      (let* ((readonly (eq (lock-hash-table hash nil) :readonly)))
     1722     (let* ((readonly (eq (read-lock-hash-table hash) :readonly)))
    17491723       (do* ((in (nhash.vector hash))
    17501724             (in-idx $nhash.vector_overhead (+ in-idx 2))
     
    17621736             (setf (%svref out out-idx) val)
    17631737             (incf out-idx))))))))
    1764  
Note: See TracChangeset for help on using the changeset viewer.