[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 248b3459615 1/4: Don't use GCC extensions in src/emacs-m
From: |
Po Lu |
Subject: |
feature/android 248b3459615 1/4: Don't use GCC extensions in src/emacs-module.c |
Date: |
Fri, 10 Mar 2023 22:36:15 -0500 (EST) |
branch: feature/android
commit 248b34596159c460a4afd152035e226c44cf31fd
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Don't use GCC extensions in src/emacs-module.c
* configure.ac: Default modules to on. Remove check for
__attribute__((cleanup)). However, keep the new `ifavailable'
value for systems without dlopen.
* src/emacs-module.c (MODULE_HANDLE_NONLOCAL_EXIT): Don't rely
on cleanup attribute and correctly reset handlerlist upon
longjmp.
(MODULE_INTERNAL_CLEANUP): New macro.
(module_make_global_ref, module_free_global_ref)
(module_make_function, module_get_function_finalizer)
(module_set_function_finalizer, module_make_interactive)
(module_funcall, module_intern, module_type_of)
(module_extract_integer, module_make_integer, module_extract_float)
(module_make_float, module_copy_string_contents)
(module_make_string, module_make_unibyte_string)
(module_make_user_ptr, module_get_user_ptr, module_set_user_ptr)
(module_get_user_finalizer, module_set_user_finalizer)
(module_vec_set, module_vec_get, module_vec_size)
(module_process_input, module_extract_time, module_make_time)
(module_extract_big_integer, module_make_big_integer)
(module_open_channel): Call MODULE_INTERNAL_CLEANUP prior to
returning.
---
configure.ac | 114 +++++++++++-----------------------------
src/emacs-module.c | 149 ++++++++++++++++++++++++++++++++++++++++++++---------
2 files changed, 156 insertions(+), 107 deletions(-)
diff --git a/configure.ac b/configure.ac
index 328b55d96ec..56e293a6baa 100644
--- a/configure.ac
+++ b/configure.ac
@@ -550,7 +550,7 @@ OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings
support])
OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
-OPTION_DEFAULT_IFAVAILABLE([modules],[don't compile with dynamic modules
support])
+OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support])
OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support])
OPTION_DEFAULT_OFF([cygwin32-native-compilation],[use native compilation on
32-bit Cygwin])
OPTION_DEFAULT_ON([xinput2],[don't use version 2 of the X Input Extension for
input])
@@ -4874,90 +4874,36 @@ if test $window_system = pgtk; then
esac
fi
-if test "${with_modules}" != "no"; then
- # __attribute__ ((cleanup)) is required for dynamic modules to
- # work.
- AC_CACHE_CHECK([for working __attribute__((cleanup))],
- [emacs_cv_attribute_cleanup],
- [AC_RUN_IFELSE([AC_LANG_PROGRAM([[
-
- extern int exit ();
-
- cleanup_func_1 (k)
- int *k;
- {
- exit (*k - 100);
- }
-
- cleanup_func ()
- {
- int k __attribute__((cleanup (cleanup_func_1))) = 100;
- }
-
- ]], [[cleanup_func (); return 1;]])],
- [emacs_cv_attribute_cleanup=yes],
- [emacs_cv_attribute_cleanup=no],
- [AC_COMPILE_IFELSE([
- AC_LANG_PROGRAM([[
- cleanup_func_1 (k)
- int *k;
- {
- return *k;
- };
- cleanup_func ()
- {
- int k __attribute__((cleanup (cleanup_func_1))) = 100;
- }]],
- [[cleanup_func ()]])],
- [emacs_cv_attribute_cleanup="guessing yes"],
- [emacs_cv_attribute_cleanup=no])])])
-
- if test "$emacs_cv_attribute_cleanup" = "no"; then
- if test "${with_modules}" = "ifavailable"; then
- AC_MSG_WARN([your compiler does not support cleanup attributes,
-and as a result dynamic modules have been disabled])
- else
- AC_MSG_ERROR([your compiler is missing the cleanup attribute
-required for dynamic modules to work])
- fi
- else
- case $opsys in
- gnu|gnu-linux)
- LIBMODULES="-ldl"
- HAVE_MODULES=yes
- ;;
- cygwin|mingw32|darwin)
- HAVE_MODULES=yes
- ;;
- *)
- # BSD systems have dlopen in libc.
- AC_CHECK_FUNC([dlopen], [HAVE_MODULES=yes])
- ;;
- esac
-
- if test "${HAVE_MODULES}" = no; then
- AC_MSG_ERROR([Dynamic modules are not supported on your system])
- else
- SAVE_LIBS=$LIBS
- LIBS="$LIBS $LIBMODULES"
- AC_CHECK_FUNCS([dladdr dlfunc])
- LIBS=$SAVE_LIBS
- fi
- fi
-fi
+AS_IF([test "x$with_modules" != "xno"],
+ [AS_CASE(["$opsys"],
+ [gnu|gnu-linux],
+ [LIBMODULES="-ldl"
+ HAVE_MODULES=yes],
+ [cygwin|mingw32|darwin],
+ [HAVE_MODULES=yes],
+ # BSD systems have dlopen in libc.
+ [AC_CHECK_FUNC([dlopen], [HAVE_MODULES=yes])])
+
+ AS_IF([test "x$HAVE_MODULES" = "xno"],
+ [AS_IF([test "$with_modules" = "ifavailable"],
+ [AC_MSG_WARN([Dynamic modules are not supported on your system])],
+ [AC_MSG_ERROR([Dynamic modules are not supported on your system])])],
+ [SAVE_LIBS=$LIBS
+ LIBS="$LIBS $LIBMODULES"
+ AC_CHECK_FUNCS([dladdr dlfunc])
+ LIBS=$SAVE_LIBS])])
+
+AS_IF([test "x$HAVE_MODULES" = xyes],
+ [MODULES_OBJ="emacs-module.o"
+ NEED_DYNLIB=yes
+ AC_DEFINE([HAVE_MODULES], [1], [Define to 1 if dynamic modules are
enabled])
+ AC_DEFINE_UNQUOTED([MODULES_SUFFIX], ["$MODULES_SUFFIX"],
+ [System extension for dynamic libraries])
+ AS_IF([test -n "$MODULES_SECONDARY_SUFFIX"],
+ [AC_DEFINE_UNQUOTED([MODULES_SECONDARY_SUFFIX],
+ ["$MODULES_SECONDARY_SUFFIX"],
+ [Alternative system extension for dynamic libraries.])])])
-if test "${HAVE_MODULES}" = yes; then
- MODULES_OBJ="emacs-module.o"
- NEED_DYNLIB=yes
- AC_DEFINE([HAVE_MODULES], [1], [Define to 1 if dynamic modules are enabled])
- AC_DEFINE_UNQUOTED([MODULES_SUFFIX], ["$MODULES_SUFFIX"],
- [System extension for dynamic libraries])
- if test -n "${MODULES_SECONDARY_SUFFIX}"; then
- AC_DEFINE_UNQUOTED([MODULES_SECONDARY_SUFFIX],
- ["$MODULES_SECONDARY_SUFFIX"],
- [Alternative system extension for dynamic libraries.])
- fi
-fi
AC_SUBST([MODULES_OBJ])
AC_SUBST([LIBMODULES])
AC_SUBST([HAVE_MODULES])
diff --git a/src/emacs-module.c b/src/emacs-module.c
index d9e564771d0..4719b15c992 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -253,10 +253,8 @@ module_decode_utf_8 (const char *str, ptrdiff_t len)
/* It is very important that pushing the handler doesn't itself raise
a signal. Install the cleanup only after the handler has been
- pushed. Use __attribute__ ((cleanup)) to avoid
- non-local-exit-prone manual cleanup. This is an extension provided
- by GCC and similar compilers; configure prevents module.c from
- being compiled when it is not present.
+ pushed. All code following this point should use
+ MODULE_INTERNAL_CLEANUP before each return.
The do-while forces uses of the macro to be followed by a semicolon.
This macro cannot enclose its entire body inside a do-while, as the
@@ -276,17 +274,20 @@ module_decode_utf_8 (const char *str, ptrdiff_t len)
return retval; \
} \
struct handler *internal_cleanup \
- __attribute__ ((cleanup (module_reset_handlerlist))) \
= internal_handler; \
if (sys_setjmp (internal_cleanup->jmp)) \
{ \
module_handle_nonlocal_exit (env, \
internal_cleanup->nonlocal_exit, \
internal_cleanup->val); \
+ module_reset_handlerlist (&internal_cleanup); \
return retval; \
} \
do { } while (false)
+#define MODULE_INTERNAL_CLEANUP \
+ module_reset_handlerlist (&internal_cleanup)
+
/* Implementation of runtime and environment functions.
@@ -313,7 +314,10 @@ module_decode_utf_8 (const char *str, ptrdiff_t len)
Emacs functions, by placing the macro
MODULE_HANDLE_NONLOCAL_EXIT right after the above 2 tests.
- 5. Do NOT use 'eassert' for checking validity of user code in the
+ 5. Finally, any code which expands MODULE_HANDLE_NONLOCAL_EXIT
+ should use MODULE_INTERNAL_CLEANUP prior to returning.
+
+ 6. Do NOT use 'eassert' for checking validity of user code in the
module. Instead, make those checks part of the code, and if the
check fails, call 'module_non_local_exit_signal_1' or
'module_non_local_exit_throw_1' to report the error. This is
@@ -436,6 +440,7 @@ module_make_global_ref (emacs_env *env, emacs_value value)
bool overflow = INT_ADD_WRAPV (ref->refcount, 1, &ref->refcount);
if (overflow)
overflow_error ();
+ MODULE_INTERNAL_CLEANUP;
return &ref->value;
}
else
@@ -448,6 +453,7 @@ module_make_global_ref (emacs_env *env, emacs_value value)
Lisp_Object value;
XSETPSEUDOVECTOR (value, ref, PVEC_OTHER);
hash_put (h, new_obj, value, hashcode);
+ MODULE_INTERNAL_CLEANUP;
return &ref->value;
}
}
@@ -479,6 +485,8 @@ module_free_global_ref (emacs_env *env, emacs_value
global_value)
if (--ref->refcount == 0)
hash_remove_from_table (h, obj);
}
+
+ MODULE_INTERNAL_CLEANUP;
}
static enum emacs_funcall_exit
@@ -572,6 +580,8 @@ static emacs_value
module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
emacs_function func, const char *docstring, void *data)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= min_arity
@@ -596,7 +606,9 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity,
ptrdiff_t max_arity,
XSET_MODULE_FUNCTION (result, function);
eassert (MODULE_FUNCTIONP (result));
- return lisp_to_value (env, result);
+ value = lisp_to_value (env, result);
+ MODULE_INTERNAL_CLEANUP;
+ return value;
}
static emacs_finalizer
@@ -605,6 +617,7 @@ module_get_function_finalizer (emacs_env *env, emacs_value
arg)
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (arg);
CHECK_MODULE_FUNCTION (lisp);
+ MODULE_INTERNAL_CLEANUP;
return XMODULE_FUNCTION (lisp)->finalizer;
}
@@ -616,6 +629,7 @@ module_set_function_finalizer (emacs_env *env, emacs_value
arg,
Lisp_Object lisp = value_to_lisp (arg);
CHECK_MODULE_FUNCTION (lisp);
XMODULE_FUNCTION (lisp)->finalizer = fin;
+ MODULE_INTERNAL_CLEANUP;
}
void
@@ -635,6 +649,7 @@ module_make_interactive (emacs_env *env, emacs_value
function, emacs_value spec)
/* Normalize (interactive nil) to (interactive). */
XMODULE_FUNCTION (lisp_fun)->interactive_form
= NILP (lisp_spec) ? list1 (Qinteractive) : list2 (Qinteractive,
lisp_spec);
+ MODULE_INTERNAL_CLEANUP;
}
Lisp_Object
@@ -668,21 +683,30 @@ module_funcall (emacs_env *env, emacs_value func,
ptrdiff_t nargs,
newargs[1 + i] = value_to_lisp (args[i]);
emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs));
SAFE_FREE ();
+ MODULE_INTERNAL_CLEANUP;
return result;
}
static emacs_value
module_intern (emacs_env *env, const char *name)
{
+ emacs_value tem;
+
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, intern (name));
+ tem = lisp_to_value (env, intern (name));
+ MODULE_INTERNAL_CLEANUP;
+ return tem;
}
static emacs_value
module_type_of (emacs_env *env, emacs_value arg)
{
+ emacs_value tem;
+
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, Ftype_of (value_to_lisp (arg)));
+ tem = lisp_to_value (env, Ftype_of (value_to_lisp (arg)));
+ MODULE_INTERNAL_CLEANUP;
+ return tem;
}
static bool
@@ -708,14 +732,20 @@ module_extract_integer (emacs_env *env, emacs_value arg)
intmax_t i;
if (! integer_to_intmax (lisp, &i))
xsignal1 (Qoverflow_error, lisp);
+ MODULE_INTERNAL_CLEANUP;
return i;
}
static emacs_value
module_make_integer (emacs_env *env, intmax_t n)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, make_int (n));
+ value = lisp_to_value (env, make_int (n));
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
static double
@@ -724,14 +754,21 @@ module_extract_float (emacs_env *env, emacs_value arg)
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lisp = value_to_lisp (arg);
CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp);
+ MODULE_INTERNAL_CLEANUP;
+
return XFLOAT_DATA (lisp);
}
static emacs_value
module_make_float (emacs_env *env, double d)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, make_float (d));
+ value = lisp_to_value (env, make_float (d));
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
static bool
@@ -763,6 +800,7 @@ module_copy_string_contents (emacs_env *env, emacs_value
value, char *buf,
if (buf == NULL)
{
*len = required_buf_size;
+ MODULE_INTERNAL_CLEANUP;
return true;
}
@@ -778,36 +816,51 @@ module_copy_string_contents (emacs_env *env, emacs_value
value, char *buf,
*len = required_buf_size;
memcpy (buf, SDATA (lisp_str_utf8), raw_size + 1);
+ MODULE_INTERNAL_CLEANUP;
return true;
}
static emacs_value
module_make_string (emacs_env *env, const char *str, ptrdiff_t len)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= len && len <= STRING_BYTES_BOUND))
overflow_error ();
Lisp_Object lstr
= len == 0 ? empty_multibyte_string : module_decode_utf_8 (str, len);
- return lisp_to_value (env, lstr);
+ value = lisp_to_value (env, lstr);
+ MODULE_INTERNAL_CLEANUP;
+ return value;
}
static emacs_value
module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= length && length <= STRING_BYTES_BOUND))
overflow_error ();
Lisp_Object lstr
= length == 0 ? empty_unibyte_string : make_unibyte_string (str, length);
- return lisp_to_value (env, lstr);
+ value = lisp_to_value (env, lstr);
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
static emacs_value
module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, make_user_ptr (fin, ptr));
+ value = lisp_to_value (env, make_user_ptr (fin, ptr));
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
static void *
@@ -816,6 +869,8 @@ module_get_user_ptr (emacs_env *env, emacs_value arg)
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
+ MODULE_INTERNAL_CLEANUP;
+
return XUSER_PTR (lisp)->p;
}
@@ -826,6 +881,7 @@ module_set_user_ptr (emacs_env *env, emacs_value arg, void
*ptr)
Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->p = ptr;
+ MODULE_INTERNAL_CLEANUP;
}
static emacs_finalizer
@@ -834,6 +890,7 @@ module_get_user_finalizer (emacs_env *env, emacs_value arg)
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
+ MODULE_INTERNAL_CLEANUP;
return XUSER_PTR (lisp)->finalizer;
}
@@ -845,6 +902,7 @@ module_set_user_finalizer (emacs_env *env, emacs_value arg,
Lisp_Object lisp = value_to_lisp (arg);
CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->finalizer = fin;
+ MODULE_INTERNAL_CLEANUP;
}
static void
@@ -864,15 +922,21 @@ module_vec_set (emacs_env *env, emacs_value vector,
ptrdiff_t index,
Lisp_Object lisp = value_to_lisp (vector);
check_vec_index (lisp, index);
ASET (lisp, index, value_to_lisp (value));
+ MODULE_INTERNAL_CLEANUP;
}
static emacs_value
module_vec_get (emacs_env *env, emacs_value vector, ptrdiff_t index)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (vector);
check_vec_index (lisp, index);
- return lisp_to_value (env, AREF (lisp, index));
+ value = lisp_to_value (env, AREF (lisp, index));
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
static ptrdiff_t
@@ -881,6 +945,8 @@ module_vec_size (emacs_env *env, emacs_value vector)
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lisp = value_to_lisp (vector);
CHECK_VECTOR (lisp);
+ MODULE_INTERNAL_CLEANUP;
+
return ASIZE (lisp);
}
@@ -896,23 +962,37 @@ module_should_quit (emacs_env *env)
static enum emacs_process_input_result
module_process_input (emacs_env *env)
{
+ enum emacs_process_input_result rc;
+
MODULE_FUNCTION_BEGIN (emacs_process_input_quit);
maybe_quit ();
- return emacs_process_input_continue;
+ rc = emacs_process_input_continue;
+ MODULE_INTERNAL_CLEANUP;
+ return rc;
}
static struct timespec
module_extract_time (emacs_env *env, emacs_value arg)
{
+ struct timespec value;
+
MODULE_FUNCTION_BEGIN ((struct timespec) {0});
- return lisp_time_argument (value_to_lisp (arg));
+ value = lisp_time_argument (value_to_lisp (arg));
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
static emacs_value
module_make_time (emacs_env *env, struct timespec time)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
- return lisp_to_value (env, timespec_to_lisp (time));
+ value = lisp_to_value (env, timespec_to_lisp (time));
+ MODULE_INTERNAL_CLEANUP;
+
+ return value;
}
/*
@@ -989,7 +1069,10 @@ module_extract_big_integer (emacs_env *env, emacs_value
arg, int *sign,
EMACS_INT x = XFIXNUM (o);
*sign = (0 < x) - (x < 0);
if (x == 0 || count == NULL)
- return true;
+ {
+ MODULE_INTERNAL_CLEANUP;
+ return true;
+ }
/* As a simplification we don't check how many array elements
are exactly required, but use a reasonable static upper
bound. For most architectures exactly one element should
@@ -1000,6 +1083,7 @@ module_extract_big_integer (emacs_env *env, emacs_value
arg, int *sign,
if (magnitude == NULL)
{
*count = required;
+ MODULE_INTERNAL_CLEANUP;
return true;
}
if (*count < required)
@@ -1018,12 +1102,16 @@ module_extract_big_integer (emacs_env *env, emacs_value
arg, int *sign,
verify (required * bits < PTRDIFF_MAX);
for (ptrdiff_t i = 0; i < required; ++i)
magnitude[i] = (emacs_limb_t) (u >> (i * bits));
+ MODULE_INTERNAL_CLEANUP;
return true;
}
const mpz_t *x = xbignum_val (o);
*sign = mpz_sgn (*x);
if (count == NULL)
- return true;
+ {
+ MODULE_INTERNAL_CLEANUP;
+ return true;
+ }
size_t required_size = (mpz_sizeinbase (*x, 2) + numb - 1) / numb;
eassert (required_size <= PTRDIFF_MAX);
ptrdiff_t required = (ptrdiff_t) required_size;
@@ -1031,6 +1119,7 @@ module_extract_big_integer (emacs_env *env, emacs_value
arg, int *sign,
if (magnitude == NULL)
{
*count = required;
+ MODULE_INTERNAL_CLEANUP;
return true;
}
if (*count < required)
@@ -1043,6 +1132,7 @@ module_extract_big_integer (emacs_env *env, emacs_value
arg, int *sign,
size_t written;
mpz_export (magnitude, &written, order, size, endian, nails, *x);
eassert (written == required_size);
+ MODULE_INTERNAL_CLEANUP;
return true;
}
@@ -1050,21 +1140,34 @@ static emacs_value
module_make_big_integer (emacs_env *env, int sign,
ptrdiff_t count, const emacs_limb_t *magnitude)
{
+ emacs_value value;
+
MODULE_FUNCTION_BEGIN (NULL);
if (sign == 0)
- return lisp_to_value (env, make_fixed_natnum (0));
+ {
+ value = lisp_to_value (env, make_fixed_natnum (0));
+ MODULE_INTERNAL_CLEANUP;
+ return value;
+ }
enum { order = -1, size = sizeof *magnitude, endian = 0, nails = 0 };
mpz_import (mpz[0], count, order, size, endian, nails, magnitude);
if (sign < 0)
mpz_neg (mpz[0], mpz[0]);
- return lisp_to_value (env, make_integer_mpz ());
+ value = lisp_to_value (env, make_integer_mpz ());
+ MODULE_INTERNAL_CLEANUP;
+ return value;
}
static int
module_open_channel (emacs_env *env, emacs_value pipe_process)
{
+ int rc;
+
MODULE_FUNCTION_BEGIN (-1);
- return open_channel_for_module (value_to_lisp (pipe_process));
+ rc = open_channel_for_module (value_to_lisp (pipe_process));
+ MODULE_INTERNAL_CLEANUP;
+
+ return rc;
}