procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse source
This commit is contained in:
Michael Albinus 2017-06-05 13:00:07 +02:00
commit 9f496c591d
15 changed files with 250 additions and 218 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
doc/lispref/strings.texi
View file

@ -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

4
lisp/desktop.el
View file

@ -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

11
lisp/linum.el
View file

@ -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 ()

2
lisp/progmodes/elisp-mode.el
View file

@ -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)

10
src/data.c
View file

@ -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)

34
src/dynlib.c
View file

@ -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 *

16
src/dynlib.h
View file

@ -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 */

154
src/editfns.c
View file

@ -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));

162
src/emacs-module.c
View file

@ -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);
}
@ -936,35 +950,6 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (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. */
@ -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,

3
src/emacs-module.h
View file

@ -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. */

7
src/eval.c
View file

@ -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 ();

16
src/lisp.h
View file

@ -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

30
src/print.c
View file

@ -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

2
test/Makefile.in
View file

@ -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

4
test/src/emacs-module-tests.el
View file

@ -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)