* lib-src/make-docfile.c (struct global): New field 'flags'.
(DEFUN_noreturn, DEFUN_const): New enum bitfields.
(add_global): Now return pointer to global.
(write_globals): Add _Noreturn and ATTRIBUTE_CONST attributes
if requested by global's flags.
(stream_match): New function.
(scan_c_stream): Recognize 'attributes:' of DEFUN.
* src/callint.c (Finteractive):
* src/character.c (Fcharacterp, Fmax_char):
* src.data.c (Feq, Fnull, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp)
(Fstringp, Fchar_or_string_p, Fintegerp, Fnatnump, Fnumberp)
(Ffloatp, Fbyteorder):
* src/decompress.c (Fzlib_available_p):
* src/fns.c (Fidentity):
* src/frame.c (Fframe_windows_min_size):
* src/gnutls.c (Fgnutls_error_p, Fgnutls_available_p):
* src/window.c (Fwindow__sanitize_window_sizes):
* src/xdisp.c (Ftool_bar_height):
* src/xfaces.c (Fface_attribute_relative_p): Add const attribute.
* src/emacs.c (Fkill_emacs):
* src/eval.c (Fthrow):
* src/keyboard.c (Ftop_level, Fexit_recursive_edit)
(Fabor_recursive_edit): Add noreturn attribute.
+2015-01-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Support DEFUN attributes.
+ * make-docfile.c (struct global): New field 'flags'.
+ (DEFUN_noreturn, DEFUN_const): New enum bitfields.
+ (add_global): Now return pointer to global.
+ (write_globals): Add _Noreturn and ATTRIBUTE_CONST attributes
+ if requested by global's flags.
+ (stream_match): New function.
+ (scan_c_stream): Recognize 'attributes:' of DEFUN.
+
2015-01-10 Paul Eggert <eggert@cs.ucla.edu>
Port to 32-bit --with-wide-int
{
enum global_type type;
char *name;
+ int flags;
union
{
int value;
} v;
};
+/* Bit values for FLAGS field from the above. Applied for DEFUNs only. */
+enum { DEFUN_noreturn = 1, DEFUN_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. */
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
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 & DEFUN_noreturn)
fputs ("_Noreturn ", stdout);
printf ("EXFUN (%s, ", globals[i].name);
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 & DEFUN_const)
fputs (" ATTRIBUTE_CONST", stdout);
puts (";");
return scan_c_stream (infile);
}
+/* Return 1 if next input from INFILE is equal to P, -1 if EOF,
+ 0 if input doesn't match. */
+
+static int
+stream_match (FILE *infile, const char *p)
+{
+ for (; *p; p++)
+ {
+ int c = getc (infile);
+ if (c == EOF)
+ return -1;
+ if (c != *p)
+ return 0;
+ }
+ return 1;
+}
+
static int
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 function attributes
+ specified after the docstring, e.g.:
+
+ DEFUN ("foo", Ffoo, Sfoo, X, Y, Z,
+ doc: /\* doc *\/
+ attributes: attribute1 attribute2 ...)
+ (Lisp_Object arg...)
+
+ Now only 'noreturn' and 'const' attributes are used. */
+
+ /* Advance to the end of docstring. */
+ c = getc (infile);
+ if (c == EOF)
+ goto eof;
+ int d = getc (infile);
+ if (d == EOF)
+ goto eof;
+ while (1)
+ {
+ if (c == '*' && d == '/')
+ break;
+ c = d, d = getc (infile);
+ if (d == EOF)
+ goto eof;
+ }
+ /* Skip spaces, if any. */
+ do
+ {
+ c = getc (infile);
+ if (c == EOF)
+ goto eof;
+ }
+ while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
+ /* Check for 'attributes:' token. */
+ if (c == 'a' && stream_match (infile, "ttributes:"))
+ {
+ char *p = input_buffer;
+ /* Collect attributes up to ')'. */
+ while (1)
+ {
+ c = getc (infile);
+ if (c == EOF)
+ goto eof;
+ if (c == ')')
+ break;
+ if (p - input_buffer > sizeof (input_buffer))
+ abort ();
+ *p++ = c;
+ }
+ *p = 0;
+ if (strstr (input_buffer, "noreturn"))
+ g->flags |= DEFUN_noreturn;
+ if (strstr (input_buffer, "const"))
+ g->flags |= DEFUN_const;
+ }
continue;
}
+2015-01-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Add DEFUN attributes.
+ * callint.c (Finteractive):
+ * character.c (Fcharacterp, Fmax_char):
+ * data.c (Feq, Fnull, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp)
+ (Fstringp, Fchar_or_string_p, Fintegerp, Fnatnump, Fnumberp)
+ (Ffloatp, Fbyteorder):
+ * decompress.c (Fzlib_available_p):
+ * fns.c (Fidentity):
+ * frame.c (Fframe_windows_min_size):
+ * gnutls.c (Fgnutls_error_p, Fgnutls_available_p):
+ * window.c (Fwindow__sanitize_window_sizes):
+ * xdisp.c (Ftool_bar_height):
+ * xfaces.c (Fface_attribute_relative_p): Add const attribute.
+ * emacs.c (Fkill_emacs):
+ * eval.c (Fthrow):
+ * keyboard.c (Ftop_level, Fexit_recursive_edit)
+ (Fabor_recursive_edit): Add noreturn attribute.
+
2015-01-12 Paul Eggert <eggert@cs.ucla.edu>
Port to 32-bit MingGW --with-wide-int
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) */
+ attributes: const)
(Lisp_Object args)
{
return Qnil;
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) */
+ attributes: 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. */
+ attributes: const)
(void)
{
return make_number (MAX_CHAR);
/* Data type predicates. */
DEFUN ("eq", Feq, Seq, 2, 2, 0,
- doc: /* Return t if the two args are the same Lisp object. */)
+ doc: /* Return t if the two args are the same Lisp object. */
+ attributes: const)
(Lisp_Object obj1, Lisp_Object obj2)
{
if (EQ (obj1, obj2))
}
DEFUN ("null", Fnull, Snull, 1, 1, 0,
- doc: /* Return t if OBJECT is nil. */)
+ doc: /* Return t if OBJECT is nil. */
+ attributes: const)
(Lisp_Object object)
{
if (NILP (object))
}
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. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object))
}
DEFUN ("atom", Fatom, Satom, 1, 1, 0,
- doc: /* Return t if OBJECT is not a cons cell. This includes nil. */)
+ doc: /* Return t if OBJECT is not a cons cell. This includes nil. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object))
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. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object) || NILP (object))
}
DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
- doc: /* Return t if OBJECT is not a list. Lists include nil. */)
+ doc: /* Return t if OBJECT is not a list. Lists include nil. */
+ attributes: const)
(Lisp_Object object)
{
if (CONSP (object) || NILP (object))
}
\f
DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
- doc: /* Return t if OBJECT is a symbol. */)
+ doc: /* Return t if OBJECT is a symbol. */
+ attributes: const)
(Lisp_Object object)
{
if (SYMBOLP (object))
}
DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
- doc: /* Return t if OBJECT is a string. */)
+ doc: /* Return t if OBJECT is a string. */
+ attributes: const)
(Lisp_Object object)
{
if (STRINGP (object))
}
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. */
+ attributes: const)
(register Lisp_Object object)
{
if (CHARACTERP (object) || STRINGP (object))
}
\f
DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
- doc: /* Return t if OBJECT is an integer. */)
+ doc: /* Return t if OBJECT is an integer. */
+ attributes: const)
(Lisp_Object object)
{
if (INTEGERP (object))
}
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. */
+ attributes: const)
(Lisp_Object object)
{
if (NATNUMP (object))
}
DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
- doc: /* Return t if OBJECT is a number (floating point or integer). */)
+ doc: /* Return t if OBJECT is a number (floating point or integer). */
+ attributes: const)
(Lisp_Object object)
{
if (NUMBERP (object))
}
DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
- doc: /* Return t if OBJECT is a floating point number. */)
+ doc: /* Return t if OBJECT is a floating point number. */
+ attributes: const)
(Lisp_Object object)
{
if (FLOATP (object))
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. */
+ attributes: const)
(void)
{
unsigned i = 0x04030201;
}
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. */)
+ doc: /* Return t if zlib decompression is available in this instance of Emacs. */
+ attributes: const)
(void)
{
#ifdef WINDOWSNT
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. */
+ attributes: noreturn)
(Lisp_Object arg)
{
struct gcpro gcpro1;
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. */
+ attributes: noreturn)
(register Lisp_Object tag, Lisp_Object value)
{
struct handler *c;
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. */
+ attributes: const)
(Lisp_Object arg)
{
return arg;
/* 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: /* */
+ attributes: const)
(Lisp_Object frame, Lisp_Object horizontal,
Lisp_Object ignore, Lisp_Object pixelwise)
{
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) */
+ attributes: const)
(Lisp_Object err)
{
if (EQ (err, Qt)) return Qnil;
#endif /* HAVE_GNUTLS */
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. */)
+ doc: /* Return t if GnuTLS is available in this instance of Emacs. */
+ attributes: const)
(void)
{
#ifdef HAVE_GNUTLS
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. */
+ attributes: noreturn)
(void)
{
#ifdef HAVE_WINDOW_SYSTEM
/* _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. */)
+ doc: /* Exit from the innermost recursive edit or minibuffer. */
+ attributes: noreturn)
(void)
{
if (command_loop_level > 0 || minibuf_level > 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. */)
+ doc: /* Abort the command that requested this recursive edit or minibuffer input. */
+ attributes: noreturn)
(void)
{
if (command_loop_level > 0 || minibuf_level > 0)
/* 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: /* */
+ attributes: const)
(Lisp_Object frame, Lisp_Object horizontal)
{
return Qnil;
0, 2, 0,
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. */)
+PIXELWISE non-nil means return the height of the tool bar in pixels. */
+ attributes: const)
(Lisp_Object frame, Lisp_Object pixelwise)
{
int height = 0;
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. */)
+However, for :height, floating point values are also relative. */
+ attributes: const)
(Lisp_Object attribute, Lisp_Object value)
{
if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface)))
projects / emacs.git / commitdiff