X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1224dfb0bfbd3a4dfa062cd56ae9f72c960d8e1a..9e91c8e7b5fcdeb6389ac7ccbcd9c77348c4493a:/src/class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index a975ebe..09f7e9f 100644
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -139,6 +139,11 @@
   ;; We need each message's method entry type for this, so we need to dig it
   ;; out of the vtmsgs structure.  Indeed, the vtmsgs for this class contains
   ;; entries for precisely the messages we want to make macros for.
+  (when (some #'varargs-message-p (sod-class-messages class))
+    (one-off-output 'varargs-macros sequencer :early-decls
+		    (lambda (stream)
+		      (format stream
+			      "~%SOD__VARARGS_MACROS_PREAMBLE~%"))))
   (when (sod-class-messages class)
     (sequence-output (stream sequencer)
       ((class :message-macros)
@@ -174,7 +179,7 @@
 			(push name in-names)
 			(push name out-names)))))
 	     (when varargsp
-	       (format stream "#if __STDC_VERSION__ >= 199901~%"))
+	       (format stream "#ifdef SOD__HAVE_VARARGS_MACROS~%"))
 	     (format stream "#define ~A(~{~A~^, ~}) ~
 				   ~A->_vt->~A.~A(~{~A~^, ~})~%"
 		     (message-macro-name class entry)
@@ -255,18 +260,21 @@
 			      (reason (eql :h))
 			      sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtptr
-    (sequence-output (stream sequencer)
-      ((class :ichain chain-head :slots)
-       (format stream "  const struct ~A *_vt;~%"
-	       (vtable-struct-tag chain-tail chain-head))))))
+    (when (eq class chain-tail)
+      (sequence-output (stream sequencer)
+	((class :ichain chain-head :slots)
+	 (format stream "  const struct ~A *_vt;~%"
+		 (vtable-struct-tag chain-tail chain-head)))))))
 
 (defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass slots) islots
-    (sequence-output (stream sequencer)
-      ((subclass :ichain (sod-class-chain-head class) :slots)
-       (format stream "  struct ~A ~A;~%"
-	       (islots-struct-tag class)
-	       (sod-class-nickname class))))))
+    (let ((head (sod-class-chain-head class)))
+      (when (eq head (sod-class-chain-head subclass))
+	(sequence-output (stream sequencer)
+	  ((subclass :ichain (sod-class-chain-head class) :slots)
+	   (format stream "  struct ~A ~A;~%"
+		   (islots-struct-tag class)
+		   (sod-class-nickname class))))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Vtable structure.
@@ -317,11 +325,12 @@
 
 (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass chain-head chain-tail) vtmsgs
-    (sequence-output (stream sequencer)
-      ((subclass :vtable chain-head :slots)
-       (format stream "  struct ~A ~A;~%"
-	       (vtmsgs-struct-tag subclass class)
-	       (sod-class-nickname class))))))
+    (when (eq subclass chain-tail)
+      (sequence-output (stream sequencer)
+	((subclass :vtable chain-head :slots)
+	 (format stream "  struct ~A ~A;~%"
+		 (vtmsgs-struct-tag subclass class)
+		 (sod-class-nickname class)))))))
 
 (defmethod hook-output progn
     ((vtmsgs vtmsgs) (reason (eql 'vtmsgs)) sequencer)
@@ -358,26 +367,29 @@
 (defmethod hook-output progn
     ((cptr class-pointer) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
-    (sequence-output (stream sequencer)
-      ((class :vtable chain-head :slots)
-       (format stream "  const ~A *~:[_class~;~:*_cls_~A~];~%"
-	       metaclass
-	       (and (sod-class-direct-superclasses meta-chain-head)
-		    (sod-class-nickname meta-chain-head)))))))
+    (when (eq chain-head (sod-class-chain-head class))
+      (sequence-output (stream sequencer)
+	((class :vtable chain-head :slots)
+	 (format stream "  const ~A *~:[_class~;~:*_cls_~A~];~%"
+		 metaclass
+		 (and (sod-class-direct-superclasses meta-chain-head)
+		      (sod-class-nickname meta-chain-head))))))))
 
 (defmethod hook-output progn ((boff base-offset) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head) boff
-    (sequence-output (stream sequencer)
-      ((class :vtable chain-head :slots)
-       (write-line "  size_t _base;" stream)))))
+    (when (eq chain-head (sod-class-chain-head class))
+      (sequence-output (stream sequencer)
+	((class :vtable chain-head :slots)
+	 (write-line "  size_t _base;" stream))))))
 
 (defmethod hook-output progn
     ((choff chain-offset) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head target-head) choff
-    (sequence-output (stream sequencer)
-      ((class :vtable chain-head :slots)
-       (format stream "  ptrdiff_t _off_~A;~%"
-	       (sod-class-nickname target-head))))))
+    (when (eq chain-head (sod-class-chain-head class))
+      (sequence-output (stream sequencer)
+	((class :vtable chain-head :slots)
+	 (format stream "  ptrdiff_t _off_~A;~%"
+		 (sod-class-nickname target-head)))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Implementation output.
@@ -440,15 +452,25 @@ const struct ~A ~A__classobj = {~%"
 
 (defmethod hook-output progn
     ((method sod-method) (reason (eql :c)) sequencer)
-  (with-slots ((class %class) body) method
+  (with-slots ((class %class) role body message) method
     (unless body
       (return-from hook-output))
     (sequence-output (stream sequencer)
       :constraint ((class :direct-methods :start)
+		   (class :direct-method method :banner)
 		   (class :direct-method method :start)
 		   (class :direct-method method :body)
 		   (class :direct-method method :end)
 		   (class :direct-methods :end))
+      ((class :direct-method method :banner)
+       (format-banner-comment stream "Direct ~@[~(~A~) ~]method ~:_~
+				      on `~A.~A' ~:_defined by `~A'."
+			      role
+			      (sod-class-nickname
+			       (sod-message-class message))
+			      (sod-message-name message)
+			      class)
+       (fresh-line stream))
       ((class :direct-method method :body)
        (pprint-c-type (sod-method-function-type method)
 		      stream