From 3b0080de52db1756fc47f1642ee9980655421af9 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 4 Jun 2017 18:57:51 +0200 Subject: [PATCH] Rework printing of module functions Fix a FIXME in emacs-module.c. Put the printing into print.c, like other types. * src/print.c (print_vectorlike): Add code to print module functions. * src/emacs-module.c (funcall_module): Stop calling 'module_format_fun_env'. Now that module functions are first-class objects, they can be added to signal data directly. (module_handle_signal): Remove now-unused function 'module_format_fun_env'. * test/src/emacs-module-tests.el (mod-test-sum-test): Adapt unit test. * src/eval.c (funcall_lambda): Adapt call to changed signature of 'funcall_module'. --- src/emacs-module.c | 44 ++++++---------------------------- src/eval.c | 2 +- src/lisp.h | 4 +--- src/print.c | 30 +++++++++++++++++++++-- test/src/emacs-module-tests.el | 4 ++-- 5 files changed, 39 insertions(+), 45 deletions(-) diff --git a/src/emacs-module.c b/src/emacs-module.c index f2eaa71de3f..f9e76b5f0f8 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -645,14 +645,13 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, } Lisp_Object -funcall_module (const struct Lisp_Module_Function *const function, - ptrdiff_t nargs, Lisp_Object *arglist) +funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) { - eassume (0 <= function->min_arity); - if (! (function->min_arity <= nargs - && (function->max_arity < 0 || nargs <= function->max_arity))) - xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (function), - make_number (nargs)); + const struct Lisp_Module_Function *func = XMODULE_FUNCTION (function); + eassume (0 <= func->min_arity); + if (! (func->min_arity <= nargs + && (func->max_arity < 0 || nargs <= func->max_arity))) + xsignal2 (Qwrong_number_of_arguments, function, make_natnum (nargs)); emacs_env pub; struct emacs_env_private priv; @@ -669,7 +668,7 @@ funcall_module (const struct Lisp_Module_Function *const function, args[i] = lisp_to_value (arglist[i]); } - emacs_value ret = function->subr (&pub, nargs, args, function->data); + emacs_value ret = func->subr (&pub, nargs, args, func->data); SAFE_FREE (); eassert (&priv == pub.private_members); @@ -941,35 +940,6 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val) module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val)); } - -/* Function environments. */ - -/* Return a string object that contains a user-friendly - representation of the function environment. */ -Lisp_Object -module_format_fun_env (const struct Lisp_Module_Function *env) -{ - /* Try to print a function name if possible. */ - /* FIXME: Move this function into print.c, then use prin1-to-string - above. */ - const char *path, *sym; - static char const noaddr_format[] = "#"; - char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256]; - char *buf = buffer; - ptrdiff_t bufsize = sizeof buffer; - ptrdiff_t size - = (dynlib_addr (env->subr, &path, &sym) - ? exprintf (&buf, &bufsize, buffer, -1, - "#", sym, path) - : sprintf (buffer, noaddr_format, env->subr)); - AUTO_STRING_WITH_LEN (unibyte_result, buffer, size); - Lisp_Object result = code_convert_string_norecord (unibyte_result, - Qutf_8, false); - if (buf != buffer) - xfree (buf); - return result; -} - /* Segment initializer. */ diff --git a/src/eval.c b/src/eval.c index f472efad52e..8aa33a11282 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2952,7 +2952,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) - return funcall_module (XMODULE_FUNCTION (fun), nargs, arg_vector); + return funcall_module (fun, nargs, arg_vector); #endif else emacs_abort (); diff --git a/src/lisp.h b/src/lisp.h index 7b8f1e754d8..ce939fcee62 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3952,10 +3952,8 @@ XMODULE_FUNCTION (Lisp_Object o) extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p); /* Defined in emacs-module.c. */ -extern Lisp_Object funcall_module (const struct Lisp_Module_Function *, - ptrdiff_t, Lisp_Object *); +extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *); extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *); -extern Lisp_Object module_format_fun_env (const struct Lisp_Module_Function *); extern void syms_of_module (void); #endif diff --git a/src/print.c b/src/print.c index 49408bbeb40..e89f3d80725 100644 --- a/src/print.c +++ b/src/print.c @@ -33,6 +33,7 @@ along with GNU Emacs. If not, see . */ #include "intervals.h" #include "blockinput.h" #include "xwidget.h" +#include "dynlib.h" #include #include @@ -1699,8 +1700,33 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, #ifdef HAVE_MODULES case PVEC_MODULE_FUNCTION: - print_string (module_format_fun_env (XMODULE_FUNCTION (obj)), - printcharfun); + { + print_c_string ("#subr; + const char *file = NULL; + const char *symbol = NULL; + dynlib_addr (ptr, &file, &symbol); + + if (symbol == NULL) + { + print_c_string (" at ", printcharfun); + enum { pointer_bufsize = sizeof ptr * 16 / CHAR_BIT + 2 + 1 }; + char buffer[pointer_bufsize]; + int needed = snprintf (buffer, sizeof buffer, "%p", ptr); + eassert (needed <= sizeof buffer); + print_c_string (buffer, printcharfun); + } + else + print_c_string (symbol, printcharfun); + + if (file != NULL) + { + print_c_string (" from ", printcharfun); + print_c_string (file, printcharfun); + } + + printchar ('>', printcharfun); + } break; #endif diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 5e78aebf7c3..622bbadb3ef 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -31,13 +31,13 @@ (should (= (mod-test-sum 1 2) 3)) (let ((descr (should-error (mod-test-sum 1 2 3)))) (should (eq (car descr) 'wrong-number-of-arguments)) - (should (stringp (nth 1 descr))) + (should (module-function-p (nth 1 descr))) (should (eq 0 (string-match (concat "#") - (nth 1 descr)))) + (prin1-to-string (nth 1 descr))))) (should (= (nth 2 descr) 3))) (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument) (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument) -- 2.39.2