Re: __attribute__ ((cleanup)) and emacs-module.c

[Po Lu]

Paul Eggert <eggert@cs.ucla.edu> writes:

> On 2023-03-09 05:31, Po Lu wrote:
>> Philipp Stephani<phst@google.com>  writes:
>> 
>>> It's not impossible to do this
>>> manually (it's not so different from the unbind_to calls in the Emacs
>>> codebase), but rather error-prone.
>> Yes, I know why it's necessary.  I'm up to doing what what it does by
>> hand in portable C.
>
> Thanks for volunteering to take on this portability task.

Would people please review this change?  I have not yet had a chance to
test it, but if it is good I will install it to feature/android.

Thanks.

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 @@ #define MODULE_HANDLE_NONLOCAL_EXIT(retval)               
              \
       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 @@ #define MODULE_HANDLE_NONLOCAL_EXIT(retval)                
             \
       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 @@ #define XSET_MODULE_FUNCTION(var, ptr) \
 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 @@ module_extract_big_integer (emacs_env *env, emacs_value 
arg, int *sign,
 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;
 }