Changeset 10780


Ignore:
Timestamp:
Sep 17, 2008, 1:19:24 AM (11 years ago)
Author:
gz
Message:

Allow lock-free hash tables to be asserted readonly. This doesn't change what gethash does, but all writers check the flag and signal a continuable error

File:
1 edited

Legend:

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

    r10776 r10780  
    489489
    490490(defun signal-read-only-hash-table-error (hash)
    491   (cond (*continue-from-readonly-hashtable-lock-error*
     491  (cond ((hash-lock-free-p hash)
     492         ;; We don't really do anything different if this is set, so no problem
     493         (cerror "Modify it anyway"
     494                 "Attempt to modify readonly hash table ~s" hash))
     495        (*continue-from-readonly-hashtable-lock-error*
    492496         (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!"
    493497                 "Hash-table ~s is readonly" hash)
     
    697701(defun lock-free-remhash (key hash)
    698702  (declare (optimize (speed 3) (safety 0) (debug 0)))
     703  (when (nhash.read-only hash)
     704    (signal-read-only-hash-table-error hash)) ;; continuable
    699705  (loop
    700706    (let* ((vector (nhash.vector hash))
     
    718724
    719725(defun lock-free-clrhash (hash)
     726  (when (nhash.read-only hash)
     727    (signal-read-only-hash-table-error hash)) ;;continuable
    720728  (with-lock-context
    721729    (without-interrupts
     
    734742            (eq value free-hash-marker))
    735743    (error "Illegal value ~s for storing in a hash table" value))
     744  (when (nhash.read-only hash)
     745    (signal-read-only-hash-table-error hash)) ;;continuable
    736746  (loop
    737747    (let* ((vector (nhash.vector  hash))
     
    17601770      (when (nhash.owner hash)
    17611771        (error "Hash~table ~s is thread-private and can't be made read-only for that reason" hash))
    1762       (with-lock-context
    1763         (without-interrupts
    1764          (write-lock-hash-table hash)
    1765          (let* ((flags (nhash.vector.flags (nhash.vector hash))))
    1766            (declare (fixnum flags))
    1767            (when (or (logbitp $nhash_track_keys_bit flags)
    1768                      (logbitp $nhash_component_address_bit flags))
    1769              (format t "~&Hash-table ~s uses address-based hashing and can't yet be made read-only for that reason." hash)
     1772      (if (hash-lock-free-p hash)
     1773        (setf (nhash.read-only hash) t)
     1774        (with-lock-context
     1775          (without-interrupts
     1776           (write-lock-hash-table hash)
     1777           (let* ((flags (nhash.vector.flags (nhash.vector hash))))
     1778             (declare (fixnum flags))
     1779             (when (or (logbitp $nhash_track_keys_bit flags)
     1780                       (logbitp $nhash_component_address_bit flags))
     1781               (format t "~&Hash-table ~s uses address-based hashing and can't yet be made read-only for that reason." hash)
     1782               (unlock-hash-table hash nil)
     1783               (return-from assert-hash-table-readonly nil))
     1784             (setf (nhash.read-only hash) t)
    17701785             (unlock-hash-table hash nil)
    1771              (return-from assert-hash-table-readonly nil))
    1772            (setf (nhash.read-only hash) t)
    1773            (unlock-hash-table hash nil)
    1774            t)))))
     1786             t))))))
    17751787
    17761788;; This is dangerous, if multiple threads are accessing a read-only
Note: See TracChangeset for help on using the changeset viewer.