Simon Wright <[email protected]> writes: > On 29 May 2015, at 16:42, Stephen Leake <[email protected]> > wrote: > >> Simon Wright <[email protected]> writes: >> >>> On 21 May 2015, at 14:21, Stephen Leake <[email protected]> >>> wrote: >>> >>>> I've got an Emacs module (which is a dynamic library with a defined >>>> interface) that implements an OpenToken parser for Ada mode. >>> >>> Does this need an Emacs built from the branch described in >>> https://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00123.html ? >> >> Yes, but with local patches. >> >> If you want to play with it, I'll work on getting it into the Emacs >> Savannah git, so we can all use it more easily (other people were doing >> that, but they seem to be on a break or something). > > I’d like to check out the Mac side of things so as to know what to > expect!
Ok, that would be helpful. >> Meanwhile, I can send you my patches; I'm focusing on the FastToken work >> for now, so the Emacs side is stable on my end. > > That would be great. Attached. -- -- Stephe
diff --git a/ChangeLog b/ChangeLog index 0bfdfbb..55a9002 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,42 @@ +2015-05-18 Stephen Leake <[email protected]> + + specify emacs_value size to match EMACS_INT + + * src/emacs_module.h: macro for emacs_value type + + * src/module.c: define EMACS_VALUE_TYPE + (Fmodule_unsafe_unload): new + (Fmodule_emacs_value_type): new; return value for EMACS_VALUE_TYPE + +2015-05-15 Stephen Leake <[email protected]> + + add FIXMEs for remaining module issues + + * src/emacs_module.h: emacs_value type/size + + * src/module.c: several fixmes + +2015-05-14 Stephen Leake <[email protected]> + + implement some missing module functions, add new ones + + * src/emacs_module.h: add buffer_byte_length, copy_buffer_substring + + * src/module.c: add buffer_byte_length, copy_buffer_substring + +2015-05-13 Stephen Leake <[email protected]> + + * src/emacs_module.h: add Qt_value, Qnil_value change signal_error + to take 'const char*' instead of emacs_value for string add + intern_soft, bind_function, message, symbol_value + + * src/module.c: change declaration order to match emacs_module.h, + doc missing features, add new implement module_signal_error, + module_intern_soft, module_bind_function, module_message, + module_symbol_value + + * src/module.c: (Fmodule_load): improve error message + 2015-02-27 Paul Eggert <[email protected]> Don't require GNU putenv diff --git a/src/emacs_module.h b/src/emacs_module.h index 072ee46..2dbb2a2 100644 --- a/src/emacs_module.h +++ b/src/emacs_module.h @@ -25,9 +25,17 @@ #include <stdlib.h> #include <stdbool.h> -/* Current environement */ +/* Current environment */ typedef struct emacs_env_25 emacs_env; -typedef void* emacs_value; + +/* 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 { @@ -51,6 +59,12 @@ struct emacs_env_25 { size_t size; /* + * Constants + */ + emacs_value Qt_value; + emacs_value Qnil_value; + + /* * Memory management */ @@ -73,7 +87,7 @@ struct emacs_env_25 { emacs_value *error_data_out); void (*signal_error)(emacs_env *env, - emacs_value error_symbol, + const char* msg, emacs_value error_data); /* @@ -93,6 +107,13 @@ struct emacs_env_25 { 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 */ @@ -117,8 +138,38 @@ struct emacs_env_25 { 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/module.c b/src/module.c index a4fc13c..d69a4b5 100644 --- a/src/module.c +++ b/src/module.c @@ -20,15 +20,29 @@ #include <config.h> #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 <ltdl.h> +/* 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); -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); + +/* 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, @@ -37,9 +51,41 @@ 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; @@ -50,14 +96,32 @@ static struct emacs_runtime* module_get_runtime (void) 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->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; + 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; } @@ -77,6 +141,32 @@ 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, @@ -91,6 +181,7 @@ static emacs_value module_make_function (emacs_env *env, 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"); @@ -138,6 +229,100 @@ static emacs_value module_funcall (emacs_env *env, 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) @@ -158,12 +343,13 @@ DEFUN ("module-call", Fmodule_call, Smodule_call, 3, 3, 0, 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") + doc: /* Load module FILE. */) (Lisp_Object file) { - static int lt_init_done = 0; lt_dlhandle handle; emacs_init_function module_init; void *gpl_sym; @@ -181,10 +367,13 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, 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", SDATA (file)); + error ("Cannot load file %s : %s", SDATA (file), lt_dlerror()); gpl_sym = lt_dlsym (handle, "plugin_is_GPL_compatible"); if (!gpl_sym) @@ -197,12 +386,50 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, 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); }
_______________________________________________ Emacs-ada-mode mailing list [email protected] http://host114.hostmonster.com/mailman/listinfo/emacs-ada-mode_stephe-leake.org
