diff options
| -rw-r--r-- | lib-src/ChangeLog | 11 | ||||
| -rw-r--r-- | lib-src/make-docfile.c | 123 | ||||
| -rw-r--r-- | src/ChangeLog | 20 | ||||
| -rw-r--r-- | src/callint.c | 3 | ||||
| -rw-r--r-- | src/character.c | 6 | ||||
| -rw-r--r-- | src/data.c | 42 | ||||
| -rw-r--r-- | src/decompress.c | 3 | ||||
| -rw-r--r-- | src/emacs.c | 3 | ||||
| -rw-r--r-- | src/eval.c | 3 | ||||
| -rw-r--r-- | src/fns.c | 3 | ||||
| -rw-r--r-- | src/frame.c | 3 | ||||
| -rw-r--r-- | src/gnutls.c | 6 | ||||
| -rw-r--r-- | src/keyboard.c | 9 | ||||
| -rw-r--r-- | src/window.c | 3 | ||||
| -rw-r--r-- | src/xdisp.c | 3 | ||||
| -rw-r--r-- | src/xfaces.c | 3 |
16 files changed, 175 insertions, 69 deletions
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 740359605f..969aac8012 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,14 @@ +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 diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index bc5420ea93..79d421a0a8 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. 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. */ @@ -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 & DEFUN_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 & DEFUN_const) fputs (" ATTRIBUTE_CONST", stdout); puts (";"); @@ -817,6 +789,23 @@ scan_c_file (char *filename, const char *mode) 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) { @@ -1033,7 +1022,63 @@ 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; } diff --git a/src/ChangeLog b/src/ChangeLog index 252dfd3362..792407e15e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +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 diff --git a/src/callint.c b/src/callint.c index 25955039ac..dd238b976a 100644 --- a/src/callint.c +++ b/src/callint.c @@ -101,7 +101,8 @@ 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) */ + attributes: const) (Lisp_Object args) { return Qnil; diff --git a/src/character.c b/src/character.c index 4a5c7ec315..39d32c9d41 100644 --- a/src/character.c +++ b/src/character.c @@ -232,14 +232,16 @@ 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) */ + 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); diff --git a/src/data.c b/src/data.c index 820c3ce840..0389eb49b0 100644 --- a/src/data.c +++ b/src/data.c @@ -176,7 +176,8 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) /* 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)) @@ -185,7 +186,8 @@ 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. */ + attributes: const) (Lisp_Object object) { if (NILP (object)) @@ -263,7 +265,8 @@ 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. */ + attributes: const) (Lisp_Object object) { if (CONSP (object)) @@ -272,7 +275,8 @@ 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. */) + doc: /* Return t if OBJECT is not a cons cell. This includes nil. */ + attributes: const) (Lisp_Object object) { if (CONSP (object)) @@ -282,7 +286,8 @@ 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. */ + attributes: const) (Lisp_Object object) { if (CONSP (object) || NILP (object)) @@ -291,7 +296,8 @@ Otherwise, return nil. */) } 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)) @@ -300,7 +306,8 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, } 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)) @@ -333,7 +340,8 @@ 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. */ + attributes: const) (Lisp_Object object) { if (STRINGP (object)) @@ -436,7 +444,8 @@ 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. */ + attributes: const) (register Lisp_Object object) { if (CHARACTERP (object) || STRINGP (object)) @@ -445,7 +454,8 @@ DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, } 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)) @@ -463,7 +473,8 @@ 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. */ + attributes: const) (Lisp_Object object) { if (NATNUMP (object)) @@ -472,7 +483,8 @@ 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). */) + doc: /* Return t if OBJECT is a number (floating point or integer). */ + attributes: const) (Lisp_Object object) { if (NUMBERP (object)) @@ -492,7 +504,8 @@ 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. */) + doc: /* Return t if OBJECT is a floating point number. */ + attributes: const) (Lisp_Object object) { if (FLOATP (object)) @@ -2954,7 +2967,8 @@ 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. */ + attributes: const) (void) { unsigned i = 0x04030201; diff --git a/src/decompress.c b/src/decompress.c index b14f0a2cd7..b78dacee20 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -88,7 +88,8 @@ 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. */) + doc: /* Return t if zlib decompression is available in this instance of Emacs. */ + attributes: const) (void) { #ifdef WINDOWSNT diff --git a/src/emacs.c b/src/emacs.c index d09c3c36c8..ca1a8b26d8 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1892,7 +1892,8 @@ 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. */ + attributes: noreturn) (Lisp_Object arg) { struct gcpro gcpro1; diff --git a/src/eval.c b/src/eval.c index 7e4b016b23..5cadb1bc2d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1162,7 +1162,8 @@ 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. */ + attributes: noreturn) (register Lisp_Object tag, Lisp_Object value) { struct handler *c; @@ -46,7 +46,8 @@ 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. */ + attributes: const) (Lisp_Object arg) { return arg; diff --git a/src/frame.c b/src/frame.c index 0eb51bd786..f138db9cec 100644 --- a/src/frame.c +++ b/src/frame.c @@ -270,7 +270,8 @@ 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: /* */ + attributes: const) (Lisp_Object frame, Lisp_Object horizontal, Lisp_Object ignore, Lisp_Object pixelwise) { diff --git a/src/gnutls.c b/src/gnutls.c index 75fe6149a5..5e6c6353b4 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -695,7 +695,8 @@ 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) */ + attributes: const) (Lisp_Object err) { if (EQ (err, Qt)) return Qnil; @@ -1603,7 +1604,8 @@ This function may also return `gnutls-e-again', or #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 diff --git a/src/keyboard.c b/src/keyboard.c index 9d6eb07a18..0fe2ffc53f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1163,7 +1163,8 @@ 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. */ + attributes: noreturn) (void) { #ifdef HAVE_WINDOW_SYSTEM @@ -1186,7 +1187,8 @@ 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. */) + doc: /* Exit from the innermost recursive edit or minibuffer. */ + attributes: noreturn) (void) { if (command_loop_level > 0 || minibuf_level > 0) @@ -1197,7 +1199,8 @@ 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. */) + doc: /* Abort the command that requested this recursive edit or minibuffer input. */ + attributes: noreturn) (void) { if (command_loop_level > 0 || minibuf_level > 0) diff --git a/src/window.c b/src/window.c index 5ae95f27d6..e5ddef5fa4 100644 --- a/src/window.c +++ b/src/window.c @@ -3000,7 +3000,8 @@ 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: /* */ + attributes: const) (Lisp_Object frame, Lisp_Object horizontal) { return Qnil; diff --git a/src/xdisp.c b/src/xdisp.c index f006f8e0b9..041a022a37 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12276,7 +12276,8 @@ DEFUN ("tool-bar-height", Ftool_bar_height, Stool_bar_height, 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; diff --git a/src/xfaces.c b/src/xfaces.c index 6ecd857d68..85af770c6a 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3546,7 +3546,8 @@ with the value VALUE is relative. 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))) |