Also print function data when printing module functions.
This is especially useful in cases where modules only use a single entry point and use the data to dispatch to the actual function. Such a design is common for languages such as Go and C++. * src/emacs-module.c (module_function_data): New function. * src/print.c (print_vectorlike): Use it to print module function data if not NULL. (print_object): Adapt size of buffer. * test/data/emacs-module/mod-test.c (emacs_module_init): Pass some non-NULL data to ‘mod-test-sum’. (Fmod_test_sum): Check that correct data is passed through. * test/src/emacs-module-tests.el (mod-test-sum-test) (module-function-object): Adapt unit tests.
This commit is contained in:
parent
9d38564cdd
commit
fc92c2d894
5 changed files with 31 additions and 5 deletions
|
@ -1098,6 +1098,12 @@ module_function_address (const struct Lisp_Module_Function *function)
|
|||
return (module_funcptr) function->subr;
|
||||
}
|
||||
|
||||
void *
|
||||
module_function_data (const struct Lisp_Module_Function *function)
|
||||
{
|
||||
return function->data;
|
||||
}
|
||||
|
||||
|
||||
/* Helper functions. */
|
||||
|
||||
|
|
|
@ -4245,6 +4245,7 @@ extern Lisp_Object module_function_documentation
|
|||
(struct Lisp_Module_Function const *);
|
||||
extern module_funcptr module_function_address
|
||||
(struct Lisp_Module_Function const *);
|
||||
extern void *module_function_data (const struct Lisp_Module_Function *);
|
||||
extern void module_finalize_function (const struct Lisp_Module_Function *);
|
||||
extern void mark_modules (void);
|
||||
extern void init_module_assertions (bool);
|
||||
|
|
18
src/print.c
18
src/print.c
|
@ -1796,7 +1796,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
|
|||
case PVEC_MODULE_FUNCTION:
|
||||
{
|
||||
print_c_string ("#<module function ", printcharfun);
|
||||
module_funcptr ptr = module_function_address (XMODULE_FUNCTION (obj));
|
||||
const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj);
|
||||
module_funcptr ptr = module_function_address (function);
|
||||
char const *file;
|
||||
char const *symbol;
|
||||
dynlib_addr (ptr, &file, &symbol);
|
||||
|
@ -1815,6 +1816,19 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
|
|||
else
|
||||
print_c_string (symbol, printcharfun);
|
||||
|
||||
void *data = module_function_data (function);
|
||||
if (data != NULL)
|
||||
{
|
||||
uintptr_t ui = (uintptr_t) data;
|
||||
|
||||
/* In theory this assignment could lose info on pre-C99
|
||||
hosts, but in practice it doesn't. */
|
||||
uintmax_t up = ui;
|
||||
|
||||
int len = sprintf (buf, " with data 0x%"PRIxMAX, up);
|
||||
strout (buf, len, len, printcharfun);
|
||||
}
|
||||
|
||||
if (file != NULL)
|
||||
{
|
||||
print_c_string (" from ", printcharfun);
|
||||
|
@ -1838,7 +1852,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
|
|||
{
|
||||
char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
|
||||
max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t),
|
||||
max ((sizeof "at 0x"
|
||||
max ((sizeof " with data 0x"
|
||||
+ (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4),
|
||||
40)))];
|
||||
current_thread->stack_top = buf;
|
||||
|
|
|
@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
|
||||
#include <errno.h>
|
||||
#include <limits.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
@ -86,6 +87,7 @@ static emacs_value
|
|||
Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data)
|
||||
{
|
||||
assert (nargs == 2);
|
||||
assert ((uintptr_t) data == 0x1234);
|
||||
|
||||
intmax_t a = env->extract_integer (env, args[0]);
|
||||
intmax_t b = env->extract_integer (env, args[1]);
|
||||
|
@ -587,7 +589,8 @@ emacs_module_init (struct emacs_runtime *ert)
|
|||
env->make_function (env, amin, amax, csym, doc, data))
|
||||
|
||||
DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL);
|
||||
DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)", NULL);
|
||||
DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)",
|
||||
(void *) (uintptr_t) 0x1234);
|
||||
DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL);
|
||||
DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL);
|
||||
DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
|
||||
|
|
|
@ -60,8 +60,9 @@
|
|||
(should (eq 0
|
||||
(string-match
|
||||
(concat "#<module function "
|
||||
"\\(at \\(0x\\)?[[:xdigit:]]+\\( from .*\\)?"
|
||||
"\\|Fmod_test_sum from .*\\)>")
|
||||
"\\(at \\(0x\\)?[[:xdigit:]]+ "
|
||||
"with data 0x1234\\( from .*\\)?"
|
||||
"\\|Fmod_test_sum with data 0x1234 from .*\\)>")
|
||||
(prin1-to-string (nth 1 descr)))))
|
||||
(should (= (nth 2 descr) 3)))
|
||||
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
|
||||
|
@ -97,6 +98,7 @@ changes."
|
|||
(rx bos "#<module function "
|
||||
(or "Fmod_test_sum"
|
||||
(and "at 0x" (+ hex-digit)))
|
||||
" with data 0x1234"
|
||||
(? " from " (* nonl) "mod-test" (* nonl) )
|
||||
">" eos)
|
||||
(prin1-to-string func)))))
|
||||
|
|
Loading…
Add table
Reference in a new issue