X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/b492babc8de898bd22d638d7c25f24356896a3a9..2d8d81c52aded8f15e37b061971d493742f55751:/src/method-impl.lisp diff --git a/src/method-impl.lisp b/src/method-impl.lisp index 366d1dc..f0fd3fc 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -337,7 +337,7 @@ (defmethod method-entry-function-name (sod-class-nickname message-class) (sod-message-name message) (sod-class-nickname chain-head)) - 0))) + *null-pointer*))) (defmethod method-entry-slot-name ((entry method-entry)) (let* ((method (method-entry-effective-method entry)) @@ -438,15 +438,21 @@ (defmethod compute-method-entry-functions ((method basic-effective-method)) (type (c-type (fun (lisp return-type) ("me" (* (class tail))) . entry-args)))) - (codegen-pop-function codegen name type) + (codegen-pop-function codegen name type + "~@(~@[~A ~]entry~) function ~:_~ + for method `~A.~A' ~:_~ + via chain headed by `~A' ~:_~ + defined on `~A'." + (if parm-n "Indirect argument-tail" nil) + (sod-class-nickname message-class) + (sod-message-name message) + head class) ;; If this is a varargs method then we've made the ;; `:valist' role. Also make the `nil' role. (when parm-n - (let ((call (make-call-inst name - (cons "me" - (mapcar #'argument-name - entry-args)))) + (let ((call (apply #'make-call-inst name "me" + (mapcar #'argument-name entry-args))) (main (method-entry-function-name method head nil)) (main-type (c-type (fun (lisp return-type) ("me" (* (class tail))) @@ -460,7 +466,15 @@ (defmethod compute-method-entry-functions ((method basic-effective-method)) (deliver-expr codegen target call) (deliver-call codegen :void "va_end" *sod-ap*))) - (codegen-pop-function codegen main main-type)))))) + (codegen-pop-function codegen main main-type + "Variable-length argument list ~:_~ + entry function ~:_~ + for method `~A.~A' ~:_~ + via chain headed by `~A' ~:_~ + defined on `~A'." + (sod-class-nickname message-class) + (sod-message-name message) + head class)))))) ;; Generate the method body. We'll work out what to do with it later. (codegen-push codegen) @@ -494,11 +508,15 @@ (defmethod compute-method-entry-functions ((method basic-effective-method)) ;; function and call it a lot. (codegen-build-function codegen emf-name emf-type vars (nconc insts (and result - (list (make-return-inst result))))) - - (let ((call (make-call-inst emf-name - (cons "sod__obj" (mapcar #'argument-name - emf-arg-tail))))) + (list (make-return-inst result)))) + "Effective method function ~:_for `~A.~A' ~:_~ + defined on `~A'." + (sod-class-nickname message-class) + (sod-message-name message) + (effective-method-class method)) + + (let ((call (apply #'make-call-inst emf-name "sod__obj" + (mapcar #'argument-name emf-arg-tail)))) (dolist (tail chain-tails) (setup-entry tail) (deliver-expr codegen entry-target call)