]> code.delx.au - gnu-emacs/blobdiff - src/emacs-module.c
; Merge from origin/emacs-25
[gnu-emacs] / src / emacs-module.c
index d8f2c1da14e0d2631e1339ec22fcc739ef20a4f8..724d24a77688aa0249006e92e2f66d5ae2ab9b42 100644 (file)
@@ -6,8 +6,8 @@ This file is part of GNU Emacs.
 
 GNU Emacs is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -64,6 +64,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
@@ -241,6 +248,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.  */
@@ -267,9 +280,9 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
   if (i >= 0)
     {
       Lisp_Object value = HASH_VALUE (h, i);
-      verify (EMACS_INT_MAX > MOST_POSITIVE_FIXNUM);
       EMACS_INT refcount = XFASTINT (value) + 1;
-      if (FIXNUM_OVERFLOW_P (refcount)) xsignal0 (Qoverflow_error);
+      if (MOST_POSITIVE_FIXNUM < refcount)
+       xsignal0 (Qoverflow_error);
       value = make_natnum (refcount);
       set_hash_value_slot (h, i, value);
     }
@@ -382,17 +395,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));
 
@@ -409,7 +424,8 @@ 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;
-  if (nargs == PTRDIFF_MAX) xsignal0 (Qoverflow_error);
+  if (nargs == PTRDIFF_MAX)
+    xsignal0 (Qoverflow_error);
   SAFE_ALLOCA_LISP (newargs, nargs + 1);
   newargs[0] = value_to_lisp (fun);
   for (ptrdiff_t i = 0; i < nargs; i++)
@@ -464,7 +480,8 @@ static emacs_value
 module_make_integer (emacs_env *env, intmax_t n)
 {
   MODULE_FUNCTION_BEGIN (module_nil);
-  if (FIXNUM_OVERFLOW_P (n)) xsignal0 (Qoverflow_error);
+  if (FIXNUM_OVERFLOW_P (n))
+    xsignal0 (Qoverflow_error);
   return lisp_to_value (make_number (n));
 }
 
@@ -494,7 +511,6 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
 
   Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
   ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
-  if (raw_size == PTRDIFF_MAX) xsignal0 (Qoverflow_error);
   ptrdiff_t required_buf_size = raw_size + 1;
 
   eassert (length != NULL);
@@ -523,8 +539,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) xsignal0 (Qoverflow_error);
-  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));
 }
 
@@ -540,7 +555,7 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr)
 {
   MODULE_FUNCTION_BEGIN (NULL);
   Lisp_Object lisp = value_to_lisp (uptr);
-  CHECK_TYPE (USER_PTRP (lisp), Quser_ptrp, lisp);
+  CHECK_USER_PTR (lisp);
   return XUSER_PTR (lisp)->p;
 }
 
@@ -550,7 +565,7 @@ 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 ();
   Lisp_Object lisp = value_to_lisp (uptr);
-  CHECK_TYPE (USER_PTRP (lisp), Quser_ptrp, lisp);
+  CHECK_USER_PTR (lisp);
   XUSER_PTR (lisp)->p = ptr;
 }
 
@@ -559,7 +574,7 @@ module_get_user_finalizer (emacs_env *env, emacs_value uptr)
 {
   MODULE_FUNCTION_BEGIN (NULL);
   Lisp_Object lisp = value_to_lisp (uptr);
-  CHECK_TYPE (USER_PTRP (lisp), Quser_ptrp, lisp);
+  CHECK_USER_PTR (lisp);
   return XUSER_PTR (lisp)->finalizer;
 }
 
@@ -570,19 +585,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);
-  CHECK_TYPE (USER_PTRP (lisp), Quser_ptrp, 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);
-  CHECK_VECTOR (lvec);
-  if (FIXNUM_OVERFLOW_P (i)) xsignal0 (Qoverflow_error);
-  CHECK_RANGED_INTEGER (make_number (i), 0, ASIZE (lvec) - 1);
+  check_vec_index (lvec, i);
   ASET (lvec, i, value_to_lisp (val));
 }
 
@@ -591,9 +613,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);
-  CHECK_VECTOR (lvec);
-  if (FIXNUM_OVERFLOW_P (i)) xsignal0 (Qoverflow_error);
-  CHECK_RANGED_INTEGER (make_number (i), 0, ASIZE (lvec) - 1);
+  check_vec_index (lvec, i);
   return lisp_to_value (AREF (lvec, i));
 }
 
@@ -974,10 +994,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;
 }
 
 \f
@@ -1036,7 +1058,7 @@ 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);
 }