[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 71b8f1fc63: Make `command-modes' work for (native-compiled) subrs
From: |
Lars Ingebrigtsen |
Subject: |
master 71b8f1fc63: Make `command-modes' work for (native-compiled) subrs, too |
Date: |
Sat, 19 Mar 2022 10:13:22 -0400 (EDT) |
branch: master
commit 71b8f1fc635d9bbe00ca89457065e0c83456ac43
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
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.
---
lisp/emacs-lisp/comp.el | 12 ++++++++++--
src/alloc.c | 1 +
src/comp.c | 16 +++++++++++++---
src/data.c | 6 +++++-
src/lisp.h | 1 +
src/pdumper.c | 4 +++-
6 files changed, 33 insertions(+), 7 deletions(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 122638077c..00efedd71f 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 c19e3dabb6..b0fbc91fe5 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 6449eedb27..499eee7e70 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 23b0e7c29d..5894340aba 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 e4d156c0f4..b558d311a8 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 f14239f863..1183102362 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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 71b8f1fc63: Make `command-modes' work for (native-compiled) subrs, too,
Lars Ingebrigtsen <=