X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/e85df3ff84611b7c790f9ffb46dfca77e2a717c0..2d8d81c52aded8f15e37b061971d493742f55751:/src/method-impl.lisp diff --git a/src/method-impl.lisp b/src/method-impl.lisp index 725a0ec..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))) @@ -455,14 +461,20 @@ (defmethod compute-method-entry-functions ((method basic-effective-method)) (ensure-var codegen *sod-ap* c-type-va-list) (convert-stmts codegen entry-target return-type (lambda (target) - (emit-inst codegen - (make-va-start-inst - *sod-ap* - (argument-name parm-n))) + (deliver-call codegen :void "va_start" + *sod-ap* parm-n) (deliver-expr codegen target call) - (emit-inst codegen - (make-va-end-inst *sod-ap*)))) - (codegen-pop-function codegen main main-type)))))) + (deliver-call codegen :void "va_end" + *sod-ap*))) + (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) @@ -496,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)