summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/lispref/strings.texi13
-rw-r--r--lisp/desktop.el4
-rw-r--r--lisp/linum.el11
-rw-r--r--lisp/progmodes/elisp-mode.el2
-rw-r--r--src/data.c10
-rw-r--r--src/dynlib.c34
-rw-r--r--src/dynlib.h16
-rw-r--r--src/editfns.c154
-rw-r--r--src/emacs-module.c162
-rw-r--r--src/emacs-module.h3
-rw-r--r--src/eval.c7
-rw-r--r--src/lisp.h16
-rw-r--r--src/print.c30
-rw-r--r--test/Makefile.in2
-rw-r--r--test/src/emacs-module-tests.el4
15 files changed, 250 insertions, 218 deletions
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index f365c80493d..23961f99efd 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -926,7 +926,8 @@ digit.
@item %%
Replace the specification with a single @samp{%}. This format
-specification is unusual in that it does not use a value. For example,
+specification is unusual in that its only form is plain
+@samp{%%} and that it does not use a value. For example,
@code{(format "%% %d" 30)} returns @code{"% 30"}.
@end table
@@ -965,10 +966,9 @@ extra values to be formatted are ignored.
decimal number immediately after the initial @samp{%}, followed by a
literal dollar sign @samp{$}. It causes the format specification to
convert the argument with the given number instead of the next
-argument. Field numbers start at 1. A field number should differ
-from the other field numbers in the same format. A format can contain
-either numbered or unnumbered format specifications but not both,
-except that @samp{%%} can be mixed with numbered specifications.
+argument. Field numbers start at 1. A format can contain either
+numbered or unnumbered format specifications but not both, except that
+@samp{%%} can be mixed with numbered specifications.
@example
(format "%2$s, %3$s, %%, %1$s" "x" "y" "z")
@@ -1026,8 +1026,7 @@ ignored.
A specification can have a @dfn{width}, which is a decimal number
that appears after any field number and flags. If the printed
representation of the object contains fewer characters than this
-width, @code{format} extends it with padding. The width is
-ignored for the @samp{%%} specification. Any padding introduced by
+width, @code{format} extends it with padding. Any padding introduced by
the width normally consists of spaces inserted on the left:
@example
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 39dc92fabe2..540d0e3b11d 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -733,6 +733,10 @@ if different)."
(condition-case err
(unless (or (eq frame this)
(eq frame mini)
+ ;; Don't delete daemon's initial frame, or
+ ;; we'll never be able to close the last
+ ;; client's frame (Bug#26912).
+ (if (daemonp) (not (frame-parameter frame 'client)))
(frame-parameter frame 'desktop-dont-clear))
(delete-frame frame))
(error
diff --git a/lisp/linum.el b/lisp/linum.el
index 8baa263f0b3..9cfb94dab68 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -112,7 +112,16 @@ Linum mode is a buffer-local minor mode."
(define-globalized-minor-mode global-linum-mode linum-mode linum-on)
(defun linum-on ()
- (unless (minibufferp)
+ (unless (or (minibufferp)
+ ;; Turning linum-mode in the daemon's initial frame
+ ;; could significantly slow down startup, if the buffer
+ ;; in which this is done is large, because Emacs thinks
+ ;; the "window" spans the entire buffer then. This
+ ;; could happen when restoring session via desktop.el,
+ ;; if some large buffer was under linum-mode when
+ ;; desktop was saved. So we disable linum-mode for
+ ;; non-client frames in a daemon session.
+ (and (daemonp) (null (frame-parameter nil 'client))))
(linum-mode 1)))
(defun linum-delete-overlays ()
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 6c6fb925040..b3f452ca5b9 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1372,7 +1372,7 @@ or elsewhere, return a 1-line docstring."
(condition-case nil (documentation sym t)
(invalid-function nil))
sym))
- (car doc))
+ (substitute-command-keys (car doc)))
(t (help-function-arglist sym)))))
;; Stringify, and store before highlighting, downcasing, etc.
(elisp--last-data-store sym (elisp-function-argstring args)
diff --git a/src/data.c b/src/data.c
index 25859105ee0..e4e55290e62 100644
--- a/src/data.c
+++ b/src/data.c
@@ -700,12 +700,10 @@ global value outside of any lexical scope. */)
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
}
-/* FIXME: It has been previously suggested to make this function an
- alias for symbol-function, but upon discussion at Bug#23957,
- there is a risk breaking backward compatibility, as some users of
- fboundp may expect `t' in particular, rather than any true
- value. An alias is still welcome so long as the compatibility
- issues are addressed. */
+/* It has been previously suggested to make this function an alias for
+ symbol-function, but upon discussion at Bug#23957, there is a risk
+ breaking backward compatibility, as some users of fboundp may
+ expect `t' in particular, rather than any true value. */
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's function definition is not void. */)
(register Lisp_Object symbol)
diff --git a/src/dynlib.c b/src/dynlib.c
index 95619236d43..79e98b0f288 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -28,6 +28,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dynlib.h"
+#include <stddef.h>
+
#ifdef WINDOWSNT
/* MS-Windows systems. */
@@ -120,7 +122,7 @@ dynlib_sym (dynlib_handle_ptr h, const char *sym)
return (void *)sym_addr;
}
-bool
+void
dynlib_addr (void *addr, const char **fname, const char **symname)
{
static char dll_filename[MAX_UTF8_PATH];
@@ -128,7 +130,6 @@ dynlib_addr (void *addr, const char **fname, const char **symname)
static GetModuleHandleExA_Proc s_pfn_Get_Module_HandleExA = NULL;
char *dll_fn = NULL;
HMODULE hm_kernel32 = NULL;
- bool result = false;
HMODULE hm_dll = NULL;
wchar_t mfn_w[MAX_PATH];
char mfn_a[MAX_PATH];
@@ -206,23 +207,18 @@ dynlib_addr (void *addr, const char **fname, const char **symname)
dynlib_last_err = GetLastError ();
}
if (dll_fn)
- {
- dostounix_filename (dll_fn);
- /* We cannot easily produce the function name, since
- typically all of the module functions will be unexported,
- and probably even static, which means the symbols can be
- obtained only if we link against libbfd (and the DLL can
- be stripped anyway). So we just show the address and the
- file name; they can use that with addr2line or GDB to
- recover the symbolic name. */
- sprintf (addr_str, "at 0x%x", (DWORD_PTR)addr);
- *symname = addr_str;
- result = true;
- }
+ dostounix_filename (dll_fn);
}
*fname = dll_fn;
- return result;
+
+ /* We cannot easily produce the function name, since typically all
+ of the module functions will be unexported, and probably even
+ static, which means the symbols can be obtained only if we link
+ against libbfd (and the DLL can be stripped anyway). So we just
+ show the address and the file name; they can use that with
+ addr2line or GDB to recover the symbolic name. */
+ *symname = NULL;
}
const char *
@@ -283,19 +279,19 @@ dynlib_sym (dynlib_handle_ptr h, const char *sym)
return dlsym (h, sym);
}
-bool
+void
dynlib_addr (void *ptr, const char **path, const char **sym)
{
+ *path = NULL;
+ *sym = NULL;
#ifdef HAVE_DLADDR
Dl_info info;
if (dladdr (ptr, &info) && info.dli_fname && info.dli_sname)
{
*path = info.dli_fname;
*sym = info.dli_sname;
- return true;
}
#endif
- return false;
}
const char *
diff --git a/src/dynlib.h b/src/dynlib.h
index 5ccec11bc79..1d53b8e5b2f 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -24,11 +24,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
typedef void *dynlib_handle_ptr;
dynlib_handle_ptr dynlib_open (const char *path);
-void *dynlib_sym (dynlib_handle_ptr h, const char *sym);
-typedef struct dynlib_function_ptr_nonce *(*dynlib_function_ptr) (void);
-dynlib_function_ptr dynlib_func (dynlib_handle_ptr h, const char *sym);
-bool dynlib_addr (void *ptr, const char **path, const char **sym);
-const char *dynlib_error (void);
int dynlib_close (dynlib_handle_ptr h);
+const char *dynlib_error (void);
+
+ATTRIBUTE_MAY_ALIAS void *dynlib_sym (dynlib_handle_ptr h, const char *sym);
+
+typedef struct dynlib_function_ptr_nonce *(ATTRIBUTE_MAY_ALIAS *dynlib_function_ptr) (void);
+dynlib_function_ptr dynlib_func (dynlib_handle_ptr h, const char *sym);
+
+/* Sets *FILE to the file name from which PTR was loaded, and *SYM to
+ its symbol name. If the file or symbol name could not be
+ determined, set the corresponding argument to NULL. */
+void dynlib_addr (void *ptr, const char **file, const char **sym);
#endif /* DYNLIB_H */
diff --git a/src/editfns.c b/src/editfns.c
index 56aa8ce1a72..43b17f9f116 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3891,8 +3891,8 @@ the next available argument, or the argument explicitly specified:
The argument used for %d, %o, %x, %e, %f, %g or %c must be a number.
Use %% to put a single % into the output.
-A %-sequence may contain optional field number, flag, width, and
-precision specifiers, as follows:
+A %-sequence other than %% may contain optional field number, flag,
+width, and precision specifiers, as follows:
%<field><flags><width><precision>character
@@ -3901,10 +3901,9 @@ where field is [0-9]+ followed by a literal dollar "$", flags is
followed by [0-9]+.
If a %-sequence is numbered with a field with positive value N, the
-Nth argument is substituted instead of the next one. A field number
-should differ from the other field numbers in the same format. A
-format can contain either numbered or unnumbered %-sequences but not
-both, except that %% can be mixed with numbered %-sequences.
+Nth argument is substituted instead of the next one. A format can
+contain either numbered or unnumbered %-sequences but not both, except
+that %% can be mixed with numbered %-sequences.
The + flag character inserts a + before any positive number, while a
space inserts a space before any positive number; these flags only
@@ -3980,49 +3979,40 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
bool arg_intervals = false;
USE_SAFE_ALLOCA;
- /* Each element records, for one field,
- the corresponding argument,
- the start and end bytepos in the output string,
- whether the argument has been converted to string (e.g., due to "%S"),
- and whether the argument is a string with intervals. */
+ /* Information recorded for each format spec. */
struct info
{
+ /* The corresponding argument, converted to string if conversion
+ was needed. */
Lisp_Object argument;
+
+ /* The start and end bytepos in the output string. */
ptrdiff_t start, end;
- bool_bf converted_to_string : 1;
+
+ /* Whether the argument is a string with intervals. */
bool_bf intervals : 1;
} *info;
CHECK_STRING (args[0]);
char *format_start = SSDATA (args[0]);
+ bool multibyte_format = STRING_MULTIBYTE (args[0]);
ptrdiff_t formatlen = SBYTES (args[0]);
- /* The number of percent characters is a safe upper bound for the
- number of format fields. */
- ptrdiff_t num_percent = 0;
- for (ptrdiff_t i = 0; i < formatlen; ++i)
- if (format_start[i] == '%')
- ++num_percent;
+ /* Upper bound on number of format specs. Each uses at least 2 chars. */
+ ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1;
/* Allocate the info and discarded tables. */
ptrdiff_t alloca_size;
- if (INT_MULTIPLY_WRAPV (num_percent, sizeof *info, &alloca_size)
- || INT_ADD_WRAPV (sizeof *info, alloca_size, &alloca_size)
+ if (INT_MULTIPLY_WRAPV (nspec_bound, sizeof *info, &alloca_size)
|| INT_ADD_WRAPV (formatlen, alloca_size, &alloca_size)
|| SIZE_MAX < alloca_size)
memory_full (SIZE_MAX);
- /* info[0] is unused. Unused elements have -1 for start. */
info = SAFE_ALLOCA (alloca_size);
- memset (info, 0, alloca_size);
- for (ptrdiff_t i = 0; i < num_percent + 1; i++)
- {
- info[i].argument = Qunbound;
- info[i].start = -1;
- }
/* discarded[I] is 1 if byte I of the format
string was not copied into the output.
It is 2 if byte I was not the first byte of its character. */
- char *discarded = (char *) &info[num_percent + 1];
+ char *discarded = (char *) &info[nspec_bound];
+ memset (discarded, 0, formatlen);
/* Try to determine whether the result should be multibyte.
This is not always right; sometimes the result needs to be multibyte
@@ -4030,8 +4020,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
or because a grave accent or apostrophe is requoted,
and in that case, we won't know it here. */
- /* True if the format is multibyte. */
- bool multibyte_format = STRING_MULTIBYTE (args[0]);
/* True if the output should be a multibyte string,
which is true if any of the inputs is one. */
bool multibyte = multibyte_format;
@@ -4042,6 +4030,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
int quoting_style = message ? text_quoting_style () : -1;
ptrdiff_t ispec;
+ ptrdiff_t nspec = 0;
/* If we start out planning a unibyte result,
then discover it has to be multibyte, we jump back to retry. */
@@ -4155,11 +4144,14 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (! (n < nargs))
error ("Not enough arguments for format string");
- eassert (ispec < num_percent);
- ++ispec;
-
- if (EQ (info[ispec].argument, Qunbound))
- info[ispec].argument = args[n];
+ struct info *spec = &info[ispec++];
+ if (nspec < ispec)
+ {
+ spec->argument = args[n];
+ spec->intervals = false;
+ nspec = ispec;
+ }
+ Lisp_Object arg = spec->argument;
/* For 'S', prin1 the argument, and then treat like 's'.
For 's', princ any argument that is not a string or
@@ -4167,16 +4159,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
happen after retrying. */
if ((conversion == 'S'
|| (conversion == 's'
- && ! STRINGP (info[ispec].argument)
- && ! SYMBOLP (info[ispec].argument))))
+ && ! STRINGP (arg) && ! SYMBOLP (arg))))
{
- if (! info[ispec].converted_to_string)
+ if (EQ (arg, args[n]))
{
Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
- info[ispec].argument =
- Fprin1_to_string (info[ispec].argument, noescape);
- info[ispec].converted_to_string = true;
- if (STRING_MULTIBYTE (info[ispec].argument) && ! multibyte)
+ spec->argument = arg = Fprin1_to_string (arg, noescape);
+ if (STRING_MULTIBYTE (arg) && ! multibyte)
{
multibyte = true;
goto retry;
@@ -4186,29 +4175,25 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
else if (conversion == 'c')
{
- if (INTEGERP (info[ispec].argument)
- && ! ASCII_CHAR_P (XINT (info[ispec].argument)))
+ if (INTEGERP (arg) && ! ASCII_CHAR_P (XINT (arg)))
{
if (!multibyte)
{
multibyte = true;
goto retry;
}
- info[ispec].argument =
- Fchar_to_string (info[ispec].argument);
- info[ispec].converted_to_string = true;
+ spec->argument = arg = Fchar_to_string (arg);
}
- if (info[ispec].converted_to_string)
+ if (!EQ (arg, args[n]))
conversion = 's';
zero_flag = false;
}
- if (SYMBOLP (info[ispec].argument))
+ if (SYMBOLP (arg))
{
- info[ispec].argument =
- SYMBOL_NAME (info[ispec].argument);
- if (STRING_MULTIBYTE (info[ispec].argument) && ! multibyte)
+ spec->argument = arg = SYMBOL_NAME (arg);
+ if (STRING_MULTIBYTE (arg) && ! multibyte)
{
multibyte = true;
goto retry;
@@ -4239,12 +4224,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
else
{
ptrdiff_t nch, nby;
- width = lisp_string_width (info[ispec].argument,
- prec, &nch, &nby);
+ width = lisp_string_width (arg, prec, &nch, &nby);
if (prec < 0)
{
- nchars_string = SCHARS (info[ispec].argument);
- nbytes = SBYTES (info[ispec].argument);
+ nchars_string = SCHARS (arg);
+ nbytes = SBYTES (arg);
}
else
{
@@ -4254,11 +4238,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
convbytes = nbytes;
- if (convbytes && multibyte &&
- ! STRING_MULTIBYTE (info[ispec].argument))
- convbytes =
- count_size_as_multibyte (SDATA (info[ispec].argument),
- nbytes);
+ if (convbytes && multibyte && ! STRING_MULTIBYTE (arg))
+ convbytes = count_size_as_multibyte (SDATA (arg), nbytes);
ptrdiff_t padding
= width < field_width ? field_width - width : 0;
@@ -4274,20 +4255,18 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
p += padding;
nchars += padding;
}
- info[ispec].start = nchars;
+ spec->start = nchars;
if (p > buf
&& multibyte
&& !ASCII_CHAR_P (*((unsigned char *) p - 1))
- && STRING_MULTIBYTE (info[ispec].argument)
- && !CHAR_HEAD_P (SREF (info[ispec].argument, 0)))
+ && STRING_MULTIBYTE (arg)
+ && !CHAR_HEAD_P (SREF (arg, 0)))
maybe_combine_byte = true;
- p += copy_text (SDATA (info[ispec].argument),
- (unsigned char *) p,
+ p += copy_text (SDATA (arg), (unsigned char *) p,
nbytes,
- STRING_MULTIBYTE (info[ispec].argument),
- multibyte);
+ STRING_MULTIBYTE (arg), multibyte);
nchars += nchars_string;
@@ -4297,12 +4276,12 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
p += padding;
nchars += padding;
}
- info[ispec].end = nchars;
+ spec->end = nchars;
/* If this argument has text properties, record where
in the result string it appears. */
- if (string_intervals (info[ispec].argument))
- info[ispec].intervals = arg_intervals = true;
+ if (string_intervals (arg))
+ spec->intervals = arg_intervals = true;
continue;
}
@@ -4313,8 +4292,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
|| conversion == 'X'))
error ("Invalid format operation %%%c",
STRING_CHAR ((unsigned char *) format - 1));
- else if (! (INTEGERP (info[ispec].argument)
- || (FLOATP (info[ispec].argument) && conversion != 'c')))
+ else if (! (INTEGERP (arg) || (FLOATP (arg) && conversion != 'c')))
error ("Format specifier doesn't match argument type");
else
{
@@ -4376,7 +4354,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (INT_AS_LDBL)
{
*f = 'L';
- f += INTEGERP (info[ispec].argument);
+ f += INTEGERP (arg);
}
}
else if (conversion != 'c')
@@ -4408,22 +4386,22 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
ptrdiff_t sprintf_bytes;
if (float_conversion)
{
- if (INT_AS_LDBL && INTEGERP (info[ispec].argument))
+ if (INT_AS_LDBL && INTEGERP (arg))
{
/* Although long double may have a rounding error if
DIG_BITS_LBOUND * LDBL_MANT_DIG < FIXNUM_BITS - 1,
it is more accurate than plain 'double'. */
- long double x = XINT (info[ispec].argument);
+ long double x = XINT (arg);
sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
}
else
sprintf_bytes = sprintf (sprintf_buf, convspec, prec,
- XFLOATINT (info[ispec].argument));
+ XFLOATINT (arg));
}
else if (conversion == 'c')
{
/* Don't use sprintf here, as it might mishandle prec. */
- sprintf_buf[0] = XINT (info[ispec].argument);
+ sprintf_buf[0] = XINT (arg);
sprintf_bytes = prec != 0;
}
else if (conversion == 'd' || conversion == 'i')
@@ -4432,11 +4410,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
instead so it also works for values outside
the integer range. */
printmax_t x;
- if (INTEGERP (info[ispec].argument))
- x = XINT (info[ispec].argument);
+ if (INTEGERP (arg))
+ x = XINT (arg);
else
{
- double d = XFLOAT_DATA (info[ispec].argument);
+ double d = XFLOAT_DATA (arg);
if (d < 0)
{
x = TYPE_MINIMUM (printmax_t);
@@ -4456,11 +4434,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
{
/* Don't sign-extend for octal or hex printing. */
uprintmax_t x;
- if (INTEGERP (info[ispec].argument))
- x = XUINT (info[ispec].argument);
+ if (INTEGERP (arg))
+ x = XUINT (arg);
else
{
- double d = XFLOAT_DATA (info[ispec].argument);
+ double d = XFLOAT_DATA (arg);
if (d < 0)
x = 0;
else
@@ -4541,7 +4519,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
exponent_bytes = src + sprintf_bytes - e;
}
- info[ispec].start = nchars;
+ spec->start = nchars;
if (! minus_flag)
{
memset (p, ' ', padding);
@@ -4572,7 +4550,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
p += padding;
nchars += padding;
}
- info[ispec].end = nchars;
+ spec->end = nchars;
continue;
}
@@ -4681,7 +4659,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (CONSP (props))
{
ptrdiff_t bytepos = 0, position = 0, translated = 0;
- ptrdiff_t fieldn = 1;
+ ptrdiff_t fieldn = 0;
/* Adjust the bounds of each text property
to the proper start and end in the output string. */
@@ -4747,7 +4725,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
/* Add text properties from arguments. */
if (arg_intervals)
- for (ptrdiff_t i = 1; i <= num_percent; i++)
+ for (ptrdiff_t i = 0; i < nspec; i++)
if (info[i].intervals)
{
len = make_number (SCHARS (info[i].argument));
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 33c5fbd484b..71e04d869e9 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "dynlib.h"
#include "coding.h"
+#include "keyboard.h"
#include "syssignal.h"
#include <intprops.h>
@@ -36,12 +37,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Feature tests. */
-#if __has_attribute (cleanup)
-enum { module_has_cleanup = true };
-#else
-enum { module_has_cleanup = false };
-#endif
-
#ifdef WINDOWSNT
#include <windows.h>
#include "w32term.h"
@@ -88,8 +83,6 @@ struct emacs_env_private
environment. */
struct emacs_runtime_private
{
- /* FIXME: Ideally, we would just define "struct emacs_runtime_private"
- as a synonym of "emacs_env", but I don't know how to do that in C. */
emacs_env pub;
};
@@ -102,8 +95,8 @@ static Lisp_Object value_to_lisp (emacs_value);
static emacs_value lisp_to_value (Lisp_Object);
static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
static void check_main_thread (void);
-static void finalize_environment (struct emacs_env_private *);
-static void initialize_environment (emacs_env *, struct emacs_env_private *priv);
+static void initialize_environment (emacs_env *, struct emacs_env_private *);
+static void finalize_environment (emacs_env *, struct emacs_env_private *);
static void module_handle_signal (emacs_env *, Lisp_Object);
static void module_handle_throw (emacs_env *, Lisp_Object);
static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object);
@@ -169,7 +162,7 @@ static emacs_value const module_nil = 0;
module_out_of_memory (env); \
return retval; \
} \
- verify (module_has_cleanup); \
+ verify (__has_attribute (cleanup)); \
struct handler *c __attribute__ ((cleanup (module_reset_handlerlist))) \
= c0; \
if (sys_setjmp (c->jmp)) \
@@ -213,14 +206,24 @@ static emacs_value const module_nil = 0;
instead of reporting the error back to Lisp, and also because
'eassert' is compiled to nothing in the release version. */
+/* Use MODULE_FUNCTION_BEGIN_NO_CATCH to implement steps 2 and 3 for
+ environment functions that are known to never exit non-locally. On
+ error it will return its argument, which can be a sentinel
+ value. */
+
+#define MODULE_FUNCTION_BEGIN_NO_CATCH(error_retval) \
+ do { \
+ check_main_thread (); \
+ if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
+ return error_retval; \
+ } while (false)
+
/* Use MODULE_FUNCTION_BEGIN to implement steps 2 through 4 for most
environment functions. On error it will return its argument, which
- should be a sentinel value. */
+ can be a sentinel value. */
-#define MODULE_FUNCTION_BEGIN(error_retval) \
- check_main_thread (); \
- if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
- return error_retval; \
+#define MODULE_FUNCTION_BEGIN(error_retval) \
+ MODULE_FUNCTION_BEGIN_NO_CATCH (error_retval); \
MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
static void
@@ -342,7 +345,7 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
value_to_lisp (value));
}
-/* A module function is a pseudovector of subtype type
+/* A module function is a pseudovector of subtype
PVEC_MODULE_FUNCTION; see lisp.h for the definition. */
static emacs_value
@@ -418,18 +421,14 @@ module_type_of (emacs_env *env, emacs_value value)
static bool
module_is_not_nil (emacs_env *env, emacs_value value)
{
- check_main_thread ();
- if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
- return false;
+ MODULE_FUNCTION_BEGIN_NO_CATCH (false);
return ! NILP (value_to_lisp (value));
}
static bool
module_eq (emacs_env *env, emacs_value a, emacs_value b)
{
- check_main_thread ();
- if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
- return false;
+ MODULE_FUNCTION_BEGIN_NO_CATCH (false);
return EQ (value_to_lisp (a), value_to_lisp (b));
}
@@ -487,8 +486,6 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
return true;
}
- eassert (*length >= 0);
-
if (*length < required_buf_size)
{
*length = required_buf_size;
@@ -505,6 +502,8 @@ static emacs_value
module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
{
MODULE_FUNCTION_BEGIN (module_nil);
+ if (! (0 <= length && length <= STRING_BYTES_BOUND))
+ xsignal0 (Qoverflow_error);
AUTO_STRING_WITH_LEN (lstr, str, length);
return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
}
@@ -593,6 +592,15 @@ module_vec_size (emacs_env *env, emacs_value vec)
return ASIZE (lvec);
}
+/* This function should return true if and only if maybe_quit would do
+ anything. */
+static bool
+module_should_quit (emacs_env *env)
+{
+ MODULE_FUNCTION_BEGIN_NO_CATCH (false);
+ return (! NILP (Vquit_flag) && NILP (Vinhibit_quit)) || pending_signals;
+}
+
/* Subroutines. */
@@ -607,15 +615,15 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
CHECK_STRING (file);
handle = dynlib_open (SSDATA (file));
if (!handle)
- error ("Cannot load file %s: %s", SDATA (file), dynlib_error ());
+ xsignal2 (Qmodule_open_failed, file, build_string (dynlib_error ()));
gpl_sym = dynlib_sym (handle, "plugin_is_GPL_compatible");
if (!gpl_sym)
- error ("Module %s is not GPL compatible", SDATA (file));
+ xsignal1 (Qmodule_not_gpl_compatible, file);
module_init = (emacs_init_function) dynlib_func (handle, "emacs_module_init");
if (!module_init)
- error ("Module %s does not have an init function.", SDATA (file));
+ xsignal1 (Qmissing_module_init_function, file);
struct emacs_runtime_private rt; /* Includes the public emacs_env. */
struct emacs_env_private priv;
@@ -627,34 +635,33 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
.get_environment = module_get_environment
};
int r = module_init (&pub);
- finalize_environment (&priv);
+ finalize_environment (&rt.pub, &priv);
if (r != 0)
{
if (FIXNUM_OVERFLOW_P (r))
xsignal0 (Qoverflow_error);
- xsignal2 (Qmodule_load_failed, file, make_number (r));
+ xsignal2 (Qmodule_init_failed, file, make_number (r));
}
return Qt;
}
Lisp_Object
-funcall_module (const struct Lisp_Module_Function *const function,
- ptrdiff_t nargs, Lisp_Object *arglist)
+funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
{
- eassume (0 <= function->min_arity);
- if (! (function->min_arity <= nargs
- && (function->max_arity < 0 || nargs <= function->max_arity)))
- xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (function),
- make_number (nargs));
+ const struct Lisp_Module_Function *func = XMODULE_FUNCTION (function);
+ eassume (0 <= func->min_arity);
+ if (! (func->min_arity <= nargs
+ && (func->max_arity < 0 || nargs <= func->max_arity)))
+ xsignal2 (Qwrong_number_of_arguments, function, make_number (nargs));
emacs_env pub;
struct emacs_env_private priv;
initialize_environment (&pub, &priv);
USE_SAFE_ALLOCA;
- emacs_value *args;
+ ATTRIBUTE_MAY_ALIAS emacs_value *args;
if (plain_values)
args = (emacs_value *) arglist;
else
@@ -664,28 +671,32 @@ funcall_module (const struct Lisp_Module_Function *const function,
args[i] = lisp_to_value (arglist[i]);
}
- emacs_value ret = function->subr (&pub, nargs, args, function->data);
+ emacs_value ret = func->subr (&pub, nargs, args, func->data);
SAFE_FREE ();
eassert (&priv == pub.private_members);
+ /* Process the quit flag first, so that quitting doesn't get
+ overridden by other non-local exits. */
+ maybe_quit ();
+
switch (priv.pending_non_local_exit)
{
case emacs_funcall_exit_return:
- finalize_environment (&priv);
+ finalize_environment (&pub, &priv);
return value_to_lisp (ret);
case emacs_funcall_exit_signal:
{
Lisp_Object symbol = priv.non_local_exit_symbol;
Lisp_Object data = priv.non_local_exit_data;
- finalize_environment (&priv);
+ finalize_environment (&pub, &priv);
xsignal (symbol, data);
}
case emacs_funcall_exit_throw:
{
Lisp_Object tag = priv.non_local_exit_symbol;
Lisp_Object value = priv.non_local_exit_data;
- finalize_environment (&priv);
+ finalize_environment (&pub, &priv);
Fthrow (tag, value);
}
default:
@@ -894,14 +905,17 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->vec_set = module_vec_set;
env->vec_get = module_vec_get;
env->vec_size = module_vec_size;
+ env->should_quit = module_should_quit;
Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
}
/* Must be called before the lifetime of the environment object
ends. */
static void
-finalize_environment (struct emacs_env_private *env)
+finalize_environment (emacs_env *env, struct emacs_env_private *priv)
{
+ eassert (env->private_members == priv);
+ eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
Vmodule_environments = XCDR (Vmodule_environments);
}
@@ -937,35 +951,6 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
}
-/* Function environments. */
-
-/* Return a string object that contains a user-friendly
- representation of the function environment. */
-Lisp_Object
-module_format_fun_env (const struct Lisp_Module_Function *env)
-{
- /* Try to print a function name if possible. */
- /* FIXME: Move this function into print.c, then use prin1-to-string
- above. */
- const char *path, *sym;
- static char const noaddr_format[] = "#<module function at %p>";
- char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
- char *buf = buffer;
- ptrdiff_t bufsize = sizeof buffer;
- ptrdiff_t size
- = (dynlib_addr (env->subr, &path, &sym)
- ? exprintf (&buf, &bufsize, buffer, -1,
- "#<module function %s from %s>", sym, path)
- : sprintf (buffer, noaddr_format, env->subr));
- AUTO_STRING_WITH_LEN (unibyte_result, buffer, size);
- Lisp_Object result = code_convert_string_norecord (unibyte_result,
- Qutf_8, false);
- if (buf != buffer)
- xfree (buf);
- return result;
-}
-
-
/* Segment initializer. */
void
@@ -999,11 +984,34 @@ syms_of_module (void)
Fput (Qmodule_load_failed, Qerror_message,
build_pure_c_string ("Module load failed"));
- DEFSYM (Qinvalid_module_call, "invalid-module-call");
- Fput (Qinvalid_module_call, Qerror_conditions,
- listn (CONSTYPE_PURE, 2, Qinvalid_module_call, Qerror));
- Fput (Qinvalid_module_call, Qerror_message,
- build_pure_c_string ("Invalid module call"));
+ DEFSYM (Qmodule_open_failed, "module-open-failed");
+ Fput (Qmodule_open_failed, Qerror_conditions,
+ listn (CONSTYPE_PURE, 3,
+ Qmodule_open_failed, Qmodule_load_failed, Qerror));
+ Fput (Qmodule_open_failed, Qerror_message,
+ build_pure_c_string ("Module could not be opened"));
+
+ DEFSYM (Qmodule_not_gpl_compatible, "module-not-gpl-compatible");
+ Fput (Qmodule_not_gpl_compatible, Qerror_conditions,
+ listn (CONSTYPE_PURE, 3,
+ Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror));
+ Fput (Qmodule_not_gpl_compatible, Qerror_message,
+ build_pure_c_string ("Module is not GPL compatible"));
+
+ DEFSYM (Qmissing_module_init_function, "missing-module-init-function");
+ Fput (Qmissing_module_init_function, Qerror_conditions,
+ listn (CONSTYPE_PURE, 3,
+ Qmissing_module_init_function, Qmodule_load_failed, Qerror));
+ Fput (Qmissing_module_init_function, Qerror_message,
+ build_pure_c_string ("Module does not export an "
+ "initialization function"));
+
+ DEFSYM (Qmodule_init_failed, "module-init-failed");
+ Fput (Qmodule_init_failed, Qerror_conditions,
+ listn (CONSTYPE_PURE, 3,
+ Qmodule_init_failed, Qmodule_load_failed, Qerror));
+ Fput (Qmodule_init_failed, Qerror_message,
+ build_pure_c_string ("Module initialization failed"));
DEFSYM (Qinvalid_arity, "invalid-arity");
Fput (Qinvalid_arity, Qerror_conditions,
diff --git a/src/emacs-module.h b/src/emacs-module.h
index d9eeeabec3f..b8bf2ed2d5f 100644
--- a/src/emacs-module.h
+++ b/src/emacs-module.h
@@ -185,6 +185,9 @@ struct emacs_env_25
emacs_value val);
ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec);
+
+ /* Returns whether a quit is pending. */
+ bool (*should_quit) (emacs_env *env);
};
/* Every module should define a function as follows. */
diff --git a/src/eval.c b/src/eval.c
index f472efad52e..ef961046bcf 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1474,7 +1474,10 @@ process_quit_flag (void)
If quit-flag is set to `kill-emacs' the SIGINT handler has received
a request to exit Emacs when it is safe to do.
- When not quitting, process any pending signals. */
+ When not quitting, process any pending signals.
+
+ If you change this function, also adapt module_should_quit in
+ emacs-module.c. */
void
maybe_quit (void)
@@ -2952,7 +2955,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
- return funcall_module (XMODULE_FUNCTION (fun), nargs, arg_vector);
+ return funcall_module (fun, nargs, arg_vector);
#endif
else
emacs_abort ();
diff --git a/src/lisp.h b/src/lisp.h
index 7b8f1e754d8..c35bd1f6df1 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1346,7 +1346,9 @@ SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
INLINE ptrdiff_t
SCHARS (Lisp_Object string)
{
- return XSTRING (string)->size;
+ ptrdiff_t nchars = XSTRING (string)->size;
+ eassume (0 <= nchars);
+ return nchars;
}
#ifdef GC_CHECK_STRING_BYTES
@@ -1356,10 +1358,12 @@ INLINE ptrdiff_t
STRING_BYTES (struct Lisp_String *s)
{
#ifdef GC_CHECK_STRING_BYTES
- return string_bytes (s);
+ ptrdiff_t nbytes = string_bytes (s);
#else
- return s->size_byte < 0 ? s->size : s->size_byte;
+ ptrdiff_t nbytes = s->size_byte < 0 ? s->size : s->size_byte;
#endif
+ eassume (0 <= nbytes);
+ return nbytes;
}
INLINE ptrdiff_t
@@ -1373,7 +1377,7 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
/* This function cannot change the size of data allocated for the
string when it was created. */
eassert (STRING_MULTIBYTE (string)
- ? newsize <= SBYTES (string)
+ ? 0 <= newsize && newsize <= SBYTES (string)
: newsize == SCHARS (string));
XSTRING (string)->size = newsize;
}
@@ -3952,10 +3956,8 @@ XMODULE_FUNCTION (Lisp_Object o)
extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
/* Defined in emacs-module.c. */
-extern Lisp_Object funcall_module (const struct Lisp_Module_Function *,
- ptrdiff_t, Lisp_Object *);
+extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
-extern Lisp_Object module_format_fun_env (const struct Lisp_Module_Function *);
extern void syms_of_module (void);
#endif
diff --git a/src/print.c b/src/print.c
index 49408bbeb40..76ae10fe132 100644
--- a/src/print.c
+++ b/src/print.c
@@ -33,6 +33,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "intervals.h"
#include "blockinput.h"
#include "xwidget.h"
+#include "dynlib.h"
#include <c-ctype.h>
#include <float.h>
@@ -1699,8 +1700,33 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
#ifdef HAVE_MODULES
case PVEC_MODULE_FUNCTION:
- print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
- printcharfun);
+ {
+ print_c_string ("#<module function ", printcharfun);
+ void *ptr = XMODULE_FUNCTION (obj)->subr;
+ const char *file = NULL;
+ const char *symbol = NULL;
+ dynlib_addr (ptr, &file, &symbol);
+
+ if (symbol == NULL)
+ {
+ print_c_string ("at ", printcharfun);
+ enum { pointer_bufsize = sizeof ptr * 16 / CHAR_BIT + 2 + 1 };
+ char buffer[pointer_bufsize];
+ int needed = snprintf (buffer, sizeof buffer, "%p", ptr);
+ eassert (needed <= sizeof buffer);
+ print_c_string (buffer, printcharfun);
+ }
+ else
+ print_c_string (symbol, printcharfun);
+
+ if (file != NULL)
+ {
+ print_c_string (" from ", printcharfun);
+ print_c_string (file, printcharfun);
+ }
+
+ printchar ('>', printcharfun);
+ }
break;
#endif
diff --git a/test/Makefile.in b/test/Makefile.in
index 4f12a8ea48c..7b8c967128f 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -182,7 +182,7 @@ test_module_dir := $(srcdir)/data/emacs-module
test_module_name := mod-test@MODULES_SUFFIX@
test_module := $(test_module_dir)/$(test_module_name)
$(srcdir)/src/emacs-module-tests.log: $(test_module)
-$(test_module): $(srcdir)/../src/emacs-module.[ch]
+$(test_module): $(srcdir)/../src/emacs-module.[ch] $(test_module_dir)/mod-test.c
$(MAKE) -C $(test_module_dir) $(test_module_name) SO=@MODULES_SUFFIX@
endif
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 5e78aebf7c3..622bbadb3ef 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -31,13 +31,13 @@
(should (= (mod-test-sum 1 2) 3))
(let ((descr (should-error (mod-test-sum 1 2 3))))
(should (eq (car descr) 'wrong-number-of-arguments))
- (should (stringp (nth 1 descr)))
+ (should (module-function-p (nth 1 descr)))
(should (eq 0
(string-match
(concat "#<module function "
"\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
"\\|Fmod_test_sum from .*\\)>")
- (nth 1 descr))))
+ (prin1-to-string (nth 1 descr)))))
(should (= (nth 2 descr) 3)))
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
(should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
View Lorry Controller Status