[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] coverity 4a157e8 4/9: Merge remote-tracking branch 'origin
|
From: |
John Wiegley |
|
Subject: |
[Emacs-diffs] coverity 4a157e8 4/9: Merge remote-tracking branch 'origin/emacs-25' into coverity |
|
Date: |
Mon, 14 Dec 2015 19:38:16 +0000 |
branch: coverity
commit 4a157e827d6f169c294533e3c02938032bed12da
Merge: 5a9164b ca3bc79
Author: John Wiegley <address@hidden>
Commit: John Wiegley <address@hidden>
Merge remote-tracking branch 'origin/emacs-25' into coverity
---
.gitignore | 3 +
admin/release-process | 71 ++-
configure.ac | 47 ++-
lisp/cedet/semantic/db-find.el | 2 +-
lisp/cedet/semantic/find.el | 4 +-
lisp/cedet/semantic/fw.el | 2 +-
lisp/cedet/semantic/tag.el | 4 +-
lisp/erc/erc.el | 6 +-
lisp/ido.el | 2 +-
lisp/net/eww.el | 2 +-
lisp/progmodes/hideshow.el | 4 +-
lisp/progmodes/mantemp.el | 2 +-
lisp/server.el | 2 +-
lisp/vc/vc.el | 6 +-
m4/ax_gcc_var_attribute.m4 | 141 +++++
modules/mod-test/Makefile | 33 ++
modules/mod-test/mod-test.c | 273 +++++++++
modules/mod-test/test.el | 106 ++++
modules/modhelp.py | 198 +++++++
src/Makefile.in | 9 +-
src/alloc.c | 36 ++-
src/data.c | 24 +
src/dynlib.c | 109 ++++
src/dynlib.h | 33 ++
src/emacs.c | 9 +
src/eval.c | 53 ++-
src/fns.c | 5 +-
src/keyboard.c | 2 +-
src/lisp.h | 86 +++-
src/lread.c | 33 +-
src/module.c | 1197 ++++++++++++++++++++++++++++++++++++++++
src/module.h | 229 ++++++++
src/print.c | 13 +
33 files changed, 2665 insertions(+), 81 deletions(-)
diff --git a/.gitignore b/.gitignore
index fda50e9..86e377e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -42,6 +42,7 @@ InfoPlist.strings
Makefile
makefile
!etc/refcards/Makefile
+!modules/mod-test/Makefile
!test/automated/data/flymake/Makefile
!test/indent/Makefile
!test/etags/Makefile
@@ -139,6 +140,7 @@ src/stamp-h1
*.elc
*.o
*.res
+*.so
[0-9]*.core
core
core.*[0-9]
@@ -207,6 +209,7 @@ lisp/international/uni-*.el
*.cms
*.cp
*.cps
+*.doc
*.dvi
*.fn
*.fns
diff --git a/admin/release-process b/admin/release-process
index c403698..d0b55ba 100644
--- a/admin/release-process
+++ b/admin/release-process
@@ -10,21 +10,31 @@ The first phase of the release schedule is the "heads-down"
working
period for new features, on the `master' branch and several feature
branches.
-** Phase two: bugfixes
+** Phase two: fixing and stabilizing the release branch
Shortly before this phase, Emacs developers will be devoted to
figuring out what features to include in the next release and what
features to defer to a later release.
-At the beginning of this phase, a release branch called "emacs-NN"
-("NN" represents the major version number of the new Emacs release)
-will be cut from `master'.
-
-This phase is mostly spent fixing bugs and eliminating undocumented
-new features on the "emacs-NN" branch. Actually, the default branch
+This phase is mostly spent fixing bugs and documenting new features
+and changes on the "emacs-NN" branch. Actually, the default branch
for pushing any work in this phase should be "emacs-NN", except for
new features.
+At the beginning of this phase, a release branch called "emacs-NN"
+("NN" represents the major version number of the new Emacs release)
+will be cut from `master'. When that happens, the version number on
+`master' should be incremented; use admin/admin.el's `set-version'
+command to do that, then commit the changes it made and push to
+`master'. For major releases, also update the value of
+`customize-changed-options-previous-release'.
+
+The 2 main manuals, the User Manual and the Emacs Lisp Manual, need to
+be proofread, preferably by at least 2 different persons, and any
+uncovered problems fixed. This is a lot of work, so it is advisable
+to divide the job between several people (see the checklist near the
+end of this file).
+
In parallel to this phase, `master' can receive new features, to be
released in the next release cycle. From time to time, the master
branches merges bugfix commits from the "emacs-NN" branch.
@@ -49,8 +59,16 @@ files. See `admin/notes/years' for information about
maintaining
copyright years for GNU Emacs.
** Make sure the necessary sources and scripts for any generated files
-are included in the source tarfile. (They don't need to be installed,
-so eg admin/ is fine.)
+are included in the source tarball. (They don't need to be installed,
+so e.g. admin/ is fine.)
+
+** Regenerate AUTHORS by using admin/authors.el
+(The instructions are at the beginning of that file.)
+
+** Remove temporary +++/--- lines in NEWS.
+But first make sure there are no unmarked entries, and update the
+documentation (or decide no updates are necessary) for those that
+aren't.
** Manuals
Check for node names using problematic characters:
@@ -61,7 +79,15 @@ Check for major new features added since the last release
(e.g. new
lisp files), and add the relevant authors to the Acknowledgments in
doc/emacs/ack.texi and emacs.texi.
-Check cross-references between the manuals (eg from emacs to elisp)
+For major releases, rewrite the "Antinews" appendix of the User Manual
+(doc/emacs/anti.texi) to describe features lost by downgrading to the
+previous version. The way to do that is read NEWS, pick up the more
+significant changes and new features in the upcoming release, then
+describe the "benefits" from losing those features. Be funny, use
+humor. The text written for the previous major release can serve as
+good example.
+
+Check cross-references between the manuals (e.g. from emacs to elisp)
are correct. You can use something like the following in the info
directory in the Emacs build tree:
@@ -79,32 +105,31 @@ Redirect /software/emacs/manual/html_node/automake/
/software/automake/manual/ht
Another tool you can use to check links is gnu.org's linc.py:
http://www.gnu.org/server/source/
-You run this something like:
+You run this with something like:
cd /path/to/cvs/emacs-www
linc.py -o /path/to/output-dir --url http://www.gnu.org/software/emacs/ .
Be warned that it is really, really slow (as in, can take ~ a full day
to check the manual/ directory). It is probably best to run it on a
-single directory at a time from eg manual/html_node. It is very
+single directory at a time from e.g. manual/html_node. It is very
inefficient, but may reveal a few things that info-xref does not.
-
make emacs.dvi, elisp.dvi, and deal with any errors (undefined
references etc) in the output. Break any overfull lines.
Underfull hboxes are not serious, but it can be nice to get rid of
them if a simple rephrasing or rearrangement will work.
-Update the master menu and detailed menu (eg the antinews version).
+Update the master menu and detailed menu (e.g. the antinews version).
The command texinfo-multiple-files-update can do this, but you
-probably want to apply the results selectively (eg the current master
+probably want to apply the results selectively (e.g. the current master
menu has better line-breaks than the automatic version). It includes
the menu-entry name (if there is one) as well as the node name - using
only the latter looks better. Also, it doesn't seem to handle nested
includes, so will miss edebug.texi etc.
Check for widow and orphan lines in the printed manual; make sure all
-the pages really look ok in the manual as formatted. Orphans/widows
+the pages really look OK in the manual as formatted. Orphans/widows
are cases where the first/last line of a paragraph is on its own at
the end/start of a page, or where the last word in a paragraph is on
its own at the start of a line. It looks better if you reword/respace
@@ -118,9 +143,13 @@ pages of the manuals, and even if they do, the resulting
page breaks
depend on what paper and font size they use. This also means that if
you _are_ going to do this, it should be done with the paper and font
size that the GNU Press are going to use when they print the manuals.
-I think this is different to what you get if you just use eg 'make
+I think this is different to what you get if you just use e.g. 'make
emacs.pdf' (e.g., enable "smallbook").
+** Try to reorder NEWS: most important things first, related items together.
+
+** For a major release, add a "New in Emacs XX" section to faq.texi.
+
** Check the keybindings in the refcards are correct, and add any new ones.
What paper size are the English versions supposed to be on?
On Debian testing, the packages texlive-lang-czechslovak and
@@ -142,14 +171,6 @@ pt-br Rodrigo Real
ru Alex Ott
sk Miroslav Vaško
-** For a major release, add a "New in Emacs XX" section to faq.texi.
-
-** Remove temporary +++/--- lines in NEWS.
-
-** Try to reorder NEWS: most important things first, related items together.
-
-** Consider bumping customize-changed-options-previous-release.
-
** cusver-check from admin.el can help find new defcustoms missing
:version tags.
diff --git a/configure.ac b/configure.ac
index cfd591c..7c90610 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,46 @@ 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
+ 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 +5219,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 +5267,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 have dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars?
${USE_TOOLKIT_SCROLL_BARS}
"])
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index b441cd1..e5ce4cf 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -316,7 +316,7 @@ Default action as described in
`semanticdb-find-translate-path'."
;;;###autoload
(define-overloadable-function semanticdb-find-table-for-include (includetag
&optional table)
"For a single INCLUDETAG found in TABLE, find a `semanticdb-table' object
-INCLUDETAG is a semantic TAG of class 'include.
+INCLUDETAG is a semantic TAG of class `include'.
TABLE is a semanticdb table that identifies where INCLUDETAG came from.
TABLE is optional if INCLUDETAG has an overlay of :filename attribute."
)
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index fdd5f52..5450ac9 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -378,11 +378,11 @@ See `semantic-tag-protected-p' for details on which tags
are returned."
;;;###autoload
(define-overloadable-function semantic-find-tags-included (&optional table)
- "Find all tags in TABLE that are of the 'include class.
+ "Find all tags in TABLE that are of the `include' class.
TABLE is a tag table. See `semantic-something-to-tag-table'.")
(defun semantic-find-tags-included-default (&optional table)
- "Find all tags in TABLE that are of the 'include class.
+ "Find all tags in TABLE that are of the `include' class.
TABLE is a tag table. See `semantic-something-to-tag-table'.
By default, just call `semantic-find-tags-by-class'."
(semantic-find-tags-by-class 'include table))
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index b7a6ed3..fed50fb 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -171,7 +171,7 @@ That is remove the unsupported :help stuff."
NAME specifies a special name that can be searched for later to
recover the cached data with `semantic-get-cache-data'.
LIFESPAN indicates how long the data cache will be remembered.
-The default LIFESPAN is 'end-of-command.
+The default LIFESPAN is `end-of-command'.
Possible Lifespans are:
`end-of-command' - Remove the cache at the end of the currently
executing command.
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 8ec5fff..f53f5d2 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -958,8 +958,8 @@ Return nil if TAG is not of class `alias'."
"Return a list of components for TAG.
A Component is a part of TAG which itself may be a TAG.
Examples include the elements of a structure in a
-tag of class 'type, or the list of arguments to a
-tag of class 'function."
+tag of class `type', or the list of arguments to a
+tag of class `function'."
)
(defun semantic-tag-components-default (tag)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ab90df8..a66338d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2419,9 +2419,9 @@ If STRING is nil, the function does nothing."
"Display STRING in the ERC BUFFER.
All screen output must be done through this function. If BUFFER is nil
or omitted, the default ERC buffer for the `erc-session-server' is used.
-The BUFFER can be an actual buffer, a list of buffers, 'all or 'active.
-If BUFFER = 'all, the string is displayed in all the ERC buffers for the
-current session. 'active means the current active buffer
+The BUFFER can be an actual buffer, a list of buffers, `all' or `active'.
+If BUFFER = `all', the string is displayed in all the ERC buffers for the
+current session. `active' means the current active buffer
\(`erc-active-buffer'). If the buffer can't be resolved, the current
buffer is used. `erc-display-line-1' is used to display STRING.
diff --git a/lisp/ido.el b/lisp/ido.el
index 22025e2..a254b4f 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -756,7 +756,7 @@ matching item, even without typing a slash."
(defcustom ido-create-new-buffer 'prompt
"Specify whether a new buffer is created if no buffer matches substring.
Choices are `always' to create new buffers unconditionally, `prompt' to
-ask user whether to create buffer, or 'never to never create new buffer."
+ask user whether to create buffer, or `never' to never create new buffer."
:type '(choice (const always)
(const prompt)
(const never))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index cd659d0..205be41 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1869,7 +1869,7 @@ Generally, the list should not include the (usually
overly large)
(defun eww-restore-desktop (file-name buffer-name misc-data)
"Restore an eww buffer from its desktop file record.
-If `eww-restore-desktop' is t or 'auto, this function will also
+If `eww-restore-desktop' is t or `auto', this function will also
initiate the retrieval of the respective URI in the background.
Otherwise, the restored buffer will contain a prompt to do so by using
\\[eww-reload]."
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index ebc5e24..7dfef5f 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -469,9 +469,9 @@ KIND is either `code' or `comment'. Optional fourth arg
B-OFFSET
when added to B specifies the actual buffer position where the block
begins. Likewise for optional fifth arg E-OFFSET. If unspecified
they are taken to be 0 (zero). The following properties are set
-in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also,
+in the overlay: `invisible' `hs' `hs-b-offset' `hs-e-offset'. Also,
depending on variable `hs-isearch-open', the following properties may
-be present: 'isearch-open-invisible 'isearch-open-invisible-temporary.
+be present: `isearch-open-invisible' `isearch-open-invisible-temporary'.
If variable `hs-set-up-overlay' is non-nil it should specify a function
to call with the newly initialized overlay."
(unless b-offset (setq b-offset 0))
diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el
index 6c89a51..79a6040 100644
--- a/lisp/progmodes/mantemp.el
+++ b/lisp/progmodes/mantemp.el
@@ -128,7 +128,7 @@
(defun mantemp-insert-cxx-syntax ()
"Insert C++ syntax around each template class and function.
-Insert `template class' for classes, 'template' for
+Insert `template class' for classes, `template' for
functions and add the statement delimiter `;' at the end of
the lines."
(save-excursion
diff --git a/lisp/server.el b/lisp/server.el
index 59fd973..35243ae 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1172,7 +1172,7 @@ The following commands are accepted by the client:
;; Allow Cygwin's emacsclient to be used as a file
;; handler on MS-Windows, in which case FILENAME
;; might start with a drive letter.
- (when (and (eq system-type 'cygwin)
+ (when (and (fboundp 'cygwin-convert-file-name-from-windows)
(string-match "\\`[A-Za-z]:" file))
(setq file (cygwin-convert-file-name-from-windows file)))
(setq file (expand-file-name file dir))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 0edbc94..8d72a36 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1026,9 +1026,6 @@ BEWARE: this function may change the current buffer."
(if observer
(vc-dired-deduce-fileset)
(error "State changing VC operations not supported in `dired-mode'")))
- ((and (derived-mode-p 'log-view-mode)
- (setq backend (vc-responsible-backend default-directory)))
- (list backend default-directory))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1044,6 +1041,9 @@ BEWARE: this function may change the current buffer."
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
(vc-deduce-fileset observer allow-unregistered state-model-only-files)))
+ ((and (derived-mode-p 'log-view-mode)
+ (setq backend (vc-responsible-backend default-directory)))
+ (list backend nil))
((not buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
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/modules/mod-test/Makefile b/modules/mod-test/Makefile
new file mode 100644
index 0000000..654c22a
--- /dev/null
+++ b/modules/mod-test/Makefile
@@ -0,0 +1,33 @@
+# Test GNU Emacs modules.
+
+# Copyright 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/>.
+
+ROOT = ../..
+
+CC = gcc
+LD = gcc
+CFLAGS = -ggdb3 -Wall
+LDFLAGS =
+
+all: mod-test.so
+
+%.so: %.o
+ $(LD) -shared $(LDFLAGS) -o $@ $<
+
+%.o: %.c
+ $(CC) $(CFLAGS) -I$(ROOT)/src -fPIC -c $<
diff --git a/modules/mod-test/mod-test.c b/modules/mod-test/mod-test.c
new file mode 100644
index 0000000..04b6122
--- /dev/null
+++ b/modules/mod-test/mod-test.c
@@ -0,0 +1,273 @@
+/* Test GNU Emacs modules.
+
+Copyright 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 <assert.h>
+#include <stdio.h>
+#include <module.h>
+
+int plugin_is_GPL_compatible;
+
+/*
+ * Always return symbol 't'
+ */
+static emacs_value Fmod_test_return_t (emacs_env *env, int nargs, emacs_value
args[], void *data)
+{
+ return env->intern (env, "t");
+}
+
+
+/*
+ * Expose simple sum function
+ */
+static int64_t sum (int64_t a, int64_t b)
+{
+ return a + b;
+}
+
+static emacs_value Fmod_test_sum (emacs_env *env, int nargs, emacs_value
args[], void* data)
+{
+ int64_t a = env->extract_integer (env, args[0]);
+ int64_t b = env->extract_integer (env, args[1]);
+
+ int64_t r = sum(a, b);
+
+ return env->make_integer (env, r);
+}
+
+
+/*
+ * Signal '(error 56)
+ */
+static emacs_value Fmod_test_signal (emacs_env *env, int nargs, emacs_value
args[], void* data)
+{
+ assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
+ env->non_local_exit_signal (env, env->intern (env, "error"),
env->make_integer (env, 56));
+ return NULL;
+}
+
+
+/*
+ * Throw '(tag 65)
+ */
+static emacs_value Fmod_test_throw (emacs_env *env, int nargs, emacs_value
args[], void* data)
+{
+ assert (env->non_local_exit_check (env) == emacs_funcall_exit_return);
+ env->non_local_exit_throw (env, env->intern (env, "tag"), env->make_integer
(env, 65));
+ return NULL;
+}
+
+
+/*
+ * Call argument function, catch all non-local exists and return
+ * either normal result or a list describing the non-local exit.
+ */
+static emacs_value Fmod_test_non_local_exit_funcall (emacs_env *env, int
nargs, emacs_value args[], void* data)
+{
+ assert (nargs == 1);
+ const emacs_value result = env->funcall (env, args[0], 0, NULL);
+ emacs_value non_local_exit_symbol, non_local_exit_data;
+ enum emacs_funcall_exit code = env->non_local_exit_get (env,
&non_local_exit_symbol, &non_local_exit_data);
+ switch (code)
+ {
+ case emacs_funcall_exit_return:
+ return result;
+ case emacs_funcall_exit_signal:
+ {
+ env->non_local_exit_clear (env);
+ const emacs_value Flist = env->intern (env, "list");
+ emacs_value list_args[] = {env->intern (env, "signal"),
non_local_exit_symbol, non_local_exit_data};
+ return env->funcall (env, Flist, 3, list_args);
+ }
+ case emacs_funcall_exit_throw:
+ {
+ env->non_local_exit_clear (env);
+ const emacs_value Flist = env->intern (env, "list");
+ emacs_value list_args[] = {env->intern (env, "throw"),
non_local_exit_symbol, non_local_exit_data};
+ return env->funcall (env, Flist, 3, list_args);
+ }
+ }
+ /* never reached */
+ return env->intern (env, "nil");;
+}
+
+
+/*
+ * Return a global referrence
+ */
+static emacs_value Fmod_test_globref_make (emacs_env *env, int nargs,
emacs_value args[], void* data)
+{
+ /* make a big string and make it global */
+ size_t i;
+ char str[26*100];
+
+ for (i = 0; i < sizeof (str); i++)
+ {
+ str[i] = 'a' + (i % 26);
+ }
+
+ /* we don't need to null-terminate str */
+ emacs_value lisp_str = env->make_string (env, str, sizeof (str));
+ return env->make_global_ref (env, lisp_str);
+}
+
+
+/*
+ * Return a copy of the argument string where every 'a' is replaced with 'b'.
+ */
+static emacs_value Fmod_test_string_a_to_b (emacs_env *env, int nargs,
emacs_value args[], void* data)
+{
+ emacs_value lisp_str = args[0];
+ size_t size = 0;
+ char * buf = NULL;
+ size_t i;
+
+ env->copy_string_contents (env, lisp_str, buf, &size);
+ buf = malloc (size);
+ env->copy_string_contents (env, lisp_str, buf, &size);
+
+ for (i = 0; i+1 < size; i++) {
+ if (buf[i] == 'a')
+ buf[i] = 'b';
+ }
+
+ return env->make_string (env, buf, size-1);
+}
+
+
+/*
+ * Embedded pointers in lisp objects.
+ */
+
+/* C struct (pointer to) that will be embedded */
+struct super_struct
+{
+ int amazing_int;
+ char large_unused_buffer[512];
+};
+
+/* Associated finalizer */
+static void finalizer (void *p)
+{
+ if (p)
+ free (p);
+}
+
+/*
+ * Return a new user-pointer to a super_struct, with amazing_int set
+ * to the passed parameter.
+ */
+static emacs_value Fmod_test_userptr_make (emacs_env *env, int nargs,
emacs_value args[], void *data)
+{
+ struct super_struct *p = calloc (1, sizeof(*p));
+ p->amazing_int = env->extract_integer (env, args[0]);
+ return env->make_user_ptr (env, finalizer, p);
+}
+
+/*
+ * Return the amazing_int of a passed 'user-pointer to a super_struct'.
+ */
+static emacs_value Fmod_test_userptr_get (emacs_env *env, int nargs,
emacs_value args[], void *data)
+{
+ struct super_struct *p = env->get_user_ptr (env, args[0]);
+ return env->make_integer (env, p->amazing_int);
+}
+
+
+/*
+ * Fill vector in args[0] with value in args[1]
+ */
+static emacs_value Fmod_test_vector_fill (emacs_env *env, int nargs,
emacs_value args[], void *data)
+{
+ size_t i;
+ emacs_value vec = args[0];
+ emacs_value val = args[1];
+ const size_t size = env->vec_size (env, vec);
+ for (i = 0; i < size; i++)
+ env->vec_set (env, vec, i, val);
+ return env->intern (env, "t");
+}
+
+
+/*
+ * Return whether all elements of vector in args[0] are 'eq' to value in
args[1]
+ */
+static emacs_value Fmod_test_vector_eq (emacs_env *env, int nargs, emacs_value
args[], void *data)
+{
+ size_t i;
+ emacs_value vec = args[0];
+ emacs_value val = args[1];
+ const size_t size = env->vec_size (env, vec);
+ for (i = 0; i < size; i++)
+ if (!env->eq (env, env->vec_get (env, vec, i), val))
+ return env->intern (env, "nil");
+ return env->intern (env, "t");
+}
+
+
+/*
+ * Lisp utilities for easier readability (simple wrappers)
+ */
+
+/* Provide FEATURE to Emacs */
+static void provide (emacs_env *env, const char *feature)
+{
+ emacs_value Qfeat = env->intern (env, feature);
+ emacs_value Qprovide = env->intern (env, "provide");
+ emacs_value args[] = { Qfeat };
+
+ env->funcall (env, Qprovide, 1, args);
+}
+
+/* Binds NAME to FUN */
+static void bind_function (emacs_env *env, const char *name, emacs_value Sfun)
+{
+ emacs_value Qfset = env->intern (env, "fset");
+ emacs_value Qsym = env->intern (env, name);
+ emacs_value args[] = { Qsym, Sfun };
+
+ env->funcall (env, Qfset, 2, args);
+}
+
+/*
+ * Module init function.
+ */
+int emacs_module_init (struct emacs_runtime *ert)
+{
+ emacs_env *env = ert->get_environment (ert);
+
+#define DEFUN(lsym, csym, amin, amax, doc, data) \
+ bind_function (env, lsym, env->make_function (env, amin, amax, csym, doc,
data))
+
+ DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B", NULL);
+ DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
1, 1, NULL, NULL);
+ DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
+ DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
+
+#undef DEFUN
+
+ provide (env, "mod-test");
+ return 0;
+}
diff --git a/modules/mod-test/test.el b/modules/mod-test/test.el
new file mode 100644
index 0000000..ed584eb
--- /dev/null
+++ b/modules/mod-test/test.el
@@ -0,0 +1,106 @@
+;;; Test GNU Emacs modules.
+
+;; Copyright 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/>. */
+
+(require 'ert)
+
+(add-to-list 'load-path (file-name-directory (or #$ (expand-file-name
(buffer-file-name)))))
+(require 'mod-test)
+
+;;
+;; basic tests
+;;
+
+(ert-deftest mod-test-sum-test ()
+ (should (= (mod-test-sum 1 2) 3)))
+
+(ert-deftest mod-test-sum-docstring ()
+ (should (string= (documentation 'mod-test-sum) "Return A + B")))
+
+;;
+;; non-local exists (throw, signal)
+;;
+
+(ert-deftest mod-test-non-local-exit-signal-test ()
+ (should-error (mod-test-signal)))
+
+(ert-deftest mod-test-non-local-exit-throw-test ()
+ (should (equal
+ (catch 'tag
+ (mod-test-throw)
+ (ert-fail "expected throw"))
+ 65)))
+
+(ert-deftest mod-test-non-local-exit-funcall-normal ()
+ (should (equal (mod-test-non-local-exit-funcall (lambda () 23))
+ 23)))
+
+(ert-deftest mod-test-non-local-exit-funcall-signal ()
+ (should (equal (mod-test-non-local-exit-funcall (lambda () (signal 'error
'(32))))
+ '(signal error (32)))))
+
+(ert-deftest mod-test-non-local-exit-funcall-throw ()
+ (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32)))
+ '(throw tag 32))))
+
+;;
+;; string
+;;
+
+(defun multiply-string (s n)
+ (let ((res ""))
+ (dotimes (i n res)
+ (setq res (concat res s)))))
+
+(ert-deftest mod-test-globref-make-test ()
+ (let ((mod-str (mod-test-globref-make))
+ (ref-str (multiply-string "abcdefghijklmnopqrstuvwxyz" 100)))
+ (garbage-collect) ;; XXX: not enough to really test but it's something..
+ (should (string= ref-str mod-str))))
+
+(ert-deftest mod-test-string-a-to-b-test ()
+ (should (string= (mod-test-string-a-to-b "aaa") "bbb")))
+
+;;
+;; user-pointer
+;;
+
+(ert-deftest mod-test-userptr-fun-test ()
+ (let* ((n 42)
+ (v (mod-test-userptr-make n))
+ (r (mod-test-userptr-get v)))
+
+ (should (eq (type-of v) 'user-ptr))
+ (should (integerp r))
+ (should (= r n))))
+
+;; TODO: try to test finalizer
+
+;;
+;; vectors
+;;
+
+(ert-deftest mod-test-vector-test ()
+ (dolist (s '(2 10 100 1000))
+ (dolist (e '(42 foo "foo"))
+ (let* ((v-ref (make-vector 2 e))
+ (eq-ref (eq (aref v-ref 0) (aref v-ref 1)))
+ (v-test (make-vector s nil)))
+
+ (should (eq (mod-test-vector-fill v-test e) t))
+ (should (eq (mod-test-vector-eq v-test e) eq-ref))))))
diff --git a/modules/modhelp.py b/modules/modhelp.py
new file mode 100755
index 0000000..5afe8f2
--- /dev/null
+++ b/modules/modhelp.py
@@ -0,0 +1,198 @@
+#!/usr/bin/env python
+
+# Module helper script.
+
+# Copyright 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/>.
+
+import os
+import string
+import subprocess as sp
+import argparse
+import re
+
+EMACS = os.path.join('..', 'src', 'emacs')
+
+def find_modules():
+ modpaths = []
+ for (dirname, dirs, files) in os.walk('.'):
+ if 'Makefile' in files:
+ modpaths.append(dirname)
+ return modpaths
+
+def cmd_test(args):
+ mods = args.module
+ if not mods:
+ mods = find_modules()
+
+ make_cmd = ['make']
+ if args.force:
+ make_cmd.append('-B')
+
+ failed = []
+ for m in mods:
+ print '[*] %s: ------- start -------' % m
+ print '[*] %s: running make' % m
+ r = sp.call(make_cmd, cwd=m)
+ if r != 0:
+ print '[E] %s: make failed' % m
+ failed += [m]
+ continue
+
+ print '[*] %s: running test' % m
+ testpath = os.path.join(m, 'test.el')
+ if os.path.isfile(testpath):
+ emacs_cmd = [EMACS, '-batch', '-L', '.', '-l', 'ert', '-l',
testpath, '-f', 'ert-run-tests-batch-and-exit']
+ print ' '.join(emacs_cmd)
+ r = sp.call(emacs_cmd)
+ if r != 0:
+ print '[E] %s: test failed' % m
+ failed += [m]
+ continue
+ else:
+ print '[W] %s: no test to run' % m
+
+ print '\n[*] %d/%d MODULES OK' % (len(mods)-len(failed), len(mods))
+ for m in failed:
+ print '\tfailed: %s' % m
+
+def to_lisp_sym(sym):
+ sym = re.sub('[_ ]', '-', sym)
+ return sym
+
+def to_c_sym(sym):
+ sym = re.sub('[- ]', '_', sym)
+ return sym
+
+def cmd_init(args):
+ if os.path.exists(args.module):
+ print "%s: file/dir '%s' already exists" % (__file__, args.module)
+ return
+
+ os.mkdir(args.module)
+
+ template_vars = {
+ 'module': args.module,
+ 'func': args.fun,
+ 'c_file': '%s.c' % args.module,
+ 'c_func': 'F%s_%s' % (to_c_sym(args.module), to_c_sym(args.fun)),
+ 'lisp_func': '%s-%s' % (args.module, to_lisp_sym(args.fun)),
+ }
+
+ for path, t in TEMPLATES.items():
+ if isinstance(path, string.Template):
+ path = path.substitute(template_vars)
+ path = os.path.join(args.module, path)
+ print "writing %s..." % path
+ with open(path, "w+") as f:
+ f.write(t.substitute(template_vars))
+ print "done! you can run %s test %s" % (__file__, args.module)
+
+
+def main():
+ # path always written relative to this file
+ os.chdir(os.path.dirname(os.path.realpath(__file__)))
+
+ mainp = argparse.ArgumentParser()
+ subp = mainp.add_subparsers()
+
+ testp = subp.add_parser('test', help='run tests')
+ testp.add_argument('-f', '--force', action='store_true', help='force
regeneration (make -B)')
+ testp.add_argument('module', nargs='*', help='path to module to test
(default all)')
+ testp.set_defaults(func=cmd_test)
+
+ initp = subp.add_parser('init', help='create a test module from a
template')
+ initp.add_argument('module', help='name of the new module')
+ initp.add_argument('-f', '--fun', default='fun', help='overide name of the
default function')
+ initp.set_defaults(func=cmd_init)
+
+ args = mainp.parse_args()
+ args.func(args)
+
+
+# double the $ to escape python template syntax
+TEMPLATES = {
+ 'Makefile': string.Template('''
+ROOT = ../..
+
+CC = gcc
+LD = gcc
+CFLAGS = -ggdb3 -Wall
+LDFLAGS =
+
+all: ${module}.so ${module}.doc
+
+%.so: %.o
+ $$(LD) -shared $$(LDFLAGS) -o $$@ $$<
+
+%.o: %.c
+ $$(CC) $$(CFLAGS) -I$$(ROOT)/src -fPIC -c $$<
+
+'''),
+
+ string.Template('${c_file}'): string.Template('''
+#include <module.h>
+
+int plugin_is_GPL_compatible;
+
+static emacs_value ${c_func} (emacs_env *env, int nargs, emacs_value args[],
void *data)
+{
+ return env->intern (env, "t");
+}
+
+/* Binds NAME to FUN */
+static void bind_function (emacs_env *env, const char *name, emacs_value Sfun)
+{
+ emacs_value Qfset = env->intern (env, "fset");
+ emacs_value Qsym = env->intern (env, name);
+ emacs_value args[] = { Qsym, Sfun };
+
+ env->funcall (env, Qfset, 2, args);
+}
+
+/* Provide FEATURE to Emacs */
+static void provide (emacs_env *env, const char *feature)
+{
+ emacs_value Qfeat = env->intern (env, feature);
+ emacs_value Qprovide = env->intern (env, "provide");
+ emacs_value args[] = { Qfeat };
+
+ env->funcall (env, Qprovide, 1, args);
+}
+
+int emacs_module_init (struct emacs_runtime *ert)
+{
+ emacs_env *env = ert->get_environment (ert);
+ bind_function (env, "${lisp_func}", env->make_function (env, 1, 1,
${c_func}, "doc", NULL));
+ provide (env, "${module}");
+ return 0;
+}
+'''),
+ 'test.el': string.Template('''
+(require 'ert)
+(require 'module-test-common)
+
+;; #$$ works when loading, buffer-file-name when evaluating from emacs
+(module-load (module-path (or #$$ (expand-file-name (buffer-file-name)))))
+
+(ert-deftest ${lisp_func}-test ()
+ (should (eq (${lisp_func} 42) t)))
+''')
+}
+
+if __name__ == '__main__':
+ main()
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 bee7cd1..53f9745 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3711,6 +3711,23 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
}
}
+#ifdef HAVE_MODULES
+/* Create a new module user ptr object. */
+Lisp_Object
+make_user_ptr (void (*finalizer) (void*), void *p)
+{
+ Lisp_Object obj;
+ struct Lisp_User_Ptr *uptr;
+
+ obj = allocate_misc (Lisp_Misc_User_Ptr);
+ uptr = XUSER_PTR (obj);
+ uptr->finalizer = finalizer;
+ uptr->p = p;
+ return obj;
+}
+
+#endif
+
static void
init_finalizer_list (struct Lisp_Finalizer *head)
{
@@ -5557,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. */
@@ -6301,6 +6322,12 @@ mark_object (Lisp_Object arg)
mark_object (XFINALIZER (obj)->function);
break;
+#ifdef HAVE_MODULES
+ case Lisp_Misc_User_Ptr:
+ XMISCANY (obj)->gcmarkbit = true;
+ break;
+#endif
+
default:
emacs_abort ();
}
@@ -6677,8 +6704,15 @@ sweep_misc (void)
{
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
unchain_marker (&mblk->markers[i].m.u_marker);
- if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
+ else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
unchain_finalizer (&mblk->markers[i].m.u_finalizer);
+#ifdef HAVE_MODULES
+ else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr)
+ {
+ struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr;
+ uptr->finalizer (uptr->p);
+ }
+#endif
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
diff --git a/src/data.c b/src/data.c
index 5154604..1e9cc81 100644
--- a/src/data.c
+++ b/src/data.c
@@ -223,6 +223,10 @@ for example, (type-of 1) returns `integer'. */)
return Qfloat;
case Lisp_Misc_Finalizer:
return Qfinalizer;
+#ifdef HAVE_MODULES
+ case Lisp_Misc_User_Ptr:
+ return Quser_ptr;
+#endif
default:
emacs_abort ();
}
@@ -424,6 +428,17 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
return Qnil;
}
+#ifdef HAVE_MODULES
+DEFUN ("user-ptrp", Fuser_ptrp, Suser_ptrp, 1, 1, 0,
+ doc: /* Return t if OBJECT is a module user pointer. */)
+ (Lisp_Object object)
+{
+ if (USER_PTRP (object))
+ return Qt;
+ return Qnil;
+}
+#endif
+
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
doc: /* Return t if OBJECT is a built-in function. */)
(Lisp_Object object)
@@ -3478,6 +3493,9 @@ syms_of_data (void)
DEFSYM (Qbool_vector_p, "bool-vector-p");
DEFSYM (Qchar_or_string_p, "char-or-string-p");
DEFSYM (Qmarkerp, "markerp");
+#ifdef HAVE_MODULES
+ DEFSYM (Quser_ptrp, "user-ptrp");
+#endif
DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
DEFSYM (Qfboundp, "fboundp");
@@ -3569,6 +3587,9 @@ syms_of_data (void)
DEFSYM (Qmarker, "marker");
DEFSYM (Qoverlay, "overlay");
DEFSYM (Qfinalizer, "finalizer");
+#ifdef HAVE_MODULES
+ DEFSYM (Quser_ptr, "user-ptr");
+#endif
DEFSYM (Qfloat, "float");
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
@@ -3683,6 +3704,9 @@ syms_of_data (void)
defsubr (&Sbyteorder);
defsubr (&Ssubr_arity);
defsubr (&Ssubr_name);
+#ifdef HAVE_MODULES
+ defsubr (&Suser_ptrp);
+#endif
defsubr (&Sbool_vector_exclusive_or);
defsubr (&Sbool_vector_union);
diff --git a/src/dynlib.c b/src/dynlib.c
new file mode 100644
index 0000000..fbc5f9b
--- /dev/null
+++ b/src/dynlib.c
@@ -0,0 +1,109 @@
+/* Portable API for dynamic loading.
+
+Copyright 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/>. */
+
+
+/* Assume modules are enabled on modern systems... *Yes*, the
+ preprocessor macro checks could be more precise. I don't care.
+
+ If you think the abstraction is too leaky use libltdl (libtool),
+ don't reinvent the wheel by fixing this one. */
+
+#include "dynlib.h"
+
+/*
+ * Windows systems
+ */
+#if defined(_WIN32)
+
+#include <windows.h>
+
+dynlib_handle_ptr dynlib_open (const char * path)
+{
+
+ return (dynlib_handle_ptr) LoadLibrary (path);
+}
+
+void * dynlib_sym (dynlib_handle_ptr h, const char * sym)
+{
+ return GetProcAddress ((HMODULE) h, sym);
+}
+
+bool dynlib_addr (void *ptr, const char **path, const char **sym)
+{
+ return false; /* not implemented */
+}
+
+const char * dynlib_error (void)
+{
+ /* TODO: use GetLastError(), FormatMessage(), ... */
+ return "Can't load DLL";
+}
+
+int dynlib_close (dynlib_handle_ptr h)
+{
+ return FreeLibrary ((HMODULE) h) != 0;
+}
+
+
+/*
+ * POSIX systems
+ */
+#elif defined(HAVE_UNISTD_H)
+
+#include <dlfcn.h>
+
+dynlib_handle_ptr dynlib_open (const char * path)
+{
+ return dlopen (path, RTLD_LAZY);
+}
+
+void * dynlib_sym (dynlib_handle_ptr h, const char * sym)
+{
+ return dlsym (h, sym);
+}
+
+bool dynlib_addr (void *ptr, const char **path, const char **sym)
+{
+#ifdef HAVE_DLADDR
+ Dl_info info;
+ if (dladdr (ptr, &info) != 0 && info.dli_fname != NULL && info.dli_sname !=
NULL)
+ {
+ *path = info.dli_fname;
+ *sym = info.dli_sname;
+ return true;
+ }
+#endif
+ return false;
+}
+
+const char * dynlib_error (void)
+{
+ return dlerror ();
+}
+
+int dynlib_close (dynlib_handle_ptr h)
+{
+ return dlclose (h) == 0;
+}
+
+#else
+
+#error "No dynamic loading for this system"
+
+#endif
diff --git a/src/dynlib.h b/src/dynlib.h
new file mode 100644
index 0000000..852842d
--- /dev/null
+++ b/src/dynlib.h
@@ -0,0 +1,33 @@
+/* Portable API for dynamic loading.
+
+Copyright 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 DYNLIB_H
+#define DYNLIB_H
+
+#include <config.h>
+#include <stdbool.h>
+
+typedef void* dynlib_handle_ptr;
+dynlib_handle_ptr dynlib_open (const char * path);
+void * dynlib_sym (dynlib_handle_ptr h, const char * sym);
+bool dynlib_addr (void *ptr, const char **path, const char **sym);
+const char * dynlib_error (void);
+int dynlib_close (dynlib_handle_ptr h);
+
+#endif /* DYNLIB_H */
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/eval.c b/src/eval.c
index 3ee07a7..396ca84 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1145,7 +1145,9 @@ Both TAG and VALUE are evalled. */
if (!NILP (tag))
for (c = handlerlist; c; c = c->next)
{
- if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
+ if (c->type == CATCHER_ALL)
+ unwind_to_catch (c, Fcons (tag, value));
+ if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
unwind_to_catch (c, value);
}
xsignal2 (Qno_catch, tag, value);
@@ -1394,6 +1396,55 @@ internal_condition_case_n (Lisp_Object (*bfun)
(ptrdiff_t, Lisp_Object *),
return val;
}
+static void init_handler (struct handler *c, Lisp_Object tag_ch_val,
+ enum handlertype handlertype);
+
+void push_handler (struct handler **const c, const Lisp_Object tag_ch_val,
+ const enum handlertype handlertype)
+{
+ if (handlerlist->nextfree)
+ *c = handlerlist->nextfree;
+ else
+ {
+ *c = xmalloc (sizeof (struct handler));
+ (*c)->nextfree = NULL;
+ handlerlist->nextfree = *c;
+ }
+ init_handler (*c, tag_ch_val, handlertype);
+}
+
+bool push_handler_nosignal (struct handler **const c, const Lisp_Object
tag_ch_val,
+ const enum handlertype handlertype)
+{
+ if (handlerlist->nextfree)
+ *c = handlerlist->nextfree;
+ else
+ {
+ struct handler *const h = malloc (sizeof (struct handler));
+ if (! h) return false;
+ *c = h;
+ h->nextfree = NULL;
+ handlerlist->nextfree = h;
+ }
+ init_handler (*c, tag_ch_val, handlertype);
+ return true;
+}
+
+static void init_handler (struct handler *const c, const Lisp_Object
tag_ch_val,
+ const enum handlertype handlertype)
+{
+ c->type = handlertype;
+ c->tag_or_ch = tag_ch_val;
+ c->val = Qnil;
+ c->next = handlerlist;
+ c->lisp_eval_depth = lisp_eval_depth;
+ c->pdlcount = SPECPDL_INDEX ();
+ c->poll_suppress_count = poll_suppress_count;
+ c->interrupt_input_blocked = interrupt_input_blocked;
+ c->byte_stack = byte_stack_list;
+ handlerlist = c;
+}
+
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
diff --git a/src/fns.c b/src/fns.c
index 9931e80..029ac6a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3620,8 +3620,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min,
ptrdiff_t nitems_max)
Low-level Functions
***********************************************************************/
-static struct hash_table_test hashtest_eq;
-struct hash_table_test hashtest_eql, hashtest_equal;
+struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
HASH2 in hash table H using `eql'. Value is true if KEY1 and
@@ -3992,7 +3991,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key,
Lisp_Object value,
/* Remove the entry matching KEY from hash table H, if there is one. */
-static void
+void
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash_code;
diff --git a/src/keyboard.c b/src/keyboard.c
index 2449abb..849066c 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -11372,7 +11372,7 @@ If an unhandled error happens in running this hook,
the function in which the error occurred is unconditionally removed, since
otherwise the error might happen repeatedly and make Emacs nonfunctional.
-See also `pre-command-hook'. */);
+See also `post-command-hook'. */);
Vpre_command_hook = Qnil;
DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
diff --git a/src/lisp.h b/src/lisp.h
index 3efa492..3b6ea76 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -468,6 +468,9 @@ enum Lisp_Misc_Type
Lisp_Misc_Overlay,
Lisp_Misc_Save_Value,
Lisp_Misc_Finalizer,
+#ifdef HAVE_MODULES
+ Lisp_Misc_User_Ptr,
+#endif
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
Lisp_Misc_Float,
@@ -581,6 +584,12 @@ INLINE bool PROCESSP (Lisp_Object);
INLINE bool PSEUDOVECTORP (Lisp_Object, int);
INLINE bool SAVE_VALUEP (Lisp_Object);
INLINE bool FINALIZERP (Lisp_Object);
+
+#ifdef HAVE_MODULES
+INLINE bool USER_PTRP (Lisp_Object);
+INLINE struct Lisp_User_Ptr *(XUSER_PTR) (Lisp_Object);
+#endif
+
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
INLINE bool STRINGP (Lisp_Object);
@@ -2230,6 +2239,18 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
return XSAVE_VALUE (obj)->data[n].object;
}
+#ifdef HAVE_MODULES
+struct Lisp_User_Ptr
+{
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */
+ bool_bf gcmarkbit : 1;
+ unsigned spacer : 15;
+
+ void (*finalizer) (void*);
+ void *p;
+};
+#endif
+
/* A finalizer sentinel. */
struct Lisp_Finalizer
{
@@ -2265,6 +2286,9 @@ union Lisp_Misc
struct Lisp_Overlay u_overlay;
struct Lisp_Save_Value u_save_value;
struct Lisp_Finalizer u_finalizer;
+#ifdef HAVE_MODULES
+ struct Lisp_User_Ptr u_user_ptr;
+#endif
};
INLINE union Lisp_Misc *
@@ -2314,6 +2338,16 @@ XFINALIZER (Lisp_Object a)
return & XMISC (a)->u_finalizer;
}
+#ifdef HAVE_MODULES
+INLINE struct Lisp_User_Ptr *
+XUSER_PTR (Lisp_Object a)
+{
+ eassert (USER_PTRP (a));
+ return & XMISC (a)->u_user_ptr;
+}
+#endif
+
+
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
@@ -2598,6 +2632,14 @@ FINALIZERP (Lisp_Object x)
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer;
}
+#ifdef HAVE_MODULES
+INLINE bool
+USER_PTRP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr;
+}
+#endif
+
INLINE bool
AUTOLOADP (Lisp_Object x)
{
@@ -3104,7 +3146,9 @@ SPECPDL_INDEX (void)
A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch'
member is TAG, and then unbinds to it. The `val' member is used to
hold VAL while the stack is unwound; `val' is returned as the value
- of the catch form.
+ of the catch form. If there is a handler of type CATCHER_ALL, it will
+ be treated as a handler for all invocations of `throw'; in this case
+ `val' will be set to (TAG . VAL).
All the other members are concerned with restoring the interpreter
state.
@@ -3112,7 +3156,7 @@ SPECPDL_INDEX (void)
Members are volatile if their values need to survive _longjmp when
a 'struct handler' is a local variable. */
-enum handlertype { CATCHER, CONDITION_CASE };
+enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
struct handler
{
@@ -3142,25 +3186,15 @@ struct handler
/* Fill in the components of c, and put it on the list. */
#define PUSH_HANDLER(c, tag_ch_val, handlertype) \
- if (handlerlist->nextfree) \
- (c) = handlerlist->nextfree; \
- else \
- { \
- (c) = xmalloc (sizeof (struct handler)); \
- (c)->nextfree = NULL; \
- handlerlist->nextfree = (c); \
- } \
- (c)->type = (handlertype); \
- (c)->tag_or_ch = (tag_ch_val); \
- (c)->val = Qnil; \
- (c)->next = handlerlist; \
- (c)->lisp_eval_depth = lisp_eval_depth; \
- (c)->pdlcount = SPECPDL_INDEX (); \
- (c)->poll_suppress_count = poll_suppress_count; \
- (c)->interrupt_input_blocked = interrupt_input_blocked;\
- (c)->byte_stack = byte_stack_list; \
- handlerlist = (c);
+ push_handler(&(c), (tag_ch_val), (handlertype))
+
+extern void push_handler (struct handler **c, Lisp_Object tag_ch_val,
+ enum handlertype handlertype);
+/* Like push_handler, but don't signal if the handler could not be
+ allocated. Instead return false in that case. */
+extern bool push_handler_nosignal (struct handler **c, Lisp_Object tag_ch_val,
+ enum handlertype handlertype);
extern Lisp_Object memory_signal_data;
@@ -3407,7 +3441,8 @@ Lisp_Object make_hash_table (struct hash_table_test,
Lisp_Object, Lisp_Object,
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
-extern struct hash_table_test hashtest_eql, hashtest_equal;
+void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
+extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
@@ -3877,6 +3912,15 @@ Lisp_Object backtrace_top_function (void);
extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
extern bool let_shadows_global_binding_p (Lisp_Object symbol);
+#ifdef HAVE_MODULES
+/* 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. */
extern void insert1 (Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index c4456f3..c0fa0d0 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -975,6 +975,16 @@ This uses the variables `load-suffixes' and
`load-file-rep-suffixes'. */)
return Fnreverse (lst);
}
+/* Returns true if STRING ends with SUFFIX */
+static bool
+suffix_p (Lisp_Object string, const char *suffix)
+{
+ const size_t suffix_len = strlen (suffix);
+ const size_t string_len = SBYTES (string);
+
+ return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len -
suffix_len, suffix);
+}
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el',
@@ -1074,12 +1084,7 @@ Return t if the file exists and loads successfully. */)
if (! NILP (must_suffix))
{
/* Don't insist on adding a suffix if FILE already ends with one. */
- ptrdiff_t size = SBYTES (file);
- if (size > 3
- && !strcmp (SSDATA (file) + size - 3, ".el"))
- must_suffix = Qnil;
- else if (size > 4
- && !strcmp (SSDATA (file) + size - 4, ".elc"))
+ if (suffix_p (file, ".el") || suffix_p (file, ".elc"))
must_suffix = Qnil;
/* Don't insist on adding a suffix
if the argument includes a directory name. */
@@ -1151,6 +1156,13 @@ Return t if the file exists and loads successfully. */)
record_unwind_protect_int (close_file_unwind, fd);
}
+#ifdef HAVE_MODULES
+ if (suffix_p (found, MODULES_SUFFIX))
+ {
+ return Fmodule_load (found);
+ }
+#endif
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
@@ -1189,8 +1201,7 @@ Return t if the file exists and loads successfully. */)
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
- if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
- || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
+ if (suffix_p (found, ".elc") || (fd >= 0 && (version = safe_to_load_version
(fd)) > 0))
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
@@ -4491,8 +4502,14 @@ and without trailing slashes. */);
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
+#ifdef HAVE_MODULES
+ Vload_suffixes = list3 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"),
+ build_pure_c_string (MODULES_SUFFIX));
+#else
Vload_suffixes = list2 (build_pure_c_string (".elc"),
build_pure_c_string (".el"));
+#endif
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
diff --git a/src/module.c b/src/module.c
new file mode 100644
index 0000000..4069b88
--- /dev/null
+++ b/src/module.c
@@ -0,0 +1,1197 @@
+/* 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 "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 both a handle to the main thread and the
+ thread ID because the latter can be reused when a thread
+ terminates. */
+static HANDLE main_thread;
+static DWORD main_thread_id;
+#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 = (size_t) 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;
+
+ 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 () == main_thread_id
+ && 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)
+ /* This calls APIs that are only available on Vista and later. */
+#if 0
+ /* GetCurrentProcess returns a pseudohandle, which we have to duplicate. */
+ if (! DuplicateHandle (GetCurrentProcess(), GetCurrentThread(),
+ GetCurrentProcess(), &main_thread,
+ SYNCHRONIZE | THREAD_QUERY_INFORMATION,
+ FALSE, 0))
+ emacs_abort ();
+#else
+ /* GetCurrentThread returns a pseudohandle, which we have to duplicate. */
+ HANDLE th = GetCurrentThread ();
+ if (!DuplicateHandle (GetCurrentProcess (), th,
+ GetCurrentProcess (), &main_thread, 0, FALSE,
+ DUPLICATE_SAME_ACCESS))
+ emacs_abort ();
+ main_thread_id = GetCurrentThreadId ();
+#endif
+#endif
+}
diff --git a/src/module.h b/src/module.h
new file mode 100644
index 0000000..9f43c89
--- /dev/null
+++ b/src/module.h
@@ -0,0 +1,229 @@
+/* module.h - GNU Emacs 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/print.c b/src/print.c
index 6f868ce..420e6f5 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1990,6 +1990,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
printchar ('>', printcharfun);
break;
+#ifdef HAVE_MODULES
+ case Lisp_Misc_User_Ptr:
+ {
+ print_c_string ("#<user-ptr ", printcharfun);
+ int i = sprintf (buf, "ptr=%p finalizer=%p",
+ XUSER_PTR (obj)->p,
+ XUSER_PTR (obj)->finalizer);
+ strout (buf, i, i, printcharfun);
+ printchar ('>', printcharfun);
+ break;
+ }
+#endif
+
case Lisp_Misc_Finalizer:
print_c_string ("#<finalizer", printcharfun);
if (NILP (XFINALIZER (obj)->function))
- [Emacs-diffs] branch coverity created (now c1e1aaa), John Wiegley, 2015/12/14
- [Emacs-diffs] coverity 976c775 1/9: .travis.yml: Initial integration hook for TravisCI, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity 3abe629 2/9: .travis.yml: Initial integration hook for TravisCI, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity 50f7079 7/9: Merge remote-tracking branch 'remotes/hub/pr/1/head' into coverity, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity ae8078f 6/9: .travis.yml: Add coverity block, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity c1e1aaa 9/9: Update the branch_pattern in .travis.yml, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity 4a157e8 4/9: Merge remote-tracking branch 'origin/emacs-25' into coverity,
John Wiegley <=
- [Emacs-diffs] coverity 0cb1759 5/9: Merge remote-tracking branch 'origin/emacs-25' into coverity, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity 5a9164b 3/9: Merge remote-tracking branch 'origin/emacs-25' into coverity, John Wiegley, 2015/12/14
- [Emacs-diffs] coverity 54617ad 8/9: Merge remote-tracking branch 'origin/emacs-25' into coverity, John Wiegley, 2015/12/14