- Timestamp:
- Nov 24, 2007, 6:26:16 PM (17 years ago)
- File:
-
- 1 edited
-
branches/working-0711/ccl/level-0/l0-hash.lisp (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/working-0711/ccl/level-0/l0-hash.lisp
r7679 r7722 160 160 (declaim (inline compute-hash-code)) 161 161 (declaim (inline eq-hash-find eq-hash-find-for-put)) 162 (declaim (inline lock-hash-tableunlock-hash-table)))162 (declaim (inline read-lock-hash-table write-lock-hash-table unlock-hash-table))) 163 163 164 164 (defun %cons-hash-table (rehash-function keytrans-function compare-function vector … … 570 570 (defvar *continue-from-readonly-hashtable-lock-error* nil) 571 571 572 (defun signal-read-only-hash-table-error (hash write-p)572 (defun signal-read-only-hash-table-error (hash) 573 573 (cond (*continue-from-readonly-hashtable-lock-error* 574 574 (cerror "Make the hash-table writable. DANGEROUS! CONTINUE ONLY IF YOU KNOW WHAT YOU'RE DOING!" 575 575 "Hash-table ~s is readonly" hash) 576 576 (assert-hash-table-writeable hash) 577 ( lock-hash-table hash write-p))577 (write-lock-hash-table hash)) 578 578 (t (error "Hash-table ~s is readonly" hash)))) 579 579 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) 592 581 (if (nhash.read-only hash) 593 582 :readonly 594 583 (let* ((lock (nhash.exclusion-lock hash))) 595 584 (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 596 594 (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)))))) 599 597 600 598 … … 613 611 (report-bad-arg hash 'hash-table)) 614 612 (with-lock-context 615 (without-interrupts616 (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) 0629 (nhash.vector.cache-key vector) (%unbound-marker)630 (nhash.vector.cache-value vector) nil631 (nhash.vector.finalization-alist vector) nil632 (nhash.vector.free-alist vector) nil633 (nhash.vector.weak-deletions-count vector) 0634 (nhash.vector.deleted-count vector) 0635 (nhash.vector.flags vector) (logand $nhash_weak_flags_mask636 (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))) 639 637 640 638 (defun index->vector-index (index) … … 703 701 (with-lock-context 704 702 (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)) 706 708 (let* ((vector (nhash.vector hash))) 707 709 (if (and (eq key (nhash.vector.cache-key vector)) … … 745 747 (with-lock-context 746 748 (without-interrupts 747 ( lock-hash-table hash t)749 (write-lock-hash-table hash) 748 750 (%lock-gc-lock) 749 751 (when (%needs-rehashing-p hash) … … 752 754 (if (eq key (nhash.vector.cache-key vector)) 753 755 (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)))762 756 (setf (nhash.vector.cache-key vector) free-hash-key-marker 763 757 (nhash.vector.cache-value vector) nil) … … 773 767 (when (setq foundp (and (not (eq vector-key free-hash-key-marker)) 774 768 (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)))783 769 ;; always clear the cache cause I'm too lazy to call the 784 770 ;; comparison function and don't want to keep a possibly … … 821 807 (block protected 822 808 (tagbody 823 ( lock-hash-table hash t)809 (write-lock-hash-table hash) 824 810 AGAIN 825 811 (%lock-gc-lock) 826 812 (when (%needs-rehashing-p hash) 827 813 (%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))))840 814 (let ((vector (nhash.vector hash))) 841 815 (when (eq key (nhash.vector.cache-key vector)) … … 1715 1689 (with-lock-context 1716 1690 (without-interrupts 1717 ( lock-hash-table hash t)1691 (write-lock-hash-table hash) 1718 1692 (let* ((flags (nhash.vector.flags (nhash.vector hash)))) 1719 1693 (declare (fixnum flags)) … … 1746 1720 (with-lock-context 1747 1721 (without-interrupts 1748 (let* ((readonly (eq ( lock-hash-table hash nil) :readonly)))1722 (let* ((readonly (eq (read-lock-hash-table hash) :readonly))) 1749 1723 (do* ((in (nhash.vector hash)) 1750 1724 (in-idx $nhash.vector_overhead (+ in-idx 2)) … … 1762 1736 (setf (%svref out out-idx) val) 1763 1737 (incf out-idx)))))))) 1764
Note:
See TracChangeset
for help on using the changeset viewer.
