repos
/
smoke
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Cleanup C++ to Lisp translation
Annotate for file src/bindings.lisp
2009-04-05 tobias
1
(in-package :smoke)
15:36:29 '
2
2009-08-02 tobias
3
(defvar *bindings* (make-hash-table)
10:12:41 '
4
"The Smoke C++ binding classes to which virtual method calls are dispatched.")
2010-01-10 tobias
5
08:49:36 '
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
12:18:08 '
48
(defun init-smoke-module (module)
'
49
(let ((smoke (smoke-module-pointer module)))
'
50
(setf (gethash (pointer-address smoke) *smoke-modules*)
'
51
module)
'
52
(flet ((mk-array (array)
'
53
(make-smoke-array :pointer (cl-smoke-array smoke array)
'
54
:length (cl-smoke-array-size smoke array))))
'
55
(setf (smoke-module-classes module) (mk-array :classes)
'
56
(smoke-module-methods module) (mk-array :methods)
'
57
(smoke-module-method-maps module) (mk-array :method-maps)
'
58
(smoke-module-method-names module) (mk-array :method-names)
'
59
(smoke-module-types module) (mk-array :types)
'
60
'
61
(smoke-module-inheritance-list module)
'
62
(cl-smoke-array smoke :inheritance-list)
'
63
'
64
(smoke-module-argument-list module)
'
65
(cl-smoke-array smoke :argument-list)
'
66
'
67
(smoke-module-ambiguous-method-list module)
'
68
(cl-smoke-array smoke :ambiguous-method-list)))))
'
69