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-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 ;;;--------------------------------------------------------------------------
154 (export '(vtmsgs vtmsgs-class vtmsgs-subclass
155 vtmsgs-chain-head vtmsgs-chain-tail vtmsgs-entries))
157 ((%class :initarg :class :type sod-class :reader vtmsgs-class)
158 (subclass :initarg :subclass :type sod-class :reader vtmsgs-subclass)
159 (chain-head :initarg :chain-head :type sod-class
160 :reader vtmsgs-chain-head)
161 (chain-tail :initarg :chain-tail :type sod-class
162 :reader vtmsgs-chain-tail)
163 (entries :initarg :entries :type list :reader vtmsgs-entries))
165 "The message dispatch table for a particular class.
167 In detail, this lists the `method-entry' objects for the messages defined
168 by a particular CLASS, where the effective methods are specialized for the
169 SUBCLASS; the method entries adjust the instance pointer argument
170 appropriately for a call via the vtable for the chain headed by
171 CHAIN-HEAD. The CHAIN-TAIL is the most specific superclass of SUBCLASS on
172 this chain. The ENTRIES are a list of `method-entry' objects."))
174 (export 'compute-vtmsgs)
175 (defgeneric compute-vtmsgs (class subclass chain-head chain-tail)
177 "Return a `vtmsgs' object containing method entries for CLASS.
179 The CHAIN-HEAD describes which chain the method entries should be
182 The default method simply calls `make-method-entry' for each of the
183 methods and wraps a `vtmsgs' object around them. This ought to be enough
184 for almost all purposes."))
188 (export '(class-pointer class-pointer-class class-pointer-chain-head
189 class-pointer-metaclass class-pointer-meta-chain-head))
190 (defclass class-pointer ()
191 ((%class :initarg :class :type sod-class :reader class-pointer-class)
192 (chain-head :initarg :chain-head :type sod-class
193 :reader class-pointer-chain-head)
194 (metaclass :initarg :metaclass :type sod-class
195 :reader class-pointer-metaclass)
196 (meta-chain-head :initarg :meta-chain-head :type sod-class
197 :reader class-pointer-meta-chain-head))
199 "Represents a pointer to a class object for the instance's class.
201 This is somewhat complicated because there are two degrees of freedom. An
202 instance of `class-pointer' is a pointer from a vtable to an `ichain' of
203 the the class's metaclass instance. In particular, a `class-pointer'
204 instance represents a pointer in a vtable constructed for CLASS and
205 attached to the chain headed by CHAIN-HEAD; it points to an instance of
206 METACLASS, and specifically to the `ichain' substructure corresponding to
207 the chain headed by META-CHAIN-HEAD, which will be a superclass of
210 I'm sorry if this is confusing."))
212 (export 'make-class-pointer)
213 (defgeneric make-class-pointer (class chain-head metaclass meta-chain-head)
215 "Return a class pointer to a metaclass chain."))
219 (export '(base-offset base-offset-class base-offset-chain-head))
220 (defclass base-offset ()
221 ((%class :initarg :class :type sod-class :reader base-offset-class)
222 (chain-head :initarg :chain-head :type sod-class
223 :reader base-offset-chain-head))
225 "The offset of this chain to the `ilayout' base.
227 We're generating a vtable for CLASS, attached to the chain headed by
228 CHAIN-HEAD. Fortunately (and unlike `class-pointer'), the chain head can
229 do double duty, since it also identifies the `ichain' substructure of the
230 class's `ilayout' whose offset we're interested in."))
232 (export 'make-base-offset)
233 (defgeneric make-base-offset (class chain-head)
235 "Return the base offset object for CHAIN-HEAD ichain."))
239 (export '(chain-offset chain-offset-class
240 chain-offset-chain-head chain-offset-target-head))
241 (defclass chain-offset ()
242 ((%class :initarg :class :type sod-class :reader chain-offset-class)
243 (chain-head :initarg :chain-head :type sod-class
244 :reader chain-offset-chain-head)
245 (target-head :initarg :target-head :type sod-class
246 :reader chain-offset-target-head))
248 "The offset to a different `ichain'.
250 We're generating a vtable for CLASS, attached to the chain headed by
251 CHAIN-HEAD. This instance represents an offset to the (different) chain
252 headed by TARGET-HEAD.
254 This is, strictly speaking, redundant. We could do as well by using the
255 base offset and finding the offset to the target class in the class
256 object's metadata; but that would either require a search or we'd have to
257 be able work out the target chain's index in the table."))
259 (defgeneric make-chain-offset (class chain-head target-head)
261 "Return the offset from CHAIN-HEAD to TARGET-HEAD."))
265 (export '(vtable vtable-class vtable-body
266 vtable-chain-head vtable-chain-tail))
268 ((%class :initarg :class :type sod-class :reader vtable-class)
269 (chain-head :initarg :chain-head :type sod-class
270 :reader vtable-chain-head)
271 (chain-tail :initarg :chain-tail :type sod-class
272 :reader vtable-chain-tail)
273 (body :initarg :body :type list :reader vtable-body))
275 "A vtable holds all of the per-chain static information for a class.
277 Each chain of CLASS has its own vtable; the `vtable' object remembers the
278 least specific (CHAIN-HEAD) and most specific (CHAIN-TAIL) superclasses of
279 CLASS on that chain. (This is useful because we can reuse vtable
280 structure types from superclasses for chains other than the primary chain
281 -- i.e., the one in which CLASS itself appears.)
283 The BODY is a list of vtable items, including `vtmsgs' structures,
284 `chain-offset's, `class-pointers', and a `base-offset'."))
286 (export 'compute-vtable-items)
287 (defgeneric compute-vtable-items (class super chain-head chain-tail emit)
289 "Emit vtable items for a superclass of CLASS.
291 This function is called for each superclass SUPER of CLASS reached on the
292 chain headed by CHAIN-HEAD. The function should call EMIT for each
293 vtable item it wants to write.
295 The right way to check to see whether items have already been emitted
296 (e.g., has an offset to some other chain been emitted?) is as follows:
298 * In a method (ideally an `:around'-method) on `compute-vtable', bind a
299 special variable to an empty list or hash table.
301 * In a method on this function, check the variable or hash table.
303 This function is the real business end of `compute-vtable'."))
305 (export 'compute-vtable)
306 (defgeneric compute-vtable (class chain)
308 "Compute the vtable layout for a chain of CLASS.
310 The CHAIN is a list of classes, with the least specific first.
312 There is a default method which invokes `compute-vtable-items' to do the
315 (export 'compute-vtables)
316 (defgeneric compute-vtables (class)
318 "Compute the vtable layouts for CLASS.
320 Returns a list of VTABLE objects in the order of CLASS's chains."))
322 ;;;----- That's all, folks --------------------------------------------------