1 files changed, 64 insertions, 144 deletions

diff --git a/src/emacs-module.c b/src/emacs-module.c
index a28fe57b12d..280c0550c9b 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -21,16 +21,17 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include "emacs-module.h"
 
-#include <stdbool.h>
 #include <stddef.h>
 #include <stdint.h>
 #include <stdio.h>
-#include <string.h>
 
 #include "lisp.h"
 #include "dynlib.h"
 #include "coding.h"
-#include "verify.h"
+#include "syssignal.h"
+
+#include <intprops.h>
+#include <verify.h>
 
 
 /* Feature tests.  */
@@ -41,15 +42,9 @@ enum { module_has_cleanup = true };
 enum { module_has_cleanup = false };
 #endif
 
-/* Handle to the main thread.  Used to verify that modules call us in
-   the right thread.  */
-#ifdef HAVE_PTHREAD
-# include <pthread.h>
-static pthread_t main_thread;
-#elif defined WINDOWSNT
+#ifdef WINDOWSNT
 #include <windows.h>
 #include "w32term.h"
-static DWORD main_thread;
 #endif
 
 /* True if Lisp_Object and emacs_value have the same representation.
@@ -64,6 +59,13 @@ enum
 	 && INTPTR_MAX == EMACS_INT_MAX)
   };
 
+/* Function prototype for the module init function.  */
+typedef int (*emacs_init_function) (struct emacs_runtime *);
+
+/* Function prototype for the module Lisp functions.  */
+typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
+				   emacs_value [], void *);
+
 /* Function prototype for module user-pointer finalizers.  These
    should not throw C++ exceptions, so emacs-module.h declares the
    corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
@@ -107,14 +109,12 @@ 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 module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object);
 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);
 static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object);
 static void module_out_of_memory (emacs_env *);
 static void module_reset_handlerlist (const int *);
-static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
 
 /* We used to return NULL when emacs_value was a different type from
    Lisp_Object, but nowadays we just use Qnil instead.  Although they
@@ -243,6 +243,12 @@ struct module_fun_env
     return error_retval;                                                \
   MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
 
+static void
+CHECK_USER_PTR (Lisp_Object obj)
+{
+  CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
+}
+
 /* Catch signals and throws only if the code can actually signal or
    throw.  If checking is enabled, abort if the current thread is not
    the Emacs main thread.  */
@@ -270,11 +276,8 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
     {
       Lisp_Object value = HASH_VALUE (h, i);
       EMACS_INT refcount = XFASTINT (value) + 1;
-      if (refcount > MOST_POSITIVE_FIXNUM)
-        {
-          module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
-          return module_nil;
-        }
+      if (MOST_POSITIVE_FIXNUM < refcount)
+	xsignal0 (Qoverflow_error);
       value = make_natnum (refcount);
       set_hash_value_slot (h, i, value);
     }
@@ -387,17 +390,19 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
   envptr->data = data;
 
   Lisp_Object envobj = make_save_ptr (envptr);
-  Lisp_Object doc
-    = (documentation
-       ? code_convert_string_norecord (build_unibyte_string (documentation),
-				       Qutf_8, false)
-       : Qnil);
+  Lisp_Object doc = Qnil;
+  if (documentation)
+    {
+      AUTO_STRING (unibyte_doc, documentation);
+      doc = code_convert_string_norecord (unibyte_doc, Qutf_8, false);
+    }
+
   /* FIXME: Use a bytecompiled object, or even better a subr.  */
   Lisp_Object ret = list4 (Qlambda,
                            list2 (Qand_rest, Qargs),
                            doc,
                            list4 (Qapply,
-                                  list2 (Qfunction, Qinternal_module_call),
+                                  list2 (Qfunction, Qinternal__module_call),
                                   envobj,
                                   Qargs));
 
@@ -414,11 +419,14 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
      first arg, because that's what Ffuncall takes.  */
   Lisp_Object *newargs;
   USE_SAFE_ALLOCA;
-  SAFE_ALLOCA_LISP (newargs, nargs + 1);
+  ptrdiff_t nargs1;
+  if (INT_ADD_WRAPV (nargs, 1, &nargs1))
+    xsignal0 (Qoverflow_error);
+  SAFE_ALLOCA_LISP (newargs, nargs1);
   newargs[0] = value_to_lisp (fun);
   for (ptrdiff_t i = 0; i < nargs; i++)
     newargs[1 + i] = value_to_lisp (args[i]);
-  emacs_value result = lisp_to_value (Ffuncall (nargs + 1, newargs));
+  emacs_value result = lisp_to_value (Ffuncall (nargs1, newargs));
   SAFE_FREE ();
   return result;
 }
@@ -460,11 +468,7 @@ module_extract_integer (emacs_env *env, emacs_value n)
 {
   MODULE_FUNCTION_BEGIN (0);
   Lisp_Object l = value_to_lisp (n);
-  if (! INTEGERP (l))
-    {
-      module_wrong_type (env, Qintegerp, l);
-      return 0;
-    }
+  CHECK_NUMBER (l);
   return XINT (l);
 }
 
@@ -472,11 +476,8 @@ static emacs_value
 module_make_integer (emacs_env *env, intmax_t n)
 {
   MODULE_FUNCTION_BEGIN (module_nil);
-  if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM))
-    {
-      module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
-      return module_nil;
-    }
+  if (FIXNUM_OVERFLOW_P (n))
+    xsignal0 (Qoverflow_error);
   return lisp_to_value (make_number (n));
 }
 
@@ -485,11 +486,7 @@ module_extract_float (emacs_env *env, emacs_value f)
 {
   MODULE_FUNCTION_BEGIN (0);
   Lisp_Object lisp = value_to_lisp (f);
-  if (! FLOATP (lisp))
-    {
-      module_wrong_type (env, Qfloatp, lisp);
-      return 0;
-    }
+  CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp);
   return XFLOAT_DATA (lisp);
 }
 
@@ -506,19 +503,10 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
 {
   MODULE_FUNCTION_BEGIN (false);
   Lisp_Object lisp_str = value_to_lisp (value);
-  if (! STRINGP (lisp_str))
-    {
-      module_wrong_type (env, Qstringp, lisp_str);
-      return false;
-    }
+  CHECK_STRING (lisp_str);
 
   Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
   ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
-  if (raw_size == PTRDIFF_MAX)
-    {
-      module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
-      return false;
-    }
   ptrdiff_t required_buf_size = raw_size + 1;
 
   eassert (length != NULL);
@@ -534,8 +522,7 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
   if (*length < required_buf_size)
     {
       *length = required_buf_size;
-      module_non_local_exit_signal_1 (env, Qargs_out_of_range, Qnil);
-      return false;
+      xsignal0 (Qargs_out_of_range);
     }
 
   *length = required_buf_size;
@@ -548,12 +535,7 @@ static emacs_value
 module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
 {
   MODULE_FUNCTION_BEGIN (module_nil);
-  if (length > STRING_BYTES_BOUND)
-    {
-      module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
-      return module_nil;
-    }
-  Lisp_Object lstr = make_unibyte_string (str, length);
+  AUTO_STRING_WITH_LEN (lstr, str, length);
   return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
 }
 
@@ -569,11 +551,7 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr)
 {
   MODULE_FUNCTION_BEGIN (NULL);
   Lisp_Object lisp = value_to_lisp (uptr);
-  if (! USER_PTRP (lisp))
-    {
-      module_wrong_type (env, Quser_ptr, lisp);
-      return NULL;
-    }
+  CHECK_USER_PTR (lisp);
   return XUSER_PTR (lisp)->p;
 }
 
@@ -582,12 +560,8 @@ module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
 {
   /* FIXME: This function should return bool because it can fail.  */
   MODULE_FUNCTION_BEGIN ();
-  check_main_thread ();
-  if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
-    return;
   Lisp_Object lisp = value_to_lisp (uptr);
-  if (! USER_PTRP (lisp))
-    module_wrong_type (env, Quser_ptr, lisp);
+  CHECK_USER_PTR (lisp);
   XUSER_PTR (lisp)->p = ptr;
 }
 
@@ -596,11 +570,7 @@ module_get_user_finalizer (emacs_env *env, emacs_value uptr)
 {
   MODULE_FUNCTION_BEGIN (NULL);
   Lisp_Object lisp = value_to_lisp (uptr);
-  if (! USER_PTRP (lisp))
-    {
-      module_wrong_type (env, Quser_ptr, lisp);
-      return NULL;
-    }
+  CHECK_USER_PTR (lisp);
   return XUSER_PTR (lisp)->finalizer;
 }
 
@@ -611,30 +581,26 @@ module_set_user_finalizer (emacs_env *env, emacs_value uptr,
   /* FIXME: This function should return bool because it can fail.  */
   MODULE_FUNCTION_BEGIN ();
   Lisp_Object lisp = value_to_lisp (uptr);
-  if (! USER_PTRP (lisp))
-    module_wrong_type (env, Quser_ptr, lisp);
+  CHECK_USER_PTR (lisp);
   XUSER_PTR (lisp)->finalizer = fin;
 }
 
 static void
+check_vec_index (Lisp_Object lvec, ptrdiff_t i)
+{
+  CHECK_VECTOR (lvec);
+  if (! (0 <= i && i < ASIZE (lvec)))
+    args_out_of_range_3 (make_fixnum_or_float (i),
+			 make_number (0), make_number (ASIZE (lvec) - 1));
+}
+
+static void
 module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
 {
   /* FIXME: This function should return bool because it can fail.  */
   MODULE_FUNCTION_BEGIN ();
   Lisp_Object lvec = value_to_lisp (vec);
-  if (! VECTORP (lvec))
-    {
-      module_wrong_type (env, Qvectorp, lvec);
-      return;
-    }
-  if (! (0 <= i && i < ASIZE (lvec)))
-    {
-      if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
-	module_args_out_of_range (env, lvec, make_number (i));
-      else
-	module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
-      return;
-    }
+  check_vec_index (lvec, i);
   ASET (lvec, i, value_to_lisp (val));
 }
 
@@ -643,19 +609,7 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
 {
   MODULE_FUNCTION_BEGIN (module_nil);
   Lisp_Object lvec = value_to_lisp (vec);
-  if (! VECTORP (lvec))
-    {
-      module_wrong_type (env, Qvectorp, lvec);
-      return module_nil;
-    }
-  if (! (0 <= i && i < ASIZE (lvec)))
-    {
-      if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
-	module_args_out_of_range (env, lvec, make_number (i));
-      else
-	module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
-      return module_nil;
-    }
+  check_vec_index (lvec, i);
   return lisp_to_value (AREF (lvec, i));
 }
 
@@ -665,11 +619,7 @@ module_vec_size (emacs_env *env, emacs_value vec)
   /* FIXME: Return a sentinel value (e.g., -1) on error.  */
   MODULE_FUNCTION_BEGIN (0);
   Lisp_Object lvec = value_to_lisp (vec);
-  if (! VECTORP (lvec))
-    {
-      module_wrong_type (env, Qvectorp, lvec);
-      return 0;
-    }
+  CHECK_VECTOR (lvec);
   return ASIZE (lvec);
 }
 
@@ -711,7 +661,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
 
   if (r != 0)
     {
-      if (! (MOST_NEGATIVE_FIXNUM <= r && r <= MOST_POSITIVE_FIXNUM))
+      if (FIXNUM_OVERFLOW_P (r))
         xsignal0 (Qoverflow_error);
       xsignal2 (Qmodule_load_failed, file, make_number (r));
     }
@@ -796,9 +746,9 @@ static void
 check_main_thread (void)
 {
 #ifdef HAVE_PTHREAD
-  eassert (pthread_equal (pthread_self (), main_thread));
+  eassert (pthread_equal (pthread_self (), main_thread_id));
 #elif defined WINDOWSNT
-  eassert (GetCurrentThreadId () == main_thread);
+  eassert (GetCurrentThreadId () == dwMainThreadId);
 #endif
 }
 
@@ -828,14 +778,6 @@ module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
     }
 }
 
-/* Module version of `wrong_type_argument'.  */
-static void
-module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value)
-{
-  module_non_local_exit_signal_1 (env, Qwrong_type_argument,
-				  list2 (predicate, value));
-}
-
 /* Signal an out-of-memory condition to the caller.  */
 static void
 module_out_of_memory (emacs_env *env)
@@ -846,13 +788,6 @@ module_out_of_memory (emacs_env *env)
 				  XCDR (Vmemory_signal_data));
 }
 
-/* Signal arguments are out of range.  */
-static void
-module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2)
-{
-  module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2));
-}
-
 
 /* Value conversion.  */
 
@@ -1055,10 +990,12 @@ module_format_fun_env (const struct module_fun_env *env)
        ? exprintf (&buf, &bufsize, buffer, -1,
 		   "#<module function %s from %s>", sym, path)
        : sprintf (buffer, noaddr_format, env->subr));
-  Lisp_Object unibyte_result = make_unibyte_string (buffer, size);
+  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 code_convert_string_norecord (unibyte_result, Qutf_8, false);
+  return result;
 }
 
 
@@ -1117,23 +1054,6 @@ syms_of_module (void)
 
   defsubr (&Smodule_load);
 
-  DEFSYM (Qinternal_module_call, "internal--module-call");
+  DEFSYM (Qinternal__module_call, "internal--module-call");
   defsubr (&Sinternal_module_call);
 }
-
-/* Unlike syms_of_module, this initializer is called even from an
-   initialized (dumped) Emacs.  */
-
-void
-module_init (void)
-{
-  /* It is not guaranteed that dynamic initializers run in the main thread,
-     therefore detect the main thread here.  */
-#ifdef HAVE_PTHREAD
-  main_thread = pthread_self ();
-#elif defined WINDOWSNT
-  /* The 'main' function already recorded the main thread's thread ID,
-     so we need just to use it . */
-  main_thread = dwMainThreadId;
-#endif
-}