repos
/
smoke
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Support the new smokegenerator (r1015073).
Annotate for file src/class-map.lisp
2009-04-05 tobias
1
(in-package :smoke)
15:36:29 '
2
'
3
(defvar *smoke-id-class-map*
'
4
(make-hash-table)
'
5
"Maps a Smoke module pointer - id pair to a class.")
'
6
;; FIXME disallow adding a class when threads are running or add a lock.
'
7
2009-05-14 tobias
8
(defun id-class-map (smoke)
2009-06-22 tobias
9
(let ((value (gethash (pointer-address (smoke-module-pointer smoke))
2009-05-14 tobias
10
*smoke-id-class-map*)))
2010-01-17 tobias
11
(assert value ()
21:04:08 '
12
"Unknown smoke module ~A ~A."
'
13
smoke (smoke-get-module-name (smoke-module-pointer smoke)))
2009-05-14 tobias
14
value))
12:07:00 '
15
'
16
(defun (setf id-class-map) (new-value smoke)
2009-08-02 tobias
17
(setf (gethash (pointer-address (smoke-module-pointer smoke))
10:12:41 '
18
*smoke-id-class-map*)
2009-05-14 tobias
19
new-value))
2009-04-05 tobias
20
15:36:29 '
21
(defun add-id-class-map (smoke)
2009-08-02 tobias
22
(setf (id-class-map smoke) (make-hash-table)))
2009-04-05 tobias
23
15:36:29 '
24
(defun add-id (smoke-class class)
'
25
"Associates the CLOS class CLASS with SMOKE-CLASS."
2009-08-02 tobias
26
(setf (gethash (id smoke-class) (id-class-map (smoke smoke-class)))
2009-04-05 tobias
27
class))
15:36:29 '
28
2009-08-27 tobias
29
(defun find-smoke-class (class &optional (error-p t))
2009-04-05 tobias
30
"Returns the CLOS class for smoke-class CLASS."
2009-08-27 tobias
31
(let* ((class (handler-case (real-class class)
11:43:13 '
32
(undefined-class (e) (when error-p (error e)))))
'
33
(ret (when class (gethash (id class) (id-class-map (smoke class))))))
'
34
(when error-p
'
35
(assert (not (null ret))
'
36
()
'
37
"The class ~A was not found." (name class)))
2009-04-05 tobias
38
ret))