From f128e085bc0674967b988a72f8074a7d0cc8eba3 Mon Sep 17 00:00:00 2001 From: Stephen Leake Date: Tue, 9 Jun 2015 17:32:30 -0500 Subject: [PATCH] Add loadable modules using Daniel Colascione's ideas. See https://lists.gnu.org/archive/html/emacs-devel/2015-02/msg00960.html * src/Makefile.in (base_obj): add module.o (LIBES): add -lltdl * src/emacs.c (main): add syms_of_module * src/lisp.h: add syms_of_module * src/emacs_module.h: New file; emacs API for modules. * src/module.c: New file; implement API. * modules/basic/Makefile: New file; build example module on Linux. * modules/basic/basic.c: New file; simple example module. --- modules/basic/Makefile | 15 ++ modules/basic/basic.c | 64 ++++++ src/Makefile.in | 4 +- src/emacs.c | 3 + src/emacs_module.h | 175 +++++++++++++++++ src/lisp.h | 2 + src/module.c | 435 +++++++++++++++++++++++++++++++++++++++++ 7 files changed, 696 insertions(+), 2 deletions(-) create mode 100644 modules/basic/Makefile create mode 100644 modules/basic/basic.c create mode 100644 src/emacs_module.h create mode 100644 src/module.c diff --git a/modules/basic/Makefile b/modules/basic/Makefile new file mode 100644 index 00000000000..bb136f3577f --- /dev/null +++ b/modules/basic/Makefile @@ -0,0 +1,15 @@ +ROOT = ../.. + +CFLAGS = +LDFLAGS = + +all: basic.so basic.doc + +%.so: %.o + gcc -shared $(LDFLAGS) -o $@ $< + +%.o: %.c + gcc -ggdb3 -Wall -I$(ROOT)/src $(CFLAGS) -fPIC -c $< + +%.doc: %.c + $(ROOT)/lib-src/make-docfile $< > $@ diff --git a/modules/basic/basic.c b/modules/basic/basic.c new file mode 100644 index 00000000000..f288b3832ca --- /dev/null +++ b/modules/basic/basic.c @@ -0,0 +1,64 @@ +/* + + basic.c - sample module + + This module provides a simple `basic-sum' function. + + I've used the following prefixes throughout the code: + - Sfoo: subr (function wraper) + - Qfoo: symbol value + - Ffoo: function value + +*/ + +#include + +int plugin_is_GPL_compatible; + +/* C function we want to expose to emacs */ +static int64_t sum (int64_t a, int64_t b) +{ + return a + b; +} + +/* Proper module subr that wraps the C function */ +static emacs_value Fsum (emacs_env *env, int nargs, emacs_value args[]) +{ + int64_t a = env->fixnum_to_int (env, args[0]); + int64_t b = env->fixnum_to_int (env, args[1]); + + int64_t r = sum(a, b); + + return env->make_fixnum (env, r); +} + +/* Binds NAME to FUN */ +static void bind_function (emacs_env *env, const char *name, emacs_value Ffun) +{ + emacs_value Qfset = env->intern (env, "fset"); + emacs_value Qsym = env->intern (env, name); + emacs_value args[] = { Qsym, Ffun }; + + 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); + emacs_value Ssum = env->make_function (env, 2, 2, Fsum); + + bind_function (env, "basic-sum", Ssum); + provide (env, "basic"); + + return 0; +} diff --git a/src/Makefile.in b/src/Makefile.in index 172fa8e47cd..c212c48bc5b 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -376,7 +376,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 module.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ @@ -467,7 +467,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) -lltdl $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" diff --git a/src/emacs.c b/src/emacs.c index 8396f5d4e45..b9e748b364c 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1432,6 +1432,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_terminal (); syms_of_term (); syms_of_undo (); + + syms_of_module (); + #ifdef HAVE_SOUND syms_of_sound (); #endif diff --git a/src/emacs_module.h b/src/emacs_module.h new file mode 100644 index 00000000000..2dbb2a2f5ce --- /dev/null +++ b/src/emacs_module.h @@ -0,0 +1,175 @@ +/* + emacs_module.h - Module API + Copyright (C) 2015 Free Software Foundation, Inc. + + This file is part of GNU Emacs. + + GNU Emacs is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + GNU Emacs is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNU Emacs. If not, see . +*/ + +#ifndef EMACS_MODULE_H +#define EMACS_MODULE_H + +#include +#include +#include + +/* Current environment */ +typedef struct emacs_env_25 emacs_env; + +/* The size of emacs_value must match EMACS_INT: + 32 bit system: 32 bits + 32 bit system with --with-wide-int: 64 bits + 64 bit system: 64 bits. + + When compiling modules, define the macro EMACS_VALUE_TYPE by the + result of `module-emacs_value-type'. */ +typedef EMACS_VALUE_TYPE emacs_value; + +/* Struct passed to a module init function (emacs_module_init) */ +struct emacs_runtime { + size_t size; + 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[]); +struct emacs_env_25 { + /* + * Structure size (for version checking) + */ + + size_t size; + + /* + * Constants + */ + emacs_value Qt_value; + emacs_value Qnil_value; + + /* + * Memory management + */ + + emacs_value (*make_global_reference)(emacs_env *env, + emacs_value any_reference); + + void (*free_global_reference)(emacs_env *env, + emacs_value global_reference); + + /* + * Error handling + */ + + bool (*error_check)(emacs_env *env); + + void (*clear_error)(emacs_env *env); + + bool (*get_error)(emacs_env *env, + emacs_value *error_symbol_out, + emacs_value *error_data_out); + + void (*signal_error)(emacs_env *env, + const char* msg, + emacs_value error_data); + + /* + * Function registration + */ + + emacs_value (*make_function)(emacs_env *env, + int min_arity, + int max_arity, + emacs_subr function); + + emacs_value (*funcall)(emacs_env *env, + emacs_value function, + int nargs, + emacs_value args[]); + + emacs_value (*intern)(emacs_env *env, + const char *symbol_name); + + emacs_value (*intern_soft)(emacs_env *env, + const char *symbol_name); + + void (*bind_function) (emacs_env *env, + const char *name, + emacs_value definition); + + /* + * Type conversion + */ + + emacs_value (*type_of)(emacs_env *env, + emacs_value value); + + int64_t (*fixnum_to_int)(emacs_env *env, + emacs_value value); + + emacs_value (*make_fixnum)(emacs_env *env, + int64_t value); + + double (*float_to_c_double)(emacs_env *env, + emacs_value value); + + emacs_value (*make_float)(emacs_env *env, + double value); + + bool (*copy_string_contents)(emacs_env *env, + emacs_value value, + char *buffer, + size_t* length_inout); + + size_t (*buffer_byte_length)(emacs_env *env, + emacs_value start, + emacs_value end); + /* Return the size in bytes of the buffer substring in the current + buffer from START to END */ + + void (*copy_buffer_substring)(emacs_env *env, + emacs_value start, + emacs_value end, + char *buffer, + size_t* length_inout); + /* Copy buffer string from current buffer, BEG to END (integers or + markers), to BUFFER. On call, LENGTH_INOUT is the size in bytes + of BUFFER; on return, it is the size in bytes of the copied + string. + + If BUFFER is too small, signals an error. Use buffer_byte_length + to ensure BUFFER is not too small. */ + + emacs_value (*make_string)(emacs_env *env, + const char *contents); + + /* + * miscellaneous + */ + + void (*message)(emacs_env *env, + emacs_value msg); + /* msg must be already formatted */ + + emacs_value (*symbol_value)(emacs_env *env, + emacs_value symbol); +}; + +#endif /* EMACS_MODULE_H */ diff --git a/src/lisp.h b/src/lisp.h index 198f116fe02..577105bf322 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4050,6 +4050,8 @@ 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); +/* Defined in module.c. */ +void syms_of_module (void); /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); diff --git a/src/module.c b/src/module.c new file mode 100644 index 00000000000..d69a4b585e4 --- /dev/null +++ b/src/module.c @@ -0,0 +1,435 @@ +/* + 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 . +*/ + +#include +#include "lisp.h" +#include "character.h" +#include "buffer.h" + +/* see comment in emacs_module.h at emacs_value for this define */ +#define EMACS_VALUE_TYPE EMACS_INT +#include "emacs_module.h" + +#include + +/* internal functions */ +void syms_of_module (void); +static struct emacs_runtime* module_get_runtime (void); +static emacs_env* module_get_environment (struct emacs_runtime *ert); + +/* emacs_module.h emacs_env_* functions; same order as there */ +/* FIXME: make_global_reference */ +/* FIXME: free_global_reference */ +/* FIXME: error_check */ +/* FIXME: clear_error */ +/* FIXME: get_error */ +static void module_signal_error (emacs_env *env, + const char* msg, + emacs_value error_data); +static emacs_value module_make_function (emacs_env *env, + int min_arity, + int max_arity, + emacs_subr subr); +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_intern_soft (emacs_env *env, + const char *name); +static void module_bind_function (emacs_env *env, + const char *name, + emacs_value definition); +/* FIXME: type_of */ +static int64_t module_fixnum_to_int (emacs_env *env, + emacs_value n); +static emacs_value module_make_fixnum (emacs_env *env, + int64_t n); +/* FIXME: float_to_c_double */ +/* FIXME: make_float */ +/* FIXME: copy_string_contents */ +static size_t module_buffer_byte_length (emacs_env *env, + emacs_value start, + emacs_value end); + +static void module_copy_buffer_substring (emacs_env *env, + emacs_value start, + emacs_value end, + char *buffer, + size_t *length_inout); +static emacs_value module_make_string (emacs_env *env, + const char *contents); +static void module_message (emacs_env *env, + emacs_value msg); +static emacs_value module_symbol_value (emacs_env *env, + emacs_value symbol); + + +static struct emacs_runtime* module_get_runtime (void) +{ + /* FIXME: why do we need module_get_runtime, as opposed to just module_get_environment? */ + struct emacs_runtime *ert = xzalloc (sizeof *ert); + + ert->size = sizeof *ert; + ert->get_environment = module_get_environment; + + return ert; +} + +static emacs_env* module_get_environment (struct emacs_runtime *ert) +{ + /* FIXME: error if not on main emacs thread? */ + + emacs_env *env = xzalloc (sizeof *env); + + env->size = sizeof *env; + env->Qt_value = (emacs_value) Qt; + env->Qnil_value = (emacs_value) Qnil; + /* FIXME: make_global_reference */ + /* FIXME: free_global_reference */ + /* FIXME: error_check */ + /* FIXME: clear_error */ + /* FIXME: get_error */ + env->signal_error = module_signal_error; + env->make_function = module_make_function; + env->funcall = module_funcall; + env->intern = module_intern; + env->intern_soft = module_intern_soft; + env->bind_function = module_bind_function; + env->fixnum_to_int = module_fixnum_to_int; + env->make_fixnum = module_make_fixnum; + /* FIXME: copy_string_contents */ + env->buffer_byte_length = module_buffer_byte_length; + env->copy_buffer_substring = module_copy_buffer_substring; + env->make_string = module_make_string; + env->message = module_message; + env->symbol_value = module_symbol_value; + + return env; +} + +static emacs_value module_make_fixnum (emacs_env *env, int64_t n) +{ + return (emacs_value) make_number (n); +} + +static int64_t module_fixnum_to_int (emacs_env *env, emacs_value n) +{ + return (int64_t) XINT ((Lisp_Object) n); +} + +static emacs_value module_intern (emacs_env *env, const char *name) +{ + return (emacs_value) intern (name); +} + +static emacs_value module_intern_soft (emacs_env *env, const char *name) +{ + register ptrdiff_t len = strlen (name); + register Lisp_Object tem = oblookup (Vobarray, name, len, len); + + if (INTEGERP (tem)) + return (emacs_value) Qnil; + else + return (emacs_value) tem; +} + +static void module_bind_function (emacs_env *env, + const char *name, + emacs_value definition) +{ + Lisp_Object symbol = intern (name); + set_symbol_function (symbol, (Lisp_Object) definition); +} + +static void module_signal_error (emacs_env *env, + const char* msg, + emacs_value error_data) +{ + signal_error (msg, (Lisp_Object) (error_data)); +} + +static emacs_value module_make_function (emacs_env *env, + int min_arity, + int max_arity, + emacs_subr subr) +{ + /* + (function + (lambda + (&rest arglist) + (module-call + envptr + subrptr + arglist))) + */ + /* FIXME: allow for doc string and interactive */ + Lisp_Object Qrest = intern ("&rest"); + Lisp_Object Qarglist = intern ("arglist"); + Lisp_Object Qmodule_call = intern ("module-call"); + Lisp_Object envptr = make_save_ptr ((void*) env); + Lisp_Object subrptr = make_save_ptr ((void*) subr); + + Lisp_Object form = list2 (Qfunction, + list3 (Qlambda, + list2 (Qrest, Qarglist), + list4 (Qmodule_call, + envptr, + subrptr, + Qarglist))); + + struct gcpro gcpro1; + GCPRO1 (Qform); + Lisp_Object ret = Feval (form, Qnil); + UNGCPRO; + + return (emacs_value) ret; +} + +static emacs_value module_funcall (emacs_env *env, + emacs_value fun, + int nargs, + emacs_value args[]) +{ + /* + * Make a new Lisp_Object array starting with the function as the + * first arg, because that's what Ffuncall takes + */ + int i; + Lisp_Object *newargs = xmalloc ((nargs+1) * sizeof (*newargs)); + + newargs[0] = (Lisp_Object) fun; + for (i = 0; i < nargs; i++) + newargs[1 + i] = (Lisp_Object) args[i]; + + struct gcpro gcpro1; + GCPRO1 (newargs[0]); + Lisp_Object ret = Ffuncall (nargs+1, newargs); + UNGCPRO; + + xfree (newargs); + return (emacs_value) ret; +} + +static size_t module_buffer_byte_length (emacs_env *env, + emacs_value start, + emacs_value end) +{ + Lisp_Object start_1 = (Lisp_Object)start; + Lisp_Object end_1 = (Lisp_Object)end; + + validate_region (&start_1, &end_1); + + { + ptrdiff_t start_byte = CHAR_TO_BYTE (XINT (start_1)); + ptrdiff_t end_byte = CHAR_TO_BYTE (XINT (end_1)); + + return (size_t) end_byte - start_byte; + } +} + +static void module_copy_buffer_substring (emacs_env *env, + emacs_value start, + emacs_value end, + char *buffer, + size_t *length_inout) +{ + /* Copied from editfns.c "buffer-substring-no-properties" and make_buffer_string_both */ + Lisp_Object start_1 = (Lisp_Object)start; + Lisp_Object end_1 = (Lisp_Object)end; + + validate_region (&start_1, &end_1); + + { + ptrdiff_t start = XINT (start_1); + ptrdiff_t start_byte = CHAR_TO_BYTE (start); + ptrdiff_t end = XINT (end_1); + ptrdiff_t end_byte = CHAR_TO_BYTE (end); + ptrdiff_t beg0, end0, beg1, end1; + size_t size; + + if (end_byte - start_byte > *length_inout) + { + /* buffer too small */ + /* FIXME: could copy less than requested, but that's + complicated for multi-byte characters */ + signal_error ("module_copy_buffer_substring: buffer too small", Qnil); + } + + if (start_byte < GPT_BYTE && GPT_BYTE < end_byte) + { + /* Two regions, before and after the gap. */ + beg0 = start_byte; + end0 = GPT_BYTE; + beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE; + end1 = end_byte + GAP_SIZE - BEG_BYTE; + } + else + { + /* One region, before the gap. */ + beg0 = start_byte; + end0 = end_byte; + beg1 = -1; + end1 = -1; + } + + size = end0 - beg0; + + /* FIXME: need to decode? See external process stuff. */ + + /* BYTE_POS_ADDR handles one region after the gap */ + memcpy (buffer, BYTE_POS_ADDR (beg0), size); + if (beg1 != -1) + memcpy (buffer + size, BEG_ADDR + beg1, end1 - beg1); + } +} + +static emacs_value module_make_string (emacs_env *env, const char *contents) +{ + return (emacs_value) make_string (contents, strlen (contents)); +} + +static void module_message (emacs_env *env, + emacs_value msg) +{ + message3 ((Lisp_Object) msg); +} + +static emacs_value module_symbol_value (emacs_env *env, + emacs_value symbol) +{ + Lisp_Object val= find_symbol_value ((Lisp_Object) symbol); + if (!EQ (val, Qunbound)) + return (emacs_value) val; + + xsignal1 (Qvoid_variable, (Lisp_Object) symbol); +} + +DEFUN ("module-call", Fmodule_call, Smodule_call, 3, 3, 0, + doc: "Call a module function") + (Lisp_Object envptr, Lisp_Object subrptr, Lisp_Object arglist) +{ + int len = XINT (Flength (arglist)); + emacs_value *args = xzalloc (len * sizeof (*args)); + int i; + + for (i = 0; i < len; i++) + { + args[i] = (emacs_value) XCAR (arglist); + arglist = XCDR (arglist); + } + + emacs_env *env = (emacs_env*) XSAVE_POINTER (envptr, 0); + emacs_subr subr = (emacs_subr) XSAVE_POINTER (subrptr, 0); + emacs_value ret = subr (env, len, args); + return (Lisp_Object) ret; +} + +static int lt_init_done = 0; + +EXFUN (Fmodule_load, 1); +DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, + doc: /* Load module FILE. */) + (Lisp_Object file) +{ + lt_dlhandle handle; + emacs_init_function module_init; + void *gpl_sym; + Lisp_Object doc_name, args[2]; + + /* init libtool once per emacs process */ + if (!lt_init_done) + { + int ret = lt_dlinit (); + if (ret) + { + const char* s = lt_dlerror (); + error ("ltdl init fail: %s", s); + } + lt_init_done = 1; + } + + /* FIXME: check for libltdl, load it if available; don't require + --with-ltdl at configure time. See image.c for example. */ + + CHECK_STRING (file); + handle = lt_dlopen (SDATA (file)); + if (!handle) + error ("Cannot load file %s : %s", SDATA (file), lt_dlerror()); + + gpl_sym = lt_dlsym (handle, "plugin_is_GPL_compatible"); + if (!gpl_sym) + error ("Module %s is not GPL compatible", SDATA (file)); + + module_init = (emacs_init_function) lt_dlsym (handle, "emacs_module_init"); + if (!module_init) + error ("Module %s does not have an init function.", SDATA (file)); + + + int r = module_init (module_get_runtime ()); + + /* Errors are reported by calling env->signal_error. FIXME: so why does module_init return anything? */ + return Qt; +} + +EXFUN (Fmodule_unsafe_unload, 1); +DEFUN ("module-unsafe-unload", Fmodule_unsafe_unload, Smodule_unsafe_unload, 1, 1, 0, + doc: /* Unload module FILE; does not undefine any functions defined by the module. +This permits re-compiling and re-loading while developing the module, +but is otherwise not recommended. */) + (Lisp_Object file) +{ + lt_dlhandle handle; + + if (!lt_init_done) + { + error ("no module loaded"); + } + + CHECK_STRING (file); + handle = lt_dlopen (SDATA (file)); + if (!handle) + error ("file not loaded %s : %s", SDATA (file), lt_dlerror()); + + if (lt_dlclose (handle)) + error ("Module %s not unloaded: %s", SDATA (file), lt_dlerror()); + + return Qt; +} + +EXFUN (Fmodule_emacs_value_type, 0); +DEFUN ("module-emacs_value-type", Fmodule_emacs_value_type, Smodule_emacs_value_type, 0, 0, 0, + doc: /* Return a string specifying the type for emacs_value in emacs_modules.h. */) + () +{ + if (sizeof (EMACS_INT) == 4) /* 4 bytes == 32 bits */ + return make_string ("uint32_t", 8); + else + return make_string ("uint64_t", 8); +} + +void syms_of_module (void) +{ + defsubr (&Smodule_call); + defsubr (&Smodule_load); + defsubr (&Smodule_unsafe_unload); + defsubr (&Smodule_emacs_value_type); +} -- 2.39.5