Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Method combination 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 methods and entries. | |
30 | ||
31 | (export '(effective-method effective-method-message effective-method-class)) | |
32 | (defclass effective-method () | |
33 | ((message :initarg :message :type sod-message | |
34 | :reader effective-method-message) | |
35 | (class :initarg :class :type sod-class :reader effective-method-class)) | |
36 | (:documentation | |
37 | "The behaviour invoked by sending a message to an instance of a class. | |
38 | ||
39 | This class describes the behaviour when an instance of CLASS is sent | |
40 | MESSAGE. | |
41 | ||
42 | This is not a useful class by itself. Message classes are expected to | |
43 | define their own effective-method classes. | |
44 | ||
bf090e02 | 45 | An effective method class must accept a `:direct-methods' initarg, which |
dea4d055 MW |
46 | will be a list of applicable methods sorted in most-to-least specific |
47 | order. (Either that or you have to add an overriding method to | |
48 | `compute-sod-effective-method'.")) | |
49 | ||
50 | (export 'message-effective-method-class) | |
51 | (defgeneric message-effective-method-class (message) | |
52 | (:documentation | |
53 | "Return the effective method class for the given MESSAGE. | |
54 | ||
55 | This function is invoked by `compute-sod-effective-method'.")) | |
56 | ||
57 | (export 'primary-method-class) | |
58 | (defgeneric primary-method-class (message) | |
59 | (:documentation | |
60 | "Return the name of the primary direct method class for MESSAGE. | |
61 | ||
62 | This protocol is used by `simple-message' subclasses.")) | |
63 | ||
64 | (export 'compute-sod-effective-method) | |
65 | (defgeneric compute-sod-effective-method (message class) | |
66 | (:documentation | |
67 | "Return the effective method when a CLASS instance receives MESSAGE. | |
68 | ||
69 | The default method constructs an instance of the message's chosen | |
70 | `message-effective-method-class', passing the MESSAGE, the CLASS and the | |
71 | list of applicable methods as initargs to `make-instance'.")) | |
72 | ||
73 | (export 'compute-effective-methods) | |
74 | (defgeneric compute-effective-methods (class) | |
75 | (:documentation | |
76 | "Return a list of all of the effective methods needed for CLASS. | |
77 | ||
78 | The list needn't be in any particular order.")) | |
79 | ||
80 | (export '(method-entry method-entry-effective-method | |
81 | method-entry-chain-head method-entry-chain-tail)) | |
82 | (defclass method-entry () | |
83 | ((method :initarg :method :type effective-method | |
84 | :reader method-entry-effective-method) | |
85 | (chain-head :initarg :chain-head :type sod-class | |
86 | :reader method-entry-chain-head) | |
87 | (chain-tail :initarg :chain-tail :type sod-class | |
88 | :reader method-entry-chain-tail)) | |
89 | (:documentation | |
90 | "An entry point into an effective method. | |
91 | ||
92 | Specifically, this is the entry point to the effective method METHOD | |
93 | invoked via the vtable for the chain headed by CHAIN-HEAD. The CHAIN-TAIL | |
94 | is the most specific class on this chain; this is useful because we can | |
95 | reuse the types of method entries from superclasses on non-primary chains. | |
96 | ||
97 | Each effective method may have several different method entries, because | |
98 | an effective method can be called via vtables attached to different | |
99 | chains, and such calls will pass instance pointers which point to | |
100 | different `ichain' structures within the overall instance layout; it's the | |
101 | job of the method entry to adjust the instance pointers correctly for the | |
102 | rest of the effective method. | |
103 | ||
104 | The boundaries between a method entry and the effective method | |
105 | is (intentionally) somewhat fuzzy. In extreme cases, the effective method | |
106 | may not exist at all as a distinct entity in the output because its | |
107 | content is duplicated in all of the method entry functions. This is left | |
108 | up to the effective method protocol.")) | |
109 | ||
110 | (export 'make-method-entry) | |
111 | (defgeneric make-method-entry (effective-method chain-head chain-tail) | |
112 | (:documentation | |
113 | "Return a METHOD-ENTRY for an EFFECTIVE-METHOD called via CHAIN-HEAD. | |
114 | ||
115 | There is no default method for this function. (Maybe when the | |
116 | effective-method/method-entry output protocol has settled down I'll know | |
117 | what a sensible default action would be.)")) | |
118 | ||
119 | ;;;-------------------------------------------------------------------------- | |
120 | ;;; Protocol for messages and direct-methods. | |
121 | ||
122 | (export 'sod-message-argument-tail) | |
123 | (defgeneric sod-message-argument-tail (message) | |
124 | (:documentation | |
125 | "Return the argument tail for the message, with invented argument names. | |
126 | ||
127 | No `me' argument is prepended; any `:ellipsis' is left as it is.")) | |
128 | ||
129 | (export 'sod-message-no-varargs-tail) | |
130 | (defgeneric sod-message-no-varargs-tail (message) | |
131 | (:documentation | |
132 | "Return the argument tail for the message with `:ellipsis' substituted. | |
133 | ||
3109662a MW |
134 | As with `sod-message-argument-tail', no `me' argument is prepended. |
135 | However, an `:ellipsis' is replaced by an argument of type `va_list', | |
136 | named `sod__ap'.")) | |
dea4d055 MW |
137 | |
138 | (export 'sod-method-function-type) | |
139 | (defgeneric sod-method-function-type (method) | |
140 | (:documentation | |
141 | "Return the C function type for the direct method. | |
142 | ||
143 | This is called during initialization of a direct method object, and the | |
144 | result is cached. | |
145 | ||
146 | A default method is provided (by `basic-direct-method') which simply | |
147 | prepends an appropriate `me' argument to the user-provided argument list. | |
148 | Fancy method classes may need to override this behaviour.")) | |
149 | ||
150 | (export 'sod-method-next-method-type) | |
151 | (defgeneric sod-method-next-method-type (method) | |
152 | (:documentation | |
153 | "Return the C function type for the next-method trampoline. | |
154 | ||
155 | This is called during initialization of a direct method object, and the | |
156 | result is cached. It should return a function type, not a pointer type. | |
157 | ||
158 | A default method is provided (by `delegating-direct-method') which should | |
159 | do the right job. Very fancy subclasses might need to do something | |
160 | different.")) | |
161 | ||
162 | (export 'sod-method-function-name) | |
163 | (defgeneric sod-method-function-name (method) | |
164 | (:documentation | |
165 | "Return the C function name for the direct method.")) | |
166 | ||
167 | (export 'varargs-message-p) | |
168 | (defun varargs-message-p (message) | |
169 | "Answer whether the MESSAGE accepts a variable-length argument list. | |
170 | ||
171 | We need to jump through some extra hoops in order to cope with varargs | |
172 | messages, so this is useful to know." | |
173 | (member :ellipsis (sod-message-argument-tail message))) | |
174 | ||
175 | ;;;-------------------------------------------------------------------------- | |
176 | ;;; Protocol for effective methods and method entries. | |
177 | ||
178 | (export 'method-entry-function-type) | |
179 | (defgeneric method-entry-function-type (entry) | |
180 | (:documentation | |
181 | "Return the C function type for a method entry.")) | |
182 | ||
183 | (export 'effective-method-basic-argument-names) | |
184 | (defgeneric effective-method-basic-argument-names (method) | |
185 | (:documentation | |
186 | "Return a list of argument names to be passed to direct methods. | |
187 | ||
188 | The argument names are constructed from the message's arguments returned | |
189 | by `sod-message-no-varargs-tail'. The basic arguments are the ones | |
190 | immediately derived from the programmer's explicitly stated arguments; the | |
191 | `me' argument is not included, and neither are more exotic arguments added | |
192 | as part of the method delegation protocol.")) | |
193 | ||
194 | ;;;-------------------------------------------------------------------------- | |
195 | ;;; Code generation. | |
196 | ||
197 | ;;; Enhanced code-generator class. | |
198 | ||
199 | (export '(method-codegen codegen-message codegen-class | |
200 | codegen-method codegen-target)) | |
201 | (defclass method-codegen (codegen) | |
202 | ((message :initarg :message :type sod-message :reader codegen-message) | |
203 | (class :initarg :class :type sod-class :reader codegen-class) | |
204 | (method :initarg :method :type effective-method :reader codegen-method) | |
205 | (target :initarg :target :reader codegen-target)) | |
206 | (:documentation | |
207 | "Augments CODEGEN with additional state regarding an effective method. | |
208 | ||
209 | We store the effective method, and also its target class and owning | |
210 | message, so that these values are readily available to the code-generating | |
211 | functions.")) | |
212 | ||
213 | ;;; Protocol. | |
214 | ||
215 | (export 'compute-effective-method-body) | |
216 | (defgeneric compute-effective-method-body (method codegen target) | |
217 | (:documentation | |
218 | "Generates the body of an effective method. | |
219 | ||
220 | Writes the function body to the code generator. It can (obviously) | |
221 | generate auxiliary functions if it needs to. | |
222 | ||
223 | The arguments are as specified by the `sod-message-no-varargs-tail', with | |
224 | an additional argument `sod__obj' of type pointer-to-ilayout. The code | |
225 | should deliver the result (if any) to the TARGET.")) | |
226 | ||
227 | (export 'simple-method-body) | |
228 | (defgeneric simple-method-body (method codegen target) | |
229 | (:documentation | |
230 | "Generate the body of a simple effective method. | |
231 | ||
232 | The function is invoked on an effective METHOD, with a CODEGEN to which it | |
233 | should emit code delivering the method's value to TARGET.")) | |
234 | ||
235 | ;;; Additional instructions. | |
236 | ||
237 | (export 'convert-to-ilayout) | |
238 | (definst convert-to-ilayout (stream) (class chain-head expr) | |
239 | (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)" | |
240 | class (sod-class-nickname chain-head) expr)) | |
241 | ||
242 | ;;; Utilities. | |
243 | ||
244 | (export 'invoke-method) | |
245 | (defun invoke-method (codegen target arguments-tail direct-method) | |
246 | "Emit code to invoke DIRECT-METHOD, passing it ARGUMENTS-TAIL. | |
247 | ||
248 | The code is generated in the context of CODEGEN, which can be any instance | |
249 | of the `codegen' class -- it needn't be an instance of `method-codegen'. | |
250 | The DIRECT-METHOD is called with the given ARGUMENTS-TAIL (a list of | |
251 | argument expressions), preceded by a `me' argument of type pointer-to- | |
252 | CLASS where CLASS is the class on which the method was defined. | |
253 | ||
254 | If the message accepts a variable-length argument list then a copy of the | |
255 | prevailing master argument pointer is provided in place of the | |
256 | `:ellipsis'." | |
257 | ||
258 | (let* ((message (sod-method-message direct-method)) | |
259 | (class (sod-method-class direct-method)) | |
260 | (function (sod-method-function-name direct-method)) | |
9ec578d9 | 261 | (arguments (cons (format nil "&sod__obj->~A.~A" |
dea4d055 MW |
262 | (sod-class-nickname |
263 | (sod-class-chain-head class)) | |
264 | (sod-class-nickname class)) | |
265 | arguments-tail))) | |
266 | (if (varargs-message-p message) | |
267 | (convert-stmts codegen target | |
268 | (c-type-subtype (sod-method-type direct-method)) | |
269 | (lambda (var) | |
270 | (ensure-var codegen *sod-ap* (c-type va-list)) | |
271 | (emit-inst codegen | |
272 | (make-va-copy-inst *sod-ap* | |
273 | *sod-master-ap*)) | |
274 | (deliver-expr codegen var | |
275 | (make-call-inst function arguments)) | |
276 | (emit-inst codegen | |
277 | (make-va-end-inst *sod-ap*)))) | |
278 | (deliver-expr codegen target (make-call-inst function arguments))))) | |
279 | ||
280 | (export 'ensure-ilayout-var) | |
281 | (defun ensure-ilayout-var (codegen super) | |
282 | "Define a variable `sod__obj' pointing to the class's ilayout structure. | |
283 | ||
284 | CODEGEN is a `method-codegen'. The class in question is CODEGEN's class, | |
285 | i.e., the target class for the effective method. SUPER is one of the | |
286 | class's superclasses; it is assumed that `me' is a pointer to a SUPER | |
287 | (i.e., to SUPER's ichain within the ilayout)." | |
288 | ||
289 | (let* ((class (codegen-class codegen)) | |
290 | (super-head (sod-class-chain-head super))) | |
291 | (ensure-var codegen "sod__obj" | |
292 | (c-type (* (struct (ilayout-struct-tag class)))) | |
293 | (make-convert-to-ilayout-inst class super-head "me")))) | |
294 | ||
295 | (export 'make-trampoline) | |
296 | (defun make-trampoline (codegen super body) | |
297 | "Construct a trampoline function and return its name. | |
298 | ||
299 | CODEGEN is a `method-codegen'. SUPER is a superclass of the CODEGEN | |
300 | class. We construct a new trampoline function (with an unimaginative | |
301 | name) suitable for being passed to a direct method defined on SUPER as its | |
302 | `next_method'. In particular, it will have a `me' argument whose type is | |
303 | pointer-to-SUPER. | |
304 | ||
305 | The code of the function is generated by BODY, which will be invoked with | |
306 | a single argument which is the TARGET to which it should deliver its | |
307 | result. | |
308 | ||
309 | The return value is the name of the generated function." | |
310 | ||
311 | (let* ((message (codegen-message codegen)) | |
312 | (message-type (sod-message-type message)) | |
313 | (return-type (c-type-subtype message-type)) | |
314 | (arguments (mapcar (lambda (arg) | |
315 | (if (eq (argument-name arg) *sod-ap*) | |
316 | (make-argument *sod-master-ap* | |
317 | (c-type va-list)) | |
318 | arg)) | |
319 | (sod-message-no-varargs-tail message)))) | |
320 | (codegen-push codegen) | |
321 | (ensure-ilayout-var codegen super) | |
322 | (funcall body (codegen-target codegen)) | |
323 | (codegen-pop-function codegen (temporary-function) | |
324 | (c-type (fun (lisp return-type) | |
325 | ("me" (* (class super))) | |
326 | . arguments))))) | |
327 | ||
328 | ;;;-------------------------------------------------------------------------- | |
329 | ;;; Method entry protocol. | |
330 | ||
331 | (export 'effective-method-function-name) | |
332 | (defgeneric effective-method-function-name (method) | |
333 | (:documentation | |
334 | "Returns the function name of an effective method.")) | |
335 | ||
336 | (export 'method-entry-function-name) | |
337 | (defgeneric method-entry-function-name (method chain-head) | |
338 | (:documentation | |
339 | "Returns the function name of a method entry. | |
340 | ||
341 | The method entry is given as an effective method/chain-head pair, rather | |
342 | than as a method entry object because we want the function name before | |
343 | we've made the entry object.")) | |
344 | ||
345 | (export 'compute-method-entry-functions) | |
346 | (defgeneric compute-method-entry-functions (method) | |
347 | (:documentation | |
348 | "Construct method entry functions. | |
349 | ||
350 | Builds the effective method function (if there is one) and the necessary | |
351 | method entries. Returns a list of functions (i.e., `function-inst' | |
352 | objects) which need to be defined in the generated source code.")) | |
353 | ||
354 | ;;;-------------------------------------------------------------------------- | |
355 | ;;; Invoking direct methods. | |
356 | ||
357 | (export 'invoke-delegation-chain) | |
358 | (defun invoke-delegation-chain (codegen target basic-tail chain kernel) | |
359 | "Invoke a chain of delegating methods. | |
360 | ||
361 | CODEGEN is a `method-codegen'. BASIC-TAIL is a list of argument | |
362 | expressions to provide to the methods. The result of the delegation chain | |
363 | will be delivered to TARGET. | |
364 | ||
365 | The CHAIN is a list of method objects (it's intended to be used with | |
366 | `delegating-direct-method' objects). The behaviour is as follows. The | |
367 | first method in the chain is invoked with the necessary arguments (see | |
368 | below) including a `next_method' pointer. If KERNEL is nil and there are | |
369 | no more methods in the chain then the `next_method' pointer will be null; | |
370 | otherwise it will point to a `trampoline' function, whose behaviour is to | |
371 | call the remaining methods on the chain as a delegation chain. The method | |
372 | may choose to call this function with its arguments. It will finally | |
373 | return a value, which will be delivered to the TARGET. | |
374 | ||
375 | If the chain is empty, then the code generated by KERNEL (given a TARGET | |
376 | argument) will be invoked. It is an error if both CHAIN and KERNEL are | |
377 | nil." | |
378 | ||
379 | (let* ((message (codegen-message codegen)) | |
380 | (argument-tail (if (varargs-message-p message) | |
381 | (cons *sod-master-ap* basic-tail) | |
382 | basic-tail))) | |
383 | (labels ((next-trampoline (method chain) | |
384 | (if (or kernel chain) | |
385 | (make-trampoline codegen (sod-method-class method) | |
386 | (lambda (target) | |
387 | (invoke chain target))) | |
388 | 0)) | |
389 | (invoke (chain target) | |
390 | (if (null chain) | |
391 | (funcall kernel target) | |
bf090e02 MW |
392 | (let ((trampoline (next-trampoline (car chain) |
393 | (cdr chain)))) | |
dea4d055 MW |
394 | (invoke-method codegen target |
395 | (cons trampoline argument-tail) | |
396 | (car chain)))))) | |
397 | (invoke chain target)))) | |
398 | ||
399 | ;;;----- That's all, folks -------------------------------------------------- |