chiark / gitweb /
doc/syntax.tex: Delete (wrong) duplicate rule for <argument-declarator>.
[sod] / src / method-proto.lisp
index d0199975742c01efb6d11b010b3af8db20f7c756..6f8dc02c75396601e4cb36d07b4350bd2519fec2 100644 (file)
@@ -432,11 +432,13 @@ (defun make-trampoline (codegen super body)
                                           :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
-    (when (and (keyword-message-p message)
-              (not (eq *keyword-struct-disposition* :null)))
-      (let ((tag (effective-method-keyword-struct-tag method)))
-       (ensure-var codegen *sod-keywords* (c-type (* (struct tag :const)))
-                   *sod-key-pointer*)))
+    (when (keyword-message-p message)
+      (if (eq *keyword-struct-disposition* :null)
+         (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)
+         (let ((tag (effective-method-keyword-struct-tag method)))
+           (ensure-var codegen *sod-keywords*
+                       (c-type (* (struct tag :const)))
+                       *sod-key-pointer*))))
     (funcall body (codegen-target codegen))
     (codegen-pop-function codegen (temporary-function)
                          (c-type (fun (lisp return-type)
@@ -500,11 +502,9 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
    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)
@@ -515,9 +515,13 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
               (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))))