X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/6e6b09589b6f6d0b260fd022e6a3b189f7f7d352..944caf84ede14c9915c657dcfb61f1fbc1ff0cdb:/src/method-impl.lisp diff --git a/src/method-impl.lisp b/src/method-impl.lisp index 6c9b28d..e4aaae3 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -7,7 +7,7 @@ ;;;----- Licensing notice --------------------------------------------------- ;;; -;;; This file is part of the Sensble Object Design, an object system for C. +;;; This file is part of the Sensible Object Design, an object system for C. ;;; ;;; SOD is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -55,7 +55,7 @@ (define-on-demand-slot basic-message no-varargs-tail (message) (mapcar (lambda (arg) (if (eq arg :ellipsis) - (make-argument *sod-ap* (c-type va-list)) + (make-argument *sod-ap* c-type-va-list) arg)) (sod-message-argument-tail message))) @@ -95,7 +95,7 @@ ;;;-------------------------------------------------------------------------- ;;; Direct method classes. -(export 'basic-direct-method) +(export '(basic-direct-method sod-method-role)) (defclass basic-direct-method (sod-method) ((role :initarg :role :type symbol :reader sod-method-role) (function-type :type c-function-type :reader sod-method-function-type)) @@ -147,7 +147,7 @@ (message sod-message) (type c-function-type)) (with-slots ((msgtype %type)) message - (unless (c-type-equal-p (c-type-subtype type) (c-type void)) + (unless (c-type-equal-p (c-type-subtype type) c-type-void) (error "Method return type ~A must be `void'" (c-type-subtype type))) (unless (argument-lists-compatible-p (c-function-arguments msgtype) (c-function-arguments type)) @@ -178,8 +178,7 @@ (return-type (c-type-subtype (sod-message-type message))) (msgargs (sod-message-argument-tail message)) (arguments (if (varargs-message-p message) - (cons (make-argument *sod-master-ap* - (c-type va-list)) + (cons (make-argument *sod-master-ap* c-type-va-list) (butlast msgargs)) msgargs))) (c-type (fun (lisp return-type) @@ -197,15 +196,16 @@ method))))) . (if (varargs-message-p message) - (cons (make-argument *sod-master-ap* - (c-type va-list)) + (cons (make-argument *sod-master-ap* c-type-va-list) method-args) method-args))))) ;;;-------------------------------------------------------------------------- ;;; Effective method classes. -(export 'basic-effective-method) +(export '(basic-effective-method + effective-method-around-methods effective-method-before-methods + effective-method-after-methods)) (defclass basic-effective-method (effective-method) ((around-methods :initarg :around-methods :initform nil :type list :reader effective-method-around-methods) @@ -273,7 +273,7 @@ (declare (ignore slot-names)) (with-slots (message target) codegen (setf target - (if (eq (c-type-subtype (sod-message-type message)) (c-type void)) + (if (eq (c-type-subtype (sod-message-type message)) c-type-void) :void :return)))) @@ -337,7 +337,7 @@ (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)) @@ -443,23 +443,21 @@ ;; 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))) . raw-entry-args)))) (codegen-push codegen) - (ensure-var codegen *sod-ap* (c-type va-list)) - (emit-inst codegen - (make-va-start-inst *sod-ap* - (argument-name parm-n))) + (ensure-var codegen *sod-ap* c-type-va-list) (convert-stmts codegen entry-target return-type (lambda (target) - (deliver-expr codegen target call))) - (emit-inst codegen (make-va-end-inst *sod-ap*)) + (deliver-call codegen :void "va_start" + *sod-ap* parm-n) + (deliver-expr codegen target call) + (deliver-call codegen :void "va_end" + *sod-ap*))) (codegen-pop-function codegen main main-type)))))) ;; Generate the method body. We'll work out what to do with it later. @@ -496,9 +494,8 @@ (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))))) + (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) @@ -540,7 +537,7 @@ (defmethod primary-method-class ((message standard-message)) 'delegating-direct-method) -(defmethod message-effective-method-class ((message standard-message)) +(defmethod sod-message-effective-method-class ((message standard-message)) 'standard-effective-method) (defmethod simple-method-body