mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Alternative implementation of constants in .eln files.

Browse source 
See the comment at the start of comp.h about this.

* src/comp.c (ABI_VERSION): Make it an integer, and increment.
(ABI_VERSION_SYM): New.
(hash_native_abi): Use it.
(emit_abi_version, check_abi_version): New functions.
(Fcomp__compile_ctxt_to_file0): Emit ABI_VERSION_SYM.
(load_comp_unit): Check ABI version.

* src/comp.c (comp_t): Add n_data_relocs and
n_data_relocs_ephemeral.
(obj_to_reloc): Use them, and handle case of using pointers to
constants.
(emit_static_object): Add FIXMEs.
(declare_imported_data_relocs): Handle case of pointers to
constants vectors differently.
(declare_imported_data): Set comp's number of constants.
(setup_constants): New function.
(load_comp_unit): Don't create roots, pin instead. Don't rely on
tricks to protect ephemeral vector.
(Fnative_elisp_load): Init pins.

* src/comp.h (USE_POINTER_TO_CONSTANT_VECTOR): New. If defined,
don't use vectors.
(Lisp_Native_Comp_Unit): Define data_relocs and data_eph_relocs
depending on USE_POINTER_TO_CONSTANT_VECTOR. Add pin ids

* src/igc.c (unpin): Add an eassert.
(root_create_exact_ptr, igc_root_create_exact_ptr):
Return root list node.
(maybe_destroy_rootI: Removed.
(igc_pin, igc_unpin): New functions.
(igc_root_destroy_comp_unit): Removed.
(igc_init_pin, igc_unpin_comp_unit): New function.

* src/igc.h: Declare new functions, remove old ones.
This commit is contained in:
Gerd Möllmann 2025-10-17 09:04:47 +02:00
parent 13c058c358
commit f7052a107c
6 changed files with 348 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/.lldbinit
View file

@ -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/

276
src/comp.c
View file

@ -43,6 +43,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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))
{
reloc.array = comp.data_relocs_ephemeral;
goto found;
}
idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil);
if (NILP (idx))
xsignal1 (Qnative_ice,
build_string ("can't find data in relocation containers"));
eassume (false);
reloc.array = comp.data_relocs_ephemeral;
nconstants = comp.n_data_relocs_ephemeral;
}
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;
}
@ -2697,6 +2713,8 @@ emit_static_object (const char *name, Lisp_Object obj)
const char *p = SSDATA (str);
# 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 (
/* Emit the printed representation of the constants as a C string. */
emit_static_object (text_symbol, constants);
*nconstants = XFIXNUM (CALLNI (hash-table-count,
CALLNI (comp-data-container-idx,
container)));
#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,
comp.lisp_obj_type,
res.len),
code_symbol));
emit_static_object (text_symbol, d_reloc);
return res;
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,7 +5396,9 @@ 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);
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)))

89
src/comp.h
View file

@ -20,44 +20,107 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef COMP_H
#define COMP_H
// clang-format off
#include <dynlib.h>
#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
struct igc_root_list;
#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;

52
src/igc.c
View file

@ -175,7 +175,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# 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

25
src/igc.h
View file

@ -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

8
src/pdumper.c
View file

@ -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;