From 278f26a5e993f8cbf6784f35c5ea8aeb9ef04019 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Aur=C3=A9lien=20Aptel?= Date: Sat, 28 Feb 2015 18:39:19 +0100 Subject: [PATCH] add modules using Daniel Colascione ideas See [1] for Daniel's proposal. * src/module.c: new file * src/emacs_module.h: module API * src/Makefile.in: hardcode libltdl link flag and module.c compilation * modules/basic/basic.c: sample module * modules/basic/Makefile: module Makefile for linux 1: https://lists.gnu.org/archive/html/emacs-devel/2015-02/msg00960.html --- modules/basic/Makefile | 15 +++ modules/basic/basic.c | 64 +++++++++++++ src/Makefile.in | 4 +- src/emacs.c | 3 + src/emacs_module.h | 124 ++++++++++++++++++++++++ src/lisp.h | 2 + src/module.c | 208 +++++++++++++++++++++++++++++++++++++++++ 7 files changed, 418 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 0000000000..bb136f3577 --- /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 0000000000..f288b3832c --- /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 32615c848a..2ad469ee5a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -367,7 +367,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 \ @@ -427,7 +427,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 all: emacs$(EXEEXT) $(OTHER_FILES) .PHONY: all diff --git a/src/emacs.c b/src/emacs.c index ca5633da2d..0f367df7fe 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1430,6 +1430,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 0000000000..072ee4615b --- /dev/null +++ b/src/emacs_module.h @@ -0,0 +1,124 @@ +/* + 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 environement */ +typedef struct emacs_env_25 emacs_env; +typedef void* 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; + + /* + * 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, + emacs_value error_symbol, + 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); + + /* + * 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); + + emacs_value (*make_string)(emacs_env *env, + const char *contents); +}; + +#endif /* EMACS_MODULE_H */ diff --git a/src/lisp.h b/src/lisp.h index fb43677612..7dc028690d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4021,6 +4021,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 0000000000..a4fc13c54c --- /dev/null +++ b/src/module.c @@ -0,0 +1,208 @@ +/* + 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 "emacs_module.h" +#include + +void syms_of_module (void); +static struct emacs_runtime* module_get_runtime (void); +static emacs_env* module_get_environment (struct emacs_runtime *ert); +static emacs_value module_make_fixnum (emacs_env *env, int64_t n); +static int64_t module_fixnum_to_int (emacs_env *env, emacs_value n); +static emacs_value module_intern (emacs_env *env, const char *name); +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 struct emacs_runtime* module_get_runtime (void) +{ + 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) +{ + emacs_env *env = xzalloc (sizeof *env); + + env->size = sizeof *env; + env->make_fixnum = module_make_fixnum; + env->fixnum_to_int = module_fixnum_to_int; + env->intern = module_intern; + env->make_function = module_make_function; + env->funcall = module_funcall; + + 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_make_function (emacs_env *env, + int min_arity, + int max_arity, + emacs_subr subr) +{ + /* + (function + (lambda + (&rest arglist) + (module-call + envptr + subrptr + arglist))) + */ + 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; +} + +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; +} + +EXFUN (Fmodule_load, 1); +DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, + doc: "Load module FILE") + (Lisp_Object file) +{ + static int lt_init_done = 0; + 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; + } + + CHECK_STRING (file); + handle = lt_dlopen (SDATA (file)); + if (!handle) + error ("Cannot load file %s", SDATA (file)); + + 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 ()); + + return Qt; +} + + +void syms_of_module (void) +{ + defsubr (&Smodule_call); + defsubr (&Smodule_load); +}