mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-25 07:28:20 +00:00
mitigate ifdef proliferation
This commit is contained in:
parent
2ccce1bc39
commit
ef59b67e46
17
src/alloc.c
17
src/alloc.c
@ -3023,15 +3023,14 @@ cleanup_vector (struct Lisp_Vector *vector)
|
||||
if (uptr->finalizer)
|
||||
uptr->finalizer (uptr->p);
|
||||
}
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT))
|
||||
else if (NATIVE_COMP_FLAG
|
||||
&& PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT))
|
||||
{
|
||||
struct Lisp_Native_Comp_Unit *cu =
|
||||
PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
|
||||
eassert (cu->handle);
|
||||
dynlib_close (cu->handle);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Reclaim space used by unmarked vectors. */
|
||||
@ -6565,14 +6564,12 @@ mark_object (Lisp_Object arg)
|
||||
break;
|
||||
|
||||
case PVEC_SUBR:
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
if (SUBRP_NATIVE_COMPILEDP (obj))
|
||||
{
|
||||
set_vector_marked (ptr);
|
||||
struct Lisp_Subr *subr = XSUBR (obj);
|
||||
mark_object (subr->native_comp_u);
|
||||
mark_object (subr->native_comp_u[0]);
|
||||
}
|
||||
#endif
|
||||
break;
|
||||
|
||||
case PVEC_FREE:
|
||||
@ -6717,13 +6714,9 @@ survives_gc_p (Lisp_Object obj)
|
||||
break;
|
||||
|
||||
case Lisp_Vectorlike:
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
survives_p =
|
||||
(SUBRP (obj) && !SUBRP_NATIVE_COMPILEDP (obj)) ||
|
||||
vector_marked_p (XVECTOR (obj));
|
||||
#else
|
||||
survives_p = SUBRP (obj) || vector_marked_p (XVECTOR (obj));
|
||||
#endif
|
||||
break;
|
||||
|
||||
case Lisp_Cons:
|
||||
@ -7473,14 +7466,14 @@ N should be nonnegative. */);
|
||||
static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
|
||||
{{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
|
||||
{ .a4 = watch_gc_cons_threshold },
|
||||
4, 4, "watch_gc_cons_threshold", {0}, {0}, 0}};
|
||||
4, 4, "watch_gc_cons_threshold", {0}, {0}}};
|
||||
XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
|
||||
Fadd_variable_watcher (Qgc_cons_threshold, watcher);
|
||||
|
||||
static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
|
||||
{{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
|
||||
{ .a4 = watch_gc_cons_percentage },
|
||||
4, 4, "watch_gc_cons_percentage", {0}, {0}, 0}};
|
||||
4, 4, "watch_gc_cons_percentage", {0}, {0}}};
|
||||
XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
|
||||
Fadd_variable_watcher (Qgc_cons_percentage, watcher);
|
||||
}
|
||||
|
@ -3285,7 +3285,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr,
|
||||
x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name)));
|
||||
x->s.native_intspec = intspec;
|
||||
x->s.native_doc = doc;
|
||||
x->s.native_comp_u = comp_u;
|
||||
x->s.native_comp_u[0] = comp_u;
|
||||
Lisp_Object tem;
|
||||
XSETSUBR (tem, &x->s);
|
||||
set_symbol_function (name, tem);
|
||||
|
10
src/comp.h
10
src/comp.h
@ -19,6 +19,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
||||
#ifndef COMP_H
|
||||
#define COMP_H
|
||||
|
||||
/* To keep ifdefs under control. */
|
||||
enum {
|
||||
NATIVE_COMP_FLAG =
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
1
|
||||
#else
|
||||
0
|
||||
#endif
|
||||
};
|
||||
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
|
||||
#include <dynlib.h>
|
||||
|
@ -881,7 +881,7 @@ DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit,
|
||||
(Lisp_Object subr)
|
||||
{
|
||||
CHECK_SUBR (subr);
|
||||
return XSUBR (subr)->native_comp_u;
|
||||
return XSUBR (subr)->native_comp_u[0];
|
||||
}
|
||||
|
||||
DEFUN ("native-comp-unit-file", Fnative_comp_unit_file,
|
||||
@ -919,10 +919,9 @@ Value, if non-nil, is a list (interactive SPEC). */)
|
||||
|
||||
if (SUBRP (fun))
|
||||
{
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
if (SUBRP_NATIVE_COMPILEDP (fun) && XSUBR (fun)->native_intspec)
|
||||
return XSUBR (fun)->native_intspec;
|
||||
#endif
|
||||
|
||||
const char *spec = XSUBR (fun)->intspec;
|
||||
if (spec)
|
||||
return list2 (Qinteractive,
|
||||
|
@ -510,12 +510,10 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
|
||||
XSETCAR (tem, make_fixnum (offset));
|
||||
}
|
||||
}
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
else if (SUBRP_NATIVE_COMPILEDP (fun))
|
||||
{
|
||||
XSUBR (fun)->native_doc = Qnil;
|
||||
}
|
||||
#endif
|
||||
/* Lisp_Subrs have a slot for it. */
|
||||
else if (SUBRP (fun))
|
||||
{
|
||||
|
19
src/eval.c
19
src/eval.c
@ -219,14 +219,17 @@ void
|
||||
init_eval_once (void)
|
||||
{
|
||||
/* Don't forget to update docs (lispref node "Local Variables"). */
|
||||
#ifndef HAVE_NATIVE_COMP
|
||||
max_specpdl_size = 1600; /* 1500 is not enough for cl-generic.el. */
|
||||
max_lisp_eval_depth = 800;
|
||||
#else
|
||||
/* Original values increased for comp.el. */
|
||||
max_specpdl_size = 2100;
|
||||
max_lisp_eval_depth = 1400;
|
||||
#endif
|
||||
if (!NATIVE_COMP_FLAG)
|
||||
{
|
||||
max_specpdl_size = 1600; /* 1500 is not enough for cl-generic.el. */
|
||||
max_lisp_eval_depth = 800;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Original values increased for comp.el. */
|
||||
max_specpdl_size = 2100;
|
||||
max_lisp_eval_depth = 1400;
|
||||
}
|
||||
Vrun_hooks = Qnil;
|
||||
pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
|
||||
}
|
||||
|
15
src/lisp.h
15
src/lisp.h
@ -2098,9 +2098,7 @@ struct Lisp_Subr
|
||||
EMACS_INT doc;
|
||||
Lisp_Object native_doc;
|
||||
};
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
Lisp_Object native_comp_u;
|
||||
#endif
|
||||
Lisp_Object native_comp_u[NATIVE_COMP_FLAG];
|
||||
} GCALIGNED_STRUCT;
|
||||
union Aligned_Lisp_Subr
|
||||
{
|
||||
@ -3113,7 +3111,7 @@ CHECK_INTEGER (Lisp_Object x)
|
||||
static union Aligned_Lisp_Subr sname = \
|
||||
{{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
|
||||
{ .a ## maxargs = fnname }, \
|
||||
minargs, maxargs, lname, {intspec}, {0}, 0}}; \
|
||||
minargs, maxargs, lname, {intspec}, {0}}}; \
|
||||
Lisp_Object fnname
|
||||
|
||||
/* defsubr (Sname);
|
||||
@ -4763,7 +4761,7 @@ extern char *emacs_root_dir (void);
|
||||
INLINE bool
|
||||
SUBRP_NATIVE_COMPILEDP (Lisp_Object a)
|
||||
{
|
||||
return SUBRP (a) && XSUBR (a)->native_comp_u;
|
||||
return SUBRP (a) && XSUBR (a)->native_comp_u[0];
|
||||
}
|
||||
|
||||
INLINE struct Lisp_Native_Comp_Unit *
|
||||
@ -4772,6 +4770,13 @@ allocate_native_comp_unit (void)
|
||||
return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec,
|
||||
PVEC_NATIVE_COMP_UNIT);
|
||||
}
|
||||
#else
|
||||
INLINE bool
|
||||
SUBRP_NATIVE_COMPILEDP (Lisp_Object a)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* Defined in lastfile.c. */
|
||||
|
32
src/lread.c
32
src/lread.c
@ -1281,11 +1281,9 @@ Return t if the file exists and loads successfully. */)
|
||||
bool is_module = false;
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX);
|
||||
#else
|
||||
bool is_native_elisp = false;
|
||||
#endif
|
||||
bool is_native_elisp =
|
||||
NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false;
|
||||
|
||||
/* Check if we're stuck in a recursive load cycle.
|
||||
|
||||
2000-09-21: It's not possible to just check for the file loaded
|
||||
@ -1486,15 +1484,16 @@ Return t if the file exists and loads successfully. */)
|
||||
}
|
||||
else if (is_native_elisp)
|
||||
{
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
specbind (Qcurrent_load_list, Qnil);
|
||||
LOADHIST_ATTACH (found);
|
||||
Fnative_elisp_load (found);
|
||||
build_load_history (found, true);
|
||||
#else
|
||||
/* This cannot happen. */
|
||||
emacs_abort ();
|
||||
#endif
|
||||
if (NATIVE_COMP_FLAG)
|
||||
{
|
||||
specbind (Qcurrent_load_list, Qnil);
|
||||
LOADHIST_ATTACH (found);
|
||||
Fnative_elisp_load (found);
|
||||
build_load_history (found, true);
|
||||
}
|
||||
else
|
||||
/* This cannot happen. */
|
||||
emacs_abort ();
|
||||
}
|
||||
else
|
||||
{
|
||||
@ -4465,9 +4464,8 @@ defsubr (union Aligned_Lisp_Subr *aname)
|
||||
XSETPVECTYPE (sname, PVEC_SUBR);
|
||||
XSETSUBR (tem, sname);
|
||||
set_symbol_function (sym, tem);
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
Vcomp_subr_list = Fcons (tem, Vcomp_subr_list);
|
||||
#endif /* HAVE_NATIVE_COMP */
|
||||
if (NATIVE_COMP_FLAG)
|
||||
Vcomp_subr_list = Fcons (tem, Vcomp_subr_list);
|
||||
}
|
||||
|
||||
#ifdef NOTDEF /* Use fset in subr.el now! */
|
||||
|
@ -2948,18 +2948,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
|
||||
struct Lisp_Subr out;
|
||||
dump_object_start (ctx, &out, sizeof (out));
|
||||
DUMP_FIELD_COPY (&out, subr, header.size);
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
if (subr->native_comp_u)
|
||||
if (NATIVE_COMP_FLAG && subr->native_comp_u[0])
|
||||
out.function.a0 = NULL;
|
||||
else
|
||||
dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
|
||||
#else
|
||||
dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
|
||||
#endif
|
||||
DUMP_FIELD_COPY (&out, subr, min_args);
|
||||
DUMP_FIELD_COPY (&out, subr, max_args);
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
if (subr->native_comp_u)
|
||||
if (NATIVE_COMP_FLAG && subr->native_comp_u[0])
|
||||
{
|
||||
dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
|
||||
dump_remember_cold_op (ctx,
|
||||
@ -2974,15 +2969,11 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
|
||||
dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
|
||||
DUMP_FIELD_COPY (&out, subr, doc);
|
||||
}
|
||||
dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL);
|
||||
#else
|
||||
dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
|
||||
dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
|
||||
DUMP_FIELD_COPY (&out, subr, doc);
|
||||
#endif
|
||||
if (NATIVE_COMP_FLAG)
|
||||
dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL);
|
||||
|
||||
dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
|
||||
if (ctx->flags.dump_object_contents && subr->native_comp_u)
|
||||
if (ctx->flags.dump_object_contents && subr->native_comp_u[0])
|
||||
/* We'll do the final addr relocation during VERY_LATE_RELOCS time
|
||||
after the compilation units has been loaded. */
|
||||
dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
|
||||
@ -5320,7 +5311,7 @@ dump_do_dump_relocation (const uintptr_t dump_base,
|
||||
struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
|
||||
Lisp_Object name = intern (subr->symbol_name);
|
||||
struct Lisp_Native_Comp_Unit *comp_u =
|
||||
XNATIVE_COMP_UNIT (subr->native_comp_u);
|
||||
XNATIVE_COMP_UNIT (subr->native_comp_u[0]);
|
||||
if (!comp_u->handle)
|
||||
error ("can't relocate native subr with not loaded compilation unit");
|
||||
Lisp_Object c_name = Fgethash (name, Vcomp_sym_subr_c_name_h, Qnil);
|
||||
|
Loading…
Reference in New Issue
Block a user