Port to C compilers that lack size-0 arrays

The C standard does not allow size-zero arrays, so redo struct
Lisp_Subr to not use size-zero arrays when native compilation is
not being used.  Formerly, the code was using size-zero arrays (a
GNU C extension) to avoid using memory unnecessarily when
HAVE_NATIVE_COMP is not defined.  Replace this hack with the
more-traditional hack of putting the relevant members inside
‘#ifdef HAVE_NATIVE_COMP’.
* src/alloc.c (cleanup_vector, mark_object):
* src/comp.c (make_subr):
* src/data.c (Fsubr_native_lambda_list, Fsubr_native_comp_unit):
* src/eval.c (init_eval_once, funcall_lambda):
* src/lisp.h (SUBR_NATIVE_COMPILEDP, SUBR_NATIVE_COMPILED_DYNP)
(SUBR_TYPE):
* src/lread.c (Fload):
Conditionally compile with ‘#ifdef HAVE_NATIVE_COMP’ instead of
with ‘if (NATIVE_COMP_FLAG)’.  Redo members like native_comp_u[0]
to be plain native_comp_u.  Put all uses of these members inside
‘#ifdef HAVE_NATIVE_COMP’.
* src/lisp.h (struct Lisp_Subr): Members native_comp_u,
native_c_name, lambda_list, type are now all ifdeffed out if
HAVE_NATIVE_COMP is not defined, instead of being size-zero
arrays.  All uses changed.
* src/pdumper.c (dump_subr, dump_cold_native_subr)
(dump_do_dump_relocation):
* src/comp.h (NATIVE_COMP_FLAG): Remove; no longer needed.
This commit is contained in:
Paul Eggert 2021-12-02 19:01:33 -08:00
parent fed35a8951
commit 9c222b9c1a
8 changed files with 78 additions and 71 deletions

View file

@ -3152,26 +3152,26 @@ cleanup_vector (struct Lisp_Vector *vector)
module_finalize_function (function); module_finalize_function (function);
} }
#endif #endif
else if (NATIVE_COMP_FLAG #ifdef HAVE_NATIVE_COMP
&& PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT))
{ {
struct Lisp_Native_Comp_Unit *cu = struct Lisp_Native_Comp_Unit *cu =
PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
unload_comp_unit (cu); unload_comp_unit (cu);
} }
else if (NATIVE_COMP_FLAG else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR))
&& PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR))
{ {
struct Lisp_Subr *subr = struct Lisp_Subr *subr =
PSEUDOVEC_STRUCT (vector, Lisp_Subr); PSEUDOVEC_STRUCT (vector, Lisp_Subr);
if (!NILP (subr->native_comp_u[0])) if (!NILP (subr->native_comp_u))
{ {
/* FIXME Alternative and non invasive solution to this /* FIXME Alternative and non invasive solution to this
cast? */ cast? */
xfree ((char *)subr->symbol_name); xfree ((char *)subr->symbol_name);
xfree (subr->native_c_name[0]); xfree (subr->native_c_name);
} }
} }
#endif
} }
/* Reclaim space used by unmarked vectors. */ /* Reclaim space used by unmarked vectors. */
@ -6773,15 +6773,17 @@ mark_object (Lisp_Object arg)
break; break;
case PVEC_SUBR: case PVEC_SUBR:
#ifdef HAVE_NATIVE_COMP
if (SUBR_NATIVE_COMPILEDP (obj)) if (SUBR_NATIVE_COMPILEDP (obj))
{ {
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->native_comp_u[0]); mark_object (subr->native_comp_u);
mark_object (subr->lambda_list[0]); mark_object (subr->lambda_list);
mark_object (subr->type[0]); mark_object (subr->type);
} }
#endif
break; break;
case PVEC_FREE: case PVEC_FREE:

View file

@ -5154,21 +5154,29 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg,
if (CONSP (minarg)) if (CONSP (minarg))
{ {
/* Dynamic code. */ /* Dynamic code. */
x->s.lambda_list[0] = maxarg; #ifdef HAVE_NATIVE_COMP
x->s.lambda_list = maxarg;
#endif
maxarg = XCDR (minarg); maxarg = XCDR (minarg);
minarg = XCAR (minarg); minarg = XCAR (minarg);
} }
else else
x->s.lambda_list[0] = Qnil; {
#ifdef HAVE_NATIVE_COMP
x->s.lambda_list = Qnil;
#endif
}
x->s.function.a0 = func; x->s.function.a0 = func;
x->s.min_args = XFIXNUM (minarg); x->s.min_args = XFIXNUM (minarg);
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.doc = XFIXNUM (doc_idx); x->s.doc = XFIXNUM (doc_idx);
x->s.native_comp_u[0] = comp_u; #ifdef HAVE_NATIVE_COMP
x->s.native_c_name[0] = xstrdup (SSDATA (c_name)); x->s.native_comp_u = comp_u;
x->s.type[0] = type; x->s.native_c_name = xstrdup (SSDATA (c_name));
x->s.type = type;
#endif
Lisp_Object tem; Lisp_Object tem;
XSETSUBR (tem, &x->s); XSETSUBR (tem, &x->s);

View file

@ -20,16 +20,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef COMP_H #ifndef COMP_H
#define COMP_H #define COMP_H
/* To keep ifdefs under control. */
enum {
NATIVE_COMP_FLAG =
#ifdef HAVE_NATIVE_COMP
1
#else
0
#endif
};
#include <dynlib.h> #include <dynlib.h>
struct Lisp_Native_Comp_Unit struct Lisp_Native_Comp_Unit

View file

@ -891,9 +891,11 @@ function or t otherwise. */)
{ {
CHECK_SUBR (subr); CHECK_SUBR (subr);
return SUBR_NATIVE_COMPILED_DYNP (subr) #ifdef HAVE_NATIVE_COMP
? XSUBR (subr)->lambda_list[0] if (SUBR_NATIVE_COMPILED_DYNP (subr))
: Qt; return XSUBR (subr)->lambda_list;
#endif
return Qt;
} }
DEFUN ("subr-type", Fsubr_type, DEFUN ("subr-type", Fsubr_type,
@ -917,7 +919,7 @@ DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit,
(Lisp_Object subr) (Lisp_Object subr)
{ {
CHECK_SUBR (subr); CHECK_SUBR (subr);
return XSUBR (subr)->native_comp_u[0]; return XSUBR (subr)->native_comp_u;
} }
DEFUN ("native-comp-unit-file", Fnative_comp_unit_file, DEFUN ("native-comp-unit-file", Fnative_comp_unit_file,

View file

@ -219,17 +219,14 @@ void
init_eval_once (void) init_eval_once (void)
{ {
/* Don't forget to update docs (lispref node "Local Variables"). */ /* Don't forget to update docs (lispref node "Local Variables"). */
if (!NATIVE_COMP_FLAG) #ifndef HAVE_NATIVE_COMP
{ max_specpdl_size = 1800; /* See bug#46818. */
max_specpdl_size = 1800; /* See bug#46818. */ max_lisp_eval_depth = 800;
max_lisp_eval_depth = 800; #else
} /* Original values increased for comp.el. */
else max_specpdl_size = 2500;
{ max_lisp_eval_depth = 1600;
/* Original values increased for comp.el. */ #endif
max_specpdl_size = 2500;
max_lisp_eval_depth = 1600;
}
Vrun_hooks = Qnil; Vrun_hooks = Qnil;
pdumper_do_now_and_after_load (init_eval_once_for_pdumper); pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
} }
@ -3236,11 +3233,13 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
else if (MODULE_FUNCTIONP (fun)) else if (MODULE_FUNCTIONP (fun))
return funcall_module (fun, nargs, arg_vector); return funcall_module (fun, nargs, arg_vector);
#endif #endif
#ifdef HAVE_NATIVE_COMP
else if (SUBR_NATIVE_COMPILED_DYNP (fun)) else if (SUBR_NATIVE_COMPILED_DYNP (fun))
{ {
syms_left = XSUBR (fun)->lambda_list[0]; syms_left = XSUBR (fun)->lambda_list;
lexenv = Qnil; lexenv = Qnil;
} }
#endif
else else
emacs_abort (); emacs_abort ();

View file

@ -2083,10 +2083,12 @@ struct Lisp_Subr
Lisp_Object native_intspec; Lisp_Object native_intspec;
}; };
EMACS_INT doc; EMACS_INT doc;
Lisp_Object native_comp_u[NATIVE_COMP_FLAG]; #ifdef HAVE_NATIVE_COMP
char *native_c_name[NATIVE_COMP_FLAG]; Lisp_Object native_comp_u;
Lisp_Object lambda_list[NATIVE_COMP_FLAG]; char *native_c_name;
Lisp_Object type[NATIVE_COMP_FLAG]; Lisp_Object lambda_list;
Lisp_Object type;
#endif
} GCALIGNED_STRUCT; } GCALIGNED_STRUCT;
union Aligned_Lisp_Subr union Aligned_Lisp_Subr
{ {
@ -4773,19 +4775,19 @@ extern char *emacs_root_dir (void);
INLINE bool INLINE bool
SUBR_NATIVE_COMPILEDP (Lisp_Object a) SUBR_NATIVE_COMPILEDP (Lisp_Object a)
{ {
return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u[0]); return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u);
} }
INLINE bool INLINE bool
SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a) SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a)
{ {
return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list[0]); return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list);
} }
INLINE Lisp_Object INLINE Lisp_Object
SUBR_TYPE (Lisp_Object a) SUBR_TYPE (Lisp_Object a)
{ {
return XSUBR (a)->type[0]; return XSUBR (a)->type;
} }
INLINE struct Lisp_Native_Comp_Unit * INLINE struct Lisp_Native_Comp_Unit *

View file

@ -1271,7 +1271,10 @@ Return t if the file exists and loads successfully. */)
|| suffix_p (file, MODULES_SECONDARY_SUFFIX) || suffix_p (file, MODULES_SECONDARY_SUFFIX)
#endif #endif
#endif #endif
|| (NATIVE_COMP_FLAG && suffix_p (file, NATIVE_ELISP_SUFFIX))) #ifdef HAVE_NATIVE_COMP
|| suffix_p (file, NATIVE_ELISP_SUFFIX)
#endif
)
must_suffix = Qnil; must_suffix = Qnil;
/* Don't insist on adding a suffix /* Don't insist on adding a suffix
if the argument includes a directory name. */ if the argument includes a directory name. */
@ -1351,8 +1354,11 @@ Return t if the file exists and loads successfully. */)
bool is_module = false; bool is_module = false;
#endif #endif
bool is_native_elisp = #ifdef HAVE_NATIVE_COMP
NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false; bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX);
#else
bool is_native_elisp = false;
#endif
/* Check if we're stuck in a recursive load cycle. /* Check if we're stuck in a recursive load cycle.

View file

@ -2859,13 +2859,18 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
struct Lisp_Subr out; struct Lisp_Subr out;
dump_object_start (ctx, &out, sizeof (out)); dump_object_start (ctx, &out, sizeof (out));
DUMP_FIELD_COPY (&out, subr, header.size); DUMP_FIELD_COPY (&out, subr, header.size);
if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0])) #ifdef HAVE_NATIVE_COMP
bool native_comp = !NILP (subr->native_comp_u);
#else
bool native_comp = false;
#endif
if (native_comp)
out.function.a0 = NULL; out.function.a0 = NULL;
else else
dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
DUMP_FIELD_COPY (&out, subr, min_args); DUMP_FIELD_COPY (&out, subr, min_args);
DUMP_FIELD_COPY (&out, subr, max_args); DUMP_FIELD_COPY (&out, subr, max_args);
if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0])) if (native_comp)
{ {
dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
dump_remember_cold_op (ctx, dump_remember_cold_op (ctx,
@ -2879,19 +2884,16 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
} }
DUMP_FIELD_COPY (&out, subr, doc); DUMP_FIELD_COPY (&out, subr, doc);
if (NATIVE_COMP_FLAG) #ifdef HAVE_NATIVE_COMP
{ dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL);
dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL); if (!NILP (subr->native_comp_u))
if (!NILP (subr->native_comp_u[0])) dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name);
dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name[0]);
dump_field_lv (ctx, &out, subr, &subr->lambda_list[0], WEIGHT_NORMAL); dump_field_lv (ctx, &out, subr, &subr->lambda_list, WEIGHT_NORMAL);
dump_field_lv (ctx, &out, subr, &subr->type[0], WEIGHT_NORMAL); dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL);
} #endif
dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
if (NATIVE_COMP_FLAG if (native_comp && ctx->flags.dump_object_contents)
&& ctx->flags.dump_object_contents
&& !NILP (subr->native_comp_u[0]))
/* We'll do the final addr relocation during VERY_LATE_RELOCS time /* We'll do the final addr relocation during VERY_LATE_RELOCS time
after the compilation units has been loaded. */ after the compilation units has been loaded. */
dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
@ -3421,9 +3423,9 @@ dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr)
dump_remember_fixup_ptr_raw dump_remember_fixup_ptr_raw
(ctx, (ctx,
subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name[0]), subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name),
ctx->offset); ctx->offset);
const char *c_name = XSUBR (subr)->native_c_name[0]; const char *c_name = XSUBR (subr)->native_c_name;
dump_write (ctx, c_name, 1 + strlen (c_name)); dump_write (ctx, c_name, 1 + strlen (c_name));
} }
#endif #endif
@ -5360,20 +5362,16 @@ dump_do_dump_relocation (const uintptr_t dump_base,
} }
case RELOC_NATIVE_SUBR: case RELOC_NATIVE_SUBR:
{ {
if (!NATIVE_COMP_FLAG)
/* This cannot happen. */
emacs_abort ();
/* When resurrecting from a dump given non all the original /* When resurrecting from a dump given non all the original
native compiled subrs may be still around we can't rely on native compiled subrs may be still around we can't rely on
a 'top_level_run' mechanism, we revive them one-by-one a 'top_level_run' mechanism, we revive them one-by-one
here. */ here. */
struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
struct Lisp_Native_Comp_Unit *comp_u = struct Lisp_Native_Comp_Unit *comp_u =
XNATIVE_COMP_UNIT (subr->native_comp_u[0]); XNATIVE_COMP_UNIT (subr->native_comp_u);
if (!comp_u->handle) if (!comp_u->handle)
error ("NULL handle in compilation unit %s", SSDATA (comp_u->file)); error ("NULL handle in compilation unit %s", SSDATA (comp_u->file));
const char *c_name = subr->native_c_name[0]; const char *c_name = subr->native_c_name;
eassert (c_name); eassert (c_name);
void *func = dynlib_sym (comp_u->handle, c_name); void *func = dynlib_sym (comp_u->handle, c_name);
if (!func) if (!func)