[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/aptel/dynamic-modules-rc3 c59f2de: add new Lisp_Mo
From: |
Teodor Zlatanov |
Subject: |
[Emacs-diffs] feature/aptel/dynamic-modules-rc3 c59f2de: add new Lisp_Module type (misc subtype) |
Date: |
Wed, 11 Feb 2015 15:46:55 +0000 |
branch: feature/aptel/dynamic-modules-rc3
commit c59f2deaae99ca85b0a4fcdd53a3d8ed41d995cd
Author: Aurélien Aptel <address@hidden>
Commit: Aurélien Aptel <address@hidden>
add new Lisp_Module type (misc subtype)
Lisp_Module is a new subtype of Misc objects. As other Misc types, it
re-uses the marker free list.
A module must have a custom destructor, which is automatically called
by the GC.
Previous module object using the Save_Value type still work and they
still have to be free explicitely from Lisp. Their use is now
discouraged in modules.
A simple module example + tests are available in modules/memtest.
---
modules/fmod/test.el | 4 ++
modules/memtest/Makefile | 12 +++++
modules/memtest/memtest.c | 116 +++++++++++++++++++++++++++++++++++++++++++++
modules/memtest/test.el | 20 ++++++++
src/Makefile.in | 2 +-
src/alloc.c | 58 +++++++++++++++++++++-
src/data.c | 24 +++++++++
src/emacs.c | 1 +
src/lisp.h | 57 ++++++++++++++++++++++
src/module.c | 59 +++++++++++++++++++++++
src/print.c | 17 +++++++
11 files changed, 366 insertions(+), 4 deletions(-)
diff --git a/modules/fmod/test.el b/modules/fmod/test.el
index e1478d8..040c5f0 100644
--- a/modules/fmod/test.el
+++ b/modules/fmod/test.el
@@ -2,6 +2,10 @@
;; basic module test should go here
+(ert-deftest fmod-module-available ()
+ "Tests if `module-available-p' is t"
+ (should (module-available-p)))
+
(ert-deftest fmod-require ()
"Tests bindings after require"
(skip-unless (not (fboundp 'fmod)))
diff --git a/modules/memtest/Makefile b/modules/memtest/Makefile
new file mode 100644
index 0000000..2492af1
--- /dev/null
+++ b/modules/memtest/Makefile
@@ -0,0 +1,12 @@
+ROOT = ../..
+
+all: memtest.so memtest.doc
+
+%.so: %.o
+ gcc -shared -o $@ $<
+
+%.o: %.c
+ gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
+
+%.doc: %.c
+ $(ROOT)/lib-src/make-docfile $< > $@
diff --git a/modules/memtest/memtest.c b/modules/memtest/memtest.c
new file mode 100644
index 0000000..f2dbf4a
--- /dev/null
+++ b/modules/memtest/memtest.c
@@ -0,0 +1,116 @@
+#include <config.h>
+#include <lisp.h>
+
+int plugin_is_GPL_compatible;
+
+static module_id_t module_id;
+static Lisp_Object MQmemtest;
+
+static int free_count = 0;
+
+struct int_buffer
+{
+ int size;
+ int capacity;
+ int *buf;
+};
+
+#define MXBUF(x) ((struct int_buffer*)(XMODULE (x)->p))
+
+static void buf_init (struct int_buffer *b, int size)
+{
+ b->size = size;
+ b->capacity = (size == 0 ? 1 : size);
+ b->buf = malloc (sizeof (*b->buf) * b->capacity);
+}
+
+static void buf_add (struct int_buffer *b, int val)
+{
+ if (b->size >= b->capacity)
+ {
+ b->capacity *= 2;
+ b->buf = realloc (b->buf, sizeof (*b->buf) * b->capacity);
+ }
+
+ b->buf[b->size++] = val;
+}
+
+static void memtest_destructor (void *p)
+{
+ struct int_buffer *b = p;
+ free (b->buf);
+ free (b);
+ free_count++;
+}
+
+EXFUN (Fmemtest_make, 1);
+DEFUN ("memtest-make", Fmemtest_make, Smemtest_make, 0, 1, 0,
+ doc: "Return an int buffer in the form of a Lisp_Module object.")
+ (Lisp_Object size)
+{
+ struct int_buffer *b;
+
+ b = malloc (sizeof (*b));
+ buf_init (b, NILP (size) ? 0 : XINT (size));
+
+ return module_make_object (module_id, memtest_destructor, (void*)b);
+}
+
+EXFUN (Fmemtest_get, 2);
+DEFUN ("memtest-get", Fmemtest_get, Smemtest_get, 2, 2, 0,
+ doc: "Get value at index N of a memtest buffer.")
+ (Lisp_Object buf, Lisp_Object n)
+{
+ return make_number (MXBUF (buf)->buf[XINT (n)]);
+}
+
+EXFUN (Fmemtest_set, 3);
+DEFUN ("memtest-set", Fmemtest_set, Smemtest_set, 3, 3, 0,
+ doc: "Doc")
+ (Lisp_Object buf, Lisp_Object n, Lisp_Object value)
+{
+ MXBUF (buf)->buf[XINT (n)] = XINT (value);
+ return value;
+}
+
+EXFUN (Fmemtest_size, 1);
+DEFUN ("memtest-size", Fmemtest_size, Smemtest_size, 1, 1, 0,
+ doc: "Doc")
+ (Lisp_Object buf)
+{
+ return make_number (MXBUF (buf)->size);
+}
+
+EXFUN (Fmemtest_add, 2);
+DEFUN ("memtest-add", Fmemtest_add, Smemtest_add, 2, 2, 0,
+ doc: "Doc")
+ (Lisp_Object buf, Lisp_Object value)
+{
+ buf_add (MXBUF (buf), XINT (value));
+ return Qnil;
+}
+
+
+EXFUN (Fmemtest_free_count, 0);
+DEFUN ("memtest-free-count", Fmemtest_free_count, Smemtest_free_count, 0, 0, 0,
+ doc: "Doc")
+ (void)
+{
+ return make_number (free_count);
+}
+
+
+void init ()
+{
+ module_id = module_make_id ();
+ MQmemtest = intern ("memtest");
+
+ defsubr (&Smemtest_make);
+ defsubr (&Smemtest_set);
+ defsubr (&Smemtest_get);
+ defsubr (&Smemtest_add);
+ defsubr (&Smemtest_size);
+ defsubr (&Smemtest_free_count);
+
+ Fprovide (MQmemtest, Qnil);
+}
diff --git a/modules/memtest/test.el b/modules/memtest/test.el
new file mode 100644
index 0000000..d7bf2bf
--- /dev/null
+++ b/modules/memtest/test.el
@@ -0,0 +1,20 @@
+(require 'ert)
+(require 'memtest)
+
+(ert-deftest memtest-basic ()
+ "Tests creation/access/release of module objects"
+ (let* ((fc (memtest-free-count))
+ (n 100))
+
+ (let ((b (memtest-make)))
+ (dotimes (i n)
+ (should (= (memtest-size b) i))
+ (memtest-add b i)
+ (should (= (memtest-size b) (1+ i)))))
+
+ ;; force GC
+ (garbage-collect)
+ (sleep-for 1)
+ (garbage-collect)
+
+ (should (= (memtest-free-count) (1+ fc)))))
diff --git a/src/Makefile.in b/src/Makefile.in
index b2bfbfc..30abe03 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -366,7 +366,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o
$(XMENU_OBJ) window.o \
$(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
emacs.o keyboard.o macros.o keymap.o sysdep.o \
buffer.o filelock.o insdel.o marker.o \
- minibuf.o fileio.o dired.o \
+ minibuf.o fileio.o dired.o module.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 \
diff --git a/src/alloc.c b/src/alloc.c
index 4daa60c..5a0b264 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3657,6 +3657,38 @@ free_marker (Lisp_Object marker)
free_misc (marker);
}
+#ifdef HAVE_LTDL
+/* Create a new module object. */
+Lisp_Object
+module_make_object (module_id_t id, void (*dtor) (void*), void *userptr)
+{
+ Lisp_Object obj;
+ struct Lisp_Module *m;
+
+ eassert (id < MODULE_ID_MAX);
+
+ obj = allocate_misc (Lisp_Misc_Module);
+ m = XMODULE (obj);
+ m->id = id;
+ m->dtor = dtor;
+ m->p = userptr;
+ return obj;
+}
+
+/* Free a module using its own destructor. */
+void
+module_free_object (Lisp_Object obj)
+{
+ /* every change made here probably needs to be done in
+ sweep_marker() */
+
+ struct Lisp_Module *m = XMODULE (obj);
+ m->dtor (m->p);
+
+ free_misc (obj);
+}
+#endif
+
/* Return a newly created vector or string with specified arguments as
elements. If all the arguments are characters that can fit
@@ -6367,6 +6399,12 @@ mark_object (Lisp_Object arg)
mark_overlay (XOVERLAY (obj));
break;
+#ifdef HAVE_LTDL
+ case Lisp_Misc_Module:
+ XMISCANY (obj)->gcmarkbit = 1;
+ break;
+#endif
+
default:
emacs_abort ();
}
@@ -6744,9 +6782,23 @@ sweep_misc (void)
for (i = 0; i < lim; i++)
{
if (!mblk->markers[i].m.u_any.gcmarkbit)
- {
- if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
- unchain_marker (&mblk->markers[i].m.u_marker);
+ {
+ switch (mblk->markers[i].m.u_any.type)
+ {
+ case Lisp_Misc_Marker:
+ unchain_marker (&mblk->markers[i].m.u_marker);
+ break;
+#ifdef HAVE_LTDL
+ case Lisp_Misc_Module:
+ /* Module dtor need to be called */
+ {
+ /* see module_free_object() */
+ struct Lisp_Module *m = &mblk->markers[i].m.u_module;
+ m->dtor (m->p);
+ }
+ break;
+#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 d06b991..ece0a32 100644
--- a/src/data.c
+++ b/src/data.c
@@ -224,6 +224,10 @@ for example, (type-of 1) returns `integer'. */)
return Qoverlay;
case Lisp_Misc_Float:
return Qfloat;
+#ifdef HAVE_LTDL
+ case Lisp_Misc_Module:
+ return Qmodule;
+#endif
}
emacs_abort ();
@@ -424,6 +428,17 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
return Qnil;
}
+#ifdef HAVE_LTDL
+DEFUN ("modulep", Fmodulep, Smodulep, 1, 1, 0,
+ doc: /* Return t if OBJECT is a module object. */)
+ (Lisp_Object object)
+{
+ if (MODULEP (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)
@@ -3457,6 +3472,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_LTDL
+ DEFSYM (Qmodulep, "modulep");
+#endif
DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
DEFSYM (Qboundp, "boundp");
@@ -3552,6 +3570,9 @@ syms_of_data (void)
DEFSYM (Qcons, "cons");
DEFSYM (Qmarker, "marker");
DEFSYM (Qoverlay, "overlay");
+#ifdef HAVE_LTDL
+ DEFSYM (Qmodule, "module");
+#endif
DEFSYM (Qfloat, "float");
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
@@ -3601,6 +3622,9 @@ syms_of_data (void)
defsubr (&Ssequencep);
defsubr (&Sbufferp);
defsubr (&Smarkerp);
+#ifdef HAVE_LTDL
+ defsubr (&Smodulep);
+#endif
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
defsubr (&Schar_or_string_p);
diff --git a/src/emacs.c b/src/emacs.c
index fdd17d1..a329afd 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1403,6 +1403,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
/* syms_of_keymap (); */
syms_of_macros ();
syms_of_marker ();
+ syms_of_module ();
syms_of_minibuf ();
syms_of_process ();
syms_of_search ();
diff --git a/src/lisp.h b/src/lisp.h
index e3ae396..d606e9c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -491,6 +491,9 @@ enum Lisp_Misc_Type
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
Lisp_Misc_Float,
+#ifdef HAVE_LTDL
+ Lisp_Misc_Module,
+#endif
/* This is not a type code. It is for range checking. */
Lisp_Misc_Limit
};
@@ -600,6 +603,9 @@ INLINE bool OVERLAYP (Lisp_Object);
INLINE bool PROCESSP (Lisp_Object);
INLINE bool PSEUDOVECTORP (Lisp_Object, int);
INLINE bool SAVE_VALUEP (Lisp_Object);
+#ifdef HAVE_LTDL
+INLINE bool MODULEP (Lisp_Object);
+#endif
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
INLINE bool STRINGP (Lisp_Object);
@@ -2176,6 +2182,24 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
return XSAVE_VALUE (obj)->data[n].object;
}
+#ifdef HAVE_LTDL
+
+#define MODULE_ID_BITS 5
+#define MODULE_ID_MAX ((1 << MODULE_ID_BITS) - 1)
+typedef unsigned module_id_t;
+struct Lisp_Module
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Module */
+ bool_bf gcmarkbit : 1;
+ unsigned spacer : 15 - MODULE_ID_BITS;
+ unsigned id : MODULE_ID_BITS;
+
+ void (*dtor) (void*);
+ void *p;
+ };
+
+#endif
+
/* A miscellaneous object, when it's on the free list. */
struct Lisp_Free
{
@@ -2195,6 +2219,9 @@ union Lisp_Misc
struct Lisp_Marker u_marker;
struct Lisp_Overlay u_overlay;
struct Lisp_Save_Value u_save_value;
+#ifdef HAVE_LTDL
+ struct Lisp_Module u_module;
+#endif
};
INLINE union Lisp_Misc *
@@ -2236,6 +2263,17 @@ XSAVE_VALUE (Lisp_Object a)
eassert (SAVE_VALUEP (a));
return & XMISC (a)->u_save_value;
}
+
+#ifdef HAVE_LTDL
+
+INLINE struct Lisp_Module *
+XMODULE (Lisp_Object a)
+{
+ eassert (MODULEP (a));
+ return & XMISC (a)->u_module;
+}
+
+#endif
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
@@ -2482,6 +2520,14 @@ SAVE_VALUEP (Lisp_Object x)
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
}
+#ifdef HAVE_LTDL
+INLINE bool
+MODULEP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Module;
+}
+#endif
+
INLINE bool
AUTOLOADP (Lisp_Object x)
{
@@ -3839,6 +3885,10 @@ extern Lisp_Object make_save_funcptr_ptr_obj (void (*)
(void), void *,
Lisp_Object);
extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
extern void free_save_value (Lisp_Object);
+#ifdef HAVE_LTDL
+extern Lisp_Object module_make_object (module_id_t id, void (*dtor) (void*),
void *userptr);
+extern void module_free_object (Lisp_Object);
+#endif
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
@@ -4060,6 +4110,13 @@ extern Lisp_Object set_marker_restricted_both
(Lisp_Object, Lisp_Object,
extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
extern void syms_of_marker (void);
+/* Defined in module.c. */
+
+#ifdef HAVE_LTDL
+extern module_id_t module_make_id (void);
+#endif
+extern void syms_of_module (void);
+
/* Defined in fileio.c. */
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
diff --git a/src/module.c b/src/module.c
new file mode 100644
index 0000000..b1aca0f
--- /dev/null
+++ b/src/module.c
@@ -0,0 +1,59 @@
+/* Dynamic modules related functions for GNU Emacs
+
+ 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 <config.h>
+#include <limits.h>
+#include "lisp.h"
+
+EXFUN (Fmodule_available_p, 0);
+DEFUN ("module-available-p", Fmodule_available_p, Smodule_available_p, 0, 0, 0,
+ doc: "Doc")
+ (void)
+{
+#ifdef HAVE_LTDL
+ return Qt;
+#else
+ return Qnil;
+#endif
+}
+
+/* Module functions */
+#ifdef HAVE_LTDL
+
+/* Return a unique id for a new module opaque type. */
+module_id_t
+module_make_id (void)
+{
+ static module_id_t module_count = 0;
+
+ eassert (module_count < MODULE_ID_MAX);
+ return module_count++;
+}
+
+#endif
+
+void syms_of_module (void)
+{
+#ifdef HAVE_LTDL
+ /* Nothing yet! */
+#endif
+
+ defsubr(&Smodule_available_p);
+}
diff --git a/src/print.c b/src/print.c
index 1a0aebb..db41adc 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2045,6 +2045,23 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
PRINTCHAR ('>');
break;
+#ifdef HAVE_LTDL
+ case Lisp_Misc_Module:
+ strout ("#<module id = ", -1, -1, printcharfun);
+ {
+ int len = sprintf (buf, "%u", XMODULE (obj)->id);
+ strout (buf, len, len, printcharfun);
+ strout (", dtor = ", -1, -1, printcharfun);
+ len = sprintf (buf, "%p", XMODULE (obj)->dtor);
+ strout (buf, len, len, printcharfun);
+ strout (", p = ", -1, -1, printcharfun);
+ len = sprintf (buf, "%p", XMODULE (obj)->p);
+ strout (buf, len, len, printcharfun);
+ strout (">", -1, -1, printcharfun);
+ }
+ break;
+#endif
+
/* Remaining cases shouldn't happen in normal usage, but let's
print them anyway for the benefit of the debugger. */
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] feature/aptel/dynamic-modules-rc3 c59f2de: add new Lisp_Module type (misc subtype),
Teodor Zlatanov <=