X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/6bc944c3cebb89056d9ed0b53eff6260909291a9..d83a91c663ced211bb7e4509f800859c3fa086e9:/src/class-output.lisp diff --git a/src/class-output.lisp b/src/class-output.lisp index 3345ac3..2ab6363 100644 --- a/src/class-output.lisp +++ b/src/class-output.lisp @@ -122,20 +122,17 @@ (eql (vtmsgs-class item) class))) (vtable-body vtable)))) (format stream "/* Message invocation macros. */~%") - ;;(break) (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))) @@ -152,11 +149,11 @@ (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~%")))) @@ -349,7 +346,7 @@ (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) @@ -542,15 +539,15 @@ const struct ~A ~A__classobj = {~%" (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.