X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/bd60ce6d5f67dd0fa0d29a58c8de567a28568380..db2abd9da3507b4329c06cced193ab7bedb49cea:/src/class-output.lisp diff --git a/src/class-output.lisp b/src/class-output.lisp index d6ead49..2ab6363 100644 --- a/src/class-output.lisp +++ b/src/class-output.lisp @@ -125,16 +125,14 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer) (dolist (entry (vtmsgs-entries vtmsgs)) (let* ((type (method-entry-function-type entry)) (args (c-function-arguments type)) - (method (method-entry-effective-method entry)) - (message (effective-method-message method)) (in-names nil) (out-names nil) (varargsp nil) (me "me")) (do ((args args (cdr args))) ((endp args)) - (let* ((raw-name (argument-name (car args))) + (let* ((raw-name (princ-to-string (argument-name (car args)))) (name (if (find raw-name (list "_vt" (sod-class-nickname class) - (sod-message-name message)) + (method-entry-slot-name entry)) :test #'string=) (format nil "sod__a_~A" raw-name) raw-name))) @@ -151,11 +149,11 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer) (format stream "#if __STDC_VERSION__ >= 199901~%")) (format stream "#define ~A(~{~A~^, ~}) ~ ~A->_vt->~A.~A(~{~A~^, ~})~%" - (message-macro-name class message) + (message-macro-name class entry) (nreverse in-names) me (sod-class-nickname class) - (sod-message-name message) + (method-entry-slot-name entry) (nreverse out-names)) (when varargsp (format stream "#endif~%")))) @@ -348,7 +346,7 @@ (defmethod hook-output progn ((entry method-entry) (sequence-output (stream sequencer) ((class :vtmsgs (sod-message-class message) :slots) (pprint-logical-block (stream nil :prefix " " :suffix ";") - (pprint-c-type pointer-type stream (sod-message-name message))) + (pprint-c-type pointer-type stream (method-entry-slot-name entry))) (terpri stream))))) (defmethod hook-output progn ((cptr class-pointer) @@ -541,15 +539,15 @@ (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) sequencer) (defmethod hook-output progn ((entry method-entry) (reason (eql :c)) sequencer) - (with-slots (method chain-head chain-tail) entry + (with-slots (method chain-head chain-tail role) entry (let* ((message (effective-method-message method)) (class (effective-method-class method)) (super (sod-message-class message))) (sequence-output (stream sequencer) ((class :vtable chain-head :vtmsgs super :slots) (format stream " /* ~19@A = */ ~A,~%" - (sod-message-name message) - (method-entry-function-name method chain-head))))))) + (method-entry-slot-name entry) + (method-entry-function-name method chain-head role))))))) ;;;-------------------------------------------------------------------------- ;;; Filling in the class object.