1;; -*- Lisp -*- vim:filetype=lisp 2 3#+LISPWORKS 4(progn 5 (defun gc () (mark-and-sweep 3)) 6 (defun hash-table-weak-p (ht) (system::hash-table-weak-kind ht)) 7 t) 8#+LISPWORKS 9T 10 11(hash-table-weak-p 12 (progn 13 (setq tab (make-hash-table #+LISPWORKS :weak-kind #-LISPWORKS :weak :key 14 :test 'equal 15 #+CLISP :initial-contents #+CLISP '((1 . 2) ("foo" . "bar")))) 16 #-CLISP (setf (gethash 1 tab) 2) 17 #-CLISP (setf (gethash "foo" tab) "bar") 18 tab)) 19:key 20 21(gethash 1 tab) 222 23 24(gethash "foo" tab) 25"bar" 26 27(gethash "zot" tab) 28nil 29 30(gethash "bar" tab) 31nil 32 33(progn (gc) t) 34t 35 36(gethash 1 tab) 372 38 39(gethash "foo" tab) 40nil 41 42(gethash "zot" tab) 43nil 44 45(gethash "bar" tab) 46nil 47 48#+LISPWORKS (set-hash-table-weak tab nil) 49#-LISPWORKS (setf (hash-table-weak-p tab) nil) 50nil 51 52(gethash 1 tab) 532 54 55(gethash "foo" tab) 56nil 57 58(setf (gethash "foo" tab) "bar") 59"bar" 60 61(gethash "foo" tab) 62"bar" 63 64(progn (gc) t) 65t 66 67(gethash "foo" tab) 68"bar" 69 70#+LISPWORKS (set-hash-table-weak tab :key) 71#-LISPWORKS (setf (hash-table-weak-p tab) :key) 72:key 73 74(progn (gc) t) 75t 76 77(gethash "foo" tab) 78nil 79 80#+LISPWORKS (set-hash-table-weak tab :value) 81#-LISPWORKS (setf (hash-table-weak-p tab) :value) 82:value 83(setf (gethash "foo" tab) 1) 1 84(setf (gethash 1 tab) "bar") "bar" 85(setf (gethash "zoo" tab) "zot") "zot" 86(progn (gc) t) t 87(gethash "foo" tab) 1 88(gethash 1 tab) nil 89(gethash "zoo" tab) nil 90 91#+LISPWORKS (set-hash-table-weak tab :both) #+LISPWORKS :both 92#-LISPWORKS (setf (hash-table-weak-p tab) :key-and-value) #-LISPWORKS :key-and-value 93(setf (gethash "foo" tab) 1) 1 94(setf (gethash 1 tab) "bar") "bar" 95(setf (gethash "zoo" tab) "zot") "zot" 96(progn (gc) t) t 97(gethash "foo" tab) nil 98(gethash 1 tab) nil 99(gethash "zoo" tab) nil 100 101#+LISPWORKS (set-hash-table-weak tab :either) #+LISPWORKS :either 102#-LISPWORKS (setf (hash-table-weak-p tab) :key-or-value) #-LISPWORKS :key-or-value 103(setf (gethash "foo" tab) 1) 1 104(setf (gethash 1 tab) "bar") "bar" 105(setf (gethash "zoo" tab) "zot") "zot" 106(progn (gc) t) t 107(gethash "foo" tab) 1 108(gethash 1 tab) "bar" 109(gethash "zoo" tab) nil 110 111(let ((htv (make-hash-table :test 'eql 112 #+LISPWORKS :weak-kind #-LISPWORKS :weak :value)) 113 (htk (make-hash-table :test 'eql 114 #+LISPWORKS :weak-kind #-LISPWORKS :weak :key)) 115 (li nil)) 116 (loop :for i :from 0 :to 1000 117 :for string = (format nil "~r" i) 118 :do (push string li) 119 (setf (gethash i htv) string 120 (gethash string htk) i)) 121 (list (length li) 122 (cons (hash-table-count htv) (hash-table-count htk)) 123 (progn (gc) (cons (hash-table-count htv) (hash-table-count htk))) 124 (progn (setq li nil) (gc) 125 (cons (hash-table-count htv) (hash-table-count htk))))) 126(1001 (1001 . 1001) (1001 . 1001) (0 . 0)) 127 128; This was a bug that - strangely - led to crashes _only_ in the 129; SPVW_PAGES LINUX_NOEXEC_HEAPCODES NO_GENERATIONAL_GC configuration. 130#+CLISP 131(flet ((ht_kvtable (ht) 132 (if (integerp (sys::%record-ref ht 1)) ; GENERATIONAL_GC build? 133 (sys::%record-ref ht 2) 134 (sys::%record-ref ht 1))) 135 (whal_itable (kvt) (sys::%record-ref kvt 1))) 136 (let* ((ht (make-hash-table :test 'ext::stablehash-eq :weak :key)) 137 (kvt (ht_kvtable ht))) 138 (assert (simple-vector-p (whal_itable kvt))) 139 (gc) ; first GC removed kvt from the all_weakpointers list 140 (gc) ; second GC dropped the itable 141 (and (eq (ht_kvtable ht) kvt) 142 (simple-vector-p (whal_itable kvt))))) 143#+CLISP 144T 145 146(progn ; cleanup 147 (symbol-cleanup 'tab)) 148T 149