mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-21 21:20:44 -08:00
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.
This commit is contained in:
parent
c79e0188e8
commit
71b8f1fc63
6 changed files with 33 additions and 7 deletions
|
|
@ -898,6 +898,8 @@ non local exit (ends with an `unreachable' insn)."))
|
||||||
:documentation "Doc string.")
|
:documentation "Doc string.")
|
||||||
(int-spec nil :type list
|
(int-spec nil :type list
|
||||||
:documentation "Interactive form.")
|
:documentation "Interactive form.")
|
||||||
|
(command-modes nil :type list
|
||||||
|
:documentation "Command modes.")
|
||||||
(lap () :type list
|
(lap () :type list
|
||||||
:documentation "LAP assembly representation.")
|
:documentation "LAP assembly representation.")
|
||||||
(ssa-status nil :type symbol
|
(ssa-status nil :type symbol
|
||||||
|
|
@ -1243,6 +1245,7 @@ clashes."
|
||||||
:c-name c-name
|
:c-name c-name
|
||||||
:doc (documentation f t)
|
:doc (documentation f t)
|
||||||
:int-spec (interactive-form f)
|
:int-spec (interactive-form f)
|
||||||
|
:command-modes (command-modes f)
|
||||||
:speed (comp-spill-speed function-name)
|
:speed (comp-spill-speed function-name)
|
||||||
:pure (comp-spill-decl-spec function-name
|
:pure (comp-spill-decl-spec function-name
|
||||||
'pure))))
|
'pure))))
|
||||||
|
|
@ -1282,10 +1285,12 @@ clashes."
|
||||||
(make-comp-func-l :c-name c-name
|
(make-comp-func-l :c-name c-name
|
||||||
:doc (documentation form t)
|
:doc (documentation form t)
|
||||||
:int-spec (interactive-form form)
|
:int-spec (interactive-form form)
|
||||||
|
:command-modes (command-modes form)
|
||||||
:speed (comp-ctxt-speed comp-ctxt))
|
:speed (comp-ctxt-speed comp-ctxt))
|
||||||
(make-comp-func-d :c-name c-name
|
(make-comp-func-d :c-name c-name
|
||||||
:doc (documentation form t)
|
:doc (documentation form t)
|
||||||
:int-spec (interactive-form form)
|
:int-spec (interactive-form form)
|
||||||
|
:command-modes (command-modes form)
|
||||||
:speed (comp-ctxt-speed comp-ctxt)))))
|
:speed (comp-ctxt-speed comp-ctxt)))))
|
||||||
(let ((lap (byte-to-native-lambda-lap
|
(let ((lap (byte-to-native-lambda-lap
|
||||||
(gethash (aref byte-code 1)
|
(gethash (aref byte-code 1)
|
||||||
|
|
@ -1327,6 +1332,7 @@ clashes."
|
||||||
(comp-func-byte-func func) byte-func
|
(comp-func-byte-func func) byte-func
|
||||||
(comp-func-doc func) (documentation byte-func t)
|
(comp-func-doc func) (documentation byte-func t)
|
||||||
(comp-func-int-spec func) (interactive-form byte-func)
|
(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-c-name func) c-name
|
||||||
(comp-func-lap func) lap
|
(comp-func-lap func) lap
|
||||||
(comp-func-frame-size func) (comp-byte-frame-size byte-func)
|
(comp-func-frame-size func) (comp-byte-frame-size byte-func)
|
||||||
|
|
@ -2079,7 +2085,8 @@ and the annotation emission."
|
||||||
(i (hash-table-count h)))
|
(i (hash-table-count h)))
|
||||||
(puthash i (comp-func-doc f) h)
|
(puthash i (comp-func-doc f) h)
|
||||||
i)
|
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
|
;; This is the compilation unit it-self passed as
|
||||||
;; parameter.
|
;; parameter.
|
||||||
(make-comp-mvar :slot 0))))))
|
(make-comp-mvar :slot 0))))))
|
||||||
|
|
@ -2122,7 +2129,8 @@ These are stored in the reloc data array."
|
||||||
(i (hash-table-count h)))
|
(i (hash-table-count h)))
|
||||||
(puthash i (comp-func-doc func) h)
|
(puthash i (comp-func-doc func) h)
|
||||||
i)
|
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
|
;; This is the compilation unit it-self passed as
|
||||||
;; parameter.
|
;; parameter.
|
||||||
(make-comp-mvar :slot 0)))))
|
(make-comp-mvar :slot 0)))))
|
||||||
|
|
|
||||||
|
|
@ -6844,6 +6844,7 @@ mark_object (Lisp_Object arg)
|
||||||
set_vector_marked (ptr);
|
set_vector_marked (ptr);
|
||||||
struct Lisp_Subr *subr = XSUBR (obj);
|
struct Lisp_Subr *subr = XSUBR (obj);
|
||||||
mark_object (subr->native_intspec);
|
mark_object (subr->native_intspec);
|
||||||
|
mark_object (subr->command_modes);
|
||||||
mark_object (subr->native_comp_u);
|
mark_object (subr->native_comp_u);
|
||||||
mark_object (subr->lambda_list);
|
mark_object (subr->lambda_list);
|
||||||
mark_object (subr->type);
|
mark_object (subr->type);
|
||||||
|
|
|
||||||
16
src/comp.c
16
src/comp.c
|
|
@ -5411,7 +5411,7 @@ native_function_doc (Lisp_Object function)
|
||||||
static Lisp_Object
|
static Lisp_Object
|
||||||
make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg,
|
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 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);
|
struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u);
|
||||||
dynlib_handle_ptr handle = cu->handle;
|
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.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
|
||||||
x->s.symbol_name = xstrdup (SSDATA (symbol_name));
|
x->s.symbol_name = xstrdup (SSDATA (symbol_name));
|
||||||
x->s.native_intspec = intspec;
|
x->s.native_intspec = intspec;
|
||||||
|
x->s.command_modes = command_modes;
|
||||||
x->s.doc = XFIXNUM (doc_idx);
|
x->s.doc = XFIXNUM (doc_idx);
|
||||||
#ifdef HAVE_NATIVE_COMP
|
#ifdef HAVE_NATIVE_COMP
|
||||||
x->s.native_comp_u = comp_u;
|
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 doc_idx = FIRST (rest);
|
||||||
Lisp_Object intspec = SECOND (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);
|
struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u);
|
||||||
if (cu->loaded_once)
|
if (cu->loaded_once)
|
||||||
return Qnil;
|
return Qnil;
|
||||||
|
|
||||||
Lisp_Object tem =
|
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
|
/* We must protect it against GC because the function is not
|
||||||
reachable through symbols. */
|
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 doc_idx = FIRST (rest);
|
||||||
Lisp_Object intspec = SECOND (rest);
|
Lisp_Object intspec = SECOND (rest);
|
||||||
|
Lisp_Object command_modes = Qnil;
|
||||||
|
if (!NILP (XCDR (XCDR (rest))))
|
||||||
|
command_modes = THIRD (rest);
|
||||||
|
|
||||||
Lisp_Object tem =
|
Lisp_Object tem =
|
||||||
make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx,
|
make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx,
|
||||||
intspec, comp_u);
|
intspec, command_modes, comp_u);
|
||||||
|
|
||||||
defalias (name, tem);
|
defalias (name, tem);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1167,7 +1167,11 @@ The value, if non-nil, is a list of mode name symbols. */)
|
||||||
fun = Fsymbol_function (fun);
|
fun = Fsymbol_function (fun);
|
||||||
}
|
}
|
||||||
|
|
||||||
if (COMPILEDP (fun))
|
if (SUBRP (fun))
|
||||||
|
{
|
||||||
|
return XSUBR (fun)->command_modes;
|
||||||
|
}
|
||||||
|
else if (COMPILEDP (fun))
|
||||||
{
|
{
|
||||||
if (PVSIZE (fun) <= COMPILED_INTERACTIVE)
|
if (PVSIZE (fun) <= COMPILED_INTERACTIVE)
|
||||||
return Qnil;
|
return Qnil;
|
||||||
|
|
|
||||||
|
|
@ -2154,6 +2154,7 @@ struct Lisp_Subr
|
||||||
const char *intspec;
|
const char *intspec;
|
||||||
Lisp_Object native_intspec;
|
Lisp_Object native_intspec;
|
||||||
};
|
};
|
||||||
|
Lisp_Object command_modes;
|
||||||
EMACS_INT doc;
|
EMACS_INT doc;
|
||||||
#ifdef HAVE_NATIVE_COMP
|
#ifdef HAVE_NATIVE_COMP
|
||||||
Lisp_Object native_comp_u;
|
Lisp_Object native_comp_u;
|
||||||
|
|
|
||||||
|
|
@ -2854,7 +2854,7 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v)
|
||||||
static dump_off
|
static dump_off
|
||||||
dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
|
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."
|
# error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h."
|
||||||
#endif
|
#endif
|
||||||
struct Lisp_Subr out;
|
struct Lisp_Subr out;
|
||||||
|
|
@ -2878,11 +2878,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
|
||||||
COLD_OP_NATIVE_SUBR,
|
COLD_OP_NATIVE_SUBR,
|
||||||
make_lisp_ptr ((void *) subr, Lisp_Vectorlike));
|
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->native_intspec, WEIGHT_NORMAL);
|
||||||
|
dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
|
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->intspec);
|
||||||
|
dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes);
|
||||||
}
|
}
|
||||||
DUMP_FIELD_COPY (&out, subr, doc);
|
DUMP_FIELD_COPY (&out, subr, doc);
|
||||||
#ifdef HAVE_NATIVE_COMP
|
#ifdef HAVE_NATIVE_COMP
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue