Changeset 10978


Ignore:
Timestamp:
Oct 5, 2008, 2:38:14 AM (11 years ago)
Author:
gz
Message:

Propagate r10780 to trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-hash.lisp

    r10913 r10978  
    495495
    496496(defun signal-read-only-hash-table-error (hash)
    497   (cond (*continue-from-readonly-hashtable-lock-error*
     497  (cond ((hash-lock-free-p hash)
     498         ;; We don't really do anything different if this is set, so no problem
     499         (cerror "Modify it anyway"
     500                 "Attempt to modify readonly hash table ~s" hash))
     501        (*continue-from-readonly-hashtable-lock-error*
    498502         (cerror "Make the hash-table writable. DANGEROUS! This could damage your lisp if another thread is acccessing this table. CONTINUE ONLY IF YOU KNOW WHAT YOU'RE DOING!"
    499503                 "Hash-table ~s is readonly" hash)
     
    803807(defun lock-free-remhash (key hash)
    804808  (declare (optimize (speed 3) (safety 0) (debug 0)))
     809  (when (nhash.read-only hash)
     810    (signal-read-only-hash-table-error hash)) ;; continuable
    805811  (loop
    806812    (let* ((vector (nhash.vector hash))
     
    827833
    828834(defun lock-free-clrhash (hash)
     835  (when (nhash.read-only hash)
     836    (signal-read-only-hash-table-error hash)) ;;continuable
    829837  (with-lock-context
    830838    (without-interrupts
     
    846854            (eq value free-hash-marker))
    847855    (error "Illegal value ~s for storing in a hash table" value))
     856  (when (nhash.read-only hash)
     857    (signal-read-only-hash-table-error hash)) ;;continuable
    848858  (loop
    849859    (let* ((vector (nhash.vector  hash))
     
    18791889      (when (nhash.owner hash)
    18801890        (error "Hash~table ~s is thread-private and can't be made read-only for that reason" hash))
    1881       (with-lock-context
    1882         (without-interrupts
    1883          (write-lock-hash-table hash)
    1884          (let* ((flags (nhash.vector.flags (nhash.vector hash))))
    1885            (declare (fixnum flags))
    1886            (when (or (logbitp $nhash_track_keys_bit flags)
    1887                      (logbitp $nhash_component_address_bit flags))
    1888              (format t "~&Hash-table ~s uses address-based hashing and can't yet be made read-only for that reason." hash)
     1891      (if (hash-lock-free-p hash)
     1892        (setf (nhash.read-only hash) t)
     1893        (with-lock-context
     1894          (without-interrupts
     1895           (write-lock-hash-table hash)
     1896           (let* ((flags (nhash.vector.flags (nhash.vector hash))))
     1897             (declare (fixnum flags))
     1898             (when (or (logbitp $nhash_track_keys_bit flags)
     1899                       (logbitp $nhash_component_address_bit flags))
     1900               (format t "~&Hash-table ~s uses address-based hashing and can't yet be made read-only for that reason." hash)
     1901               (unlock-hash-table hash nil)
     1902               (return-from assert-hash-table-readonly nil))
     1903             (setf (nhash.read-only hash) t)
    18891904             (unlock-hash-table hash nil)
    1890              (return-from assert-hash-table-readonly nil))
    1891            (setf (nhash.read-only hash) t)
    1892            (unlock-hash-table hash nil)
    1893            t)))))
     1905             t))))))
    18941906
    18951907;; This is dangerous, if multiple threads are accessing a read-only
Note: See TracChangeset for help on using the changeset viewer.