Changeset 7482 for branches/working-0710


Ignore:
Timestamp:
Oct 19, 2007, 10:02:36 PM (12 years ago)
Author:
gb
Message:

Support for readonly hash-tables.
Tricky to bootstrap: do

? (ccl::update-modules 'ccl::lispequ t)
? (ccl::compile-modules 'ccl::hash t) ; expect warnings
? (ccl::rebuild-ccl) ; no args

which should build a runnable image.

Location:
branches/working-0710/ccl
Files:
3 edited

Legend:

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

    r7392 r7482  
    187187   find                                 ; nhash.find
    188188   find-new                             ; nhash.find-new
     189   nil                                  ; hhash.read-only
    189190   ))
    190191
     
    569570
    570571
    571 (defun lock-hash-table (hash)
    572   (let* ((lock (nhash.exclusion-lock hash)))
    573     (if lock
    574       (write-lock-rwlock lock)
    575       (progn (unless (eq (nhash.owner hash) *current-process*)
    576                (allowing-deferred-gc (error "Not owner of hash table ~s" hash)))))))
    577 
    578 (defun unlock-hash-table (hash)
    579   (let* ((lock (nhash.exclusion-lock hash)))
    580     (if lock
    581       (unlock-rwlock lock))))
     572(defun lock-hash-table (hash write-p)
     573  (if (nhash.read-only hash)
     574    (if write-p
     575      (error "Hash-table ~s is readonly" hash)
     576      :readonly)
     577    (let* ((lock (nhash.exclusion-lock hash)))
     578      (if lock
     579        (write-lock-rwlock lock)
     580        (progn (unless (eq (nhash.owner hash) *current-process*)
     581                 (error "Not owner of hash table ~s" hash)))))))
     582
     583(defun lock-hash-table-for-map (hash)
     584  (if (nhash.read-only hash)
     585    :readonly
     586    (let* ((lock (nhash.exclusion-lock hash)))
     587      (if lock
     588        (write-lock-rwlock lock)
     589        (progn (unless (eq (nhash.owner hash) *current-process*)
     590                 (error "Not owner of hash table ~s" hash)))))))
     591
     592
     593(defun unlock-hash-table (hash was-readonly)
     594  (unless was-readonly
     595    (let* ((lock (nhash.exclusion-lock hash)))
     596      (if lock
     597        (unlock-rwlock lock)))))
    582598
    583599
     
    589605    (report-bad-arg hash 'hash-table))
    590606  (without-interrupts
    591    (lock-hash-table hash)
     607   (lock-hash-table hash t)
    592608   (let* ((vector (nhash.vector hash))
    593609          (size (nhash.vector-size vector))
     
    610626           (nhash.vector.flags vector) (logand $nhash_weak_flags_mask
    611627                                               (nhash.vector.flags vector))))
    612    (unlock-hash-table hash)
     628   (unlock-hash-table hash nil)
    613629   hash))
    614630
     
    662678;;  don't get dumped as "simple" %defuns.
    663679;;
    664 
    665680
    666681
     
    675690         (vector-key nil)
    676691         (gc-locked nil)
     692         (readonly nil)
    677693         (foundp nil))
    678694    (without-interrupts
    679      (lock-hash-table hash)
     695     (setq readonly (eq (lock-hash-table hash nil) :readonly))
    680696     (let* ((vector (nhash.vector hash)))
    681697       (if (and (eq key (nhash.vector.cache-key vector))
     
    694710             (cond ((setq foundp (and (not (eq vector-key free-hash-key-marker))
    695711                                      (not (eq vector-key deleted-hash-key-marker))))
     712                    #+no
    696713                    (setf (nhash.vector.cache-key vector) vector-key
    697714                          (nhash.vector.cache-value vector) value
     
    705722               (t (return)))))))
    706723     (when gc-locked (%unlock-gc-lock))
    707      (unlock-hash-table hash))
     724     (unlock-hash-table hash readonly))
    708725    (if foundp
    709726      (values value t)
     
    717734  (let* ((foundp nil))
    718735    (without-interrupts
    719      (lock-hash-table hash)
     736     (lock-hash-table hash t)
    720737     (%lock-gc-lock)
    721738     (when (%needs-rehashing-p hash)
     
    728745             (unless (= (the fixnum (hti.index iterator))
    729746                        (the fixnum (nhash.vector.cache-idx vector)))
    730                (unlock-hash-table hash)
     747               (unlock-hash-table hash nil)
    731748               (%unlock-gc-lock)
    732749               (error "Can't remove key ~s during iteration on hash-table ~s"
     
    749766               (unless (= (the fixnum (hti.index iterator))
    750767                          (the fixnum (vector-index->index vector-index)))
    751                  (unlock-hash-table hash)
     768                 (unlock-hash-table hash nil)
    752769                 (%unlock-gc-lock)
    753770                 (error "Can't remove key ~s during iteration on hash-table ~s"
     
    782799     ;; Return T if we deleted something
    783800     (%unlock-gc-lock)
    784      (unlock-hash-table hash))
     801     (unlock-hash-table hash nil))
    785802    foundp))
    786803
     
    792809   (block protected
    793810     (tagbody
    794         (lock-hash-table hash)
     811        (lock-hash-table hash t)
    795812        AGAIN
    796813        (%lock-gc-lock)
     
    805822            (when (and (< index (the fixnum (uvsize vector)))
    806823                       (not (funcall test (%svref vector index) key)))
    807               (unlock-hash-table hash)
     824              (unlock-hash-table hash nil)
    808825              (%unlock-gc-lock)
    809826              (error "Can't add key ~s during iteration on hash-table ~s"
     
    850867                  (nhash.vector.cache-value vector) value)))))
    851868   (%unlock-gc-lock)
    852    (unlock-hash-table hash))
     869   (unlock-hash-table hash nil))
    853870  value)
    854871
     
    16801697    vector))
    16811698
     1699(defun assert-hash-table-readonly (hash)
     1700  (unless (hash-table-p hash)
     1701    (report-bad-arg hash 'hash-table))
     1702  (or (nhash.read-only hash)
     1703      (without-interrupts
     1704       (lock-hash-table hash t)
     1705       (let* ((flags (nhash.vector.flags (nhash.vector hash))))
     1706         (declare (fixnum flags))
     1707         (when (or (logbitp $nhash_track_keys_bit flags)
     1708                   (logbitp $nhash_component_address_bit flags))
     1709           (format t "~&Hash-table ~s uses address-based hashing and can't yet be made read-only for that reason." hash)
     1710           (unlock-hash-table hash nil)
     1711           (return-from assert-hash-table-readonly nil))
     1712         (setf (nhash.read-only hash) t)
     1713         (unlock-hash-table hash nil)
     1714         t))))
  • branches/working-0710/ccl/lib/hash.lisp

    r2584 r7482  
    209209
    210210(defun start-hash-table-iterator (hash state)
    211   (let (vector)
     211  (let (vector locked)
    212212    (unless (hash-table-p hash)
    213213      (setf (hti.hash-table state) nil)         ; for finish-hash-table-iterator
     
    216216    (without-interrupts
    217217     (setf (hti.hash-table state) hash)
    218      (lock-hash-table hash)
    219      (%lock-gc-lock)
     218     (setf (hti.lock state) (setq locked (not (eq :readonly (lock-hash-table-for-map hash)))))
     219     (when locked (%lock-gc-lock))
    220220     (setq vector (nhash.vector hash))
    221221     (setf (hti.vector state) vector)
     
    254254(defun finish-hash-table-iterator (state)
    255255  (without-interrupts
    256    (let ((hash (hti.hash-table state)))
     256   (let ((hash (hti.hash-table state))
     257         (locked (hti.lock state)))
    257258     (when hash
    258259       (setf (hti.hash-table state) nil)
    259        (unlock-hash-table hash)
    260        (%unlock-gc-lock)
     260       (when locked
     261         (unlock-hash-table hash nil)
     262         (%unlock-gc-lock))
    261263       (when (eq state (nhash.iterator hash))
    262264         (setf (nhash.iterator hash) (hti.prev-iterator state)))
  • branches/working-0710/ccl/library/lispequ.lisp

    r6913 r7482  
    12231223    nhash.find                          ; function: find vector-index
    12241224    nhash.find-new                      ; function: find vector-index on put
     1225    nhash.read-only                     ; boolean: true when read-only
    12251226    )
    12261227
Note: See TracChangeset for help on using the changeset viewer.