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 ;;;--------------------------------------------------------------------------
76 (export '(islots islots-class islots-subclass islots-slots))
78 ((%class :initarg :class :type sod-class :reader islots-class)
79 (subclass :initarg :subclass :type sod-class :reader islots-subclass)
80 (slots :initarg :slots :type list :reader islots-slots))
82 "Contains effective slot definitions for a class's direct slots.
84 In detail: SLOTS is a list of effective slot objects corresponding to
85 CLASS's direct slots, and containing initializers computed relative to
88 (export 'compute-islots)
89 (defgeneric compute-islots (class subclass)
91 "Return `islots' for a particular CLASS and SUBCLASS.
93 Initializers for the slots should be taken from the most specific
94 superclass of SUBCLASS."))
98 (export '(vtable-pointer vtable-pointer-class
99 vtable-pointer-chain-head vtable-pointer-chain-tail))
100 (defclass vtable-pointer ()
101 ((%class :initarg :class :type sod-class :reader vtable-pointer-class)
102 (chain-head :initarg :chain-head :type sod-class
103 :reader vtable-pointer-chain-head)
104 (chain-tail :initarg :chain-tail :type sod-class
105 :reader vtable-pointer-chain-tail))
107 "Represents a pointer to a class's vtable.
109 There's one of these for each of CLASS's chains. This particular one
110 belongs to the chain headed by CHAIN-HEAD; the most specific superclass of
111 CLASS on that chain is CHAIN-TAIL. (The tail is useful because we can --
112 and do -- use structure types defined by the tail class for non-primary
117 (export '(ichain ichain-class ichain-head ichain-tail ichain-body))
119 ((%class :initarg :class :type sod-class :reader ichain-class)
120 (chain-head :initarg :chain-head :type sod-class :reader ichain-head)
121 (chain-tail :initarg :chain-tail :type sod-class :reader ichain-tail)
122 (body :initarg :body :type list :reader ichain-body))
124 "Contains instance data for a particular chain of superclasses.
126 In detail: describes instance data for one of CLASS's chains, specifically
127 the chain headed by CHAIN-HEAD. The CHAIN-TAIL is the most specific
128 superclass of CLASS on the chain in question. The BODY is a list of
129 layout objects to be included.
131 An `ilayout' object maintains a list of `ichain' objects, one for each of
134 (export 'compute-ichain)
135 (defgeneric compute-ichain (class chain)
137 "Return an ICHAIN for a particular CHAIN of CLASS's superclasses.
139 The CHAIN is a list of classes, with the least specific first -- so the
140 chain head is the first element."))
144 (export '(ilayout ilayout-class ilayout-ichains))
146 ((%class :initarg :class :type sod-class :reader ilayout-class)
147 (ichains :initarg :ichains :type list :reader ilayout-ichains))
149 "All of the instance layout for a class.
151 Describes the layout of an instance of CLASS. The list ICHAINS contains
152 an `ichain' object for each chain of CLASS."))
154 (export 'compute-ilayout)
155 (defgeneric compute-ilayout (class)
157 "Compute and return an instance layout for CLASS."))
159 ;;;--------------------------------------------------------------------------
164 (export '(vtmsgs vtmsgs-class vtmsgs-subclass
165 vtmsgs-chain-head vtmsgs-chain-tail vtmsgs-entries))
167 ((%class :initarg :class :type sod-class :reader vtmsgs-class)
168 (subclass :initarg :subclass :type sod-class :reader vtmsgs-subclass)
169 (chain-head :initarg :chain-head :type sod-class
170 :reader vtmsgs-chain-head)
171 (chain-tail :initarg :chain-tail :type sod-class
172 :reader vtmsgs-chain-tail)
173 (entries :initarg :entries :type list :reader vtmsgs-entries))
175 "The message dispatch table for a particular class.
177 In detail, this lists the `method-entry' objects for the messages defined
178 by a particular CLASS, where the effective methods are specialized for the
179 SUBCLASS; the method entries adjust the instance pointer argument
180 appropriately for a call via the vtable for the chain headed by
181 CHAIN-HEAD. The CHAIN-TAIL is the most specific superclass of SUBCLASS on
182 this chain. The ENTRIES are a list of `method-entry' objects."))
184 (export 'compute-vtmsgs)
185 (defgeneric compute-vtmsgs (class subclass chain-head chain-tail)
187 "Return a `vtmsgs' object containing method entries for CLASS.
189 The CHAIN-HEAD describes which chain the method entries should be
192 The default method simply calls `make-method-entry' for each of the
193 methods and wraps a `vtmsgs' object around them. This ought to be enough
194 for almost all purposes."))
198 (export '(class-pointer class-pointer-class class-pointer-chain-head
199 class-pointer-metaclass class-pointer-meta-chain-head))
200 (defclass class-pointer ()
201 ((%class :initarg :class :type sod-class :reader class-pointer-class)
202 (chain-head :initarg :chain-head :type sod-class
203 :reader class-pointer-chain-head)
204 (metaclass :initarg :metaclass :type sod-class
205 :reader class-pointer-metaclass)
206 (meta-chain-head :initarg :meta-chain-head :type sod-class
207 :reader class-pointer-meta-chain-head))
209 "Represents a pointer to a class object for the instance's class.
211 This is somewhat complicated because there are two degrees of freedom. An
212 instance of `class-pointer' is a pointer from a vtable to an `ichain' of
213 the the class's metaclass instance. In particular, a `class-pointer'
214 instance represents a pointer in a vtable constructed for CLASS and
215 attached to the chain headed by CHAIN-HEAD; it points to an instance of
216 METACLASS, and specifically to the `ichain' substructure corresponding to
217 the chain headed by META-CHAIN-HEAD, which will be a superclass of
220 I'm sorry if this is confusing."))
222 (export 'make-class-pointer)
223 (defgeneric make-class-pointer (class chain-head metaclass meta-chain-head)
225 "Return a class pointer to a metaclass chain."))
229 (export '(base-offset base-offset-class base-offset-chain-head))
230 (defclass base-offset ()
231 ((%class :initarg :class :type sod-class :reader base-offset-class)
232 (chain-head :initarg :chain-head :type sod-class
233 :reader base-offset-chain-head))
235 "The offset of this chain to the `ilayout' base.
237 We're generating a vtable for CLASS, attached to the chain headed by
238 CHAIN-HEAD. Fortunately (and unlike `class-pointer'), the chain head can
239 do double duty, since it also identifies the `ichain' substructure of the
240 class's `ilayout' whose offset we're interested in."))
242 (export 'make-base-offset)
243 (defgeneric make-base-offset (class chain-head)
245 "Return the base offset object for CHAIN-HEAD ichain."))
249 (export '(chain-offset chain-offset-class
250 chain-offset-chain-head chain-offset-target-head))
251 (defclass chain-offset ()
252 ((%class :initarg :class :type sod-class :reader chain-offset-class)
253 (chain-head :initarg :chain-head :type sod-class
254 :reader chain-offset-chain-head)
255 (target-head :initarg :target-head :type sod-class
256 :reader chain-offset-target-head))
258 "The offset to a different `ichain'.
260 We're generating a vtable for CLASS, attached to the chain headed by
261 CHAIN-HEAD. This instance represents an offset to the (different) chain
262 headed by TARGET-HEAD.
264 This is, strictly speaking, redundant. We could do as well by using the
265 base offset and finding the offset to the target class in the class
266 object's metadata; but that would either require a search or we'd have to
267 be able work out the target chain's index in the table."))
269 (defgeneric make-chain-offset (class chain-head target-head)
271 "Return the offset from CHAIN-HEAD to TARGET-HEAD."))
275 (export '(vtable vtable-class vtable-body
276 vtable-chain-head vtable-chain-tail))
278 ((%class :initarg :class :type sod-class :reader vtable-class)
279 (chain-head :initarg :chain-head :type sod-class
280 :reader vtable-chain-head)
281 (chain-tail :initarg :chain-tail :type sod-class
282 :reader vtable-chain-tail)
283 (body :initarg :body :type list :reader vtable-body))
285 "A vtable holds all of the per-chain static information for a class.
287 Each chain of CLASS has its own vtable; the `vtable' object remembers the
288 least specific (CHAIN-HEAD) and most specific (CHAIN-TAIL) superclasses of
289 CLASS on that chain. (This is useful because we can reuse vtable
290 structure types from superclasses for chains other than the primary chain
291 -- i.e., the one in which CLASS itself appears.)
293 The BODY is a list of vtable items, including `vtmsgs' structures,
294 `chain-offset's, `class-pointers', and a `base-offset'."))
296 (export 'compute-vtable-items)
297 (defgeneric compute-vtable-items (class super chain-head chain-tail emit)
299 "Emit vtable items for a superclass of CLASS.
301 This function is called for each superclass SUPER of CLASS reached on the
302 chain headed by CHAIN-HEAD. The function should call EMIT for each
303 vtable item it wants to write.
305 The right way to check to see whether items have already been emitted
306 (e.g., has an offset to some other chain been emitted?) is as follows:
308 * In a method (ideally an `:around'-method) on `compute-vtable', bind a
309 special variable to an empty list or hash table.
311 * In a method on this function, check the variable or hash table.
313 This function is the real business end of `compute-vtable'."))
315 (export 'compute-vtable)
316 (defgeneric compute-vtable (class chain)
318 "Compute the vtable layout for a chain of CLASS.
320 The CHAIN is a list of classes, with the least specific first.
322 There is a default method which invokes `compute-vtable-items' to do the
325 (export 'compute-vtables)
326 (defgeneric compute-vtables (class)
328 "Compute the vtable layouts for CLASS.
330 Returns a list of VTABLE objects in the order of CLASS's chains."))
332 ;;;----- That's all, folks --------------------------------------------------