3 ;;; Class layout protocol
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible Object Design, an object system for C.
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.
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.
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.
28 ;;;--------------------------------------------------------------------------
29 ;;; Effective slot objects.
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-class :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 (initargs :initarg :initargs :initform nil
39 :type list :reader effective-slot-initargs))
41 "Describes a slot and how it's meant to be initialized.
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
48 Effective slot objects are usually found in `islots' objects."))
50 (export 'find-slot-initializer)
51 (defgeneric find-slot-initializer (class slot)
53 "Return the most specific initializer for SLOT, starting from CLASS."))
55 (export 'find-slot-initargs)
56 (defgeneric find-slot-initargs (class slot)
58 "Return as a list all of the initargs defined on CLASS to initialize SLOT.
60 The list is returned with initargs defined on more specific classes
63 (export 'compute-effective-slot)
64 (defgeneric compute-effective-slot (class slot)
66 "Construct an effective slot from the supplied direct slot.
68 SLOT is a direct slot defined on CLASS or one of its superclasses.
69 (Metaclass initializers are handled using a different mechanism.)"))
71 (export 'find-class-initializer)
72 (defgeneric find-class-initializer (slot class)
74 "Return an initializer value (any printable value) for a class slot SLOT.
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.
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."))
84 ;;;--------------------------------------------------------------------------
89 (export '(islots islots-class islots-subclass islots-slots))
91 ((%class :initarg :class :type sod-class :reader islots-class)
92 (subclass :initarg :subclass :type sod-class :reader islots-subclass)
93 (slots :initarg :slots :type list :reader islots-slots))
95 "Contains effective slot definitions for a class's direct slots.
97 In detail: SLOTS is a list of effective slot objects corresponding to
98 CLASS's direct slots, and containing initializers computed relative to
101 (export 'compute-islots)
102 (defgeneric compute-islots (class subclass)
104 "Return `islots' for a particular CLASS and SUBCLASS.
106 Initializers for the slots should be taken from the most specific
107 superclass of SUBCLASS."))
111 (export '(vtable-pointer vtable-pointer-class
112 vtable-pointer-chain-head vtable-pointer-chain-tail))
113 (defclass vtable-pointer ()
114 ((%class :initarg :class :type sod-class :reader vtable-pointer-class)
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))
120 "Represents a pointer to a class's vtable.
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
130 (export '(ichain ichain-class ichain-head ichain-tail ichain-body))
132 ((%class :initarg :class :type sod-class :reader ichain-class)
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))
137 "Contains instance data for a particular chain of superclasses.
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.
144 An `ilayout' object maintains a list of `ichain' objects, one for each of
147 (export 'compute-ichain)
148 (defgeneric compute-ichain (class chain)
150 "Return an ICHAIN for a particular CHAIN of CLASS's superclasses.
152 The CHAIN is a list of classes, with the least specific first -- so the
153 chain head is the first element."))
157 (export '(ilayout ilayout-class ilayout-ichains))
159 ((%class :initarg :class :type sod-class :reader ilayout-class)
160 (ichains :initarg :ichains :type list :reader ilayout-ichains))
162 "All of the instance layout for a class.
164 Describes the layout of an instance of CLASS. The list ICHAINS contains
165 an `ichain' object for each chain of CLASS."))
167 (export 'compute-ilayout)
168 (defgeneric compute-ilayout (class)
170 "Compute and return an instance layout for CLASS."))
172 ;;;--------------------------------------------------------------------------
177 (export '(vtmsgs vtmsgs-class vtmsgs-subclass
178 vtmsgs-chain-head vtmsgs-chain-tail vtmsgs-entries))
180 ((%class :initarg :class :type sod-class :reader vtmsgs-class)
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))
188 "The message dispatch table for a particular class.
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."))
197 (export 'compute-vtmsgs)
198 (defgeneric compute-vtmsgs (class subclass chain-head chain-tail)
200 "Return a `vtmsgs' object containing method entries for CLASS.
202 The CHAIN-HEAD describes which chain the method entries should be
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."))
211 (export '(class-pointer class-pointer-class class-pointer-chain-head
212 class-pointer-metaclass class-pointer-meta-chain-head))
213 (defclass class-pointer ()
214 ((%class :initarg :class :type sod-class :reader class-pointer-class)
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))
222 "Represents a pointer to a class object for the instance's class.
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
226 the the class's metaclass instance. In particular, a `class-pointer'
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
233 I'm sorry if this is confusing."))
235 (export 'make-class-pointer)
236 (defgeneric make-class-pointer (class chain-head metaclass meta-chain-head)
238 "Return a class pointer to a metaclass chain."))
242 (export '(base-offset base-offset-class base-offset-chain-head))
243 (defclass base-offset ()
244 ((%class :initarg :class :type sod-class :reader base-offset-class)
245 (chain-head :initarg :chain-head :type sod-class
246 :reader base-offset-chain-head))
248 "The offset of this chain to the `ilayout' base.
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."))
255 (export 'make-base-offset)
256 (defgeneric make-base-offset (class chain-head)
258 "Return the base offset object for CHAIN-HEAD ichain."))
262 (export '(chain-offset chain-offset-class
263 chain-offset-chain-head chain-offset-target-head))
264 (defclass chain-offset ()
265 ((%class :initarg :class :type sod-class :reader chain-offset-class)
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))
271 "The offset to a different `ichain'.
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.
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."))
282 (export 'make-chain-offset)
283 (defgeneric make-chain-offset (class chain-head target-head)
285 "Return the offset from CHAIN-HEAD to TARGET-HEAD."))
289 (export '(vtable vtable-class vtable-body
290 vtable-chain-head vtable-chain-tail))
292 ((%class :initarg :class :type sod-class :reader vtable-class)
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))
299 "A vtable holds all of the per-chain static information for a class.
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.)
307 The BODY is a list of vtable items, including `vtmsgs' structures,
308 `chain-offset's, `class-pointers', and a `base-offset'."))
310 (export 'compute-vtable-items)
311 (defgeneric compute-vtable-items (class super chain-head chain-tail emit)
313 "Emit vtable items for a superclass of CLASS.
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.
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:
322 * In a method (ideally an `:around'-method) on `compute-vtable', bind a
323 special variable to an empty list or hash table.
325 * In a method on this function, check the variable or hash table.
327 This function is the real business end of `compute-vtable'."))
329 (export 'compute-vtable)
330 (defgeneric compute-vtable (class chain)
332 "Compute the vtable layout for a chain of CLASS.
334 The CHAIN is a list of classes, with the least specific first.
336 There is a default method which invokes `compute-vtable-items' to do the
339 (export 'compute-vtables)
340 (defgeneric compute-vtables (class)
342 "Compute the vtable layouts for CLASS.
344 Returns a list of VTABLE objects in the order of CLASS's chains."))
346 ;;;----- That's all, folks --------------------------------------------------