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