diff options
| author | Philipp Stephani | 2017-04-22 18:04:29 +0200 |
|---|---|---|
| committer | Philipp | 2017-05-06 21:29:08 +0200 |
| commit | a3e9694078e24d19db860aa4ff8dec8bc34b59b7 (patch) | |
| tree | 235bf0857ebe0011ffd0b9cbef5f8daa242efbc1 /src/emacs-module.c | |
| parent | 5e47c2e52b9b7616668c5586084e0128b231272a (diff) | |
| download | emacs-a3e9694078e24d19db860aa4ff8dec8bc34b59b7.tar.gz emacs-a3e9694078e24d19db860aa4ff8dec8bc34b59b7.zip | |
Introduce new misc type for module function
This resolves a couple of FIXMEs in emacs-module.c.
* src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.
* src/alloc.c (make_module_function): New function.
(mark_object): GC support.
* src/data.c (Ftype_of, syms_of_data): Handle module function type.
* src/print.c (print_object): Print support for new type.
* src/emacs-module.c (module_make_function, Finternal_module_call):
Use new module function type, remove FIXMEs.
(module_format_fun_env): Adapt and give it external linkage.
* test/src/emacs-module-tests.el (module-function-object): Add unit
test.
Diffstat (limited to 'src/emacs-module.c')
| -rw-r--r-- | src/emacs-module.c | 48 |
1 files changed, 9 insertions, 39 deletions
diff --git a/src/emacs-module.c b/src/emacs-module.c index 1b445dcc3b2..cd025a1396e 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c | |||
| @@ -62,10 +62,6 @@ enum | |||
| 62 | /* Function prototype for the module init function. */ | 62 | /* Function prototype for the module init function. */ |
| 63 | typedef int (*emacs_init_function) (struct emacs_runtime *); | 63 | typedef int (*emacs_init_function) (struct emacs_runtime *); |
| 64 | 64 | ||
| 65 | /* Function prototype for the module Lisp functions. */ | ||
| 66 | typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, | ||
| 67 | emacs_value [], void *); | ||
| 68 | |||
| 69 | /* Function prototype for module user-pointer finalizers. These | 65 | /* Function prototype for module user-pointer finalizers. These |
| 70 | should not throw C++ exceptions, so emacs-module.h declares the | 66 | should not throw C++ exceptions, so emacs-module.h declares the |
| 71 | corresponding interfaces with EMACS_NOEXCEPT. There is only C code | 67 | corresponding interfaces with EMACS_NOEXCEPT. There is only C code |
| @@ -102,7 +98,6 @@ struct emacs_runtime_private | |||
| 102 | 98 | ||
| 103 | struct module_fun_env; | 99 | struct module_fun_env; |
| 104 | 100 | ||
| 105 | static Lisp_Object module_format_fun_env (const struct module_fun_env *); | ||
| 106 | static Lisp_Object value_to_lisp (emacs_value); | 101 | static Lisp_Object value_to_lisp (emacs_value); |
| 107 | static emacs_value lisp_to_value (Lisp_Object); | 102 | static emacs_value lisp_to_value (Lisp_Object); |
| 108 | static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); | 103 | static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); |
| @@ -184,22 +179,6 @@ static emacs_value const module_nil = 0; | |||
| 184 | do { } while (false) | 179 | do { } while (false) |
| 185 | 180 | ||
| 186 | 181 | ||
| 187 | /* Function environments. */ | ||
| 188 | |||
| 189 | /* A function environment is an auxiliary structure used by | ||
| 190 | `module_make_function' to store information about a module | ||
| 191 | function. It is stored in a save pointer and retrieved by | ||
| 192 | `internal--module-call'. Its members correspond to the arguments | ||
| 193 | given to `module_make_function'. */ | ||
| 194 | |||
| 195 | struct module_fun_env | ||
| 196 | { | ||
| 197 | ptrdiff_t min_arity, max_arity; | ||
| 198 | emacs_subr subr; | ||
| 199 | void *data; | ||
| 200 | }; | ||
| 201 | |||
| 202 | |||
| 203 | /* Implementation of runtime and environment functions. | 182 | /* Implementation of runtime and environment functions. |
| 204 | 183 | ||
| 205 | These should abide by the following rules: | 184 | These should abide by the following rules: |
| @@ -382,14 +361,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, | |||
| 382 | : min_arity <= max_arity))) | 361 | : min_arity <= max_arity))) |
| 383 | xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); | 362 | xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); |
| 384 | 363 | ||
| 385 | /* FIXME: This should be freed when envobj is GC'd. */ | 364 | Lisp_Object envobj = make_module_function (); |
| 386 | struct module_fun_env *envptr = xmalloc (sizeof *envptr); | 365 | struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj); |
| 387 | envptr->min_arity = min_arity; | 366 | envptr->min_arity = min_arity; |
| 388 | envptr->max_arity = max_arity; | 367 | envptr->max_arity = max_arity; |
| 389 | envptr->subr = subr; | 368 | envptr->subr = subr; |
| 390 | envptr->data = data; | 369 | envptr->data = data; |
| 391 | 370 | ||
| 392 | Lisp_Object envobj = make_save_ptr (envptr); | ||
| 393 | Lisp_Object doc = Qnil; | 371 | Lisp_Object doc = Qnil; |
| 394 | if (documentation) | 372 | if (documentation) |
| 395 | { | 373 | { |
| @@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST) */) | |||
| 677 | (ptrdiff_t nargs, Lisp_Object *arglist) | 655 | (ptrdiff_t nargs, Lisp_Object *arglist) |
| 678 | { | 656 | { |
| 679 | Lisp_Object envobj = arglist[0]; | 657 | Lisp_Object envobj = arglist[0]; |
| 680 | /* FIXME: Rather than use a save_value, we should create a new object type. | 658 | CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj); |
| 681 | Making save_value visible to Lisp is wrong. */ | 659 | struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj); |
| 682 | CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj); | ||
| 683 | struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj); | ||
| 684 | CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj); | ||
| 685 | /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0) | ||
| 686 | is a module_fun_env pointer. If some other part of Emacs also | ||
| 687 | exports save_value objects to Elisp, than we may be getting here this | ||
| 688 | other kind of save_value which will likely hold something completely | ||
| 689 | different in this field. */ | ||
| 690 | struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0); | ||
| 691 | EMACS_INT len = nargs - 1; | 660 | EMACS_INT len = nargs - 1; |
| 692 | eassume (0 <= envptr->min_arity); | 661 | eassume (0 <= envptr->min_arity); |
| 693 | if (! (envptr->min_arity <= len | 662 | if (! (envptr->min_arity <= len |
| @@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val) | |||
| 976 | 945 | ||
| 977 | /* Return a string object that contains a user-friendly | 946 | /* Return a string object that contains a user-friendly |
| 978 | representation of the function environment. */ | 947 | representation of the function environment. */ |
| 979 | static Lisp_Object | 948 | Lisp_Object |
| 980 | module_format_fun_env (const struct module_fun_env *env) | 949 | module_format_fun_env (const struct Lisp_Module_Function *env) |
| 981 | { | 950 | { |
| 982 | /* Try to print a function name if possible. */ | 951 | /* Try to print a function name if possible. */ |
| 952 | /* FIXME: Move this function into print.c, then use prin1-to-string | ||
| 953 | above. */ | ||
| 983 | const char *path, *sym; | 954 | const char *path, *sym; |
| 984 | static char const noaddr_format[] = "#<module function at %p>"; | 955 | static char const noaddr_format[] = "#<module function at %p>"; |
| 985 | char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256]; | 956 | char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256]; |
| @@ -1048,8 +1019,7 @@ syms_of_module (void) | |||
| 1048 | code or modules should not access it. */ | 1019 | code or modules should not access it. */ |
| 1049 | Funintern (Qmodule_refs_hash, Qnil); | 1020 | Funintern (Qmodule_refs_hash, Qnil); |
| 1050 | 1021 | ||
| 1051 | DEFSYM (Qsave_value_p, "save-value-p"); | 1022 | DEFSYM (Qmodule_function_p, "module-function-p"); |
| 1052 | DEFSYM (Qsave_pointer_p, "save-pointer-p"); | ||
| 1053 | 1023 | ||
| 1054 | defsubr (&Smodule_load); | 1024 | defsubr (&Smodule_load); |
| 1055 | 1025 | ||