[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/aptel/dynamic-modules-rc5 93235eb 18/20: Add dynam
|
From: |
Teodor Zlatanov |
|
Subject: |
[Emacs-diffs] feature/aptel/dynamic-modules-rc5 93235eb 18/20: Add dynamic module module support |
|
Date: |
Wed, 18 Nov 2015 19:17:09 +0000 |
branch: feature/aptel/dynamic-modules-rc5
commit 93235ebf836c0c46c710a95781f40467a5187375
Author: Aurélien Aptel <address@hidden>
Commit: Ted Zlatanov <address@hidden>
Add dynamic module module support
* configure.ac: Add '--with-modules' option. Conditionally add
dynlib.o and module.o to the list of objects. Add any system
specific flags to the linker flags to support dynamic libraries.
* m4/ax_gcc_var_attribute.m4: Add autoconf extension to test gcc
attributes.
* src/Makefile.in: Conditionally add module objects and linker flags.
* src/alloc.c (garbage_collect_1): protect module local values from
GC.
* src/lisp.h: Add 'module_init' and 'syms_of_module' prototypes.
* src/emacs_module.h: New header file included by modules. Public
module API.
* src/module.c: New module implementation file.
Co-authored-by: Philipp Stephani <address@hidden>
---
configure.ac | 49 ++-
m4/ax_gcc_var_attribute.m4 | 141 ++++++
src/Makefile.in | 9 +-
src/alloc.c | 4 +
src/emacs.c | 9 +
src/emacs_module.h | 230 +++++++++
src/lisp.h | 4 +
src/module.c | 1185 ++++++++++++++++++++++++++++++++++++++++++++
8 files changed, 1628 insertions(+), 3 deletions(-)
diff --git a/configure.ac b/configure.ac
index 639cbd1..a4df4af 100644
--- a/configure.ac
+++ b/configure.ac
@@ -353,6 +353,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_OFF([modules],[compile with dynamic modules support])
AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
[use a file notification library (LIB one of: yes, gfile, inotify, w32,
no)])],
@@ -2191,6 +2192,9 @@ LIBS="$LIBS_SYSTEM $LIBS"
dnl FIXME replace main with a function we actually want from this library.
AC_CHECK_LIB(Xbsd, main, LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd")
+dnl Check for C11 threads.
+AC_CHECK_HEADERS_ONCE(threads.h)
+
dnl Check for the POSIX thread library.
LIB_PTHREAD=
AC_CHECK_HEADERS_ONCE(pthread.h)
@@ -3285,6 +3289,48 @@ if test "${HAVE_ZLIB}" = "yes"; then
fi
AC_SUBST(LIBZ)
+### Dynamic modules support
+LIBMODULES=
+HAVE_MODULES=no
+MODULES_OBJ=
+MODULES_SUFFIX=
+if test "${with_modules}" != "no"; then
+ if test "$opsys" = "gnu-linux"; then
+ LIBMODULES="-ldl"
+ MODULES_SUFFIX=".so"
+ HAVE_MODULES=yes
+ elif test "$opsys" = "cygwin"; then
+ # XXX: not tested
+ LIBMODULES="-lcygwin"
+ MODULES_SUFFIX=".dll"
+ HAVE_MODULES=yes
+ elif test "$opsys" = "darwin"; then
+ MODULES_SUFFIX=".so"
+ HAVE_MODULES=yes
+ elif test "$opsys" = "mingw32"; then
+ MODULES_SUFFIX=".dll"
+ HAVE_MODULES=yes
+ else
+ # BSD system have dlopen in the libc
+ AC_CHECK_FUNC(dlopen, [MODULES_SUFFIX=".so"]
+ [HAVE_MODULES=yes], [])
+ fi
+
+ if test "${HAVE_MODULES}" = no; then
+ AC_MSG_ERROR([Dynamic modules are not supported on your system])
+ fi
+fi
+
+if test "${HAVE_MODULES}" = yes; then
+ MODULES_OBJ="dynlib.o module.o"
+ 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])
+fi
+AC_SUBST(MODULES_OBJ)
+AC_SUBST(LIBMODULES)
+AX_GCC_VAR_ATTRIBUTE(cleanup)
+AC_CHECK_FUNCS(dladdr)
+
### Use -lpng if available, unless '--with-png=no'.
HAVE_PNG=no
LIBPNG=
@@ -5175,7 +5221,7 @@ optsep=
emacs_config_features=
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
- LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT X11 NS; do
+ LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT X11 NS MODULES; do
case $opt in
NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;;
@@ -5223,6 +5269,7 @@ AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D
Does Emacs use -lotf? ${HAVE_LIBOTF}
Does Emacs use -lxft? ${HAVE_XFT}
Does Emacs directly use zlib? ${HAVE_ZLIB}
+ Does Emacs has dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars?
${USE_TOOLKIT_SCROLL_BARS}
"])
diff --git a/m4/ax_gcc_var_attribute.m4 b/m4/ax_gcc_var_attribute.m4
new file mode 100644
index 0000000..247cc4a
--- /dev/null
+++ b/m4/ax_gcc_var_attribute.m4
@@ -0,0 +1,141 @@
+# ===========================================================================
+# http://www.gnu.org/software/autoconf-archive/ax_gcc_var_attribute.html
+# ===========================================================================
+#
+# SYNOPSIS
+#
+# AX_GCC_VAR_ATTRIBUTE(ATTRIBUTE)
+#
+# DESCRIPTION
+#
+# This macro checks if the compiler supports one of GCC's variable
+# attributes; many other compilers also provide variable attributes with
+# the same syntax. Compiler warnings are used to detect supported
+# attributes as unsupported ones are ignored by default so quieting
+# warnings when using this macro will yield false positives.
+#
+# The ATTRIBUTE parameter holds the name of the attribute to be checked.
+#
+# If ATTRIBUTE is supported define HAVE_VAR_ATTRIBUTE_<ATTRIBUTE>.
+#
+# The macro caches its result in the ax_cv_have_var_attribute_<attribute>
+# variable.
+#
+# The macro currently supports the following variable attributes:
+#
+# aligned
+# cleanup
+# common
+# nocommon
+# deprecated
+# mode
+# packed
+# tls_model
+# unused
+# used
+# vector_size
+# weak
+# dllimport
+# dllexport
+# init_priority
+#
+# Unsuppored variable attributes will be tested against a global integer
+# variable and without any arguments given to the attribute itself; the
+# result of this check might be wrong or meaningless so use with care.
+#
+# LICENSE
+#
+# Copyright (c) 2013 Gabriele Svelto <address@hidden>
+#
+# Copying and distribution of this file, with or without modification, are
+# permitted in any medium without royalty provided the copyright notice
+# and this notice are preserved. This file is offered as-is, without any
+# warranty.
+
+#serial 3
+
+AC_DEFUN([AX_GCC_VAR_ATTRIBUTE], [
+ AS_VAR_PUSHDEF([ac_var], [ax_cv_have_var_attribute_$1])
+
+ AC_CACHE_CHECK([for __attribute__(($1))], [ac_var], [
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([
+ m4_case([$1],
+ [aligned], [
+ int foo __attribute__(($1(32)));
+ ],
+ [cleanup], [
+ int bar(int *t) { return *t; };
+ ],
+ [common], [
+ int foo __attribute__(($1));
+ ],
+ [nocommon], [
+ int foo __attribute__(($1));
+ ],
+ [deprecated], [
+ int foo __attribute__(($1)) = 0;
+ ],
+ [mode], [
+ long foo __attribute__(($1(word)));
+ ],
+ [packed], [
+ struct bar {
+ int baz __attribute__(($1));
+ };
+ ],
+ [tls_model], [
+ __thread int bar1 __attribute__(($1("global-dynamic")));
+ __thread int bar2 __attribute__(($1("local-dynamic")));
+ __thread int bar3 __attribute__(($1("initial-exec")));
+ __thread int bar4 __attribute__(($1("local-exec")));
+ ],
+ [unused], [
+ int foo __attribute__(($1));
+ ],
+ [used], [
+ int foo __attribute__(($1));
+ ],
+ [vector_size], [
+ int foo __attribute__(($1(16)));
+ ],
+ [weak], [
+ int foo __attribute__(($1));
+ ],
+ [dllimport], [
+ int foo __attribute__(($1));
+ ],
+ [dllexport], [
+ int foo __attribute__(($1));
+ ],
+ [init_priority], [
+ struct bar { bar() {} ~bar() {} };
+ bar b __attribute__(($1(65535/2)));
+ ],
+ [
+ m4_warn([syntax], [Unsupported attribute $1, the test may
fail])
+ int foo __attribute__(($1));
+ ]
+ )], [
+ m4_case([$1],
+ [cleanup], [
+ int foo __attribute__(($1(bar))) = 0;
+ foo = foo + 1;
+ ],
+ []
+ )])
+ ],
+ dnl GCC doesn't exit with an error if an unknown attribute is
+ dnl provided but only outputs a warning, so accept the attribute
+ dnl only if no warning were issued.
+ [AS_IF([test -s conftest.err],
+ [AS_VAR_SET([ac_var], [no])],
+ [AS_VAR_SET([ac_var], [yes])])],
+ [AS_VAR_SET([ac_var], [no])])
+ ])
+
+ AS_IF([test yes = AS_VAR_GET([ac_var])],
+ [AC_DEFINE_UNQUOTED(AS_TR_CPP(HAVE_VAR_ATTRIBUTE_$1), 1,
+ [Define to 1 if the system has the `$1' variable attribute])], [])
+
+ AS_VAR_POPDEF([ac_var])
+])
diff --git a/src/Makefile.in b/src/Makefile.in
index d667c55..15171d4 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -230,6 +230,11 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
LIBZ = @LIBZ@
+## system-specific libs for dynamic modules, else empty
+LIBMODULES = @LIBMODULES@
+## dynlib.o module.o if modules enabled, else empty
+MODULES_OBJ = @MODULES_OBJ@
+
XRANDR_LIBS = @XRANDR_LIBS@
XRANDR_CFLAGS = @XRANDR_CFLAGS@
@@ -377,7 +382,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o
$(XMENU_OBJ) window.o \
minibuf.o fileio.o dired.o \
cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
alloc.o data.o doc.o editfns.o callint.o \
- eval.o floatfns.o fns.o font.o print.o lread.o \
+ eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
syntax.o $(UNEXEC_OBJ) bytecode.o \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
@@ -468,7 +473,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE)
$(LIBIMAGE) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
- $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ)
+ $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES)
$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
$(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)"
diff --git a/src/alloc.c b/src/alloc.c
index 48ce3f1..53f9745 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5574,6 +5574,10 @@ garbage_collect_1 (void *end)
mark_fringe_data ();
#endif
+#ifdef HAVE_MODULES
+ mark_modules ();
+#endif
+
/* Everything is now marked, except for the data in font caches,
undo lists, and finalizers. The first two are compacted by
removing an items which aren't reachable otherwise. */
diff --git a/src/emacs.c b/src/emacs.c
index b4052b8..ba71ceb 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -776,6 +776,10 @@ main (int argc, char **argv)
atexit (close_output_streams);
+#ifdef HAVE_MODULES
+ module_init ();
+#endif
+
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
@@ -1450,6 +1454,11 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
syms_of_terminal ();
syms_of_term ();
syms_of_undo ();
+
+#ifdef HAVE_MODULES
+ syms_of_module ();
+#endif
+
#ifdef HAVE_SOUND
syms_of_sound ();
#endif
diff --git a/src/emacs_module.h b/src/emacs_module.h
new file mode 100644
index 0000000..4b774fe
--- /dev/null
+++ b/src/emacs_module.h
@@ -0,0 +1,230 @@
+/*
+ emacs_module.h - Module API
+ Copyright (C) 2015 Free Software Foundation, Inc.
+
+ 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.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#ifndef EMACS_MODULE_H
+#define EMACS_MODULE_H
+
+#include <stdint.h>
+#include <stdlib.h>
+#include <stdbool.h>
+
+#ifdef __cplusplus
+#define EMACS_EXTERN_C_BEGIN extern "C" {
+#define EMACS_EXTERN_C_END }
+#else
+#define EMACS_EXTERN_C_BEGIN
+#define EMACS_EXTERN_C_END
+#endif
+
+#if defined(__cplusplus) && __cplusplus >= 201103L
+#define EMACS_NOEXCEPT noexcept
+#else
+#define EMACS_NOEXCEPT
+#endif
+
+EMACS_EXTERN_C_BEGIN
+
+/* Current environement */
+typedef struct emacs_env_25 emacs_env;
+
+/* Opaque structure pointer representing an Emacs Lisp value */
+typedef struct emacs_value_tag* emacs_value;
+
+enum emacs_arity {
+ emacs_variadic_function = -2
+};
+
+/* Struct passed to a module init function (emacs_module_init) */
+struct emacs_runtime {
+ /* Structure size (for version checking) */
+ size_t size;
+
+ /* Private data; users should not touch this */
+ struct emacs_runtime_private *private_members;
+
+ /* Returns an environment pointer. */
+ emacs_env* (*get_environment)(struct emacs_runtime *ert);
+};
+
+
+/* Function prototype for the module init function */
+typedef int (*emacs_init_function)(struct emacs_runtime *ert);
+
+/* Function prototype for the module Lisp functions */
+typedef emacs_value (*emacs_subr)(emacs_env *env,
+ int nargs,
+ emacs_value args[],
+ void *data);
+
+/* Function prototype for module user-pointer finalizers */
+typedef void (*emacs_finalizer_function)(void*);
+
+/* Possible Emacs function call outcomes. */
+enum emacs_funcall_exit {
+ /* Function has returned normally. */
+ emacs_funcall_exit_return = 0,
+ /* Function has signaled an error using `signal'. */
+ emacs_funcall_exit_signal = 1,
+ /* Function has exit using `throw'. */
+ emacs_funcall_exit_throw = 2,
+};
+
+struct emacs_env_25 {
+ /*
+ * Structure size (for version checking)
+ */
+
+ size_t size;
+
+ /* Private data; users should not touch this */
+ struct emacs_env_private *private_members;
+
+ /*
+ * Memory management
+ */
+
+
+ emacs_value (*make_global_ref)(emacs_env *env,
+ emacs_value any_reference);
+
+ void (*free_global_ref)(emacs_env *env,
+ emacs_value global_reference);
+
+ /*
+ * Non-local exit handling
+ */
+
+ enum emacs_funcall_exit (*non_local_exit_check)(emacs_env *env);
+
+ void (*non_local_exit_clear)(emacs_env *env);
+
+ enum emacs_funcall_exit (*non_local_exit_get)(emacs_env *env,
+ emacs_value *non_local_exit_symbol_out,
+ emacs_value *non_local_exit_data_out);
+
+ void (*non_local_exit_signal)(emacs_env *env,
+ emacs_value non_local_exit_symbol,
+ emacs_value non_local_exit_data);
+
+ void (*non_local_exit_throw)(emacs_env *env,
+ emacs_value tag,
+ emacs_value value);
+
+ /*
+ * Function registration
+ */
+
+ emacs_value (*make_function)(emacs_env *env,
+ int min_arity,
+ int max_arity,
+ emacs_value (*function)(emacs_env*, int,
emacs_value*, void*) EMACS_NOEXCEPT,
+ const char *documentation,
+ void *data);
+
+ emacs_value (*funcall)(emacs_env *env,
+ emacs_value function,
+ int nargs,
+ emacs_value args[]);
+
+ emacs_value (*intern)(emacs_env *env,
+ const char *symbol_name);
+
+ /*
+ * Type conversion
+ */
+
+ emacs_value (*type_of)(emacs_env *env,
+ emacs_value value);
+
+ bool (*is_not_nil)(emacs_env *env, emacs_value value);
+
+ bool (*eq)(emacs_env *env, emacs_value a, emacs_value b);
+
+ int64_t (*extract_integer)(emacs_env *env,
+ emacs_value value);
+
+ emacs_value (*make_integer)(emacs_env *env,
+ int64_t value);
+
+ double (*extract_float)(emacs_env *env,
+ emacs_value value);
+
+ emacs_value (*make_float)(emacs_env *env,
+ double value);
+
+ /*
+ * Copy the content of the lisp string VALUE to BUFFER as an utf8
+ * null-terminated string.
+ *
+ * SIZE must point to the total size of the buffer. If BUFFER is
+ * NULL or if SIZE is not big enough, write the required buffer size
+ * to SIZE and return false.
+ *
+ * Note that SIZE must include the last null byte (e.g. "abc" needs
+ * a buffer of size 4).
+ *
+ * Returns true if the string was successfully copied.
+ */
+
+ bool (*copy_string_contents)(emacs_env *env,
+ emacs_value value,
+ char *buffer,
+ size_t *size_inout);
+
+ /*
+ * Create a lisp string from a utf8 encoded string.
+ */
+ emacs_value (*make_string)(emacs_env *env,
+ const char *contents, size_t length);
+
+ /*
+ * Embedded pointer type
+ */
+ emacs_value (*make_user_ptr)(emacs_env *env,
+ void (*fin)(void *) EMACS_NOEXCEPT,
+ void *ptr);
+
+ void* (*get_user_ptr)(emacs_env *env, emacs_value uptr);
+ void (*set_user_ptr)(emacs_env *env, emacs_value uptr, void *ptr);
+
+ void (*(*get_user_finalizer)(emacs_env *env, emacs_value uptr))(void *)
EMACS_NOEXCEPT;
+ void (*set_user_finalizer)(emacs_env *env,
+ emacs_value uptr,
+ void (*fin)(void *) EMACS_NOEXCEPT);
+
+ /*
+ * Vector functions
+ */
+ emacs_value (*vec_get) (emacs_env *env,
+ emacs_value vec,
+ size_t i);
+
+ void (*vec_set) (emacs_env *env,
+ emacs_value vec,
+ size_t i,
+ emacs_value val);
+
+ size_t (*vec_size) (emacs_env *env,
+ emacs_value vec);
+};
+
+EMACS_EXTERN_C_END
+
+#endif /* EMACS_MODULE_H */
diff --git a/src/lisp.h b/src/lisp.h
index 02c1969..3b6ea76 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3916,6 +3916,10 @@ extern bool let_shadows_global_binding_p (Lisp_Object
symbol);
/* Defined in alloc.c. */
extern Lisp_Object make_user_ptr (void (*finalizer) (void*), void *p);
+/* Defined in module.c. */
+extern void module_init (void);
+extern void mark_modules (void);
+extern void syms_of_module (void);
#endif
/* Defined in editfns.c. */
diff --git a/src/module.c b/src/module.c
new file mode 100644
index 0000000..125fd7f
--- /dev/null
+++ b/src/module.c
@@ -0,0 +1,1185 @@
+/*
+ module.c - Module loading and runtime implementation
+ Copyright (C) 2015 Free Software Foundation, Inc.
+
+ 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.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#include <stdbool.h>
+#include <stddef.h>
+#include <stdint.h>
+#include <stdio.h>
+
+#include <config.h>
+#include "lisp.h"
+#include "emacs_module.h"
+#include "dynlib.h"
+#include "coding.h"
+#include "verify.h"
+
+
+/* Feature tests */
+
+enum {
+ /* 1 if we have __attribute__((cleanup(...))), 0 otherwise */
+ module_has_cleanup =
+#ifdef HAVE_VAR_ATTRIBUTE_CLEANUP
+ 1
+#else
+ 0
+#endif
+};
+
+/* Handle to the main thread. Used to verify that modules call us in
+ the right thread. */
+#if defined(HAVE_THREADS_H)
+#include <threads.h>
+static thrd_t main_thread;
+#elif defined(HAVE_PTHREAD)
+#include <pthread.h>
+static pthread_t main_thread;
+#elif defined(WINDOWSNT)
+#include <windows.h>
+/* On Windows, we store a handle to the main thread instead of the
+ thread ID because the latter can be reused when a thread terminates. */
+static HANDLE main_thread;
+#endif
+
+
+/* Implementation of runtime and environment functions */
+
+static emacs_env* module_get_environment (struct emacs_runtime *ert);
+
+static emacs_value module_make_global_ref (emacs_env *env,
+ emacs_value ref);
+static void module_free_global_ref (emacs_env *env,
+ emacs_value ref);
+static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *env);
+static void module_non_local_exit_clear (emacs_env *env);
+static enum emacs_funcall_exit module_non_local_exit_get (emacs_env *env,
emacs_value *sym, emacs_value *data);
+static void module_non_local_exit_signal (emacs_env *env, emacs_value sym,
emacs_value data);
+static void module_non_local_exit_throw (emacs_env *env, emacs_value tag,
emacs_value value);
+static emacs_value module_make_function (emacs_env *env,
+ int min_arity,
+ int max_arity,
+ emacs_subr subr,
+ const char *documentation,
+ void *data);
+static emacs_value module_funcall (emacs_env *env,
+ emacs_value fun,
+ int nargs,
+ emacs_value args[]);
+static emacs_value module_intern (emacs_env *env, const char *name);
+static emacs_value module_type_of (emacs_env *env, emacs_value value);
+static bool module_is_not_nil (emacs_env *env, emacs_value value);
+static bool module_eq (emacs_env *env, emacs_value a, emacs_value b);
+static int64_t module_extract_integer (emacs_env *env, emacs_value n);
+static emacs_value module_make_integer (emacs_env *env, int64_t n);
+static emacs_value module_make_float (emacs_env *env, double d);
+static double module_extract_float (emacs_env *env, emacs_value f);
+static bool module_copy_string_contents (emacs_env *env,
+ emacs_value value,
+ char *buffer,
+ size_t* length);
+static emacs_value module_make_string (emacs_env *env, const char *str, size_t
lenght);
+static emacs_value module_make_user_ptr (emacs_env *env,
+ emacs_finalizer_function fin,
+ void *ptr);
+static void* module_get_user_ptr (emacs_env *env, emacs_value uptr);
+static void module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr);
+static emacs_finalizer_function module_get_user_finalizer (emacs_env *env,
emacs_value uptr);
+static void module_set_user_finalizer (emacs_env *env,
+ emacs_value uptr,
+ emacs_finalizer_function fin);
+
+
+/* Helper functions */
+
+/* If checking is enabled, abort if the current thread is not the
+ Emacs main thread. */
+static void check_main_thread (void);
+
+/* Internal versions of `module_non_local_exit_signal' and
`module_non_local_exit_throw'. */
+static void module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
Lisp_Object data);
+static void module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
Lisp_Object value);
+
+/* Module version of `wrong_type_argument'. */
+static void module_wrong_type (emacs_env *env, Lisp_Object predicate,
Lisp_Object value);
+
+/* Signal an out-of-memory condition to the caller. */
+static void module_out_of_memory (emacs_env *env);
+
+/* Signal arguments are out of range. */
+static void module_args_out_of_range (emacs_env *env, Lisp_Object a1,
Lisp_Object a2);
+
+
+/* Value conversion */
+
+/* Converts an `emacs_value' to the corresponding internal object.
+ Never fails. */
+static Lisp_Object value_to_lisp (emacs_value v);
+
+/* Converts an internal object to an `emacs_value'. Allocates storage
+ from the environment; returns NULL if allocation fails. */
+static emacs_value lisp_to_value (emacs_env *env, Lisp_Object o);
+
+
+/* Memory management */
+
+/* An `emacs_value' is just a pointer to a structure holding an
+ internal Lisp object. */
+struct emacs_value_tag { Lisp_Object v; };
+
+/* Local value objects use a simple fixed-sized block allocation
+ scheme without explicit deallocation. All local values are
+ deallocated when the lifetime of their environment ends. We keep
+ track of a current frame from which new values are allocated,
+ appending further dynamically-allocated frames if necessary. */
+
+enum { value_frame_size = 512 };
+
+/* A block from which `emacs_value' object can be allocated. */
+struct emacs_value_frame {
+ /* Storage for values */
+ struct emacs_value_tag objects[value_frame_size];
+
+ /* Index of the next free value in `objects' */
+ size_t offset;
+
+ /* Pointer to next frame, if any */
+ struct emacs_value_frame *next;
+};
+
+/* Must be called for each frame before it can be used for
+ allocation. */
+static void initialize_frame (struct emacs_value_frame *frame);
+
+/* A structure that holds an initial frame (so that the first local
+ values require no dynamic allocation) and keeps track of the
+ current frame. */
+static struct emacs_value_storage {
+ struct emacs_value_frame initial;
+ struct emacs_value_frame *current;
+} global_storage;
+
+/* Must be called for any storage object before it can be used for
+ allocation. */
+static void initialize_storage (struct emacs_value_storage *storage);
+
+/* Must be called for any initialized storage object before its
+ lifetime ends. Frees all dynamically-allocated frames. */
+static void finalize_storage (struct emacs_value_storage *storage);
+
+/* Allocates a new value from STORAGE and stores OBJ in it. Returns
+ NULL if allocations fails and uses ENV for non local exit reporting. */
+static emacs_value allocate_emacs_value (emacs_env *env, struct
emacs_value_storage *storage,
+ Lisp_Object obj);
+
+
+/* Private runtime and environment members */
+
+/* The private part of an environment stores the current non local exit state
+ and holds the `emacs_value' objects allocated during the lifetime
+ of the environment. */
+struct emacs_env_private {
+ enum emacs_funcall_exit pending_non_local_exit;
+
+ /* Dedicated storage for non-local exit symbol and data so that we always
+ have storage available for them, even in an out-of-memory
+ situation. */
+ struct emacs_value_tag non_local_exit_symbol, non_local_exit_data;
+
+ struct emacs_value_storage storage;
+};
+
+/* Combines public and private parts in one structure. This structure
+ is used whenever an environment is created. */
+struct env_storage {
+ emacs_env pub;
+ struct emacs_env_private priv;
+};
+
+/* Must be called before the environment can be used. */
+static void initialize_environment (struct env_storage *env);
+
+/* Must be called before the lifetime of the environment object
+ ends. */
+static void finalize_environment (struct env_storage *env);
+
+/* The private parts of an `emacs_runtime' object contain the initial
+ environment. */
+struct emacs_runtime_private {
+ struct env_storage environment;
+};
+
+
+/* Convenience macros for non-local exit handling */
+
+/* Emacs uses setjmp(3) and longjmp(3) for non-local exits, but we
+ can't allow module frames to be skipped because they are in general
+ not prepared for long jumps (e.g. the behavior in C++ is undefined
+ if objects with nontrivial destructors would be skipped).
+ Therefore we catch all non-local exits. There are two kinds of
+ non-local exits: `signal' and `throw'. The macros in this section
+ can be used to catch both. We use macros so that we don't have to
+ write lots of additional variants of `internal_condition_case'
+ etc. and don't have to worry about passing information to the
+ handler functions. */
+
+/* Called on `signal'. ERR will be a cons cell (SYMBOL . DATA), which
+ gets stored in the environment. Sets the pending non-local exit flag. */
+static void module_handle_signal (emacs_env *env, Lisp_Object err);
+
+/* Called on `throw'. TAG_VAL will be a cons cell (TAG . VALUE),
+ which gets stored in the environment. Sets the pending non-local exit
+ flag. */
+static void module_handle_throw (emacs_env *env, Lisp_Object tag_val);
+
+/* Must be called after setting up a handler immediately before
+ returning from the function. See the comments in lisp.h and the
+ code in eval.c for details. The macros below arrange for this
+ function to be called automatically. DUMMY is ignored. */
+static void module_reset_handlerlist (const int *dummy);
+
+/* Place this macro at the beginning of a function returning a number
+ or a pointer to handle signals. The function must have an ENV
+ parameter. The function will return 0 (or NULL) if a signal is
+ caught. */
+#define MODULE_HANDLE_SIGNALS MODULE_HANDLE_SIGNALS_RETURN(0)
+
+/* Place this macro at the beginning of a function returning void to
+ handle signals. The function must have an ENV parameter. */
+#define MODULE_HANDLE_SIGNALS_VOID MODULE_HANDLE_SIGNALS_RETURN()
+
+#define MODULE_HANDLE_SIGNALS_RETURN(retval)
\
+ MODULE_SETJMP(CONDITION_CASE, module_handle_signal, retval)
+
+/* Place this macro at the beginning of a function returning a pointer
+ to handle non-local exits via `throw'. The function must have an
+ ENV parameter. The function will return NULL if a `throw' is
+ caught. */
+#define MODULE_HANDLE_THROW
\
+ MODULE_SETJMP(CATCHER_ALL, module_handle_throw, NULL)
+
+#define MODULE_SETJMP(handlertype, handlerfunc, retval)
\
+ MODULE_SETJMP_1(handlertype, handlerfunc, retval,
\
+ internal_handler_##handlertype,
\
+ internal_cleanup_##handlertype)
+
+#define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy)
\
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
\
+ struct handler *c;
\
+ /* It is very important that pushing the handler doesn't itself raise a
\
+ signal. */
\
+ if (!push_handler_nosignal(&c, Qt, handlertype)) {
\
+ module_out_of_memory(env);
\
+ return retval;
\
+ }
\
+ verify(module_has_cleanup);
\
+ /* We can install the cleanup only after the handler has been pushed. Use
\
+ __attribute__((cleanup)) to avoid non-local-exit-prone manual cleanup. */
\
+ const int dummy __attribute__((cleanup(module_reset_handlerlist)));
\
+ if (sys_setjmp(c->jmp)) {
\
+ (handlerfunc)(env, c->val);
\
+ return retval;
\
+ }
\
+ /* Force the macro to be followed by a semicolon. */
\
+ do {
\
+ } while (0)
+
+
+/* Function environments */
+
+/* A function environment is an auxiliary structure used by
+ `module_make_function' to store information about a module
+ function. It is stored in a save pointer and retrieved by
+ `module-call'. Its members correspond to the arguments given to
+ `module_make_function'. */
+
+struct module_fun_env
+{
+ int min_arity, max_arity;
+ emacs_subr subr;
+ void *data;
+};
+
+/* Returns a string object that contains a user-friendly
+ representation of the function environment. */
+static Lisp_Object module_format_fun_env (const struct module_fun_env *env);
+
+/* Holds the function definition of `module-call'. `module-call' is
+ uninterned because user code couldn't meaningfully use it, so we
+ have to keep its definition around somewhere else. */
+static Lisp_Object module_call_func;
+
+
+/* Implementation of runtime and environment functions */
+
+/* We catch signals and throws only if the code can actually signal or
+ throw. */
+
+static emacs_env* module_get_environment (struct emacs_runtime *ert)
+{
+ check_main_thread ();
+ return &ert->private_members->environment.pub;
+}
+
+/*
+ * To make global refs (GC-protected global values) we keep a hash
+ * that maps global Lisp objects to reference counts.
+ */
+
+static emacs_value module_make_global_ref (emacs_env *env,
+ emacs_value ref)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+ eassert (HASH_TABLE_P (Vmodule_refs_hash));
+ struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
+ Lisp_Object new_obj = value_to_lisp (ref);
+ EMACS_UINT hashcode;
+ ptrdiff_t i = hash_lookup (h, new_obj, &hashcode);
+
+ if (i >= 0)
+ {
+ Lisp_Object value = HASH_VALUE (h, i);
+ eassert (NATNUMP (value));
+ const EMACS_UINT refcount = XFASTINT (value);
+ if (refcount >= MOST_POSITIVE_FIXNUM)
+ {
+ module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
+ return NULL;
+ }
+ XSETFASTINT (value, refcount + 1);
+ set_hash_value_slot (h, i, value);
+ }
+ else
+ {
+ hash_put (h, new_obj, make_natnum (1), hashcode);
+ }
+
+ return allocate_emacs_value (env, &global_storage, new_obj);
+}
+
+static void module_free_global_ref (emacs_env *env,
+ emacs_value ref)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ /* TODO: This probably never signals. */
+ MODULE_HANDLE_SIGNALS_VOID;
+ eassert (HASH_TABLE_P (Vmodule_refs_hash));
+ struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
+ Lisp_Object obj = value_to_lisp (ref);
+ EMACS_UINT hashcode;
+ ptrdiff_t i = hash_lookup (h, obj, &hashcode);
+
+ if (i >= 0)
+ {
+ Lisp_Object value = HASH_VALUE (h, i);
+ eassert (NATNUMP (value));
+ const EMACS_UINT refcount = XFASTINT (value);
+ eassert (refcount > 0);
+ if (refcount > 1)
+ {
+ XSETFASTINT (value, refcount - 1);
+ set_hash_value_slot (h, i, value);
+ }
+ else
+ {
+ hash_remove_from_table (h, value);
+ }
+ }
+}
+
+static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *env)
+{
+ check_main_thread ();
+ return env->private_members->pending_non_local_exit;
+}
+
+static void module_non_local_exit_clear (emacs_env *env)
+{
+ check_main_thread ();
+ env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
+}
+
+static enum emacs_funcall_exit module_non_local_exit_get (emacs_env *env,
emacs_value *sym, emacs_value *data)
+{
+ check_main_thread ();
+ struct emacs_env_private *const p = env->private_members;
+ if (p->pending_non_local_exit != emacs_funcall_exit_return)
+ {
+ *sym = &p->non_local_exit_symbol;
+ *data = &p->non_local_exit_data;
+ }
+ return p->pending_non_local_exit;
+}
+
+/*
+ * Like for `signal', DATA must be a list
+ */
+static void module_non_local_exit_signal (emacs_env *env, emacs_value sym,
emacs_value data)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ module_non_local_exit_signal_1 (env, value_to_lisp (sym), value_to_lisp
(data));
+}
+
+static void module_non_local_exit_throw (emacs_env *env, emacs_value tag,
emacs_value value)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ module_non_local_exit_throw_1 (env, value_to_lisp (tag), value_to_lisp
(value));
+}
+
+/*
+ * A module function is lambda function that calls `module-call',
+ * passing the function pointer of the module function along with the
+ * module emacs_env pointer as arguments.
+ *
+ * (function
+ * (lambda
+ * (&rest arglist)
+ * (module-call
+ * envobj
+ * arglist)))
+ *
+ */
+static emacs_value module_make_function (emacs_env *env,
+ int min_arity,
+ int max_arity,
+ emacs_subr subr,
+ const char *const documentation,
+ void *data)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+
+ if (min_arity > MOST_POSITIVE_FIXNUM || max_arity > MOST_POSITIVE_FIXNUM)
+ xsignal0 (Qoverflow_error);
+
+ if (min_arity < 0 ||
+ (max_arity >= 0 && max_arity < min_arity) ||
+ (max_arity < 0 && max_arity != emacs_variadic_function))
+ xsignal2 (Qinvalid_arity, make_number (min_arity), make_number
(max_arity));
+
+ Lisp_Object envobj;
+
+ /* XXX: This should need to be freed when envobj is GC'd */
+ struct module_fun_env *envptr = xzalloc (sizeof (*envptr));
+ envptr->min_arity = min_arity;
+ envptr->max_arity = max_arity;
+ envptr->subr = subr;
+ envptr->data = data;
+ envobj = make_save_ptr (envptr);
+
+ Lisp_Object ret = list4 (Qlambda,
+ list2 (Qand_rest, Qargs),
+ documentation ? build_string (documentation) : Qnil,
+ list3 (module_call_func,
+ envobj,
+ Qargs));
+
+ return lisp_to_value (env, ret);
+}
+
+static emacs_value module_funcall (emacs_env *env,
+ emacs_value fun,
+ int nargs,
+ emacs_value args[])
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+ MODULE_HANDLE_THROW;
+
+ /*
+ * Make a new Lisp_Object array starting with the function as the
+ * first arg, because that's what Ffuncall takes
+ */
+ Lisp_Object newargs[nargs + 1];
+ newargs[0] = value_to_lisp (fun);
+ for (int i = 0; i < nargs; i++)
+ newargs[1 + i] = value_to_lisp (args[i]);
+ return lisp_to_value (env, Ffuncall (nargs + 1, newargs));
+}
+
+static emacs_value module_intern (emacs_env *env, const char *name)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+ return lisp_to_value (env, intern (name));
+}
+
+static emacs_value module_type_of (emacs_env *env, emacs_value value)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ return lisp_to_value (env, Ftype_of (value_to_lisp (value)));
+}
+
+static bool module_is_not_nil (emacs_env *env, emacs_value value)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ return ! NILP (value_to_lisp (value));
+}
+
+static bool module_eq (emacs_env *env, emacs_value a, emacs_value b)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ return EQ (value_to_lisp (a), value_to_lisp (b));
+}
+
+static int64_t module_extract_integer (emacs_env *env, emacs_value n)
+{
+ verify (INT64_MIN <= MOST_NEGATIVE_FIXNUM);
+ verify (INT64_MAX >= MOST_POSITIVE_FIXNUM);
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ const Lisp_Object l = value_to_lisp (n);
+ if (! INTEGERP (l))
+ {
+ module_wrong_type (env, Qintegerp, l);
+ return 0;
+ }
+ return XINT (l);
+}
+
+static emacs_value module_make_integer (emacs_env *env, int64_t n)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ if (n < MOST_NEGATIVE_FIXNUM)
+ {
+ module_non_local_exit_signal_1 (env, Qunderflow_error, Qnil);
+ return NULL;
+ }
+ if (n > MOST_POSITIVE_FIXNUM)
+ {
+ module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
+ return NULL;
+ }
+ return lisp_to_value (env, make_number (n));
+}
+
+static double module_extract_float (emacs_env *env, emacs_value f)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ const Lisp_Object lisp = value_to_lisp (f);
+ if (! FLOATP (lisp))
+ {
+ module_wrong_type (env, Qfloatp, lisp);
+ return 0;
+ }
+ return XFLOAT_DATA (lisp);
+}
+
+static emacs_value module_make_float (emacs_env *env, double d)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+ return lisp_to_value (env, make_float (d));
+}
+
+static bool module_copy_string_contents (emacs_env *env,
+ emacs_value value,
+ char *buffer,
+ size_t* length)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+ Lisp_Object lisp_str = value_to_lisp (value);
+ if (! STRINGP (lisp_str))
+ {
+ module_wrong_type (env, Qstringp, lisp_str);
+ return false;
+ }
+
+ size_t raw_size = SBYTES (lisp_str);
+
+ /*
+ * Emacs internal encoding is more-or-less UTF8, let's assume utf8
+ * encoded emacs string are the same byte size.
+ */
+
+ if (!buffer || length == 0 || *length-1 < raw_size)
+ {
+ *length = raw_size + 1;
+ return false;
+ }
+
+ Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
+ eassert (raw_size == SBYTES (lisp_str_utf8));
+ *length = raw_size + 1;
+ memcpy (buffer, SDATA (lisp_str_utf8), SBYTES (lisp_str_utf8));
+ buffer[raw_size] = 0;
+
+ return true;
+}
+
+static emacs_value module_make_string (emacs_env *env, const char *str, size_t
length)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ MODULE_HANDLE_SIGNALS;
+ if (length > PTRDIFF_MAX)
+ {
+ module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
+ return NULL;
+ }
+ /* Assume STR is utf8 encoded */
+ return lisp_to_value (env, make_string (str, length));
+}
+
+static emacs_value module_make_user_ptr (emacs_env *env,
+ emacs_finalizer_function fin,
+ void *ptr)
+{
+ check_main_thread ();
+ return lisp_to_value (env, make_user_ptr (fin, ptr));
+}
+
+static void* module_get_user_ptr (emacs_env *env, emacs_value uptr)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ const Lisp_Object lisp = value_to_lisp (uptr);
+ if (! USER_PTRP (lisp))
+ {
+ module_wrong_type (env, Quser_ptr, lisp);
+ return NULL;
+ }
+ return XUSER_PTR (lisp)->p;
+}
+
+static void module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ const Lisp_Object lisp = value_to_lisp (uptr);
+ if (! USER_PTRP (lisp)) module_wrong_type (env, Quser_ptr, lisp);
+ XUSER_PTR (lisp)->p = ptr;
+}
+
+static emacs_finalizer_function module_get_user_finalizer (emacs_env *env,
emacs_value uptr)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ const Lisp_Object lisp = value_to_lisp (uptr);
+ if (! USER_PTRP (lisp))
+ {
+ module_wrong_type (env, Quser_ptr, lisp);
+ return NULL;
+ }
+ return XUSER_PTR (lisp)->finalizer;
+}
+
+static void module_set_user_finalizer (emacs_env *env,
+ emacs_value uptr,
+ emacs_finalizer_function fin)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ const Lisp_Object lisp = value_to_lisp (uptr);
+ if (! USER_PTRP (lisp)) module_wrong_type (env, Quser_ptr, lisp);
+ XUSER_PTR (lisp)->finalizer = fin;
+}
+
+static void module_vec_set (emacs_env *env,
+ emacs_value vec,
+ size_t i,
+ emacs_value val)
+{
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ if (i > MOST_POSITIVE_FIXNUM)
+ {
+ module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
+ return;
+ }
+ Lisp_Object lvec = value_to_lisp (vec);
+ if (! VECTORP (lvec))
+ {
+ module_wrong_type (env, Qvectorp, lvec);
+ return;
+ }
+ if (i >= ASIZE (lvec))
+ {
+ module_args_out_of_range (env, lvec, make_number (i));
+ return;
+ }
+ ASET (lvec, i, value_to_lisp (val));
+}
+
+static emacs_value module_vec_get (emacs_env *env,
+ emacs_value vec,
+ size_t i)
+{
+ /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits */
+ verify (PTRDIFF_MAX <= SIZE_MAX);
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ if (i > MOST_POSITIVE_FIXNUM)
+ {
+ module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
+ return NULL;
+ }
+ Lisp_Object lvec = value_to_lisp (vec);
+ if (! VECTORP (lvec))
+ {
+ module_wrong_type (env, Qvectorp, lvec);
+ return NULL;
+ }
+ /* Prevent error-prone comparison between types of different signedness. */
+ const size_t size = ASIZE (lvec);
+ eassert (size >= 0);
+ if (i >= size)
+ {
+ if (i > MOST_POSITIVE_FIXNUM) i = MOST_POSITIVE_FIXNUM;
+ module_args_out_of_range (env, lvec, make_number (i));
+ return NULL;
+ }
+ return lisp_to_value (env, AREF (lvec, i));
+}
+
+static size_t module_vec_size (emacs_env *env,
+ emacs_value vec)
+{
+ /* Type of ASIZE (lvec) is ptrdiff_t, make sure it fits */
+ verify (PTRDIFF_MAX <= SIZE_MAX);
+ check_main_thread ();
+ eassert (module_non_local_exit_check (env) == emacs_funcall_exit_return);
+ Lisp_Object lvec = value_to_lisp (vec);
+ if (! VECTORP (lvec))
+ {
+ module_wrong_type (env, Qvectorp, lvec);
+ return 0;
+ }
+ eassert (ASIZE (lvec) >= 0);
+ return ASIZE (lvec);
+}
+
+
+/* Subroutines */
+
+DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
+ doc: /* Load module FILE. */)
+ (Lisp_Object file)
+{
+ dynlib_handle_ptr handle;
+ emacs_init_function module_init;
+ void *gpl_sym;
+ Lisp_Object doc_name, args[2];
+
+ CHECK_STRING (file);
+ handle = dynlib_open (SDATA (file));
+ if (!handle)
+ error ("Cannot load file %s: %s", SDATA (file), dynlib_error ());
+
+ gpl_sym = dynlib_sym (handle, "plugin_is_GPL_compatible");
+ if (!gpl_sym)
+ error ("Module %s is not GPL compatible", SDATA (file));
+
+ module_init = (emacs_init_function) dynlib_sym (handle, "emacs_module_init");
+ if (!module_init)
+ error ("Module %s does not have an init function.", SDATA (file));
+
+ struct {
+ struct emacs_runtime pub;
+ struct emacs_runtime_private priv;
+ } runtime = {
+ .pub = {
+ .size = sizeof runtime.pub,
+ .get_environment = module_get_environment,
+ .private_members = &runtime.priv
+ }
+ };
+ initialize_environment (&runtime.priv.environment);
+ int r = module_init (&runtime.pub);
+ finalize_environment (&runtime.priv.environment);
+
+ if (r != 0)
+ {
+ if (r < MOST_NEGATIVE_FIXNUM)
+ xsignal0 (Qunderflow_error);
+ if (r > MOST_POSITIVE_FIXNUM)
+ xsignal0 (Qoverflow_error);
+ xsignal2 (Qmodule_load_failed, file, make_number (r));
+ }
+
+ return Qt;
+}
+
+DEFUN ("module-call", Fmodule_call, Smodule_call, 2, 2, 0,
+ doc: /* Internal function to call a module function.
+ENVOBJ is a save pointer to a module_fun_env structure.
+ARGLIST is a list of arguments passed to SUBRPTR. */)
+ (Lisp_Object envobj, Lisp_Object arglist)
+{
+ const struct module_fun_env *const envptr =
+ (const struct module_fun_env *) XSAVE_POINTER (envobj, 0);
+ const EMACS_INT len = XINT (Flength (arglist));
+ eassert (len >= 0);
+ if (len > MOST_POSITIVE_FIXNUM)
+ xsignal0 (Qoverflow_error);
+ if (len > INT_MAX || len < envptr->min_arity || (envptr->max_arity >= 0 &&
len > envptr->max_arity))
+ xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr),
make_number (len));
+
+ struct env_storage env;
+ initialize_environment (&env);
+
+ emacs_value *args = xzalloc (len * sizeof (*args));
+ int i;
+
+ for (i = 0; i < len; i++)
+ {
+ args[i] = lisp_to_value (&env.pub, XCAR (arglist));
+ if (! args[i]) memory_full (sizeof *args[i]);
+ arglist = XCDR (arglist);
+ }
+
+ emacs_value ret = envptr->subr (&env.pub, len, args, envptr->data);
+ xfree (args);
+
+ switch (env.priv.pending_non_local_exit)
+ {
+ case emacs_funcall_exit_return:
+ finalize_environment (&env);
+ if (ret == NULL) xsignal1 (Qinvalid_module_call, module_format_fun_env
(envptr));
+ return value_to_lisp (ret);
+ case emacs_funcall_exit_signal:
+ {
+ const Lisp_Object symbol = value_to_lisp
(&env.priv.non_local_exit_symbol);
+ const Lisp_Object data = value_to_lisp (&env.priv.non_local_exit_data);
+ finalize_environment (&env);
+ xsignal (symbol, data);
+ }
+ case emacs_funcall_exit_throw:
+ {
+ const Lisp_Object tag = value_to_lisp
(&env.priv.non_local_exit_symbol);
+ const Lisp_Object value = value_to_lisp
(&env.priv.non_local_exit_data);
+ finalize_environment (&env);
+ Fthrow (tag, value);
+ }
+ }
+}
+
+
+/* Helper functions */
+
+static void check_main_thread (void)
+{
+#if defined(HAVE_THREADS_H)
+ eassert (thrd_equal (thdr_current (), main_thread);
+#elif defined(HAVE_PTHREAD)
+ eassert (pthread_equal (pthread_self (), main_thread));
+#elif defined(WINDOWSNT)
+ /* CompareObjectHandles would be perfect, but is only available in
+ Windows 10. Also check whether the thread is still running to
+ protect against thread identifier reuse. */
+ eassert (GetCurrentThreadID () == GetThreadID (main_thread) &&
+ WaitForSingleObject (main_thread, 0) == WAIT_TIMEOUT);
+#endif
+}
+
+static void module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
Lisp_Object data)
+{
+ struct emacs_env_private *const p = env->private_members;
+ eassert (p->pending_non_local_exit == emacs_funcall_exit_return);
+ p->pending_non_local_exit = emacs_funcall_exit_signal;
+ p->non_local_exit_symbol.v = sym;
+ p->non_local_exit_data.v = data;
+}
+
+static void module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
Lisp_Object value)
+{
+ struct emacs_env_private *const p = env->private_members;
+ eassert (p->pending_non_local_exit == emacs_funcall_exit_return);
+ p->pending_non_local_exit = emacs_funcall_exit_throw;
+ p->non_local_exit_symbol.v = tag;
+ p->non_local_exit_data.v = value;
+}
+
+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));
+}
+
+static void module_out_of_memory (emacs_env *env)
+{
+ // TODO: Reimplement this so it works even if memory-signal-data has been
modified.
+ module_non_local_exit_signal_1 (env, XCAR (Vmemory_signal_data), XCDR
(Vmemory_signal_data));
+}
+
+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 */
+
+static Lisp_Object value_to_lisp (emacs_value v)
+{
+ return v->v;
+}
+
+static emacs_value lisp_to_value (emacs_env *env, Lisp_Object o)
+{
+ struct emacs_env_private *const p = env->private_members;
+ if (p->pending_non_local_exit != emacs_funcall_exit_return) return NULL;
+ return allocate_emacs_value (env, &p->storage, o);
+}
+
+
+/* Memory management */
+
+static void initialize_frame (struct emacs_value_frame *frame)
+{
+ frame->offset = 0;
+ frame->next = NULL;
+}
+
+static void initialize_storage (struct emacs_value_storage *storage)
+{
+ initialize_frame (&storage->initial);
+ storage->current = &storage->initial;
+}
+
+static void finalize_storage (struct emacs_value_storage *storage)
+{
+ struct emacs_value_frame *next = storage->initial.next;
+ while (next != NULL)
+ {
+ struct emacs_value_frame *const current = next;
+ next = current->next;
+ free (current);
+ }
+}
+
+static emacs_value allocate_emacs_value (emacs_env *env, struct
emacs_value_storage *storage,
+ Lisp_Object obj)
+{
+ eassert (storage->current);
+ eassert (storage->current->offset < value_frame_size);
+ eassert (! storage->current->next);
+ if (storage->current->offset == value_frame_size - 1)
+ {
+ storage->current->next = malloc (sizeof *storage->current->next);
+ if (! storage->current->next)
+ {
+ module_out_of_memory (env);
+ return NULL;
+ }
+ initialize_frame (storage->current->next);
+ storage->current = storage->current->next;
+ }
+ const emacs_value value = storage->current->objects +
storage->current->offset;
+ value->v = obj;
+ ++storage->current->offset;
+ return value;
+}
+
+/* Mark all objects allocated from local environments so that they
+ don't get garbage-collected. */
+void mark_modules (void)
+{
+ for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem))
+ {
+ const struct env_storage *const env = XSAVE_POINTER (tem, 0);
+ for (const struct emacs_value_frame *frame = &env->priv.storage.initial;
frame != NULL; frame = frame->next)
+ for (size_t i = 0; i < frame->offset; ++i)
+ mark_object (frame->objects[i].v);
+ }
+}
+
+
+/* Environment lifetime management */
+
+static void initialize_environment (struct env_storage *env)
+{
+ env->priv.pending_non_local_exit = emacs_funcall_exit_return;
+ initialize_storage (&env->priv.storage);
+ env->pub.size = sizeof env->pub;
+ env->pub.private_members = &env->priv;
+ env->pub.make_global_ref = module_make_global_ref;
+ env->pub.free_global_ref = module_free_global_ref;
+ env->pub.non_local_exit_check = module_non_local_exit_check;
+ env->pub.non_local_exit_clear = module_non_local_exit_clear;
+ env->pub.non_local_exit_get = module_non_local_exit_get;
+ env->pub.non_local_exit_signal = module_non_local_exit_signal;
+ env->pub.non_local_exit_throw = module_non_local_exit_throw;
+ env->pub.make_function = module_make_function;
+ env->pub.funcall = module_funcall;
+ env->pub.intern = module_intern;
+ env->pub.type_of = module_type_of;
+ env->pub.is_not_nil = module_is_not_nil;
+ env->pub.eq = module_eq;
+ env->pub.extract_integer = module_extract_integer;
+ env->pub.make_integer = module_make_integer;
+ env->pub.extract_float = module_extract_float;
+ env->pub.make_float = module_make_float;
+ env->pub.copy_string_contents = module_copy_string_contents;
+ env->pub.make_string = module_make_string;
+ env->pub.make_user_ptr = module_make_user_ptr;
+ env->pub.get_user_ptr = module_get_user_ptr;
+ env->pub.set_user_ptr = module_set_user_ptr;
+ env->pub.get_user_finalizer = module_get_user_finalizer;
+ env->pub.set_user_finalizer = module_set_user_finalizer;
+ env->pub.vec_set = module_vec_set;
+ env->pub.vec_get = module_vec_get;
+ env->pub.vec_size = module_vec_size;
+ Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
+}
+
+static void finalize_environment (struct env_storage *env)
+{
+ finalize_storage (&env->priv.storage);
+ Vmodule_environments = XCDR (Vmodule_environments);
+}
+
+
+/* Non-local exit handling */
+
+static void module_reset_handlerlist(const int *dummy)
+{
+ handlerlist = handlerlist->next;
+}
+
+static void module_handle_signal (emacs_env *const env, const Lisp_Object err)
+{
+ module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err));
+}
+
+static void module_handle_throw (emacs_env *const env, const Lisp_Object
tag_val)
+{
+ module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val));
+}
+
+
+/* Function environments */
+
+static Lisp_Object module_format_fun_env (const struct module_fun_env *const
env)
+{
+ /* Try to print a function name if possible. */
+ const char *path, *sym;
+ if (dynlib_addr (env->subr, &path, &sym))
+ {
+ const char *const format = "#<module function %s from %s>";
+ const int size = snprintf (NULL, 0, format, sym, path);
+ eassert (size > 0);
+ char buffer[size + 1];
+ snprintf (buffer, sizeof buffer, format, sym, path);
+ return make_unibyte_string (buffer, size);
+ }
+ else
+ {
+ const char *const format = "#<module function at %p>";
+ const void *const subr = env->subr;
+ const int size = snprintf (NULL, 0, format, subr);
+ eassert (size > 0);
+ char buffer[size + 1];
+ snprintf (buffer, sizeof buffer, format, subr);
+ return make_unibyte_string (buffer, size);
+ }
+}
+
+
+/* Segment initializer */
+
+void syms_of_module (void)
+{
+ DEFSYM (Qmodule_refs_hash, "module-refs-hash");
+ DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash,
+ doc: /* Module global referrence table. */);
+
+ Vmodule_refs_hash = make_hash_table (hashtest_eq, make_number
(DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil);
+ Funintern (Qmodule_refs_hash, Qnil);
+
+ DEFSYM (Qmodule_environments, "module-environments");
+ DEFVAR_LISP ("module-environments", Vmodule_environments,
+ doc: /* List of active module environments. */);
+ Vmodule_environments = Qnil;
+ /* Unintern `module-environments' because it is only used
+ internally. */
+ Funintern (Qmodule_environments, Qnil);
+
+ DEFSYM (Qmodule_load_failed, "module-load-failed");
+ Fput (Qmodule_load_failed, Qerror_conditions,
+ listn (CONSTYPE_PURE, 2, Qmodule_load_failed, Qerror));
+ 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 (Qinvalid_arity, "invalid-arity");
+ Fput (Qinvalid_arity, Qerror_conditions,
+ listn (CONSTYPE_PURE, 2, Qinvalid_arity, Qerror));
+ Fput (Qinvalid_arity, Qerror_message,
+ build_pure_c_string ("Invalid function arity"));
+
+ initialize_storage (&global_storage);
+
+ /* Unintern `module-refs-hash' because it is internal-only and Lisp
+ code or modules should not access it. */
+ Funintern (Qmodule_refs_hash, Qnil);
+
+ defsubr (&Smodule_load);
+
+ /* Don't call defsubr on `module-call' because that would intern it,
+ but `module-call' is an internal function that users cannot
+ meaningfully use. Instead, assign its definition to a private
+ variable. */
+ XSETPVECTYPE (&Smodule_call, PVEC_SUBR);
+ XSETSUBR (module_call_func, &Smodule_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 we detect the main thread here. */
+#if defined(HAVE_THREADS_H)
+ main_thread = thrd_current ();
+#elif defined(HAVE_PTHREAD)
+ main_thread = pthread_self ();
+#elif defined(WINDOWSNT)
+ /* GetCurrentProcess returns a pseudohandle, which we have to duplicate. */
+ if (! DuplicateHandle (GetCurrentProcess(), GetCurrentThread(),
+ GetCurrentProcess(), &main_thread,
+ SYNCHRONIZE | THREAD_QUERY_LIMITED_INFORMATION,
+ FALSE, 0))
+ emacs_abort ();
+#endif
+}
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 7e70b27 13/20: Fix issue where a new tempfile was created every refresh, (continued)
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 7e70b27 13/20: Fix issue where a new tempfile was created every refresh, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 543b928 07/20: ; ChangeLog.2 fixes, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 e8a941e 11/20: * lisp/loadup.el: Set max-lisp-eval-depth here, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 970c64a 14/20: Add interactive seek command., Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 d3203d0 05/20: ; Auto-commit of ChangeLog files., Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 10b9929 15/20: Add catch-all & no-signal version of PUSH_HANDLER, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 1bbd450 16/20: Add portable layer for dynamic loading, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 449d1b2 17/20: Add new User Pointer (User_Ptr) type, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 39863f3 19/20: Make 'Fload' look for modules, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 6cc9efa 20/20: Add dynamic module test and helper script, Teodor Zlatanov, 2015/11/18
- [Emacs-diffs] feature/aptel/dynamic-modules-rc5 93235eb 18/20: Add dynamic module module support,
Teodor Zlatanov <=