src/method-proto.lisp (invoke-delegation-chain): Pass keyword args correctly.

[sod] / src / method-proto.lisp

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index 048c924..637c29e 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -428,7 +428,8 @@
                           (cons (make-argument *sod-key-pointer*
                                                (c-type (* (void :const))))
                                 raw-args))))
-        (*keyword-struct-disposition* t))
+        (*keyword-struct-disposition* (if (effective-method-keywords method)
+                                          :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
     (when (and (keyword-message-p message)
@@ -499,11 +500,9 @@
    nil."
 
   (let* ((message (codegen-message codegen))
-        (argument-tail (cond ((varargs-message-p message)
-                              (cons *sod-tmp-ap* basic-tail))
-                             ((keyword-message-p message)
-                              (cons (keyword-struct-pointer) basic-tail))
-                             (t basic-tail))))
+        (argument-tail (if (varargs-message-p message)
+                           (cons *sod-tmp-ap* basic-tail)
+                           basic-tail)))
     (labels ((next-trampoline (method chain)
               (if (or kernel chain)
                   (make-trampoline codegen (sod-method-class method)
@@ -514,9 +513,13 @@
               (if (null chain)
                   (funcall kernel target)
                   (let ((trampoline (next-trampoline (car chain)
-                                                     (cdr chain))))
+                                                     (cdr chain)))
+                        (tail (if (keyword-message-p message)
+                                  (cons (keyword-struct-pointer)
+                                        argument-tail)
+                                  argument-tail)))
                     (invoke-method codegen target
-                                   (cons trampoline argument-tail)
+                                   (cons trampoline tail)
                                    (car chain))))))
       (invoke chain target))))