Function attributes for make-docfile

[Dmitry Antipov <dmantipov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 318 bytes --]

The following patch helps make-docfile to generate _Noreturn and ATTRIBUTE_CONST
by looking at special comments found immediately after DEFUN declaration.  This
code works only for regular-form docstrings (doc: /* xxx */), so Flookup_image
is also fixed (the latter should be done anyway, IMO).  Any thoughts?

Dmitry

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: function_attributes.patch --]
[-- Type: text/x-diff; name="function_attributes.patch", Size: 17423 bytes --]

diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index bc5420e..dcc08ea 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -562,6 +562,7 @@ struct global
 {
   enum global_type type;
   char *name;
+  int flags;
   union
   {
     int value;
@@ -569,13 +570,16 @@ struct global
   } v;
 };
 
+/* Bit values for FLAGS field from the above.  */
+enum { NORETURN = 1, CONST = 2 };
+
 /* All the variable names we saw while scanning C sources in `-g'
    mode.  */
 int num_globals;
 int num_globals_allocated;
 struct global *globals;
 
-static void
+static struct global *
 add_global (enum global_type type, char *name, int value, char const *svalue)
 {
   /* Ignore the one non-symbol that can occur.  */
@@ -601,7 +605,10 @@ add_global (enum global_type type, char *name, int value, char const *svalue)
 	globals[num_globals - 1].v.svalue = svalue;
       else
 	globals[num_globals - 1].v.value = value;
+      globals[num_globals - 1].flags = 0;
+      return globals + num_globals - 1;
     }
+  return NULL;
 }
 
 static int
@@ -708,13 +715,7 @@ write_globals (void)
 		globals[i].name, globals[i].name, globals[i].name);
       else
 	{
-	  /* It would be nice to have a cleaner way to deal with these
-	     special hacks.  */
-	  if (strcmp (globals[i].name, "Fthrow") == 0
-	      || strcmp (globals[i].name, "Ftop_level") == 0
-	      || strcmp (globals[i].name, "Fkill_emacs") == 0
-	      || strcmp (globals[i].name, "Fexit_recursive_edit") == 0
-	      || strcmp (globals[i].name, "Fabort_recursive_edit") == 0)
+	  if (globals[i].flags & NORETURN)
 	    fputs ("_Noreturn ", stdout);
 
 	  printf ("EXFUN (%s, ", globals[i].name);
@@ -726,36 +727,7 @@ write_globals (void)
 	    printf ("%d", globals[i].v.value);
 	  putchar (')');
 
-	  /* It would be nice to have a cleaner way to deal with these
-	     special hacks, too.  */
-	  if (strcmp (globals[i].name, "Fatom") == 0
-	      || strcmp (globals[i].name, "Fbyteorder") == 0
-	      || strcmp (globals[i].name, "Fcharacterp") == 0
-	      || strcmp (globals[i].name, "Fchar_or_string_p") == 0
-	      || strcmp (globals[i].name, "Fconsp") == 0
-	      || strcmp (globals[i].name, "Feq") == 0
-	      || strcmp (globals[i].name, "Fface_attribute_relative_p") == 0
-	      || strcmp (globals[i].name, "Fframe_windows_min_size") == 0
-	      || strcmp (globals[i].name, "Fgnutls_errorp") == 0
-	      || strcmp (globals[i].name, "Fidentity") == 0
-	      || strcmp (globals[i].name, "Fintegerp") == 0
-	      || strcmp (globals[i].name, "Finteractive") == 0
-	      || strcmp (globals[i].name, "Ffloatp") == 0
-	      || strcmp (globals[i].name, "Flistp") == 0
-	      || strcmp (globals[i].name, "Fmax_char") == 0
-	      || strcmp (globals[i].name, "Fnatnump") == 0
-	      || strcmp (globals[i].name, "Fnlistp") == 0
-	      || strcmp (globals[i].name, "Fnull") == 0
-	      || strcmp (globals[i].name, "Fnumberp") == 0
-	      || strcmp (globals[i].name, "Fstringp") == 0
-	      || strcmp (globals[i].name, "Fsymbolp") == 0
-	      || strcmp (globals[i].name, "Ftool_bar_height") == 0
-	      || strcmp (globals[i].name, "Fwindow__sanitize_window_sizes") == 0
-#ifndef WINDOWSNT
-	      || strcmp (globals[i].name, "Fgnutls_available_p") == 0
-	      || strcmp (globals[i].name, "Fzlib_available_p") == 0
-#endif
-	      || 0)
+	  if (globals[i].flags & CONST)
 	    fputs (" ATTRIBUTE_CONST", stdout);
 
 	  puts (";");
@@ -1033,7 +1005,70 @@ scan_c_stream (FILE *infile)
 
       if (generate_globals)
 	{
-	  add_global (FUNCTION, name, maxargs, 0);
+	  struct global *g = add_global (FUNCTION, name, maxargs, 0);
+	  /* The following code tries to recognize SPECIAL-COMMENT in:
+
+	     DEFUN ("foo", Ffoo, Sfoo, X, Y, Z,
+	            doc: [docstring]) [SPECIAL-COMMENT]
+	       (Lisp_Object arg...)
+
+	     and use the latter to specify special attributes.
+	     Currently they are _Noreturn and ATTRIBUTE_CONST.  */
+	  c = getc (infile);
+	  if (c == EOF)
+	    goto eof;
+	  int d = getc (infile);
+	  if (d == EOF)
+	    goto eof;
+	  int e = getc (infile);
+	  if (e == EOF)
+	    goto eof;
+	  while (1)
+	    {
+	      if (c == '*' && d == '/' && e == ')')
+		break;
+	      c = d, d = e, e = getc (infile);
+	      if (e == EOF)
+		goto eof;
+	    }
+	  /* Found '*' '/' ')'.  */
+	  do
+	    {
+	      c = getc (infile);
+	      if (c == EOF)
+		goto eof;
+	    }
+	  while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
+	  /* Spaces are skipped.  */
+	  if (c == '/')
+	    {
+	      int d = getc (infile);
+	      if (d == EOF)
+		goto eof;
+	      if (d == '*')
+		{
+		  /* Found start of the comment.  */
+		  char *p = input_buffer;
+		  *p++ = '/', *p++ = '*';
+		  while (1)
+		    {
+		      if (c == '*' && d == '/')
+			break;
+		      c = d, d = getc (infile);
+		      if (d == EOF)
+			goto eof;
+		      *p++ = d;
+		      if (p - input_buffer > sizeof (input_buffer))
+			abort ();
+		    }
+		  *p++ = '\0';
+		  /* The comment is a string in an input buffer.  */
+		  if (strstr (input_buffer, "NORETURN"))
+		    g->flags |= NORETURN;
+		  if (strstr (input_buffer, "CONST"))
+		    g->flags |= CONST;
+		}
+	    }
 	  continue;
 	}
 
diff --git a/src/callint.c b/src/callint.c
index 2595503..b6514df 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -101,7 +101,7 @@ If the string begins with `^' and `shift-select-mode' is non-nil,
  Emacs first calls the function `handle-shift-selection'.
 You may use `@', `*', and `^' together.  They are processed in the
  order that they appear, before reading any arguments.
-usage: (interactive &optional ARGS)  */)
+usage: (interactive &optional ARGS)  */) /* CONST */
   (Lisp_Object args)
 {
   return Qnil;
diff --git a/src/character.c b/src/character.c
index 4a5c7ec..f4c9ea4 100644
--- a/src/character.c
+++ b/src/character.c
@@ -232,14 +232,14 @@ DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0,
 In Emacs Lisp, characters are represented by character codes, which
 are non-negative integers.  The function `max-char' returns the
 maximum character code.
-usage: (characterp OBJECT)  */)
+usage: (characterp OBJECT)  */) /* CONST */
   (Lisp_Object object, Lisp_Object ignore)
 {
   return (CHARACTERP (object) ? Qt : Qnil);
 }
 
 DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0,
-       doc: /* Return the character of the maximum code.  */)
+       doc: /* Return the character of the maximum code.  */) /* CONST */
   (void)
 {
   return make_number (MAX_CHAR);
diff --git a/src/data.c b/src/data.c
index 820c3ce..2f35b56 100644
--- a/src/data.c
+++ b/src/data.c
@@ -177,6 +177,7 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
 
 DEFUN ("eq", Feq, Seq, 2, 2, 0,
        doc: /* Return t if the two args are the same Lisp object.  */)
+/* CONST */
   (Lisp_Object obj1, Lisp_Object obj2)
 {
   if (EQ (obj1, obj2))
@@ -185,7 +186,7 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,
-       doc: /* Return t if OBJECT is nil.  */)
+       doc: /* Return t if OBJECT is nil.  */) /* CONST */
   (Lisp_Object object)
 {
   if (NILP (object))
@@ -263,7 +264,7 @@ for example, (type-of 1) returns `integer'.  */)
 }
 
 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a cons cell.  */)
+       doc: /* Return t if OBJECT is a cons cell.  */) /* CONST */
   (Lisp_Object object)
 {
   if (CONSP (object))
@@ -273,6 +274,7 @@ DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
 
 DEFUN ("atom", Fatom, Satom, 1, 1, 0,
        doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */)
+/* CONST */
   (Lisp_Object object)
 {
   if (CONSP (object))
@@ -282,7 +284,7 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0,
 
 DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
        doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
-Otherwise, return nil.  */)
+Otherwise, return nil.  */) /* CONST */
   (Lisp_Object object)
 {
   if (CONSP (object) || NILP (object))
@@ -292,6 +294,7 @@ Otherwise, return nil.  */)
 
 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
        doc: /* Return t if OBJECT is not a list.  Lists include nil.  */)
+/* CONST */
   (Lisp_Object object)
 {
   if (CONSP (object) || NILP (object))
@@ -300,7 +303,7 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
 }
 \f
 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a symbol.  */)
+       doc: /* Return t if OBJECT is a symbol.  */) /* CONST */
   (Lisp_Object object)
 {
   if (SYMBOLP (object))
@@ -333,7 +336,7 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
 }
 
 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a string.  */)
+       doc: /* Return t if OBJECT is a string.  */) /* CONST */
   (Lisp_Object object)
 {
   if (STRINGP (object))
@@ -436,7 +439,7 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
 }
 
 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
-       doc: /* Return t if OBJECT is a character or a string.  */)
+       doc: /* Return t if OBJECT is a character or a string.  */) /* CONST */
   (register Lisp_Object object)
 {
   if (CHARACTERP (object) || STRINGP (object))
@@ -445,7 +448,7 @@ DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
 }
 \f
 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
-       doc: /* Return t if OBJECT is an integer.  */)
+       doc: /* Return t if OBJECT is an integer.  */) /* CONST */
   (Lisp_Object object)
 {
   if (INTEGERP (object))
@@ -463,7 +466,7 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1,
 }
 
 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
-       doc: /* Return t if OBJECT is a nonnegative integer.  */)
+       doc: /* Return t if OBJECT is a nonnegative integer.  */) /* CONST */
   (Lisp_Object object)
 {
   if (NATNUMP (object))
@@ -473,6 +476,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
 
 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
        doc: /* Return t if OBJECT is a number (floating point or integer).  */)
+/* CONST */
   (Lisp_Object object)
 {
   if (NUMBERP (object))
@@ -493,6 +497,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
 
 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
        doc: /* Return t if OBJECT is a floating point number.  */)
+/* CONST */
   (Lisp_Object object)
 {
   if (FLOATP (object))
@@ -2954,7 +2959,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
 DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
        doc: /* Return the byteorder for the machine.
 Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
-lowercase l) for small endian machines.  */)
+lowercase l) for small endian machines.  */) /* CONST */
   (void)
 {
   unsigned i = 0x04030201;
diff --git a/src/decompress.c b/src/decompress.c
index b14f0a2..1dfd815 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -89,6 +89,7 @@ unwind_decompress (void *ddata)
 
 DEFUN ("zlib-available-p", Fzlib_available_p, Szlib_available_p, 0, 0, 0,
        doc: /* Return t if zlib decompression is available in this instance of Emacs.  */)
+/* CONST */
      (void)
 {
 #ifdef WINDOWSNT
diff --git a/src/emacs.c b/src/emacs.c
index d09c3c3..cef3632 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1892,7 +1892,7 @@ or SIGHUP, and upon SIGINT in batch mode.
 
 The value of `kill-emacs-hook', if not void,
 is a list of functions (of no args),
-all of which are called before Emacs is actually killed.  */)
+all of which are called before Emacs is actually killed.  */) /* NORETURN */
   (Lisp_Object arg)
 {
   struct gcpro gcpro1;
diff --git a/src/eval.c b/src/eval.c
index 7e4b016..02964e3 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1162,7 +1162,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
 
 DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
        doc: /* Throw to the catch for TAG and return VALUE from it.
-Both TAG and VALUE are evalled.  */)
+Both TAG and VALUE are evalled.  */) /* NORETURN */
   (register Lisp_Object tag, Lisp_Object value)
 {
   struct handler *c;
diff --git a/src/fns.c b/src/fns.c
index 7739663..94538d8 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -46,7 +46,7 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
 static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object);
 
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
-       doc: /* Return the argument unchanged.  */)
+       doc: /* Return the argument unchanged.  */) /* CONST */
   (Lisp_Object arg)
 {
   return arg;
diff --git a/src/frame.c b/src/frame.c
index 3d2ffbf..69aa096 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -267,7 +267,7 @@ predicates which report frame's specific UI-related capabilities.  */)
 /* Placeholder used by temacs -nw before window.el is loaded.  */
 DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
        Sframe_windows_min_size, 4, 4, 0,
-       doc: /* */)
+       doc: /* */) /* CONST */
      (Lisp_Object frame, Lisp_Object horizontal,
       Lisp_Object ignore, Lisp_Object pixelwise)
 {
diff --git a/src/gnutls.c b/src/gnutls.c
index 75fe614..b385bca 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -695,7 +695,7 @@ See also `gnutls-boot'.  */)
 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
        doc: /* Return t if ERROR indicates a GnuTLS problem.
 ERROR is an integer or a symbol with an integer `gnutls-code' property.
-usage: (gnutls-errorp ERROR)  */)
+usage: (gnutls-errorp ERROR)  */) /* CONST */
   (Lisp_Object err)
 {
   if (EQ (err, Qt)) return Qnil;
@@ -1604,6 +1604,7 @@ This function may also return `gnutls-e-again', or
 
 DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
        doc: /* Return t if GnuTLS is available in this instance of Emacs.  */)
+/* CONST */
      (void)
 {
 #ifdef HAVE_GNUTLS
diff --git a/src/image.c b/src/image.c
index 5d08a89..9c09c55 100644
--- a/src/image.c
+++ b/src/image.c
@@ -9288,7 +9288,8 @@ DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
 }
 
 
-DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
+DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0,
+       doc: /* */)
   (Lisp_Object spec)
 {
   ptrdiff_t id = -1;
diff --git a/src/keyboard.c b/src/keyboard.c
index 5411aff..c04bbda 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1163,7 +1163,7 @@ top_level_1 (Lisp_Object ignore)
 
 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
        doc: /* Exit all recursive editing levels.
-This also exits all active minibuffers.  */)
+This also exits all active minibuffers.  */) /* NORETURN */
   (void)
 {
 #ifdef HAVE_WINDOW_SYSTEM
@@ -1187,6 +1187,7 @@ user_error (const char *msg)
 /* _Noreturn will be added to prototype by make-docfile.  */
 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
        doc: /* Exit from the innermost recursive edit or minibuffer.  */)
+/* NORETURN */
   (void)
 {
   if (command_loop_level > 0 || minibuf_level > 0)
@@ -1198,6 +1199,7 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0,
 /* _Noreturn will be added to prototype by make-docfile.  */
 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
        doc: /* Abort the command that requested this recursive edit or minibuffer input.  */)
+/* NORETURN */
   (void)
 {
   if (command_loop_level > 0 || minibuf_level > 0)
diff --git a/src/window.c b/src/window.c
index 1d2221f..af03300 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3000,7 +3000,7 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizonta
 /* Placeholder used by temacs -nw before window.el is loaded.  */
 DEFUN ("window--sanitize-window-sizes", Fwindow__sanitize_window_sizes,
        Swindow__sanitize_window_sizes, 2, 2, 0,
-       doc: /* */)
+       doc: /* */) /* CONST */
      (Lisp_Object frame, Lisp_Object horizontal)
 {
   return Qnil;
diff --git a/src/xdisp.c b/src/xdisp.c
index 31702ed..7373501 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -12277,6 +12277,7 @@ DEFUN ("tool-bar-height", Ftool_bar_height, Stool_bar_height,
        doc: /* Return the number of lines occupied by the tool bar of FRAME.
 If FRAME is nil or omitted, use the selected frame.  Optional argument
 PIXELWISE non-nil means return the height of the tool bar in pixels.  */)
+/* CONST */
   (Lisp_Object frame, Lisp_Object pixelwise)
 {
   int height = 0;
diff --git a/src/xfaces.c b/src/xfaces.c
index 6ecd857..4077702 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3547,6 +3547,7 @@ A relative value is one that doesn't entirely override whatever is
 inherited from another face.  For most possible attributes,
 the only relative value that users see is `unspecified'.
 However, for :height, floating point values are also relative.  */)
+/* CONST */
   (Lisp_Object attribute, Lisp_Object value)
 {
   if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface)))