From: Lars Ingebrigtsen Date: Sat, 19 Mar 2022 14:11:15 +0000 (+0100) Subject: Make `command-modes' work for (native-compiled) subrs, too X-Git-Tag: emacs-29.0.90~1931^2~1039^2 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=71b8f1fc635d9bbe00ca89457065e0c83456ac43;p=emacs.git Make `command-modes' work for (native-compiled) subrs, too * lisp/emacs-lisp/comp.el (comp-func): Add a command-modes slot. (comp-spill-lap-function, comp-intern-func-in-ctxt): Fill it. (comp-emit-for-top-level, comp-emit-lambda-for-top-level): Use it. * src/alloc.c (mark_object): Mark the command_modes slot. * src/comp.c (make_subr): Add a command_modes parameter. (Fcomp__register_lambda): Use it. (Fcomp__register_subr): Ditto. * src/data.c (Fcommand_modes): Output the command_modes data for subrs (bug#54437). * src/lisp.h (GCALIGNED_STRUCT): Add a command_modes slot. * src/pdumper.c (dump_subr): Update hash. (dump_subr): Dump the command_modes slot. --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 122638077ce..00efedd71f3 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -898,6 +898,8 @@ non local exit (ends with an `unreachable' insn).")) :documentation "Doc string.") (int-spec nil :type list :documentation "Interactive form.") + (command-modes nil :type list + :documentation "Command modes.") (lap () :type list :documentation "LAP assembly representation.") (ssa-status nil :type symbol @@ -1243,6 +1245,7 @@ clashes." :c-name c-name :doc (documentation f t) :int-spec (interactive-form f) + :command-modes (command-modes f) :speed (comp-spill-speed function-name) :pure (comp-spill-decl-spec function-name 'pure)))) @@ -1282,10 +1285,12 @@ clashes." (make-comp-func-l :c-name c-name :doc (documentation form t) :int-spec (interactive-form form) + :command-modes (command-modes form) :speed (comp-ctxt-speed comp-ctxt)) (make-comp-func-d :c-name c-name :doc (documentation form t) :int-spec (interactive-form form) + :command-modes (command-modes form) :speed (comp-ctxt-speed comp-ctxt))))) (let ((lap (byte-to-native-lambda-lap (gethash (aref byte-code 1) @@ -1327,6 +1332,7 @@ clashes." (comp-func-byte-func func) byte-func (comp-func-doc func) (documentation byte-func t) (comp-func-int-spec func) (interactive-form byte-func) + (comp-func-command-modes func) (command-modes byte-func) (comp-func-c-name func) c-name (comp-func-lap func) lap (comp-func-frame-size func) (comp-byte-frame-size byte-func) @@ -2079,7 +2085,8 @@ and the annotation emission." (i (hash-table-count h))) (puthash i (comp-func-doc f) h) i) - (comp-func-int-spec f))) + (comp-func-int-spec f) + (comp-func-command-modes f))) ;; This is the compilation unit it-self passed as ;; parameter. (make-comp-mvar :slot 0)))))) @@ -2122,7 +2129,8 @@ These are stored in the reloc data array." (i (hash-table-count h))) (puthash i (comp-func-doc func) h) i) - (comp-func-int-spec func))) + (comp-func-int-spec func) + (comp-func-command-modes func))) ;; This is the compilation unit it-self passed as ;; parameter. (make-comp-mvar :slot 0))))) diff --git a/src/alloc.c b/src/alloc.c index c19e3dabb6e..b0fbc91fe50 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6844,6 +6844,7 @@ mark_object (Lisp_Object arg) set_vector_marked (ptr); struct Lisp_Subr *subr = XSUBR (obj); mark_object (subr->native_intspec); + mark_object (subr->command_modes); mark_object (subr->native_comp_u); mark_object (subr->lambda_list); mark_object (subr->type); diff --git a/src/comp.c b/src/comp.c index 6449eedb278..499eee7e709 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5411,7 +5411,7 @@ native_function_doc (Lisp_Object function) static Lisp_Object make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, Lisp_Object c_name, Lisp_Object type, Lisp_Object doc_idx, - Lisp_Object intspec, Lisp_Object comp_u) + Lisp_Object intspec, Lisp_Object command_modes, Lisp_Object comp_u) { struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); dynlib_handle_ptr handle = cu->handle; @@ -5445,6 +5445,7 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (symbol_name)); x->s.native_intspec = intspec; + x->s.command_modes = command_modes; x->s.doc = XFIXNUM (doc_idx); #ifdef HAVE_NATIVE_COMP x->s.native_comp_u = comp_u; @@ -5467,12 +5468,17 @@ This gets called by top_level_run during the load phase. */) { Lisp_Object doc_idx = FIRST (rest); Lisp_Object intspec = SECOND (rest); + Lisp_Object command_modes = Qnil; + if (!NILP (XCDR (XCDR (rest)))) + command_modes = THIRD (rest); + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); if (cu->loaded_once) return Qnil; Lisp_Object tem = - make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, comp_u); + make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, + command_modes, comp_u); /* We must protect it against GC because the function is not reachable through symbols. */ @@ -5497,9 +5503,13 @@ This gets called by top_level_run during the load phase. */) { Lisp_Object doc_idx = FIRST (rest); Lisp_Object intspec = SECOND (rest); + Lisp_Object command_modes = Qnil; + if (!NILP (XCDR (XCDR (rest)))) + command_modes = THIRD (rest); + Lisp_Object tem = make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx, - intspec, comp_u); + intspec, command_modes, comp_u); defalias (name, tem); diff --git a/src/data.c b/src/data.c index 23b0e7c29d9..5894340aba3 100644 --- a/src/data.c +++ b/src/data.c @@ -1167,7 +1167,11 @@ The value, if non-nil, is a list of mode name symbols. */) fun = Fsymbol_function (fun); } - if (COMPILEDP (fun)) + if (SUBRP (fun)) + { + return XSUBR (fun)->command_modes; + } + else if (COMPILEDP (fun)) { if (PVSIZE (fun) <= COMPILED_INTERACTIVE) return Qnil; diff --git a/src/lisp.h b/src/lisp.h index e4d156c0f45..b558d311a80 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2154,6 +2154,7 @@ struct Lisp_Subr const char *intspec; Lisp_Object native_intspec; }; + Lisp_Object command_modes; EMACS_INT doc; #ifdef HAVE_NATIVE_COMP Lisp_Object native_comp_u; diff --git a/src/pdumper.c b/src/pdumper.c index f14239f863a..11831023622 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2854,7 +2854,7 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_F09D8E8E19) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_A212A8F82A) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." #endif struct Lisp_Subr out; @@ -2878,11 +2878,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) COLD_OP_NATIVE_SUBR, make_lisp_ptr ((void *) subr, Lisp_Vectorlike)); dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL); + dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL); } else { dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name); dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); + dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes); } DUMP_FIELD_COPY (&out, subr, doc); #ifdef HAVE_NATIVE_COMP