Improve checking for C99-style varargs macros.

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.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 59df7630053a26128effe370db06565c84f539bc..2c33ad0ae2a6a7f41c7be3bd4b9e3299f8ab784a 100644 (file)
--- 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 cac9b01ca8dfd044a8e543faa4e41d439a49b821..6153dec067100301787e616cabd2a5347b72217f 100644 (file)
--- 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 dc85843d4fee58c1fa1f629749f80ae61e232f63..360afa83907a9c1b4e2eccae023308eefdb9f633 100644 (file)
--- 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 b47f6ba2d6b1e34247ebf635da6e922aa8d27041..b2d1ec8a7cde94a0bcca95133ff03695d7c66efe 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -139,6 +139,11 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
   ;; 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 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
                        (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 a0ca42d5423612a11b317b353c27d3dd5b003d13..1bfb34fb92926b65a0c905d224671b08d1d6e0c8 100644 (file)
--- a/src/module-output.lisp
+++ b/src/module-output.lisp
@@ -65,6 +65,20 @@ (defun guess-output-file (module type)
   (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 @@ (defun output-module (module reason stream)
   "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 @@ (defmethod hook-output progn ((module module) (reason (eql :h)) sequencer)
     (: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)