dynamic modules progress

[Stephen Leake]

I've got parsers for several symbol test grammars working as Emacs
modules. In doing so, I've added a few things to emacs_modules.h and
modules.c; patch below. I also added FIXMEs for any issues I could
identify from the discussion on emacs-devel.

Next step is to get this working with the full Ada grammar, and then
address the FIXMEs in the below patch.

Can we get this branch hosted on git.sv.gnu.org? That would make it
easier to update from current master, and to merge to master when we
agree it's ready. Aurelian, do you need write privs there?

-- 
-- Stephe

diff --git a/ChangeLog b/ChangeLog
index 0bfdfbb..681b58e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,32 @@
+2015-05-15  Stephen Leake <address@hidden>
+
+       add FIXMEs for remaining module issues
+
+       * src/emacs_module.h: emacs_value type/size
+
+       * src/module.c: several fixmes
+
+2015-05-14  Stephen Leake <address@hidden>
+
+       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 <address@hidden>
+
+       * 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  <address@hidden>
 
        Don't require GNU putenv
diff --git a/src/emacs_module.h b/src/emacs_module.h
index 072ee46..d903eae 100644
--- a/src/emacs_module.h
+++ b/src/emacs_module.h
@@ -27,6 +27,9 @@
 
 /* Current environement */
 typedef struct emacs_env_25 emacs_env;
+
+/* FIXME: size mismatch on 32 bit system with --with-wide-int. Have
+   Emacs pass env var to makefile to specify this type. */
 typedef void* emacs_value;
 
 /* Struct passed to a module init function (emacs_module_init) */
@@ -51,6 +54,12 @@ struct emacs_env_25 {
   size_t size;
 
   /*
+   * Constants
+   */
+  emacs_value Qt_value;
+  emacs_value Qnil_value;
+
+  /*
    * Memory management
    */
 
@@ -73,7 +82,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 +102,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 +133,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..bfbaab6 100644
--- a/src/module.c
+++ b/src/module.c
@@ -20,15 +20,25 @@
 
 #include <config.h>
 #include "lisp.h"
+#include "character.h"
+#include "buffer.h"
 #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 +47,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 +92,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 +137,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 +177,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 +225,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)
@@ -181,10 +362,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,6 +381,7 @@ 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;
 }