3 ;;; Class layout protocol
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble 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-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))
39 "Describes a slot and how it's meant to be initialized.
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
46 Effective slot objects are usually found in `islots' objects."))
48 (export 'find-slot-initializer)
49 (defgeneric find-slot-initializer (class slot)
51 "Return the most specific initializer for SLOT, starting from CLASS."))
53 (export 'compute-effective-slot)
54 (defgeneric compute-effective-slot (class slot)
56 "Construct an effective slot from the supplied direct slot.
58 SLOT is a direct slot defined on CLASS or one of its superclasses.
59 (Metaclass initializers are handled using a different mechanism.)"))
61 ;;;--------------------------------------------------------------------------
66 (export '(islots islots-class islots-subclass islots-slots))
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))
72 "Contains effective slot definitions for a class's direct slots.
74 In detail: SLOTS is a list of effective slot objects corresponding to
75 CLASS's direct slots, and containing initializers computed relative to
78 (export 'compute-islots)
79 (defgeneric compute-islots (class subclass)
81 "Return `islots' for a particular CLASS and SUBCLASS.
83 Initializers for the slots should be taken from the most specific
84 superclass of SUBCLASS."))
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))
97 "Represents a pointer to a class's vtable.
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
107 (export '(ichain ichain-class ichain-head ichain-tail ichain-body))
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))
114 "Contains instance data for a particular chain of superclasses.
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.
121 An `ilayout' object maintains a list of `ichain' objects, one for each of
124 (export 'compute-ichain)
125 (defgeneric compute-ichain (class chain)
127 "Return an ICHAIN for a particular CHAIN of CLASS's superclasses.
129 The CHAIN is a list of classes, with the least specific first -- so the
130 chain head is the first element."))
134 (export '(ilayout ilayout-class ilayout-ichains))
136 ((class :initarg :class :type sod-class :reader ilayout-class)
137 (ichains :initarg :ichains :type list :reader ilayout-ichains))
139 "All of the instance layout for a class.
141 Describes the layout of an instance of CLASS. The list ICHAINS contains
142 an `ichain' object for each chain of CLASS."))
144 (export 'compute-ilayout)
145 (defgeneric compute-ilayout (class)
147 "Compute and return an instance layout for CLASS."))
149 ;;;--------------------------------------------------------------------------
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))
163 "The message dispatch table for a particular class.
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."))
172 (export 'compte-vtmsgs)
173 (defgeneric compute-vtmsgs (class subclass chain-head chain-tail)
175 "Return a `vtmsgs' object containing method entries for CLASS.
177 The CHAIN-HEAD describes which chain the method entries should be
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."))
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))
197 "Represents a pointer to a class object for the instance's class.
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
201 the the class's metaclass instance. In particular, a `class-pointer'
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
208 I'm sorry if this is confusing."))
210 (export 'make-class-pointer)
211 (defgeneric make-class-pointer (class chain-head metaclass meta-chain-head)
213 "Return a class pointer to a metaclass chain."))
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))
223 "The offset of this chain to the `ilayout' base.
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."))
230 (export 'make-base-offset)
231 (defgeneric make-base-offset (class chain-head)
233 "Return the base offset object for CHAIN-HEAD ichain."))
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))
246 "The offset to a different `ichain'.
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.
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."))
257 (defgeneric make-chain-offset (class chain-head target-head)
259 "Return the offset from CHAIN-HEAD to TARGET-HEAD."))
263 (export '(vtable vtable-class vtable-body
264 vtable-chain-head vtable-chain-tail))
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))
273 "A vtable holds all of the per-chain static information for a class.
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.)
281 The BODY is a list of vtable items, including `vtmsgs' structures,
282 `chain-offset's, `class-pointers', and a `base-offset'."))
284 (export 'compute-vtable-items)
285 (defgeneric compute-vtable-items (class super chain-head chain-tail emit)
287 "Emit vtable items for a superclass of CLASS.
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.
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:
296 * In a method (ideally an `:around'-method) on `compute-vtable', bind a
297 special variable to an empty list or hash table.
299 * In a method on this function, check the variable or hash table.
301 This function is the real business end of `compute-vtable'."))
303 (export 'compute-vtable)
304 (defgeneric compute-vtable (class chain)
306 "Compute the vtable layout for a chain of CLASS.
308 The CHAIN is a list of classes, with the least specific first.
310 There is a default method which invokes `compute-vtable-items' to do the
313 (export 'compute-vtables)
314 (defgeneric compute-vtables (class)
316 "Compute the vtable layouts for CLASS.
318 Returns a list of VTABLE objects in the order of CLASS's chains."))
320 ;;;----- That's all, folks --------------------------------------------------