From b071398ba3e8031fe8284f2aed95d714cd3c92af Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Fri, 5 Apr 2019 12:18:53 +0000 Subject: [PATCH] Enhance struct Lisp_Subr to hold the alternative "BC_" function. 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. --- src/alloc.c | 14 +++++++++----- src/lisp.h | 21 +++++++++++++++------ src/lread.c | 40 ++++++++++++++++++++++++++++++++++++++++ src/pdumper.c | 8 ++++++-- 4 files changed, 70 insertions(+), 13 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 035b45864d9..e14b0d577a8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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 diff --git a/src/lisp.h b/src/lisp.h index 3324dac98f6..a22043026ad 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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); diff --git a/src/lread.c b/src/lread.c index fcee7d4df7e..cc9ee110aec 100644 --- a/src/lread.c +++ b/src/lread.c @@ -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); diff --git a/src/pdumper.c b/src/pdumper.c index a9b3732a2d4..59cd824142d 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -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: -- 2.39.5