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/bindings.lisp
2009-04-05 tobias
1
(in-package :smoke)
15:36:29 '
2
2010-01-10 tobias
3
(defvar *bindings* (make-hash-table)
08:49:36 '
4
"The Smoke C++ binding classes to which virtual method calls are dispatched.")
'
5
'
6
;; FIXME is this lock needed? (The user may not have to
'
7
;; load additional modules while threads are running.
'
8
(defvar *bindings-lock* (make-lock "bindings-lock"))
'
9
'
10
(defun binding (smoke)
'
11
"Returns the Smoke binding for the Smoke module SMOKE."
'
12
(with-lock-held (*bindings-lock*)
'
13
(multiple-value-bind (value present-p)
'
14
(gethash (pointer-address smoke) *bindings*)
'
15
(assert (eql t present-p)
'
16
()
'
17
"No binding for ~A." smoke)
'
18
value)))
'
19
'
20
(defun (setf binding) (binding smoke)
'
21
(with-lock-held (*bindings-lock*)
'
22
(setf (gethash (pointer-address smoke) *bindings*)
'
23
binding)))
'
24
2009-06-22 tobias
25
(defstruct smoke-array
2009-08-02 tobias
26
"A C array."
2009-06-22 tobias
27
(pointer (null-pointer) :type foreign-pointer)
12:18:08 '
28
(length 0 :type (smoke-index 0)))
'
29
2010-02-19 tobias
30
2009-06-22 tobias
31
(defstruct smoke-module
12:18:08 '
32
(pointer (null-pointer) :type foreign-pointer)
2010-02-19 tobias
33
(binding (null-pointer) :type foreign-pointer)
2009-06-22 tobias
34
12:18:08 '
35
(classes (make-smoke-array) :type smoke-array)
'
36
(methods (make-smoke-array) :type smoke-array)
'
37
(method-maps (make-smoke-array) :type smoke-array)
'
38
(method-names (make-smoke-array) :type smoke-array)
'
39
(types (make-smoke-array) :type smoke-array)
'
40
'
41
(inheritance-list (null-pointer) :type foreign-pointer)
'
42
(argument-list (null-pointer) :type foreign-pointer)
'
43
(ambiguous-method-list (null-pointer) :type foreign-pointer))
'
44
2009-08-02 tobias
45
(defvar *smoke-modules* (make-hash-table)
10:12:41 '
46
"All loaded Smoke modules.")
2009-06-22 tobias
47
2009-08-27 tobias
48
(defmethod print-object ((smoke-module smoke-module) stream)
11:43:13 '
49
(if (null-pointer-p (smoke-module-pointer smoke-module))
'
50
(call-next-method)
'
51
(print-unreadable-object (smoke-module stream :type t :identity t)
'
52
(princ (smoke-get-module-name (smoke-module-pointer smoke-module))
'
53
stream))))
'
54
2009-06-22 tobias
55
(defun init-smoke-module (module)
12:18:08 '
56
(let ((smoke (smoke-module-pointer module)))
'
57
(setf (gethash (pointer-address smoke) *smoke-modules*)
'
58
module)
'
59
(flet ((mk-array (array)
'
60
(make-smoke-array :pointer (cl-smoke-array smoke array)
'
61
:length (cl-smoke-array-size smoke array))))
'
62
(setf (smoke-module-classes module) (mk-array :classes)
'
63
(smoke-module-methods module) (mk-array :methods)
'
64
(smoke-module-method-maps module) (mk-array :method-maps)
'
65
(smoke-module-method-names module) (mk-array :method-names)
'
66
(smoke-module-types module) (mk-array :types)
'
67
'
68
(smoke-module-inheritance-list module)
'
69
(cl-smoke-array smoke :inheritance-list)
'
70
'
71
(smoke-module-argument-list module)
'
72
(cl-smoke-array smoke :argument-list)
'
73
'
74
(smoke-module-ambiguous-method-list module)
'
75
(cl-smoke-array smoke :ambiguous-method-list)))))
'
76