From e674612eb9e1a1dde2522260163a93a13ed44a0f Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Sun, 10 Jan 2016 13:51:04 +0000
Subject: [PATCH] Improve checking for C99-style varargs macros.
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

This is a rather sad story.  C99 introduced `variadic macros'
(gratuitously incompatible with GCC's better thought-out existing
feature for doing the same thing).  GCC implements the feature, and
enables it by default.  Unfortunately, GCC doesn't declare conformance
with C99 by default (by defining `__STDC_VERSION__' appropriately), so
the naÃ¯ve test doesn't actually work unless you give GCC some extra
options.

Now that we have a place for `preliminary utilities' in the header file,
define a new macro `SOD__HAVE_VARARGS_MACROS' to report the feature's
availability to generated code, and use this to guard definitions which
make use of the feature.

Apparently (https://gcc.gnu.org/c99status.html) the feature was added to
GCC in version 2.95; I'm testing for version three or later because it's
easy.  But this isn't enough.  If GCC isn't fully committed to the C99
feature set, then `-pedantic' mode will issue warnings about the use of
variadic macros.  Normally we could suppress these with some hacking
involving `__extension__' or `#pragma GCC diagnostic', but GCC's
preprocessor isn't clever enough to deal with any of that.  Instead, we
reach for the big hammer and have header files declare themselves to be
`system headers', which means that GCC stops trying to warn about them
at all.

This is really quite a long way from being an ideal situation.
---
 doc/SYMBOLS            |  1 +
 doc/output.tex         |  4 ++++
 lib/sod.h              | 45 ++++++++++++++++++++++++++++++++++++++++++++-
 src/class-output.lisp  |  7 ++++++-
 src/module-output.lisp | 19 +++++++++++++++++--
 5 files changed, 72 insertions(+), 4 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 59df763..2c33ad0 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -507,6 +507,7 @@ module-output.lisp
   banner                                        function
   declare-output-type                           function
   guard-name                                    function
+  one-off-output                                function
   output-module                                 function
   output-type-pathname                          function
 
diff --git a/doc/output.tex b/doc/output.tex
index cac9b01..6153dec 100644
--- a/doc/output.tex
+++ b/doc/output.tex
@@ -187,6 +187,10 @@ until the third.  So the final processing order is
 \begin{describe}{fun}{guard-name @<filename> @> @<string>}
 \end{describe}
 
+\begin{describe}{fun}
+    {one-off-output @<token> @<sequencer> @<item-name> @<function>}
+\end{describe}
+
 %%%--------------------------------------------------------------------------
 \section{Class output} \label{output.class}
 
diff --git a/lib/sod.h b/lib/sod.h
index dc85843..360afa8 100644
--- a/lib/sod.h
+++ b/lib/sod.h
@@ -34,6 +34,49 @@
 
 /*----- Preliminary utilities ---------------------------------------------*/
 
+/* --- @SOD__HAVE_VARARGS_MACROS@ --- *
+ *
+ * Use:		Defined if the compiler supports C99-style variadic macros.
+ *
+ *		This is more complicated than just checking the value of
+ *		@__STDC_VERSION__@ because GCC has traditionally claimed C89
+ *		by default, but provides the functionality anyway unless it's
+ *		been explicitly turned off.
+ */
+
+#if __STDC_VERSION__ >= 199901
+   /* The feature exists.  All is well with the world. */
+
+#  define SOD__HAVE_VARARGS_MACROS
+
+#elif __GNUC__ >= 3
+   /* We're using GCC, which is trying to deny it but we don't believe it.
+    * Unfortunately there's a fly in the ointment: if `-pedantic' -- or,
+    * worse, `-pedantic-errors' -- is set, then GCC will warn about these
+    * macros being defined, and there isn't a way to detect pedantry from the
+    * preprocessor.
+    *
+    * We must deploy bodges.  There doesn't seem to be a good way to suppress
+    * particular warnings from the preprocessor: in particular, messing about
+    * with `pragma GCC diagnostic' doesn't help.  So we're left with this
+    * hack: just declare all Sod-generated header files which try to do
+    * varargs macro things to be `system headers', which means that GCC's
+    * preprocessor will let them get away with all manner of nefarious stuff.
+    */
+
+#  define SOD__HAVE_VARARGS_MACROS
+#  define SOD__VARARGS_MACROS_PREAMBLE _Pragma("GCC system_header")
+
+#endif
+
+/* Make sure this gratuitous hack is understood, at least vacuously. */
+#ifndef SOD__VARARGS_MACROS_PREAMBLE
+#  define SOD__VARARGS_MACROS_PREAMBLE
+#endif
+
+/* We're going to want to make use of this ourselves. */
+SOD__VARARGS_MACROS_PREAMBLE
+
 /* --- @SOD__CAR@ --- *
  *
  * Arguments:	@...@ = a nonempty list of arguments
@@ -41,7 +84,7 @@
  * Returns:	The first argument only.
  */
 
-#if __STDC_VERSION__ >= 199901
+#ifdef SOD__HAVE_VARARGS_MACROS
 #  define SOD__CAR(...) SOD__CARx(__VA_LIST__, _)
 #  define SOD__CARx(a, ...) a
 #endif
diff --git a/src/class-output.lisp b/src/class-output.lisp
index b47f6ba..b2d1ec8 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)
diff --git a/src/module-output.lisp b/src/module-output.lisp
index a0ca42d..1bfb34f 100644
--- a/src/module-output.lisp
+++ b/src/module-output.lisp
@@ -65,6 +65,20 @@
   (merge-pathnames (make-pathname :type type :case :common)
 		   (module-name module)))
 
+(defvar *done-one-off-output* nil
+  "A list of tokens for things which should appear at most once in output.")
+
+(export 'one-off-output)
+(defun one-off-output (token sequencer item-name function)
+  "Arrange to output a thing at most once.
+
+   If there has been no previous call to `one-off-output' with the given
+   TOKEN during this output run, then arrange to call FUNCTION when the item
+   called ITEM-NAME is traversed.  Otherwise do nothing."
+  (unless (member token *done-one-off-output*)
+    (push token *done-one-off-output*)
+    (add-sequencer-item-function sequencer item-name function)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Main output interface.
 
@@ -73,7 +87,8 @@
   "Write the MODULE to STREAM, giving the output machinery the REASON.
 
    This is the top-level interface for producing output."
-  (let ((sequencer (make-instance 'sequencer))
+  (let ((*done-one-off-output* nil)
+	(sequencer (make-instance 'sequencer))
 	(stream (if (typep stream 'position-aware-output-stream)
 		    stream
 		    (make-instance 'position-aware-output-stream
@@ -112,7 +127,7 @@
     (:prologue
      (:guard :start)
      (:typedefs :start) :typedefs (:typedefs :end)
-     (:includes :start) :includes (:includes :end)
+     (:includes :start) :includes :early-decls (:includes :end)
      (:early-user :start) :early-user (:early-user :end)
      (:classes :start) (:classes :end)
      (:user :start) :user (:user :end)
-- 
2.11.0

