From: Andrea Corallo Date: Sat, 13 Jun 2020 09:12:15 +0000 (+0200) Subject: * Implement 'maybe_gc_or_quit' to allow correct GC in compiled Lisp. X-Git-Tag: emacs-28.0.90~2727^2~564 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5a55a845a7c426e82e8a6a6d02bc4a39992871e3;p=emacs.git * Implement 'maybe_gc_or_quit' to allow correct GC in compiled Lisp. Implement the backend side of 'maybe_gc_or_quit' so that every time a call to it is emitted we render it accordingly. This allow GC to kicks in during long loops in Lisp code. * src/comp.c (comp_t): Add 'maybe_gc_or_quit' field. (helper_link_table): Add 'maybe_gc', 'maybe_quit'. (emit_maybe_gc_or_quit): New function. (declare_runtime_imported_funcs): Import 'maybe_gc', 'maybe_quit' functions. (define_maybe_gc_or_quit): New function. (Fcomp__init_ctxt): Register emitter. (Fcomp__compile_ctxt_to_file): Call 'define_maybe_gc_or_quit'. (syms_of_comp): Define Qcomp_maybe_gc_or_quit. --- diff --git a/src/comp.c b/src/comp.c index 18a2a1ff912..24d69b2b1ef 100644 --- a/src/comp.c +++ b/src/comp.c @@ -554,6 +554,7 @@ typedef struct { gcc_jit_function *setcdr; gcc_jit_function *check_type; gcc_jit_function *check_impure; + gcc_jit_function *maybe_gc_or_quit; Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */ Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *. */ Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field. */ @@ -610,7 +611,9 @@ void *helper_link_table[] = record_unwind_current_buffer, set_internal, helper_unwind_protect, - specbind }; + specbind, + maybe_gc, + maybe_quit }; static char * ATTRIBUTE_FORMAT_PRINTF (1, 2) @@ -2316,6 +2319,13 @@ emit_integerp (Lisp_Object insn) &res); } +static gcc_jit_rvalue * +emit_maybe_gc_or_quit (Lisp_Object insn) +{ + return gcc_jit_context_new_call (comp.ctxt, NULL, comp.maybe_gc_or_quit, 0, + NULL); +} + /* This is in charge of serializing an object and export a function to retrieve it at load time. */ static void @@ -2575,6 +2585,10 @@ declare_runtime_imported_funcs (void) args[0] = args[1] = comp.lisp_obj_type; ADD_IMPORTED (specbind, comp.void_type, 2, args); + ADD_IMPORTED (maybe_gc, comp.void_type, 0, NULL); + + ADD_IMPORTED (maybe_quit, comp.void_type, 0, NULL); + #undef ADD_IMPORTED return Freverse (field_list); @@ -3512,6 +3526,96 @@ define_CHECK_IMPURE (void) gcc_jit_block_end_with_void_return (err_block, NULL); } +static void +define_maybe_gc_or_quit (void) +{ + + /* + void + maybe_gc_or_quit (void) + { + static unsigned quitcounter; + inc: + quitcounter++; + if (quitcounter >> 14) goto maybe_do_it else goto pass; + maybe_do_it: + quitcounter = 0; + maybe_gc (); + maybe_quit (); + return; + pass: + return; + } + */ + + gcc_jit_block *bb_orig = comp.block; + + gcc_jit_lvalue *quitcounter = + gcc_jit_context_new_global ( + comp.ctxt, + NULL, + GCC_JIT_GLOBAL_INTERNAL, + comp.unsigned_type, + "quitcounter"); + + comp.func = comp.maybe_gc_or_quit = + gcc_jit_context_new_function (comp.ctxt, NULL, + GCC_JIT_FUNCTION_INTERNAL, + comp.void_type, + "maybe_gc_quit", + 0, NULL, 0); + DECL_BLOCK (increment_block, comp.maybe_gc_or_quit); + DECL_BLOCK (maybe_do_it_block, comp.maybe_gc_or_quit); + DECL_BLOCK (pass_block, comp.maybe_gc_or_quit); + + comp.block = increment_block; + + gcc_jit_block_add_assignment ( + comp.block, + NULL, + quitcounter, + emit_binary_op (GCC_JIT_BINARY_OP_PLUS, + comp.unsigned_type, + gcc_jit_lvalue_as_rvalue (quitcounter), + gcc_jit_context_new_rvalue_from_int (comp.ctxt, + comp.unsigned_type, + 1))); + emit_cond_jump ( + emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT, + comp.unsigned_type, + gcc_jit_lvalue_as_rvalue (quitcounter), + gcc_jit_context_new_rvalue_from_int (comp.ctxt, + comp.unsigned_type, + 9)), + /* 9 translates into checking for GC or quit every 512 calls to + 'maybe_gc_quit'. This is the smallest value I could find with + no performance impact running elisp-banechmarks. Byte + intepreter uses 256 (see 'exec_byte_code'). */ + maybe_do_it_block, + pass_block); + + comp.block = maybe_do_it_block; + + gcc_jit_block_add_assignment ( + comp.block, + NULL, + quitcounter, + gcc_jit_context_new_rvalue_from_int (comp.ctxt, + comp.unsigned_type, + 0)); + gcc_jit_block_add_eval (comp.block, NULL, + emit_call (intern_c_string ("maybe_gc"), + comp.void_type, 0, NULL, false)); + gcc_jit_block_add_eval (comp.block, NULL, + emit_call (intern_c_string ("maybe_quit"), + comp.void_type, 0, NULL, false)); + gcc_jit_block_end_with_void_return (comp.block, NULL); + + gcc_jit_block_end_with_void_return (pass_block, NULL); + + comp.block = bb_orig; +} + /* Define a function to convert boolean into t or nil */ static void @@ -3761,6 +3865,7 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt, register_emitter (Qnegate, emit_negate); register_emitter (Qnumberp, emit_numperp); register_emitter (Qintegerp, emit_integerp); + register_emitter (Qcomp_maybe_gc_or_quit, emit_maybe_gc_or_quit); } comp.ctxt = gcc_jit_context_acquire (); @@ -3949,6 +4054,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, define_setcar_setcdr (); define_add1_sub1 (); define_negate (); + define_maybe_gc_or_quit (); struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); @@ -4756,6 +4862,7 @@ syms_of_comp (void) DEFSYM (Qnegate, "negate"); DEFSYM (Qnumberp, "numberp"); DEFSYM (Qintegerp, "integerp"); + DEFSYM (Qcomp_maybe_gc_or_quit, "comp-maybe-gc-or-quit"); /* Allocation classes. */ DEFSYM (Qd_default, "d-default");