Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 10:27:41 +00:00
Code Issues Projects Releases Packages Wiki Activity

Enhance struct Lisp_Subr to hold the alternative "BC_" function.

Browse source 
Also fix a GC bug, where symbols with position were not being disabled.

* src/lisp.h (union Lisp_Function): New type.
(struct Lisp_Subr): Add fields normal_function, BC_function, and next.
(DEFUN): Setup all three function fields to the subr (BC_function is still a
dummy), set field next to NULL.

* src/alloc.c (Fgarbage_collect): Move the binding of
Qsymbols_with_pos_enabled to garbage_collect_1 so that it gets bound when GC
is invoked via garbage_collect.

* src/lread.c (subr_ptr, using_BC_subrs): New static variables.
(Fswitch_to_BC_subrs, Fswitch_to_normal_subrs): New defuns.
(defsubr): Chain new subr to previous using field next and variable subr_ptr.
(init_lread): Initialise subr_ptr to NULL.
(syms_of_lread): Create subrs Sswitch_to_BC_subrs and Sswitch_to_normal_subrs.

* src/pdumper.c (dump_subr): Enhance to dump struct Lisp_Subr's new fields.
Update the expected value of HASH_Lisp_Subr_xxxxxxxxxx.
(dump_vectorlike): Also dump PVEC_SYMBOL_WITH_POSes.
This commit is contained in:
Alan Mackenzie 2019-04-05 12:18:53 +00:00
parent 8a23e87170
commit b071398ba3
4 changed files with 70 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/alloc.c
View file

@ -6053,12 +6053,17 @@ garbage_collect_1 (struct gcstat *gcst)
struct timespec start;
byte_ct tot_before = 0;
specbind (Qsymbols_with_pos_enabled, Qnil);
eassert (weak_hash_tables == NULL);
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
if (pure_bytes_used_before_overflow)
return false;
{
unbind_to (count, Qnil);
return false;
}
/* Record this function, so it appears on the profiler's backtraces. */
record_in_backtrace (QAutomatic_GC, 0, 0);
@ -6249,6 +6254,7 @@ garbage_collect_1 (struct gcstat *gcst)
malloc_probe (min (swept, SIZE_MAX));
}
unbind_to (count, Qnil);
return true;
}
@ -6276,11 +6282,9 @@ returns nil, because real GC can't be done.
See Info node `(elisp)Garbage Collection'. */)
(void)
{
ptrdiff_t count = SPECPDL_INDEX ();
struct gcstat gcst;
specbind (Qsymbols_with_pos_enabled, Qnil);
if (!garbage_collect_1 (&gcst))
return unbind_to (count, Qnil);
return Qnil;
Lisp_Object total[] = {
list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
@ -6315,7 +6319,7 @@ See Info node `(elisp)Garbage Collection'. */)
make_int ((mallinfo ().fordblks + 1023) >> 10)),
#endif
};
return unbind_to (count, CALLMANY (Flist, total));
return CALLMANY (Flist, total);
}
/* Mark Lisp objects in glyph matrix MATRIX. Currently the

21
src/lisp.h
View file

@ -2127,10 +2127,7 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
It is generated by the DEFUN macro only.
defsubr makes it into a Lisp object. */
struct Lisp_Subr
{
union vectorlike_header header;
union {
union Lisp_Function {
Lisp_Object (*a0) (void);
Lisp_Object (*a1) (Lisp_Object);
Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
@ -2142,10 +2139,18 @@ struct Lisp_Subr
Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
Lisp_Object (*aUNEVALLED) (Lisp_Object args);
Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
} function;
};
struct Lisp_Subr
{
union vectorlike_header header;
union Lisp_Function function;
union Lisp_Function normal_function;
union Lisp_Function BC_function;
short min_args, max_args;
const char *symbol_name;
const char *intspec;
union Aligned_Lisp_Subr *next;
EMACS_INT doc;
} GCALIGNED_STRUCT;
union Aligned_Lisp_Subr
@ -3162,7 +3167,11 @@ CHECK_INTEGER (Lisp_Object x)
static union Aligned_Lisp_Subr sname = \
{{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
{ .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}}; \
{ .a ## maxargs = fnname }, \
{ .a ## maxargs = /* BC_ ## */fnname }, \
minargs, maxargs, lname, intspec, \
NULL, \
0}}; \
Lisp_Object fnname
/* defsubr (Sname);

40
src/lread.c
View file

@ -4438,6 +4438,40 @@ init_obarray_once (void)
}
static union Aligned_Lisp_Subr *subr_ptr = NULL;
static bool using_BC_subrs = false;
DEFUN ("switch-to-BC-subrs", Fswitch_to_BC_subrs, Sswitch_to_BC_subrs, 0, 0, 0,
doc: /* Switch all subrs to using the byte compiler versions. */)
(void)
{
union Aligned_Lisp_Subr *ptr = subr_ptr;
if (!using_BC_subrs)
while (ptr)
{
ptr->s.function = ptr->s.BC_function;
ptr = ptr->s.next;
}
using_BC_subrs = true;
return Qnil;
}
DEFUN ("switch-to-normal-subrs", Fswitch_to_normal_subrs,
Sswitch_to_normal_subrs, 0, 0, 0,
doc: /* Switch all subrs to using the normal versions. */)
(void)
{
union Aligned_Lisp_Subr *ptr = subr_ptr;
if (using_BC_subrs)
while (ptr)
{
ptr->s.function = ptr->s.normal_function;
ptr = ptr->s.next;
}
using_BC_subrs = false;
return Qnil;
}
void
defsubr (union Aligned_Lisp_Subr *aname)
{
@ -4447,6 +4481,8 @@ defsubr (union Aligned_Lisp_Subr *aname)
XSETPVECTYPE (sname, PVEC_SUBR);
XSETSUBR (tem, sname);
set_symbol_function (sym, tem);
sname->next = subr_ptr;
subr_ptr = aname;
}
#ifdef NOTDEF /* Use fset in subr.el now! */
@ -4702,6 +4738,8 @@ init_lread (void)
if (NILP (Vpurify_flag) && !NILP (Ffboundp (Qfile_truename)))
Vsource_directory = call1 (Qfile_truename, Vsource_directory);
subr_ptr = NULL;
/* First, set Vload_path. */
/* Ignore EMACSLOADPATH when dumping. */
@ -4816,6 +4854,8 @@ syms_of_lread (void)
defsubr (&Sintern);
defsubr (&Sintern_soft);
defsubr (&Sunintern);
defsubr (&Sswitch_to_BC_subrs);
defsubr (&Sswitch_to_normal_subrs);
defsubr (&Sget_load_suffixes);
defsubr (&Sload);
defsubr (&Seval_buffer);

8
src/pdumper.c
View file

@ -2914,17 +2914,20 @@ 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_594AB72B54)
#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_6AE56C1912)
# error "Lisp_Subr changed. See CHECK_STRUCTS comment."
#endif
struct Lisp_Subr out;
dump_object_start (ctx, &out, sizeof (out));
DUMP_FIELD_COPY (&out, subr, header.size);
dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
dump_field_emacs_ptr (ctx, &out, subr, &subr->normal_function.a0);
dump_field_emacs_ptr (ctx, &out, subr, &subr->BC_function.a0);
DUMP_FIELD_COPY (&out, subr, min_args);
DUMP_FIELD_COPY (&out, subr, max_args);
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->next);
DUMP_FIELD_COPY (&out, subr, doc);
return dump_object_finish (ctx, &out, sizeof (out));
}
@ -2953,7 +2956,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
#if CHECK_STRUCTS && !defined (HASH_pvec_type_549C833A54)
#if CHECK_STRUCTS && !defined (HASH_pvec_type_3C7A719153)
# error "pvec_type changed. See CHECK_STRUCTS comment."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@ -2974,6 +2977,7 @@ dump_vectorlike (struct dump_context *ctx,
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
case PVEC_RECORD:
case PVEC_SYMBOL_WITH_POS:
offset = dump_vectorlike_generic (ctx, &v->header);
break;
case PVEC_BOOL_VECTOR: