Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Class layout protocol | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Sensble Object Design, an object system for C. | |
11 | ;;; | |
12 | ;;; SOD is free software; you can redistribute it and/or modify | |
13 | ;;; it under the terms of the GNU General Public License as published by | |
14 | ;;; the Free Software Foundation; either version 2 of the License, or | |
15 | ;;; (at your option) any later version. | |
16 | ;;; | |
17 | ;;; SOD is distributed in the hope that it will be useful, | |
18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;;; GNU General Public License for more details. | |
21 | ;;; | |
22 | ;;; You should have received a copy of the GNU General Public License | |
23 | ;;; along with SOD; if not, write to the Free Software Foundation, | |
24 | ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
25 | ||
26 | (cl:in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Effective slot objects. | |
30 | ||
31 | (export '(effective-slot effective-slot-class | |
32 | effective-slot-direct-slot effective-slot-initializer)) | |
33 | (defclass effective-slot () | |
34 | ((class :initarg :class :type sod-slot :reader effective-slot-class) | |
35 | (slot :initarg :slot :type sod-slot :reader effective-slot-direct-slot) | |
36 | (initializer :initarg :initializer :type (or sod-initializer null) | |
37 | :reader effective-slot-initializer)) | |
38 | (:documentation | |
39 | "Describes a slot and how it's meant to be initialized. | |
40 | ||
41 | Specifically, an effective slot object states that in an instance of | |
42 | CLASS, a particular SLOT is initializd by a particular INITIALIZER. Note | |
43 | that the CLASS is a subclass of the SLOT's defining class, and not | |
44 | necessarily the same. | |
45 | ||
46 | Effective slot objects are usually found in `islots' objects.")) | |
47 | ||
48 | (export 'find-slot-initializer) | |
49 | (defgeneric find-slot-initializer (class slot) | |
50 | (:documentation | |
51 | "Return the most specific initializer for SLOT, starting from CLASS.")) | |
52 | ||
53 | (export 'compute-effective-slot) | |
54 | (defgeneric compute-effective-slot (class slot) | |
55 | (:documentation | |
56 | "Construct an effective slot from the supplied direct slot. | |
57 | ||
58 | SLOT is a direct slot defined on CLASS or one of its superclasses. | |
59 | (Metaclass initializers are handled using a different mechanism.)")) | |
60 | ||
61 | ;;;-------------------------------------------------------------------------- | |
62 | ;;; Instance layout. | |
63 | ||
64 | ;;; islots | |
65 | ||
66 | (export '(islots islots-class islots-subclass islots-slots)) | |
67 | (defclass islots () | |
68 | ((class :initarg :class :type sod-class :reader islots-class) | |
69 | (subclass :initarg :subclass :type sod-class :reader islots-subclass) | |
70 | (slots :initarg :slots :type list :reader islots-slots)) | |
71 | (:documentation | |
72 | "Contains effective slot definitions for a class's direct slots. | |
73 | ||
74 | In detail: SLOTS is a list of effective slot objects corresponding to | |
75 | CLASS's direct slots, and containing initializers computed relative to | |
76 | SUBCLASS.")) | |
77 | ||
78 | (export 'compute-islots) | |
79 | (defgeneric compute-islots (class subclass) | |
80 | (:documentation | |
81 | "Return `islots' for a particular CLASS and SUBCLASS. | |
82 | ||
83 | Initializers for the slots should be taken from the most specific | |
84 | superclass of SUBCLASS.")) | |
85 | ||
86 | ;;; vtable-pointer | |
87 | ||
88 | (export '(vtable-pointer vtable-pointer-class | |
89 | vtable-pointer-chain-head vtable-pointer-chain-tail)) | |
90 | (defclass vtable-pointer () | |
91 | ((class :initarg :class :type sod-class :reader vtable-pointer-class) | |
92 | (chain-head :initarg :chain-head :type sod-class | |
93 | :reader vtable-pointer-chain-head) | |
94 | (chain-tail :initarg :chain-tail :type sod-class | |
95 | :reader vtable-pointer-chain-tail)) | |
96 | (:documentation | |
97 | "Represents a pointer to a class's vtable. | |
98 | ||
99 | There's one of these for each of CLASS's chains. This particular one | |
100 | belongs to the chain headed by CHAIN-HEAD; the most specific superclass of | |
101 | CLASS on that chain is CHAIN-TAIL. (The tail is useful because we can -- | |
102 | and do -- use structure types defined by the tail class for non-primary | |
103 | chains.)")) | |
104 | ||
105 | ;;; ichain | |
106 | ||
107 | (export '(ichain ichain-class ichain-head ichain-tail ichain-body)) | |
108 | (defclass ichain () | |
109 | ((class :initarg :class :type sod-class :reader ichain-class) | |
110 | (chain-head :initarg :chain-head :type sod-class :reader ichain-head) | |
111 | (chain-tail :initarg :chain-tail :type sod-class :reader ichain-tail) | |
112 | (body :initarg :body :type list :reader ichain-body)) | |
113 | (:documentation | |
114 | "Contains instance data for a particular chain of superclasses. | |
115 | ||
116 | In detail: describes instance data for one of CLASS's chains, specifically | |
117 | the chain headed by CHAIN-HEAD. The CHAIN-TAIL is the most specific | |
118 | superclass of CLASS on the chain in question. The BODY is a list of | |
119 | layout objects to be included. | |
120 | ||
121 | An `ilayout' object maintains a list of `ichain' objects, one for each of | |
122 | a class's chains.")) | |
123 | ||
124 | (export 'compute-ichain) | |
125 | (defgeneric compute-ichain (class chain) | |
126 | (:documentation | |
127 | "Return an ICHAIN for a particular CHAIN of CLASS's superclasses. | |
128 | ||
129 | The CHAIN is a list of classes, with the least specific first -- so the | |
130 | chain head is the first element.")) | |
131 | ||
132 | ;;; ilayout | |
133 | ||
134 | (export '(ilayout ilayout-class ilayout-ichains)) | |
135 | (defclass ilayout () | |
136 | ((class :initarg :class :type sod-class :reader ilayout-class) | |
137 | (ichains :initarg :ichains :type list :reader ilayout-ichains)) | |
138 | (:documentation | |
139 | "All of the instance layout for a class. | |
140 | ||
141 | Describes the layout of an instance of CLASS. The list ICHAINS contains | |
142 | an `ichain' object for each chain of CLASS.")) | |
143 | ||
144 | (export 'compute-ilayout) | |
145 | (defgeneric compute-ilayout (class) | |
146 | (:documentation | |
147 | "Compute and return an instance layout for CLASS.")) | |
148 | ||
149 | ;;;-------------------------------------------------------------------------- | |
150 | ;;; Vtable layout. | |
151 | ||
152 | ;;; vtmsgs | |
153 | ||
154 | (defclass vtmsgs () | |
155 | ((class :initarg :class :type sod-class :reader vtmsgs-class) | |
156 | (subclass :initarg :subclass :type sod-class :reader vtmsgs-subclass) | |
157 | (chain-head :initarg :chain-head :type sod-class | |
158 | :reader vtmsgs-chain-head) | |
159 | (chain-tail :initarg :chain-tail :type sod-class | |
160 | :reader vtmsgs-chain-tail) | |
161 | (entries :initarg :entries :type list :reader vtmsgs-entries)) | |
162 | (:documentation | |
163 | "The message dispatch table for a particular class. | |
164 | ||
165 | In detail, this lists the `method-entry' objects for the messages defined | |
166 | by a particular CLASS, where the effective methods are specialized for the | |
167 | SUBCLASS; the method entries adjust the instance pointer argument | |
168 | appropriately for a call via the vtable for the chain headed by | |
169 | CHAIN-HEAD. The CHAIN-TAIL is the most specific superclass of SUBCLASS on | |
170 | this chain. The ENTRIES are a list of `method-entry' objects.")) | |
171 | ||
172 | (export 'compte-vtmsgs) | |
173 | (defgeneric compute-vtmsgs (class subclass chain-head chain-tail) | |
174 | (:documentation | |
2aa51854 | 175 | "Return a `vtmsgs' object containing method entries for CLASS. |
dea4d055 MW |
176 | |
177 | The CHAIN-HEAD describes which chain the method entries should be | |
178 | constructed for. | |
179 | ||
2aa51854 MW |
180 | The default method simply calls `make-method-entry' for each of the |
181 | methods and wraps a `vtmsgs' object around them. This ought to be enough | |
182 | for almost all purposes.")) | |
dea4d055 MW |
183 | |
184 | ;;; class-pointer | |
185 | ||
186 | (export '(class-pointer class-pointer-class class-pointer-chain-head | |
187 | class-pointer-metaclass class-pointer-meta-chain-head)) | |
188 | (defclass class-pointer () | |
189 | ((class :initarg :class :type sod-class :reader class-pointer-class) | |
190 | (chain-head :initarg :chain-head :type sod-class | |
191 | :reader class-pointer-chain-head) | |
192 | (metaclass :initarg :metaclass :type sod-class | |
193 | :reader class-pointer-metaclass) | |
194 | (meta-chain-head :initarg :meta-chain-head :type sod-class | |
195 | :reader class-pointer-meta-chain-head)) | |
196 | (:documentation | |
197 | "Represents a pointer to a class object for the instance's class. | |
198 | ||
199 | This is somewhat complicated because there are two degrees of freedom. An | |
200 | instance of `class-pointer' is a pointer from a vtable to an `ichain' of | |
5608b1af | 201 | the the class's metaclass instance. In particular, a `class-pointer' |
dea4d055 MW |
202 | instance represents a pointer in a vtable constructed for CLASS and |
203 | attached to the chain headed by CHAIN-HEAD; it points to an instance of | |
204 | METACLASS, and specifically to the `ichain' substructure corresponding to | |
205 | the chain headed by META-CHAIN-HEAD, which will be a superclass of | |
206 | METACLASS. | |
207 | ||
208 | I'm sorry if this is confusing.")) | |
209 | ||
210 | (export 'make-class-pointer) | |
211 | (defgeneric make-class-pointer (class chain-head metaclass meta-chain-head) | |
212 | (:documentation | |
213 | "Return a class pointer to a metaclass chain.")) | |
214 | ||
215 | ;;; base-offset | |
216 | ||
217 | (export '(base-offset base-offset-class base-offset-chain-head)) | |
218 | (defclass base-offset () | |
219 | ((class :initarg :class :type sod-class :reader base-offset-class) | |
220 | (chain-head :initarg :chain-head :type sod-class | |
221 | :reader base-offset-chain-head)) | |
222 | (:documentation | |
223 | "The offset of this chain to the `ilayout' base. | |
224 | ||
225 | We're generating a vtable for CLASS, attached to the chain headed by | |
226 | CHAIN-HEAD. Fortunately (and unlike `class-pointer'), the chain head can | |
227 | do double duty, since it also identifies the `ichain' substructure of the | |
228 | class's `ilayout' whose offset we're interested in.")) | |
229 | ||
230 | (export 'make-base-offset) | |
231 | (defgeneric make-base-offset (class chain-head) | |
232 | (:documentation | |
233 | "Return the base offset object for CHAIN-HEAD ichain.")) | |
234 | ||
235 | ;;; chain-offset | |
236 | ||
237 | (export '(chain-offset chain-offset-class | |
238 | chain-offset-chain-head chain-offset-target-head)) | |
239 | (defclass chain-offset () | |
240 | ((class :initarg :class :type sod-class :reader chain-offset-class) | |
241 | (chain-head :initarg :chain-head :type sod-class | |
242 | :reader chain-offset-chain-head) | |
243 | (target-head :initarg :target-head :type sod-class | |
244 | :reader chain-offset-target-head)) | |
245 | (:documentation | |
246 | "The offset to a different `ichain'. | |
247 | ||
248 | We're generating a vtable for CLASS, attached to the chain headed by | |
249 | CHAIN-HEAD. This instance represents an offset to the (different) chain | |
250 | headed by TARGET-HEAD. | |
251 | ||
252 | This is, strictly speaking, redundant. We could do as well by using the | |
253 | base offset and finding the offset to the target class in the class | |
254 | object's metadata; but that would either require a search or we'd have to | |
255 | be able work out the target chain's index in the table.")) | |
256 | ||
257 | (defgeneric make-chain-offset (class chain-head target-head) | |
258 | (:documentation | |
259 | "Return the offset from CHAIN-HEAD to TARGET-HEAD.")) | |
260 | ||
261 | ;;; vtable | |
262 | ||
263 | (export '(vtable vtable-class vtable-body | |
264 | vtable-chain-head vtable-chain-tail)) | |
265 | (defclass vtable () | |
266 | ((class :initarg :class :type sod-class :reader vtable-class) | |
267 | (chain-head :initarg :chain-head :type sod-class | |
268 | :reader vtable-chain-head) | |
269 | (chain-tail :initarg :chain-tail :type sod-class | |
270 | :reader vtable-chain-tail) | |
271 | (body :initarg :body :type list :reader vtable-body)) | |
272 | (:documentation | |
273 | "A vtable holds all of the per-chain static information for a class. | |
274 | ||
275 | Each chain of CLASS has its own vtable; the `vtable' object remembers the | |
276 | least specific (CHAIN-HEAD) and most specific (CHAIN-TAIL) superclasses of | |
277 | CLASS on that chain. (This is useful because we can reuse vtable | |
278 | structure types from superclasses for chains other than the primary chain | |
279 | -- i.e., the one in which CLASS itself appears.) | |
280 | ||
281 | The BODY is a list of vtable items, including `vtmsgs' structures, | |
282 | `chain-offset's, `class-pointers', and a `base-offset'.")) | |
283 | ||
284 | (export 'compute-vtable-items) | |
285 | (defgeneric compute-vtable-items (class super chain-head chain-tail emit) | |
286 | (:documentation | |
287 | "Emit vtable items for a superclass of CLASS. | |
288 | ||
289 | This function is called for each superclass SUPER of CLASS reached on the | |
290 | chain headed by CHAIN-HEAD. The function should call EMIT for each | |
291 | vtable item it wants to write. | |
292 | ||
293 | The right way to check to see whether items have already been emitted | |
294 | (e.g., has an offset to some other chain been emitted?) is as follows: | |
295 | ||
296 | * In a method (ideally an `:around'-method) on `compute-vtable', bind a | |
297 | special variable to an empty list or hash table. | |
298 | ||
299 | * In a method on this function, check the variable or hash table. | |
300 | ||
301 | This function is the real business end of `compute-vtable'.")) | |
302 | ||
303 | (export 'compute-vtable) | |
304 | (defgeneric compute-vtable (class chain) | |
305 | (:documentation | |
306 | "Compute the vtable layout for a chain of CLASS. | |
307 | ||
308 | The CHAIN is a list of classes, with the least specific first. | |
309 | ||
310 | There is a default method which invokes `compute-vtable-items' to do the | |
311 | difficult work.")) | |
312 | ||
313 | (export 'compute-vtables) | |
314 | (defgeneric compute-vtables (class) | |
315 | (:documentation | |
316 | "Compute the vtable layouts for CLASS. | |
317 | ||
318 | Returns a list of VTABLE objects in the order of CLASS's chains.")) | |
319 | ||
320 | ;;;----- That's all, folks -------------------------------------------------- |