Ticket #993: lock-free-hash-table-test-2.lisp

File lock-free-hash-table-test-2.lisp, 1.7 KB (added by uchida, 21 months ago)
Line 
1(defpackage :lock-free-hash-table-test-2
2  (:use :cl :ccl))
3
4(in-package :lock-free-hash-table-test-2)
5
6;;(egc nil)
7;;(defvar *tbl* (make-hash-table :test 'equal :lock-free nil))
8(defvar *tbl* (make-hash-table :test 'equal))
9(defvar *lck* (make-lock))
10
11(defun run-test ()
12  (dotimes (i 1000)
13    #+LINUX
14    (sleep 0.1)
15    (dotimes (j 100)
16      (print (cons i j))
17      (run1 (cons i j)))))
18
19(defun run1 (key)
20  (with-lock-grabbed (*lck*)
21    (setf (gethash key *tbl*) 0)
22    (incf (gethash key *tbl*))))
23
24(defun ext-proc-thread ()
25  (process-run-function "ext-proc-thread"
26                        #'(lambda ()
27                            (loop
28                               #+LINUX
29                               (sleep 0.1)
30                               #+(or DARWIN LINUX)
31                               (run-program "/bin/echo" ())
32                               #+WINDOWS
33                               (run-program "cmd.exe" ())))))
34
35(defun background-memory-traffic ()
36  (process-run-function "background-memory-traffic"
37                        #'(lambda ()
38                            (loop
39                               #+LINUX
40                               (sleep 0.1)
41                               (loop for i from 1 to 15000000
42                                  collect i)))))
43
44#+(or LINUX WINDOWS)
45(defun clrhash-thread ()
46  (process-run-function "clrhash-thread"
47                        #'(lambda ()
48                            (loop
49                               (sleep 0.1)
50                               (with-lock-grabbed (*lck*)
51                                 (clrhash *tbl*))))))
52
53(background-memory-traffic)
54
55(ext-proc-thread)
56
57#+(or LINUX WINDOWS)
58(clrhash-thread)
59
60(run-test)
61
62(quit)