diff --git a/src/.lldbinit b/src/.lldbinit index b5a259c6507..7c38a974d67 100644 --- a/src/.lldbinit +++ b/src/.lldbinit @@ -116,6 +116,16 @@ command alias go process launch --disable-aslr false --working-dir ../lisp #settings set -- target.run-args --batch -l loadup --temacs=pbootstrap --bin-dest /Users/gerd/emacs/github/igc-copy/nextstep/Emacs.app/Contents/MacOS/ --eln-dest /Users/gerd/emacs/github/igc-copy/nextstep/Emacs.app/Contents/Frameworks/ #command alias go process launch --working-dir . -target create emacs -settings set -- target.run-args -command alias go process launch --working-dir . +# Start process with stderr 2> log, open log and auto-revert-tail-mode +#process attach --waitfor --name emacs (--continue) + +# Attach to future Emacs + +# target create temacs +# settings set -- target.run-args --batch -l loadup --temacs=pbootstrap --bin-dest '/Users/gerd/emacs/github/cl-packages/carbon/Emacs.app/Contents/MacOS/' --eln-dest '/Users/gerd/emacs/github/cl-packages/carbon/Emacs.app/Contents/Frameworks/' +# command alias go process launch --working-dir . +# ##settings set target.disable-aslr false + +target create bootstrap-emacs +settings set -- target.run-args -batch --no-site-file --no-site-lisp --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" --eval "(setq org--inhibit-version-check t)" -l comp -f byte-compile-refresh-preloaded -f batch-byte+native-compile ../lisp/dos-w32.el +command alias go process launch --working-dir ../lisp/ diff --git a/src/comp.c b/src/comp.c index d416520a14d..bc8e30c479e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -43,6 +43,7 @@ along with GNU Emacs. If not, see . */ #include "sysstdio.h" #include "zlib.h" + /********************************/ /* Dynamic loading of libgccjit */ @@ -471,7 +472,12 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "12" +#define ABI_VERSION 13 + +/* The name of a global emitted to the text segment that contains the + ABI version that was used to generate the file. This is checked + against the current ABI version when a file is loaded. */ +#define ABI_VERSION_SYM STR (ABI_ ## ABI_VERSION) /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 @@ -656,8 +662,10 @@ typedef struct { Lisp_Object emitter_dispatcher; /* Synthesized struct holding data relocs. */ reloc_array_t data_relocs; + EMACS_INT n_data_relocs; /* Same as before but content does not survive load phase. */ reloc_array_t data_relocs_ephemeral; + EMACS_INT n_data_relocs_ephemeral; /* Global structure holding function relocations. */ gcc_jit_lvalue *func_relocs; gcc_jit_type *func_relocs_ptr_type; @@ -797,7 +805,7 @@ hash_native_abi (void) Vcomp_abi_hash = comp_hash_string ( - concat3 (build_string (ABI_VERSION), + concat3 (build_string (STR (ABI_VERSION)), concat3 (Vemacs_version, Vsystem_configuration, Vsystem_configuration_options), Fmapconcat (intern_c_string ("comp--subr-signature"), @@ -920,34 +928,42 @@ register_emitter (Lisp_Object key, void *func) static imm_reloc_t obj_to_reloc (Lisp_Object obj) { - imm_reloc_t reloc; - Lisp_Object idx; + /* Find OBJ in one of the possible constants containers. */ + imm_reloc_t reloc = { .array = comp.data_relocs }; + EMACS_INT nconstants = comp.n_data_relocs; - idx = Fgethash (obj, comp.d_default_idx, Qnil); - if (!NILP (idx)) { - reloc.array = comp.data_relocs; - goto found; - } - - idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil); - if (!NILP (idx)) + Lisp_Object idx = Fgethash (obj, comp.d_default_idx, Qnil); + if (NILP (idx)) { + idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil); + if (NILP (idx)) + xsignal1 (Qnative_ice, + build_string ("can't find data in relocation containers")); reloc.array = comp.data_relocs_ephemeral; - goto found; + nconstants = comp.n_data_relocs_ephemeral; } - xsignal1 (Qnative_ice, - build_string ("can't find data in relocation containers")); - eassume (false); - - found: - eassert (XFIXNUM (idx) < reloc.array.len); + /* Check the index IDX in the constants vector. */ if (!FIXNUMP (idx)) xsignal1 (Qnative_ice, build_string ("inconsistent data relocation container")); + eassert (XFIXNUM (idx) < nconstants); reloc.idx = gcc_jit_context_new_rvalue_from_int (comp.ctxt, comp.ptrdiff_type, XFIXNUM (idx)); + + /* If we are using pointers to constant vectors instead of copying to + vectors in the data segment, construct an indirect access. Note + that there is no decay of arrays to pointers or similar in + libgccjit. */ +#ifdef USE_POINTER_TO_CONSTANTS + gcc_jit_rvalue *zero = gcc_jit_context_zero (comp.ctxt, comp.ptrdiff_type); + gcc_jit_lvalue *constants = + gcc_jit_context_new_array_access (comp.ctxt, NULL, reloc.array.r_val, zero); + reloc.array.len = nconstants; + reloc.array.r_val = gcc_jit_lvalue_as_rvalue (constants); +#endif + return reloc; } @@ -2696,7 +2712,9 @@ emit_static_object (const char *name, Lisp_Object obj) ptrdiff_t len = SBYTES (str); const char *p = SSDATA (str); -#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) +# if defined(LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) + /* FIXME; What is this if-condition for? This is the name of + function and should always be true. */ if (gcc_jit_global_set_initializer) { ptrdiff_t str_size = len + 1; @@ -2720,6 +2738,9 @@ emit_static_object (const char *name, Lisp_Object obj) } #endif + /* FIXME; Is the following still needed? The above case + seems to always be taken nowadays. */ + gcc_jit_type *a_type = gcc_jit_context_new_array_type (comp.ctxt, NULL, @@ -2856,35 +2877,65 @@ emit_static_object (const char *name, Lisp_Object obj) gcc_jit_rvalue *res = gcc_jit_lvalue_get_address (data_struct, NULL); gcc_jit_block_end_with_return (block, NULL, res); } + #pragma GCC diagnostic pop +/* Emit code/global variables for a constants vector. + + CONTAINER is a comp-data-container Lisp struct from comp.el that + holds the data for which to generate code. + + TEXT_SYMBOL is the name of a symbol in the text segment which will be + used for the printed representation of the Lisp objects in CONTAINER. + It corresponds to a "char TEXT_SYMBOL[N]" in the text segment. When + an eln is loaded, this is read using the Lisp reader to produce a + vector of Lisp objects. + + CODE__SYMBOL is the name of a symbol in the data segment that native + code uses to access constant Lisp objects. There are two cases: + + If USE_POINTER_TO_CONSTANTS, this is a "Lisp_Object *CODE_SYMBOL[1]". + The array member is set to the contents of the Lisp vector read from + TEXT_SYMBOL. + + If not USE_POINTER_TO_CONSTANTS, this is a "Lisp_Object + CODE_SYMBOL[N]". When the eln is loaded, Lisp objects read from + TEXT_SYMBOL are copied to this vector. */ + static reloc_array_t declare_imported_data_relocs (Lisp_Object container, const char *code_symbol, - const char *text_symbol) + const char *text_symbol, EMACS_INT *nconstants) { - /* Imported objects. */ - reloc_array_t res; - res.len = - XFIXNUM (CALLNI (hash-table-count, - CALLNI (comp-data-container-idx, container))); - Lisp_Object d_reloc = CALLNI (comp-data-container-l, container); - d_reloc = Fvconcat (1, &d_reloc); + Lisp_Object tem = CALLNI (comp-data-container-l, container); + Lisp_Object constants = Fvconcat (1, &tem); - res.r_val = - gcc_jit_lvalue_as_rvalue ( - gcc_jit_context_new_global ( - comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - gcc_jit_context_new_array_type (comp.ctxt, - NULL, - comp.lisp_obj_type, - res.len), - code_symbol)); + /* Emit the printed representation of the constants as a C string. */ + emit_static_object (text_symbol, constants); - emit_static_object (text_symbol, d_reloc); + *nconstants = XFIXNUM (CALLNI (hash-table-count, + CALLNI (comp-data-container-idx, + container))); - return res; +#ifdef USE_POINTER_TO_CONSTANTS + /* Lisp_Object *CODE_SYMBOL[1] */ + EMACS_INT len = 1; + gcc_jit_type *type = comp.lisp_obj_ptr_type; +#else + /* Lisp_Object CODE_SYMBOL[N], N = number of constants. */ + EMACS_INT len = *nconstants; + gcc_jit_type *type = comp.lisp_obj_type; +#endif + + return (reloc_array_t) { + .len = len, + .r_val = gcc_jit_lvalue_as_rvalue ( + gcc_jit_context_new_global ( + comp.ctxt, + NULL, + GCC_JIT_GLOBAL_EXPORTED, + gcc_jit_context_new_array_type (comp.ctxt, NULL, type, len), + code_symbol)) + }; } static void @@ -2894,11 +2945,13 @@ declare_imported_data (void) comp.data_relocs = declare_imported_data_relocs (CALLNI (comp-ctxt-d-default, Vcomp_ctxt), DATA_RELOC_SYM, - TEXT_DATA_RELOC_SYM); + TEXT_DATA_RELOC_SYM, + &comp.n_data_relocs); comp.data_relocs_ephemeral = declare_imported_data_relocs (CALLNI (comp-ctxt-d-ephemeral, Vcomp_ctxt), DATA_RELOC_EPHEMERAL_SYM, - TEXT_DATA_RELOC_EPHEMERAL_SYM); + TEXT_DATA_RELOC_EPHEMERAL_SYM, + &comp.n_data_relocs_ephemeral); } /* @@ -2972,6 +3025,28 @@ declare_runtime_imported_funcs (void) return Freverse (field_list); } +/* Emit an exported global whose symbol name contains the ABI + version used when generating it. */ + +static void +emit_abi_version (void) +{ + gcc_jit_context_new_global (comp.ctxt, NULL, GCC_JIT_GLOBAL_EXPORTED, + comp.void_ptr_type, ABI_VERSION_SYM); +} + +/* Check ABI version of CU against the current version. Do this because + relying on a substring of an MD5 checksum as part of an eln's file + name is prone to fail. */ + +static void +check_abi_version (struct Lisp_Native_Comp_Unit *cu) +{ + if (dynlib_sym (cu->handle, ABI_VERSION_SYM) == NULL) + error ("File '%s' has incompatible ABI version", + SDATA (cu->file)); +} + /* This emit the code needed by every compilation unit to be loaded. */ @@ -4893,6 +4968,7 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, CALLNI (comp-data-container-idx, CALLNI (comp-ctxt-d-ephemeral, Vcomp_ctxt)); emit_ctxt_code (); + emit_abi_version (); /* Define inline functions. */ define_CAR_CDR (); @@ -5225,6 +5301,7 @@ load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name) static bool check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) { +#ifndef USE_POINTER_TO_CONSTANTS dynlib_handle_ptr handle = comp_u->handle; Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); @@ -5243,6 +5320,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) else if (!EQ (x, AREF (comp_u->data_vec, i))) return false; } +#endif return true; } @@ -5252,6 +5330,36 @@ unset_cu_load_ongoing (Lisp_Object comp_u) XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false; } +/* Setup constatns vector in the data segment VEC from Lisp vector + CONSTANTS. Store in *N the number of elements in VEC. Store in *ROOT + an MPS root for VEC, if one is needed. */ + +static void +setup_constants (comp_data_vector_t vec, Lisp_Object constants, + size_t *n, ptrdiff_t *pin) +{ + *n = ASIZE (constants); + Lisp_Object *contents = XVECTOR (constants)->contents; + +#ifdef USE_POINTER_TO_CONSTANTS + if (*n > 0) + { +# ifdef HAVE_MPS + *pin = igc_pin (contents); +# endif + *vec = contents; + *n = 1; + } + else + { + *vec = NULL; + *pin = IGC_NO_PIN; + } +#else + memcpy (vec, contents, *n * sizeof *contents); +#endif +} + Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, bool late_load) @@ -5265,8 +5373,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, if (!saved_cu) xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); comp_u->loaded_once = !NILP (*saved_cu); - Lisp_Object *data_eph_relocs = - dynlib_sym (handle, DATA_RELOC_EPHEMERAL_SYM); + comp_u->data_eph_relocs = dynlib_sym (handle, DATA_RELOC_EPHEMERAL_SYM); /* While resurrecting from an image dump loading more than once the same compilation unit does not make any sense. */ @@ -5289,8 +5396,10 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, { #ifdef HAVE_MPS comp_u->comp_unit = saved_cu; - comp_u->comp_unit_root = igc_root_create_n (saved_cu, 1); -#endif + comp_u->comp_unit_pin = igc_pin (comp_u); + comp_u->data_vec_pin = -1; + comp_u->data_eph_vec_pin = -1; +# endif *saved_cu = comp_u_lisp_obj; } @@ -5314,17 +5423,18 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, if (!comp_u->loaded_once) { + check_abi_version (comp_u); + struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); bool **f_symbols_with_pos_enabled_reloc = dynlib_sym (handle, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM); - Lisp_Object *data_relocs = comp_u->data_relocs; void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); if (!(current_thread_reloc && f_symbols_with_pos_enabled_reloc - && data_relocs - && data_eph_relocs + && comp_u->data_relocs + && comp_u->data_eph_relocs && freloc_link_table && top_level_run) || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM), @@ -5345,63 +5455,41 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); } - EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); -#ifdef HAVE_MPS - comp_u->n_data_relocs = d_vec_len; - if (d_vec_len > 0) - comp_u->data_relocs_root = igc_root_create_n (data_relocs, d_vec_len); -#endif - for (EMACS_INT i = 0; i < d_vec_len; i++) - data_relocs[i] = AREF (comp_u->data_vec, i); + /* Setup the constants vector. In the case of + USE_POINTER_TO_CONSTANTS, store a pointer to the contents of + the Lisp vector read, otherwise copy Lisp objects to the vector + created in the data segment. */ + setup_constants (comp_u->data_relocs, comp_u->data_vec, + &comp_u->n_data_relocs, &comp_u->data_vec_pin); } if (!loading_dump) { - /* Note: data_ephemeral_vec is not GC protected except than by - this function frame. After this functions will be - deactivated GC will be free to collect it, but it MUST - survive till 'top_level_run' has finished his job. We store - into the ephemeral allocation class only objects that we know - are necessary exclusively during the first load. Once these - are collected we don't have to maintain them in the heap - forever. */ - Lisp_Object volatile data_ephemeral_vec = Qnil; - /* In case another load of the same CU is active on the stack - all ephemeral data is hold by that frame. Re-writing - 'data_ephemeral_vec' would be not only a waste of cycles but - more importantly would lead to crashes if the contained data - is not cons hashed. */ if (!recursive_load) { - data_ephemeral_vec = - load_static_obj (comp_u, TEXT_DATA_RELOC_EPHEMERAL_SYM); - - EMACS_INT d_vec_len = XFIXNUM (Flength (data_ephemeral_vec)); -# ifdef HAVE_MPS - /* The root is only needed until top_level_run below has - completed. Beware of recursice loads. */ - comp_u->data_eph_relocs = data_eph_relocs; - comp_u->n_data_eph_relocs = d_vec_len; - if (d_vec_len > 0) - comp_u->data_eph_relocs_root - = igc_root_create_n (data_eph_relocs, d_vec_len); -# endif - for (EMACS_INT i = 0; i < d_vec_len; i++) - data_eph_relocs[i] = AREF (data_ephemeral_vec, i); + eassert (NILP (comp_u->data_eph_vec)); + comp_u->data_eph_vec + = load_static_obj (comp_u, TEXT_DATA_RELOC_EPHEMERAL_SYM); + setup_constants (comp_u->data_eph_relocs, comp_u->data_eph_vec, + &comp_u->n_data_eph_relocs, + &comp_u->data_eph_vec_pin); } /* Executing this will perform all the expected environment modifications. */ res = top_level_run (comp_u_lisp_obj); - /* Make sure data_ephemeral_vec still exists after top_level_run has run. - Guard against sibling call optimization (or any other). */ - data_ephemeral_vec = data_ephemeral_vec; eassert (check_comp_unit_relocs (comp_u)); -# ifdef HAVE_MPS if (!recursive_load) - igc_root_destroy_comp_unit_eph (comp_u); + { +# ifdef HAVE_MPS + igc_maybe_unpin (XVECTOR (comp_u->data_eph_vec)->contents, + &comp_u->data_eph_vec_pin); # endif + /* No longer needed after top-level code has run. Let the + vector be GC'd. */ + comp_u->data_eph_vec = Qnil; + } } @@ -5421,7 +5509,7 @@ unload_comp_unit (struct Lisp_Native_Comp_Unit *cu) return; # ifdef HAVE_MPS - igc_root_destroy_comp_unit (cu); + igc_unpin_comp_unit (cu); # endif Lisp_Object *saved_cu = dynlib_sym (cu->handle, COMP_UNIT_SYM); @@ -5528,7 +5616,11 @@ This gets called by top_level_run during the load phase. */) eassert (NILP (Fgethash (c_name, cu->lambda_c_name_idx_h, Qnil))); Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h); /* Do the real relocation fixup. */ +# ifdef USE_POINTER_TO_CONSTANTS + (*cu->data_relocs)[XFIXNUM (reloc_idx)] = tem; +# else cu->data_relocs[XFIXNUM (reloc_idx)] = tem; +# endif return tem; } @@ -5595,6 +5687,12 @@ LATE-LOAD has to be non-nil when loading for deferred compilation. */) struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit (); Lisp_Object encoded_filename = ENCODE_FILE (filename); +#ifdef HAVE_MPS + igc_init_pin (&comp_u->data_vec_pin); + igc_init_pin (&comp_u->data_eph_vec_pin); + igc_init_pin (&comp_u->comp_unit_pin); +#endif + if (!NILP (Fgethash (filename, Vcomp_loaded_comp_units_h, Qnil)) && !file_in_eln_sys_dir (filename) && !NILP (Ffile_writable_p (filename))) diff --git a/src/comp.h b/src/comp.h index c475c74d7ea..265ae3428bb 100644 --- a/src/comp.h +++ b/src/comp.h @@ -20,44 +20,107 @@ along with GNU Emacs. If not, see . */ #ifndef COMP_H #define COMP_H -#include -# include "lisp.h" +// clang-format off -# ifdef HAVE_MPS -struct igc_root_list; -# endif +#include +#include "lisp.h" + +/* Shared .eln objects contain printed representations of Lisp vectors + representing constant Lisp objects used in native-compiled code. + There are two of these vectors, one for top-level code, which is + called "ephemeral", and one for other code. + + When an .eln is loaded, the Lisp reader is used to construct Lisp + vectors from these printed representations (which are C strings in + the text segment). This Lisp vector is then saved to protect the + constant objects from GC, and its contents are additionally copied to + vectors in the data segment of the .eln to avoid an additional + indirection when accessing them. + + With igc, the vectors in the data segment were once made exact roots, + and there are quite a lot of them, easily 1.5 MB. To avoid these + roots, an alternative is used, which works better: + + Compile the shared object to contain a pointer to the contents member + of the Lisp vectors that has been read, instead of copying the + vector's contents to the data segment. Access to constants then + requires an additional indirection, but the GC latency is less. It's + something like the difference between + + static Lisp_Object constants[42]; + Lisp_Object constant = constants[17]; + + and + + static Lisp_Object **constants; + Lisp_Object constant = (*constants)[17]; + + The advantage of the first method is slightly faster native code + (maybe), the advantage of the second method is (definitely) less + latency of incremental GC. */ + +#ifdef HAVE_MPS +#define USE_POINTER_TO_CONSTANTS 1 +#endif + +#ifdef USE_POINTER_TO_CONSTANTS +typedef Lisp_Object **comp_data_vector_t; +#else +typedef Lisp_Object *comp_data_vector_t; +#endif struct Lisp_Native_Comp_Unit { struct vectorlike_header header; + /* The original eln file loaded. In the pdumper file this is stored as a cons cell of 2 alternative file names: the car is the filename relative to the directory of an installed binary, the cdr is the filename relative to the directory of an uninstalled binary. This is arranged in loadup.el. */ Lisp_Object file; + Lisp_Object optimize_qualities; + /* Guard anonymous lambdas against Garbage Collection and serve sanity checks. */ Lisp_Object lambda_gc_guard_h; + /* Hash c_name -> d_reloc index. */ Lisp_Object lambda_c_name_idx_h; + /* Hash doc-idx -> function documentation. */ Lisp_Object data_fdoc_v; - /* Analogous to the constant vector but per compilation unit. Must be - last. */ + + /* Temporarily used to GC protect a vector of constants used + during the execution of top-level code. */ + Lisp_Object data_eph_vec; + + /* A Lisp vector read from a string contained in the text segment of + the .eln (TEXT_DATA_RELOC_SYM). The elements of the vector are + constants used in the native code. */ Lisp_Object data_vec; - /* STUFFS WE DO NOT DUMP!! */ -# ifdef HAVE_MPS - size_t n_data_relocs; - Lisp_Object *data_eph_relocs; - size_t n_data_eph_relocs; + + /* STUFF WE DO NOT DUMP!! */ + + /* Pointer into the data segment where the compilation unit is + stored (COMP_UNIT_SYM), and an exact root for it. */ Lisp_Object *comp_unit; - struct igc_root_list *data_relocs_root; - struct igc_root_list *data_eph_relocs_root; - struct igc_root_list *comp_unit_root; -# endif - Lisp_Object *data_relocs; + + /* Pointers into data segment where constant vectors are found. */ + comp_data_vector_t data_relocs; + comp_data_vector_t data_eph_relocs; + + /* Size of the vectors above. 1 in the USE_POINTER_TO_CONSTANTS + case. */ + size_t n_data_relocs; + size_t n_data_eph_relocs; + + /* Pins */ + ptrdiff_t data_vec_pin; + ptrdiff_t data_eph_vec_pin; + ptrdiff_t comp_unit_pin; + bool loaded_once; bool load_ongoing; dynlib_handle_ptr handle; diff --git a/src/igc.c b/src/igc.c index 20fd9f1f72e..82114c6aa50 100644 --- a/src/igc.c +++ b/src/igc.c @@ -175,7 +175,7 @@ along with GNU Emacs. If not, see . */ # ifndef HASH_terminal_4E8E555B40 # error "struct terminal changed" # endif -# ifndef HASH_Lisp_Native_Comp_Unit_B617D9AE7C +# ifndef HASH_Lisp_Native_Comp_Unit_876BE72D27 # error "struct Lisp_Native_Comp_Unit changed" # endif # ifndef HASH_pvec_type_1C9DBCD69F @@ -1067,6 +1067,7 @@ static void unpin (struct igc *gc, void *obj, ptrdiff_t i) { struct igc_pins *p = gc->pins; + eassert (i >= 0 && i < p->capacity); eassert (p->entries[i].obj == obj); p->entries[i].next_free = p->free; p->free = i; @@ -3090,10 +3091,10 @@ root_create_main_thread (struct igc *gc) "main-thread-getcjmp"); } -void +struct igc_root_list * igc_root_create_ambig (void *start, void *end, const char* label) { - root_create_ambig (global_igc, start, end, label); + return root_create_ambig (global_igc, start, end, label); } void @@ -3102,18 +3103,18 @@ igc_root_create_exact (Lisp_Object *start, Lisp_Object *end) root_create_exact (global_igc, start, end, scan_exact, "exact"); } -static void +static struct igc_root_list * root_create_exact_ptr (struct igc *gc, void *var_addr) { char *start = var_addr; char *end = start + sizeof (void *); - root_create_exact (gc, start, end, scan_ptr_exact, "exact-ptr"); + return root_create_exact (gc, start, end, scan_ptr_exact, "exact-ptr"); } -void +struct igc_root_list * igc_root_create_exact_ptr (void *var_addr) { - root_create_exact_ptr (global_igc, var_addr); + return root_create_exact_ptr (global_igc, var_addr); } static void @@ -3271,25 +3272,42 @@ igc_destroy_root_with_start (void *start) } } -static void -maybe_destroy_root (struct igc_root_list **root) +ptrdiff_t +igc_pin (void *obj) { - if (*root) - destroy_root (root); + return pin (global_igc, obj); } void -igc_root_destroy_comp_unit (struct Lisp_Native_Comp_Unit *u) +igc_unpin (void *obj, ptrdiff_t idx) { - maybe_destroy_root (&u->data_relocs_root); - maybe_destroy_root (&u->data_eph_relocs_root); - maybe_destroy_root (&u->comp_unit_root); + unpin (global_igc, obj, idx); } void -igc_root_destroy_comp_unit_eph (struct Lisp_Native_Comp_Unit *u) +igc_maybe_unpin (void *obj, ptrdiff_t *pin) { - maybe_destroy_root (&u->data_eph_relocs_root); + if (*pin >= 0) + { + igc_unpin (obj, *pin); + *pin = IGC_NO_PIN; + } +} + +void +igc_init_pin (ptrdiff_t *pin) +{ + *pin = IGC_NO_PIN; +} + +void +igc_unpin_comp_unit (struct Lisp_Native_Comp_Unit *cu) +{ + if (VECTORP (cu->data_vec)) + igc_maybe_unpin (XVECTOR (cu->data_vec)->contents, &cu->data_vec_pin); + if (VECTORP (cu->data_eph_vec)) + igc_maybe_unpin (XVECTOR (cu->data_eph_vec)->contents, &cu->data_eph_vec_pin); + igc_maybe_unpin (cu, &cu->comp_unit_pin); } static mps_res_t diff --git a/src/igc.h b/src/igc.h index 131613b5044..a17f73649d8 100644 --- a/src/igc.h +++ b/src/igc.h @@ -59,6 +59,14 @@ enum igc_obj_type #ifdef HAVE_MPS +enum { IGC_NO_PIN = -1 }; +void igc_unpin_comp_unit (struct Lisp_Native_Comp_Unit *u); +void igc_maybe_unpin (void *obj, ptrdiff_t *pin); +void igc_init_pin (ptrdiff_t *pin); +ptrdiff_t igc_pin (void *obj); +void igc_unpin (void *obj, ptrdiff_t idx); + + void igc_break (void); void init_igc (void); void syms_of_igc (void); @@ -158,11 +166,10 @@ void igc_on_alloc_main_thread_specpdl (void); void igc_on_alloc_main_thread_bc (void); void igc_on_staticpros_complete (void); void igc_collect (bool incremental); -void igc_root_create_ambig (void *start, void *end, const char *debug_name); void igc_root_create_exact (Lisp_Object *start, Lisp_Object *end); -void igc_root_create_exact_ptr (void *var_addr); -void igc_root_destroy_comp_unit (struct Lisp_Native_Comp_Unit *u); -void igc_root_destroy_comp_unit_eph (struct Lisp_Native_Comp_Unit *u); +struct igc_root_list *igc_root_create_exact_ptr (void *var_addr); +struct igc_root_list *igc_root_create_ambig (void *start, void *end, + const char *debug_name); void *igc_root_create_n (Lisp_Object start[], size_t n); void igc_destroy_root_with_start (void *start); size_t igc_header_size (void); @@ -175,6 +182,12 @@ void *igc_alloc_dump (size_t nbytes); bool igc_busy_p (void); Lisp_Object igc_discard_killed_buffers (Lisp_Object list); +ptrdiff_t igc_pin (void *obj); +void igc_unpin (void *obj, ptrdiff_t idx); + +# define eassert_not_mps() eassert (false) + +# define eassert_not_mps() eassert (false) #ifdef HAVE_NTGUI /* Union that is expected to be aligned as MPS expects from stack bottom. */ typedef union @@ -190,6 +203,10 @@ void w32_remove_non_lisp_thread (void *); extern void igc_assert_not_an_mps_object (void *ptr); # define eassert_not_mps() eassert (false) + +ptrdiff_t igc_pin (void *obj); +void igc_unpin (void *obj, ptrdiff_t idx); + #else # define igc_break() (void) 0 # define eassert_not_mps() (void) 0 diff --git a/src/pdumper.c b/src/pdumper.c index bb90549a4d9..67367a29e2e 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5869,15 +5869,23 @@ dump_do_dump_relocation (const uintptr_t dump_base, Fgethash (build_string (c_name), comp_u->lambda_c_name_idx_h, Qnil); if (!NILP (lambda_data_idx)) { + /* FIXME/elnroot: why is the fixup not done in the Lisp + vector? does it not exist? */ + eassert (VECTORP (comp_u->data_vec)); + /* This is an anonymous lambda. We must fixup d_reloc so the lambda can be referenced by code. */ Lisp_Object tem; XSETSUBR (tem, subr); + /* No need to fix something if pointers are used because + there are no copies in vectors in the data segments. */ +# ifndef USE_POINTER_TO_CONSTANTS Lisp_Object *fixup = &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); eassert (EQ (*fixup, Vcomp__hashdollar)); *fixup = tem; +# endif Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); } break;