(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)))
(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~%"))))
(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)
(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.