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