| 1 | ;;; -*-lisp-*- |
| 2 | ;;; |
| 3 | ;;; Class layout protocol |
| 4 | ;;; |
| 5 | ;;; (c) 2009 Straylight/Edgeware |
| 6 | ;;; |
| 7 | |
| 8 | ;;;----- Licensing notice --------------------------------------------------- |
| 9 | ;;; |
| 10 | ;;; This file is part of the Sensble Object Design, an object system for C. |
| 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 () |
| 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)) |
| 38 | (:documentation |
| 39 | "Describes a slot and how it's meant to be initialized. |
| 40 | |
| 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 |
| 44 | necessarily the same. |
| 45 | |
| 46 | Effective slot objects are usually found in `islots' objects.")) |
| 47 | |
| 48 | (export 'find-slot-initializer) |
| 49 | (defgeneric find-slot-initializer (class slot) |
| 50 | (:documentation |
| 51 | "Return the most specific initializer for SLOT, starting from CLASS.")) |
| 52 | |
| 53 | (export 'compute-effective-slot) |
| 54 | (defgeneric compute-effective-slot (class slot) |
| 55 | (:documentation |
| 56 | "Construct an effective slot from the supplied direct slot. |
| 57 | |
| 58 | SLOT is a direct slot defined on CLASS or one of its superclasses. |
| 59 | (Metaclass initializers are handled using a different mechanism.)")) |
| 60 | |
| 61 | ;;;-------------------------------------------------------------------------- |
| 62 | ;;; Instance layout. |
| 63 | |
| 64 | ;;; islots |
| 65 | |
| 66 | (export '(islots islots-class islots-subclass islots-slots)) |
| 67 | (defclass islots () |
| 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)) |
| 71 | (:documentation |
| 72 | "Contains effective slot definitions for a class's direct slots. |
| 73 | |
| 74 | In detail: SLOTS is a list of effective slot objects corresponding to |
| 75 | CLASS's direct slots, and containing initializers computed relative to |
| 76 | SUBCLASS.")) |
| 77 | |
| 78 | (export 'compute-islots) |
| 79 | (defgeneric compute-islots (class subclass) |
| 80 | (:documentation |
| 81 | "Return `islots' for a particular CLASS and SUBCLASS. |
| 82 | |
| 83 | Initializers for the slots should be taken from the most specific |
| 84 | superclass of SUBCLASS.")) |
| 85 | |
| 86 | ;;; vtable-pointer |
| 87 | |
| 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)) |
| 96 | (:documentation |
| 97 | "Represents a pointer to a class's vtable. |
| 98 | |
| 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 |
| 103 | chains.)")) |
| 104 | |
| 105 | ;;; ichain |
| 106 | |
| 107 | (export '(ichain ichain-class ichain-head ichain-tail ichain-body)) |
| 108 | (defclass ichain () |
| 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)) |
| 113 | (:documentation |
| 114 | "Contains instance data for a particular chain of superclasses. |
| 115 | |
| 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. |
| 120 | |
| 121 | An `ilayout' object maintains a list of `ichain' objects, one for each of |
| 122 | a class's chains.")) |
| 123 | |
| 124 | (export 'compute-ichain) |
| 125 | (defgeneric compute-ichain (class chain) |
| 126 | (:documentation |
| 127 | "Return an ICHAIN for a particular CHAIN of CLASS's superclasses. |
| 128 | |
| 129 | The CHAIN is a list of classes, with the least specific first -- so the |
| 130 | chain head is the first element.")) |
| 131 | |
| 132 | ;;; ilayout |
| 133 | |
| 134 | (export '(ilayout ilayout-class ilayout-ichains)) |
| 135 | (defclass ilayout () |
| 136 | ((class :initarg :class :type sod-class :reader ilayout-class) |
| 137 | (ichains :initarg :ichains :type list :reader ilayout-ichains)) |
| 138 | (:documentation |
| 139 | "All of the instance layout for a class. |
| 140 | |
| 141 | Describes the layout of an instance of CLASS. The list ICHAINS contains |
| 142 | an `ichain' object for each chain of CLASS.")) |
| 143 | |
| 144 | (export 'compute-ilayout) |
| 145 | (defgeneric compute-ilayout (class) |
| 146 | (:documentation |
| 147 | "Compute and return an instance layout for CLASS.")) |
| 148 | |
| 149 | ;;;-------------------------------------------------------------------------- |
| 150 | ;;; Vtable layout. |
| 151 | |
| 152 | ;;; vtmsgs |
| 153 | |
| 154 | (defclass vtmsgs () |
| 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)) |
| 162 | (:documentation |
| 163 | "The message dispatch table for a particular class. |
| 164 | |
| 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.")) |
| 171 | |
| 172 | (export 'compte-vtmsgs) |
| 173 | (defgeneric compute-vtmsgs (class subclass chain-head chain-tail) |
| 174 | (:documentation |
| 175 | "Return a `vtmsgs' object containing method entries for CLASS. |
| 176 | |
| 177 | The CHAIN-HEAD describes which chain the method entries should be |
| 178 | constructed for. |
| 179 | |
| 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.")) |
| 183 | |
| 184 | ;;; class-pointer |
| 185 | |
| 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)) |
| 196 | (:documentation |
| 197 | "Represents a pointer to a class object for the instance's class. |
| 198 | |
| 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 |
| 206 | METACLASS. |
| 207 | |
| 208 | I'm sorry if this is confusing.")) |
| 209 | |
| 210 | (export 'make-class-pointer) |
| 211 | (defgeneric make-class-pointer (class chain-head metaclass meta-chain-head) |
| 212 | (:documentation |
| 213 | "Return a class pointer to a metaclass chain.")) |
| 214 | |
| 215 | ;;; base-offset |
| 216 | |
| 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)) |
| 222 | (:documentation |
| 223 | "The offset of this chain to the `ilayout' base. |
| 224 | |
| 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.")) |
| 229 | |
| 230 | (export 'make-base-offset) |
| 231 | (defgeneric make-base-offset (class chain-head) |
| 232 | (:documentation |
| 233 | "Return the base offset object for CHAIN-HEAD ichain.")) |
| 234 | |
| 235 | ;;; chain-offset |
| 236 | |
| 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)) |
| 245 | (:documentation |
| 246 | "The offset to a different `ichain'. |
| 247 | |
| 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. |
| 251 | |
| 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.")) |
| 256 | |
| 257 | (defgeneric make-chain-offset (class chain-head target-head) |
| 258 | (:documentation |
| 259 | "Return the offset from CHAIN-HEAD to TARGET-HEAD.")) |
| 260 | |
| 261 | ;;; vtable |
| 262 | |
| 263 | (export '(vtable vtable-class vtable-body |
| 264 | vtable-chain-head vtable-chain-tail)) |
| 265 | (defclass vtable () |
| 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)) |
| 272 | (:documentation |
| 273 | "A vtable holds all of the per-chain static information for a class. |
| 274 | |
| 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.) |
| 280 | |
| 281 | The BODY is a list of vtable items, including `vtmsgs' structures, |
| 282 | `chain-offset's, `class-pointers', and a `base-offset'.")) |
| 283 | |
| 284 | (export 'compute-vtable-items) |
| 285 | (defgeneric compute-vtable-items (class super chain-head chain-tail emit) |
| 286 | (:documentation |
| 287 | "Emit vtable items for a superclass of CLASS. |
| 288 | |
| 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. |
| 292 | |
| 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: |
| 295 | |
| 296 | * In a method (ideally an `:around'-method) on `compute-vtable', bind a |
| 297 | special variable to an empty list or hash table. |
| 298 | |
| 299 | * In a method on this function, check the variable or hash table. |
| 300 | |
| 301 | This function is the real business end of `compute-vtable'.")) |
| 302 | |
| 303 | (export 'compute-vtable) |
| 304 | (defgeneric compute-vtable (class chain) |
| 305 | (:documentation |
| 306 | "Compute the vtable layout for a chain of CLASS. |
| 307 | |
| 308 | The CHAIN is a list of classes, with the least specific first. |
| 309 | |
| 310 | There is a default method which invokes `compute-vtable-items' to do the |
| 311 | difficult work.")) |
| 312 | |
| 313 | (export 'compute-vtables) |
| 314 | (defgeneric compute-vtables (class) |
| 315 | (:documentation |
| 316 | "Compute the vtable layouts for CLASS. |
| 317 | |
| 318 | Returns a list of VTABLE objects in the order of CLASS's chains.")) |
| 319 | |
| 320 | ;;;----- That's all, folks -------------------------------------------------- |