Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Method combination protocol | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
dea4d055 MW |
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 | ||
43073476 MW |
31 | (export '(effective-method |
32 | effective-method-message effective-method-class | |
33 | effective-method-keywords)) | |
dea4d055 MW |
34 | (defclass effective-method () |
35 | ((message :initarg :message :type sod-message | |
36 | :reader effective-method-message) | |
43073476 MW |
37 | (%class :initarg :class :type sod-class :reader effective-method-class) |
38 | (keywords :type list :reader effective-method-keywords)) | |
dea4d055 MW |
39 | (:documentation |
40 | "The behaviour invoked by sending a message to an instance of a class. | |
41 | ||
42 | This class describes the behaviour when an instance of CLASS is sent | |
43 | MESSAGE. | |
44 | ||
45 | This is not a useful class by itself. Message classes are expected to | |
46 | define their own effective-method classes. | |
47 | ||
43073476 | 48 | An effective method class may accept a `:direct-methods' initarg, which |
dea4d055 | 49 | will be a list of applicable methods sorted in most-to-least specific |
43073476 | 50 | order.")) |
dea4d055 | 51 | |
d5fdd49e MW |
52 | (export 'sod-message-receiver-type) |
53 | (defgeneric sod-message-receiver-type (message class) | |
54 | (:documentation | |
55 | "Return the type of the `me' argument in a MESSAGE received by CLASS. | |
56 | ||
e895be21 | 57 | Typically this will just be `CLASS *' or `const CLASS *'.")) |
d5fdd49e | 58 | |
9c29a20f MW |
59 | (export 'sod-message-applicable-methods) |
60 | (defgeneric sod-message-applicable-methods (message class) | |
61 | (:documentation | |
62 | "Return a list of applicable methods for a MESSAGE. | |
63 | ||
64 | The list contains all methods applicable for MESSAGE when sent to an | |
65 | instance of CLASS, most specific first.")) | |
66 | ||
1ec06509 MW |
67 | (export 'sod-message-keyword-argument-lists) |
68 | (defgeneric sod-message-keyword-argument-lists | |
69 | (message class direct-methods state) | |
70 | (:documentation | |
71 | "Returns a list of keyword argument lists to be merged. | |
72 | ||
73 | This should return a list suitable for passing to `merge-keyword-lists', | |
74 | i.e., each element should be a pair consisting of a function describing | |
75 | the source of the argument list (returning location and description), and | |
76 | a list of `argument' objects. | |
77 | ||
78 | The MESSAGE is the message being processed; CLASS is a receiver class | |
79 | under consideration; DIRECT-METHODS is the complete list of applicable | |
80 | direct methods (most specific first); and STATE is an `inheritance-path- | |
81 | reporter-state' object which can be used by the returned reporting | |
82 | functions.")) | |
83 | ||
84 | (export 'compute-effective-method-keyword-arguments) | |
85 | (defun compute-effective-method-keyword-arguments | |
86 | (message class direct-methods) | |
87 | "Return a merged keyword argument list. | |
88 | ||
89 | The returned list combines all of the applicable methods, provided as | |
90 | DIRECT-METHODS, applicable to MESSAGE when received by an instance of | |
91 | CLASS, possibly with other keywords as determined by `sod-keyword- | |
92 | argument-lists'." | |
93 | (let ((state (make-inheritance-path-reporter-state class))) | |
94 | (merge-keyword-lists (lambda () | |
95 | (values class | |
96 | (format nil | |
97 | "methods for message `~A' ~ | |
98 | applicable to class `~A'" | |
99 | message class))) | |
100 | (sod-message-keyword-argument-lists message | |
101 | class | |
102 | direct-methods | |
103 | state)))) | |
104 | ||
51af043f MW |
105 | (export 'sod-message-check-methods) |
106 | (defgeneric sod-message-check-methods (message class direct-methods) | |
107 | (:documentation | |
108 | "Check that the applicable methods for a MESSAGE are compatible. | |
109 | ||
110 | Specifically, given the DIRECT-METHODS applicable for the message when | |
111 | received by an instance of CLASS, signal errors if the methods don't | |
112 | match the MESSAGE or each other.")) | |
113 | ||
7f2917d2 MW |
114 | (export 'sod-message-effective-method-class) |
115 | (defgeneric sod-message-effective-method-class (message) | |
dea4d055 MW |
116 | (:documentation |
117 | "Return the effective method class for the given MESSAGE. | |
118 | ||
119 | This function is invoked by `compute-sod-effective-method'.")) | |
120 | ||
121 | (export 'primary-method-class) | |
122 | (defgeneric primary-method-class (message) | |
123 | (:documentation | |
124 | "Return the name of the primary direct method class for MESSAGE. | |
125 | ||
126 | This protocol is used by `simple-message' subclasses.")) | |
127 | ||
128 | (export 'compute-sod-effective-method) | |
129 | (defgeneric compute-sod-effective-method (message class) | |
130 | (:documentation | |
131 | "Return the effective method when a CLASS instance receives MESSAGE. | |
132 | ||
133 | The default method constructs an instance of the message's chosen | |
7f2917d2 MW |
134 | `sod-message-effective-method-class', passing the MESSAGE, the CLASS and |
135 | the list of applicable methods as initargs to `make-instance'.")) | |
dea4d055 MW |
136 | |
137 | (export 'compute-effective-methods) | |
138 | (defgeneric compute-effective-methods (class) | |
139 | (:documentation | |
140 | "Return a list of all of the effective methods needed for CLASS. | |
141 | ||
142 | The list needn't be in any particular order.")) | |
143 | ||
144 | (export '(method-entry method-entry-effective-method | |
85aa8b3e MW |
145 | method-entry-chain-head method-entry-chain-tail |
146 | method-entry-role)) | |
dea4d055 | 147 | (defclass method-entry () |
4b8e5c03 MW |
148 | ((%method :initarg :method :type effective-method |
149 | :reader method-entry-effective-method) | |
dea4d055 MW |
150 | (chain-head :initarg :chain-head :type sod-class |
151 | :reader method-entry-chain-head) | |
152 | (chain-tail :initarg :chain-tail :type sod-class | |
b426ab51 | 153 | :reader method-entry-chain-tail) |
8e45f824 | 154 | (role :initarg :role :type (or keyword null) :reader method-entry-role)) |
dea4d055 MW |
155 | (:documentation |
156 | "An entry point into an effective method. | |
157 | ||
b426ab51 MW |
158 | Specifically, this is the entry point to the effective METHOD invoked via |
159 | the vtable for the chain headed by CHAIN-HEAD, and serving the given ROLE. | |
160 | The CHAIN-TAIL is the most specific class on this chain; this is useful | |
161 | because we can reuse the types of method entries from superclasses on | |
162 | non-primary chains. | |
dea4d055 MW |
163 | |
164 | Each effective method may have several different method entries, because | |
165 | an effective method can be called via vtables attached to different | |
166 | chains, and such calls will pass instance pointers which point to | |
167 | different `ichain' structures within the overall instance layout; it's the | |
168 | job of the method entry to adjust the instance pointers correctly for the | |
169 | rest of the effective method. | |
170 | ||
b426ab51 MW |
171 | A vtable can contain more than one entry for the same message. Such |
172 | entries are distinguished by their roles. A message always has an entry | |
bf8aadd7 MW |
173 | with the `nil role; in addition, a varargs message also has a `:valist' |
174 | role, which accepts a `va_list' argument in place of the variable argument | |
175 | listNo other roles are currently defined, though they may be introduced by | |
176 | extensions. | |
b426ab51 | 177 | |
dea4d055 MW |
178 | The boundaries between a method entry and the effective method |
179 | is (intentionally) somewhat fuzzy. In extreme cases, the effective method | |
180 | may not exist at all as a distinct entity in the output because its | |
181 | content is duplicated in all of the method entry functions. This is left | |
182 | up to the effective method protocol.")) | |
183 | ||
b426ab51 MW |
184 | (export 'make-method-entries) |
185 | (defgeneric make-method-entries (effective-method chain-head chain-tail) | |
dea4d055 | 186 | (:documentation |
b426ab51 MW |
187 | "Return a list of `method-entry' objects for an EFFECTIVE-METHOD called |
188 | via CHAIN-HEAD. | |
dea4d055 MW |
189 | |
190 | There is no default method for this function. (Maybe when the | |
191 | effective-method/method-entry output protocol has settled down I'll know | |
192 | what a sensible default action would be.)")) | |
193 | ||
194 | ;;;-------------------------------------------------------------------------- | |
195 | ;;; Protocol for messages and direct-methods. | |
196 | ||
197 | (export 'sod-message-argument-tail) | |
198 | (defgeneric sod-message-argument-tail (message) | |
199 | (:documentation | |
200 | "Return the argument tail for the message, with invented argument names. | |
201 | ||
202 | No `me' argument is prepended; any `:ellipsis' is left as it is.")) | |
203 | ||
675b4824 MW |
204 | (export 'sod-method-description) |
205 | (defgeneric sod-method-description (method) | |
206 | (:documentation | |
207 | "Return an adjectival phrase describing METHOD. | |
208 | ||
209 | The result will be placed into an error message reading something like | |
210 | ``Conflicting definition of DESCRIPTION direct method `bogus'''. Two | |
211 | direct methods which can coexist in the same class, defined on the same | |
212 | message, should have differing descriptions.")) | |
213 | ||
dea4d055 MW |
214 | (export 'sod-method-function-type) |
215 | (defgeneric sod-method-function-type (method) | |
216 | (:documentation | |
217 | "Return the C function type for the direct method. | |
218 | ||
219 | This is called during initialization of a direct method object, and the | |
220 | result is cached. | |
221 | ||
222 | A default method is provided (by `basic-direct-method') which simply | |
223 | prepends an appropriate `me' argument to the user-provided argument list. | |
224 | Fancy method classes may need to override this behaviour.")) | |
225 | ||
226 | (export 'sod-method-next-method-type) | |
227 | (defgeneric sod-method-next-method-type (method) | |
228 | (:documentation | |
229 | "Return the C function type for the next-method trampoline. | |
230 | ||
231 | This is called during initialization of a direct method object, and the | |
232 | result is cached. It should return a function type, not a pointer type. | |
233 | ||
234 | A default method is provided (by `delegating-direct-method') which should | |
235 | do the right job. Very fancy subclasses might need to do something | |
236 | different.")) | |
237 | ||
238 | (export 'sod-method-function-name) | |
239 | (defgeneric sod-method-function-name (method) | |
240 | (:documentation | |
241 | "Return the C function name for the direct method.")) | |
242 | ||
43073476 MW |
243 | (export 'keyword-message-p) |
244 | (defun keyword-message-p (message) | |
245 | "Answer whether the MESSAGE accepts a keyword arguments. | |
246 | ||
247 | Dealing with keyword messages is rather fiddly, so this is useful to | |
248 | know." | |
249 | (typep (sod-message-type message) 'c-keyword-function-type)) | |
250 | ||
dea4d055 MW |
251 | (export 'varargs-message-p) |
252 | (defun varargs-message-p (message) | |
253 | "Answer whether the MESSAGE accepts a variable-length argument list. | |
254 | ||
255 | We need to jump through some extra hoops in order to cope with varargs | |
256 | messages, so this is useful to know." | |
257 | (member :ellipsis (sod-message-argument-tail message))) | |
258 | ||
259 | ;;;-------------------------------------------------------------------------- | |
260 | ;;; Protocol for effective methods and method entries. | |
261 | ||
262 | (export 'method-entry-function-type) | |
263 | (defgeneric method-entry-function-type (entry) | |
264 | (:documentation | |
265 | "Return the C function type for a method entry.")) | |
266 | ||
b426ab51 MW |
267 | (export 'method-entry-slot-name) |
268 | (defgeneric method-entry-slot-name (entry) | |
269 | (:documentation | |
270 | "Return the `vtmsgs' slot name for a method entry. | |
271 | ||
272 | The default method indirects through `method-entry-slot-name-by-role'.")) | |
273 | ||
85aa8b3e | 274 | (export 'method-entry-slot-name-by-role) |
b426ab51 MW |
275 | (defgeneric method-entry-slot-name-by-role (entry role name) |
276 | (:documentation "Easier implementation for `method-entry-slot-name'.") | |
bf8aadd7 MW |
277 | (:method ((entry method-entry) (role (eql nil)) name) name) |
278 | (:method ((entry method-entry) (role (eql :valist)) name) | |
279 | (format nil "~A__v" name))) | |
b426ab51 | 280 | |
dea4d055 MW |
281 | (export 'effective-method-basic-argument-names) |
282 | (defgeneric effective-method-basic-argument-names (method) | |
283 | (:documentation | |
284 | "Return a list of argument names to be passed to direct methods. | |
285 | ||
286 | The argument names are constructed from the message's arguments returned | |
43073476 MW |
287 | by `sod-message-argument-tail', with any ellipsis replaced by an explicit |
288 | `va_list' argument. The basic arguments are the ones immediately derived | |
289 | from the programmer's explicitly stated arguments; the `me' argument is | |
290 | not included, and neither are more exotic arguments added as part of the | |
291 | method delegation protocol.")) | |
dea4d055 | 292 | |
5135d00a MW |
293 | (export 'effective-method-live-p) |
294 | (defgeneric effective-method-live-p (method) | |
295 | (:documentation | |
296 | "Returns true if the effective METHOD is live. | |
297 | ||
8ff3d48e MW |
298 | An effective method is `live' if it should actually have proper method |
299 | entry functions associated with it and stored in the class vtable. The | |
300 | other possibility is that the method is `dead', in which case the function | |
5135d00a MW |
301 | pointers in the vtable are left null.")) |
302 | ||
dea4d055 MW |
303 | ;;;-------------------------------------------------------------------------- |
304 | ;;; Code generation. | |
305 | ||
306 | ;;; Enhanced code-generator class. | |
307 | ||
308 | (export '(method-codegen codegen-message codegen-class | |
309 | codegen-method codegen-target)) | |
310 | (defclass method-codegen (codegen) | |
311 | ((message :initarg :message :type sod-message :reader codegen-message) | |
4b8e5c03 MW |
312 | (%class :initarg :class :type sod-class :reader codegen-class) |
313 | (%method :initarg :method :type effective-method :reader codegen-method) | |
dea4d055 MW |
314 | (target :initarg :target :reader codegen-target)) |
315 | (:documentation | |
316 | "Augments CODEGEN with additional state regarding an effective method. | |
317 | ||
318 | We store the effective method, and also its target class and owning | |
319 | message, so that these values are readily available to the code-generating | |
320 | functions.")) | |
321 | ||
322 | ;;; Protocol. | |
323 | ||
324 | (export 'compute-effective-method-body) | |
325 | (defgeneric compute-effective-method-body (method codegen target) | |
326 | (:documentation | |
327 | "Generates the body of an effective method. | |
328 | ||
329 | Writes the function body to the code generator. It can (obviously) | |
330 | generate auxiliary functions if it needs to. | |
331 | ||
43073476 MW |
332 | The arguments are as determined by agreement with the generic function |
333 | `compute-method-entry-functions'; usually this will be as specified by the | |
334 | `sod-message-argument-tail', with any variable-argument tail reified to a | |
335 | `va_list', and an additional argument `sod__obj' of type pointer-to- | |
336 | ilayout. The code should deliver the result (if any) to the TARGET.")) | |
dea4d055 MW |
337 | |
338 | (export 'simple-method-body) | |
339 | (defgeneric simple-method-body (method codegen target) | |
340 | (:documentation | |
341 | "Generate the body of a simple effective method. | |
342 | ||
343 | The function is invoked on an effective METHOD, with a CODEGEN to which it | |
344 | should emit code delivering the method's value to TARGET.")) | |
345 | ||
346 | ;;; Additional instructions. | |
347 | ||
4b8e5c03 | 348 | (definst convert-to-ilayout (stream :export t) |
3ee33e04 | 349 | (%class chain-head %expr) |
dea4d055 | 350 | (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)" |
3ee33e04 | 351 | class (sod-class-nickname chain-head) expr)) |
dea4d055 MW |
352 | |
353 | ;;; Utilities. | |
354 | ||
97d10f8b | 355 | (defvar-unbound *keyword-struct-disposition* |
43073476 MW |
356 | "The current state of the keyword structure. |
357 | ||
97d10f8b | 358 | This can be one of three values. |
43073476 MW |
359 | |
360 | * `:local' -- the structure itself is in a local variable `sod__kw'. | |
361 | This is used in the top-level effective method. | |
362 | ||
363 | * `:pointer' -- the structure is pointed to by the local variable | |
364 | `sod__kw'. This is used by delegation-chain trampolines. | |
365 | ||
366 | * `:null' -- there is in fact no structure because none of the | |
367 | applicable methods actually define any keywords.") | |
368 | ||
369 | (defun keyword-access (name &optional suffix) | |
370 | "Return an lvalue designating a named member of the keyword struct. | |
371 | ||
372 | If a non-nil SUFFIX is provided, then the member is named NAMESUFFIX." | |
373 | (flet ((mem (op) | |
374 | (format nil "~A~A~A~@[~A~]" *sod-keywords* op name suffix))) | |
375 | (ecase *keyword-struct-disposition* | |
376 | (:local (mem ".")) | |
377 | (:pointer (mem "->"))))) | |
378 | ||
379 | (let ((kw-addr (format nil "&~A" *sod-keywords*))) | |
380 | (defun keyword-struct-pointer () | |
381 | "Return a pointer to the keyword structure." | |
382 | (ecase *keyword-struct-disposition* | |
383 | (:local kw-addr) | |
384 | (:pointer *sod-keywords*) | |
385 | (:null *null-pointer*)))) | |
386 | ||
dea4d055 MW |
387 | (export 'invoke-method) |
388 | (defun invoke-method (codegen target arguments-tail direct-method) | |
389 | "Emit code to invoke DIRECT-METHOD, passing it ARGUMENTS-TAIL. | |
390 | ||
391 | The code is generated in the context of CODEGEN, which can be any instance | |
392 | of the `codegen' class -- it needn't be an instance of `method-codegen'. | |
393 | The DIRECT-METHOD is called with the given ARGUMENTS-TAIL (a list of | |
394 | argument expressions), preceded by a `me' argument of type pointer-to- | |
395 | CLASS where CLASS is the class on which the method was defined. | |
396 | ||
397 | If the message accepts a variable-length argument list then a copy of the | |
2bbe0f1d | 398 | prevailing argument pointer is provided in place of the `:ellipsis'." |
dea4d055 MW |
399 | |
400 | (let* ((message (sod-method-message direct-method)) | |
401 | (class (sod-method-class direct-method)) | |
402 | (function (sod-method-function-name direct-method)) | |
43073476 MW |
403 | (type (sod-method-type direct-method)) |
404 | (keywordsp (keyword-message-p message)) | |
405 | (keywords (and keywordsp (c-function-keywords type))) | |
406 | (arguments (append (list (format nil "&sod__obj->~A.~A" | |
407 | (sod-class-nickname | |
408 | (sod-class-chain-head class)) | |
409 | (sod-class-nickname class))) | |
410 | arguments-tail | |
411 | (mapcar (lambda (arg) | |
412 | (let ((name (argument-name arg)) | |
413 | (default (argument-default arg))) | |
414 | (if default | |
415 | (make-cond-inst | |
416 | (keyword-access name | |
417 | "__suppliedp") | |
418 | (keyword-access name) | |
419 | default) | |
420 | (keyword-access name)))) | |
421 | keywords)))) | |
422 | (cond ((varargs-message-p message) | |
423 | (convert-stmts codegen target (c-type-subtype type) | |
424 | (lambda (var) | |
425 | (ensure-var codegen *sod-tmp-ap* c-type-va-list) | |
426 | (deliver-call codegen :void "va_copy" | |
427 | *sod-tmp-ap* *sod-ap*) | |
428 | (apply #'deliver-call codegen var | |
429 | function arguments) | |
430 | (deliver-call codegen :void "va_end" | |
431 | *sod-tmp-ap*)))) | |
432 | (keywords | |
433 | (let ((tag (direct-method-suppliedp-struct-tag direct-method))) | |
434 | (with-temporary-var (codegen spvar (c-type (struct tag))) | |
435 | (dolist (arg keywords) | |
436 | (let ((name (argument-name arg))) | |
437 | (deliver-expr codegen (format nil "~A.~A" spvar name) | |
438 | (keyword-access name "__suppliedp")))) | |
439 | (setf arguments (list* (car arguments) spvar | |
440 | (cdr arguments))) | |
441 | (apply #'deliver-call codegen target function arguments)))) | |
442 | (t | |
443 | (apply #'deliver-call codegen target function arguments))))) | |
dea4d055 MW |
444 | |
445 | (export 'ensure-ilayout-var) | |
446 | (defun ensure-ilayout-var (codegen super) | |
447 | "Define a variable `sod__obj' pointing to the class's ilayout structure. | |
448 | ||
449 | CODEGEN is a `method-codegen'. The class in question is CODEGEN's class, | |
450 | i.e., the target class for the effective method. SUPER is one of the | |
451 | class's superclasses; it is assumed that `me' is a pointer to a SUPER | |
452 | (i.e., to SUPER's ichain within the ilayout)." | |
453 | ||
454 | (let* ((class (codegen-class codegen)) | |
455 | (super-head (sod-class-chain-head super))) | |
456 | (ensure-var codegen "sod__obj" | |
457 | (c-type (* (struct (ilayout-struct-tag class)))) | |
458 | (make-convert-to-ilayout-inst class super-head "me")))) | |
459 | ||
460 | (export 'make-trampoline) | |
461 | (defun make-trampoline (codegen super body) | |
462 | "Construct a trampoline function and return its name. | |
463 | ||
464 | CODEGEN is a `method-codegen'. SUPER is a superclass of the CODEGEN | |
465 | class. We construct a new trampoline function (with an unimaginative | |
466 | name) suitable for being passed to a direct method defined on SUPER as its | |
467 | `next_method'. In particular, it will have a `me' argument whose type is | |
468 | pointer-to-SUPER. | |
469 | ||
470 | The code of the function is generated by BODY, which will be invoked with | |
471 | a single argument which is the TARGET to which it should deliver its | |
472 | result. | |
473 | ||
474 | The return value is the name of the generated function." | |
475 | ||
476 | (let* ((message (codegen-message codegen)) | |
477 | (message-type (sod-message-type message)) | |
7de8c666 MW |
478 | (message-class (sod-message-class message)) |
479 | (method (codegen-method codegen)) | |
dea4d055 | 480 | (return-type (c-type-subtype message-type)) |
f5d75f56 | 481 | (raw-args (sod-message-argument-tail message)) |
43073476 MW |
482 | (arguments (cond ((varargs-message-p message) |
483 | (cons (make-argument *sod-ap* c-type-va-list) | |
484 | (butlast raw-args))) | |
485 | ((keyword-message-p message) | |
486 | (cons (make-argument *sod-key-pointer* | |
487 | (c-type (* (void :const)))) | |
a469422e MW |
488 | raw-args)) |
489 | (t raw-args))) | |
bce58d37 MW |
490 | (*keyword-struct-disposition* (if (effective-method-keywords method) |
491 | :pointer :null))) | |
dea4d055 MW |
492 | (codegen-push codegen) |
493 | (ensure-ilayout-var codegen super) | |
30eb3c68 | 494 | (deliver-call codegen :void "SOD__IGNORE" "sod__obj") |
f2ed4293 MW |
495 | (when (keyword-message-p message) |
496 | (if (eq *keyword-struct-disposition* :null) | |
497 | (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*) | |
498 | (let ((tag (effective-method-keyword-struct-tag method))) | |
499 | (ensure-var codegen *sod-keywords* | |
500 | (c-type (* (struct tag :const))) | |
501 | *sod-key-pointer*)))) | |
dea4d055 MW |
502 | (funcall body (codegen-target codegen)) |
503 | (codegen-pop-function codegen (temporary-function) | |
504 | (c-type (fun (lisp return-type) | |
505 | ("me" (* (class super))) | |
7de8c666 MW |
506 | . arguments)) |
507 | "Delegation-chain trampoline ~:_~ | |
508 | for `~A.~A' ~:_on `~A'." | |
509 | (sod-class-nickname message-class) | |
510 | (sod-message-name message) | |
511 | (effective-method-class method)))) | |
dea4d055 MW |
512 | |
513 | ;;;-------------------------------------------------------------------------- | |
514 | ;;; Method entry protocol. | |
515 | ||
516 | (export 'effective-method-function-name) | |
517 | (defgeneric effective-method-function-name (method) | |
518 | (:documentation | |
519 | "Returns the function name of an effective method.")) | |
520 | ||
521 | (export 'method-entry-function-name) | |
b426ab51 | 522 | (defgeneric method-entry-function-name (method chain-head role) |
dea4d055 MW |
523 | (:documentation |
524 | "Returns the function name of a method entry. | |
525 | ||
b426ab51 MW |
526 | The method entry is given as an effective method/chain-head/role triple, |
527 | rather than as a method entry object because we want the function name | |
528 | before we've made the entry object.")) | |
dea4d055 MW |
529 | |
530 | (export 'compute-method-entry-functions) | |
531 | (defgeneric compute-method-entry-functions (method) | |
532 | (:documentation | |
533 | "Construct method entry functions. | |
534 | ||
535 | Builds the effective method function (if there is one) and the necessary | |
536 | method entries. Returns a list of functions (i.e., `function-inst' | |
537 | objects) which need to be defined in the generated source code.")) | |
538 | ||
539 | ;;;-------------------------------------------------------------------------- | |
540 | ;;; Invoking direct methods. | |
541 | ||
542 | (export 'invoke-delegation-chain) | |
543 | (defun invoke-delegation-chain (codegen target basic-tail chain kernel) | |
544 | "Invoke a chain of delegating methods. | |
545 | ||
546 | CODEGEN is a `method-codegen'. BASIC-TAIL is a list of argument | |
547 | expressions to provide to the methods. The result of the delegation chain | |
548 | will be delivered to TARGET. | |
549 | ||
550 | The CHAIN is a list of method objects (it's intended to be used with | |
551 | `delegating-direct-method' objects). The behaviour is as follows. The | |
552 | first method in the chain is invoked with the necessary arguments (see | |
553 | below) including a `next_method' pointer. If KERNEL is nil and there are | |
554 | no more methods in the chain then the `next_method' pointer will be null; | |
555 | otherwise it will point to a `trampoline' function, whose behaviour is to | |
556 | call the remaining methods on the chain as a delegation chain. The method | |
557 | may choose to call this function with its arguments. It will finally | |
558 | return a value, which will be delivered to the TARGET. | |
559 | ||
560 | If the chain is empty, then the code generated by KERNEL (given a TARGET | |
561 | argument) will be invoked. It is an error if both CHAIN and KERNEL are | |
562 | nil." | |
563 | ||
564 | (let* ((message (codegen-message codegen)) | |
12386a26 MW |
565 | (argument-tail (if (varargs-message-p message) |
566 | (cons *sod-tmp-ap* basic-tail) | |
567 | basic-tail))) | |
dea4d055 MW |
568 | (labels ((next-trampoline (method chain) |
569 | (if (or kernel chain) | |
570 | (make-trampoline codegen (sod-method-class method) | |
571 | (lambda (target) | |
572 | (invoke chain target))) | |
944caf84 | 573 | *null-pointer*)) |
dea4d055 MW |
574 | (invoke (chain target) |
575 | (if (null chain) | |
576 | (funcall kernel target) | |
bf090e02 | 577 | (let ((trampoline (next-trampoline (car chain) |
12386a26 MW |
578 | (cdr chain))) |
579 | (tail (if (keyword-message-p message) | |
580 | (cons (keyword-struct-pointer) | |
581 | argument-tail) | |
582 | argument-tail))) | |
dea4d055 | 583 | (invoke-method codegen target |
12386a26 | 584 | (cons trampoline tail) |
dea4d055 MW |
585 | (car chain)))))) |
586 | (invoke chain target)))) | |
587 | ||
588 | ;;;----- That's all, folks -------------------------------------------------- |