procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Pure storage removal: Adjust nativecomp code

Browse source 
* lisp/emacs-lisp/comp.el (comp-curr-allocation-class, comp-ctxt)
(comp--emit-for-top-level, comp--emit-lambda-for-top-level)
(comp--finalize-relocs): Remove 'd-impure' allocation class.
* src/comp.c (PURE_RELOC_SYM, DATA_RELOC_IMPURE_SYM)
(TEXT_DATA_RELOC_IMPURE_SYM): Remove definitions.
(comp_t): Remove 'pure_ptr', 'check_impure', 'data_relocs_impure',
'd_impure_idx'.
(helper_link_table): Remove 'pure_write_error'.
(obj_to_reloc): Adjust to removal of 'data_relocs_impure'.
(emit_PURE_P): Remove function.
(declare_imported_data, declare_runtime_imported_funcs)
(emit_ctxt_code): Adjust to removed fields.
(define_setcar_setcdr): Don't call 'CHECK_IMPURE'.
(define_CHECK_IMPURE): Remove function.
(Fcomp__compile_ctxt_to_file0, check_comp_unit_relocs, load_comp_unit)
(Fcomp__register_lambda): Adjust to removed allocation class 'd-impure'.
(syms_of_comp): Don't define 'd-impure'.
* src/comp.h (struct Lisp_Native_Comp_Unit): Drop support for allocation
class 'd-impure'.
* src/lisp.h (allocate_native_comp_unit):
* src/pdumper.c (dump_do_dump_relocation): Adjust to struct change.
This commit is contained in:
Pip Cet 2024-08-20 19:09:14 +00:00 • committed by Stefan Kangas
parent 69fea4f29a
commit bd2b59f073
5 changed files with 22 additions and 175 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
lisp/emacs-lisp/comp.el
View file

@ -155,7 +155,7 @@ native compilation runs.")
(defvar comp-curr-allocation-class 'd-default
"Current allocation class.
Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
Can be one of: `d-default' or `d-ephemeral'. See `comp-ctxt'.")
(defconst comp-passes '(comp--spill-lap
comp--limplify
@ -395,9 +395,6 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.")
:documentation "Documentation index -> documentation")
(d-default (make-comp-data-container) :type comp-data-container
:documentation "Standard data relocated in use by functions.")
(d-impure (make-comp-data-container) :type comp-data-container
:documentation "Relocated data that cannot be moved into pure space.
This is typically for top-level forms other than defun.")
(d-ephemeral (make-comp-data-container) :type comp-data-container
:documentation "Relocated data not necessary after load.")
(with-late-load nil :type boolean
@ -1615,7 +1612,7 @@ and the annotation emission."
(unless for-late-load
(comp--emit
(comp--call 'eval
(let ((comp-curr-allocation-class 'd-impure))
(let ((comp-curr-allocation-class 'd-default))
(make--comp-mvar :constant
(byte-to-native-top-level-form form)))
(make--comp-mvar :constant
@ -1625,7 +1622,7 @@ and the annotation emission."
"Emit the creation of subrs for lambda FUNC.
These are stored in the reloc data array."
(let ((args (comp--prepare-args-for-top-level func)))
(let ((comp-curr-allocation-class 'd-impure))
(let ((comp-curr-allocation-class 'd-default))
(comp--add-const-to-relocs (comp-func-byte-func func)))
(comp--emit
(comp--call 'comp--register-lambda
@ -3271,28 +3268,15 @@ Update all insn accordingly."
(let* ((d-default (comp-ctxt-d-default comp-ctxt))
(d-default-idx (comp-data-container-idx d-default))
(d-impure (comp-ctxt-d-impure comp-ctxt))
(d-impure-idx (comp-data-container-idx d-impure))
(d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt))
(d-ephemeral-idx (comp-data-container-idx d-ephemeral)))
;; We never want compiled lambdas ending up in pure space. A copy must
;; be already present in impure (see `comp--emit-lambda-for-top-level').
(cl-loop for obj being each hash-keys of d-default-idx
when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt))
do (cl-assert (gethash obj d-impure-idx))
(remhash obj d-default-idx))
;; Remove entries in d-impure already present in d-default.
(cl-loop for obj being each hash-keys of d-impure-idx
when (gethash obj d-default-idx)
do (remhash obj d-impure-idx))
;; Remove entries in d-ephemeral already present in d-default or
;; d-impure.
;; Remove entries in d-ephemeral already present in d-default
(cl-loop for obj being each hash-keys of d-ephemeral-idx
when (or (gethash obj d-default-idx) (gethash obj d-impure-idx))
when (gethash obj d-default-idx)
do (remhash obj d-ephemeral-idx))
;; Fix-up indexes in each relocation class and fill corresponding
;; reloc lists.
(mapc #'comp--finalize-container (list d-default d-impure d-ephemeral))
(mapc #'comp--finalize-container (list d-default d-ephemeral))
;; Make a vector from the function documentation hash table.
(cl-loop with h = (comp-ctxt-function-docs comp-ctxt)
with v = (make-vector (hash-table-count h) nil)
@ -3302,13 +3286,13 @@ Update all insn accordingly."
finally
do (setf (comp-ctxt-function-docs comp-ctxt) v))
;; And now we conclude with the following: We need to pass to
;; `comp--register-lambda' the index in the impure relocation
;; array to store revived lambdas, but given we know it only now
;; we fix it up as last.
;; `comp--register-lambda' the index in the relocation array to
;; store revived lambdas, but given we know it only now we fix it up
;; as last.
(cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt)
using (hash-value mvar)
with reverse-h = (make-hash-table) ;; Make sure idx is unique.
for idx = (gethash f d-impure-idx)
for idx = (gethash f d-default-idx)
do
(cl-assert (null (gethash idx reverse-h)))
(cl-assert (fixnump idx))

145
src/comp.c
View file

@ -476,16 +476,13 @@ load_gccjit_if_necessary (bool mandatory)
/* C symbols emitted for the load relocation mechanism. */
#define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
#define F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM "f_symbols_with_pos_enabled_reloc"
#define PURE_RELOC_SYM "pure_reloc"
#define DATA_RELOC_SYM "d_reloc"
#define DATA_RELOC_IMPURE_SYM "d_reloc_imp"
#define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph"
#define FUNC_LINK_TABLE_SYM "freloc_link_table"
#define LINK_TABLE_HASH_SYM "freloc_hash"
#define COMP_UNIT_SYM "comp_unit"
#define TEXT_DATA_RELOC_SYM "text_data_reloc"
#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp"
#define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph"
#define TEXT_OPTIM_QLY_SYM "text_optim_qly"
@ -619,7 +616,6 @@ typedef struct {
gcc_jit_type *thread_state_ptr_type;
gcc_jit_rvalue *current_thread_ref;
/* Other globals. */
gcc_jit_rvalue *pure_ptr;
#ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast
/* This version of libgccjit has really limited support for casting
therefore this union will be used for the scope. */
@ -651,7 +647,6 @@ typedef struct {
gcc_jit_function *setcar;
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 *. */
@ -659,8 +654,6 @@ typedef struct {
Lisp_Object emitter_dispatcher;
/* Synthesized struct holding data relocs. */
reloc_array_t data_relocs;
/* Same as before but can't go in pure space. */
reloc_array_t data_relocs_impure;
/* Same as before but content does not survive load phase. */
reloc_array_t data_relocs_ephemeral;
/* Global structure holding function relocations. */
@ -670,7 +663,6 @@ typedef struct {
gcc_jit_lvalue *func_relocs_local;
gcc_jit_function *memcpy;
Lisp_Object d_default_idx;
Lisp_Object d_impure_idx;
Lisp_Object d_ephemeral_idx;
} comp_t;
@ -708,7 +700,6 @@ helper_sanitizer_assert (Lisp_Object, Lisp_Object);
static void *helper_link_table[] =
{ wrong_type_argument,
helper_PSEUDOVECTOR_TYPEP_XUNTAG,
pure_write_error,
push_handler,
record_unwind_protect_excursion,
helper_unbind_n,
@ -939,13 +930,6 @@ obj_to_reloc (Lisp_Object obj)
goto found;
}
idx = Fgethash (obj, comp.d_impure_idx, Qnil);
if (!NILP (idx))
{
reloc.array = comp.data_relocs_impure;
goto found;
}
idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil);
if (!NILP (idx))
{
@ -1987,28 +1971,6 @@ emit_XSETCDR (gcc_jit_rvalue *c, gcc_jit_rvalue *n)
NULL),
n);
}
static gcc_jit_rvalue *
emit_PURE_P (gcc_jit_rvalue *ptr)
{
emit_comment ("PURE_P");
return
gcc_jit_context_new_comparison (
comp.ctxt,
NULL,
GCC_JIT_COMPARISON_LE,
emit_binary_op (
GCC_JIT_BINARY_OP_MINUS,
comp.uintptr_type,
ptr,
comp.pure_ptr),
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
comp.uintptr_type,
PURESIZE));
}
/*************************************/
/* Code emitted by LIMPLE statemes. */
@ -2925,10 +2887,6 @@ declare_imported_data (void)
declare_imported_data_relocs (CALL1I (comp-ctxt-d-default, Vcomp_ctxt),
DATA_RELOC_SYM,
TEXT_DATA_RELOC_SYM);
comp.data_relocs_impure =
declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt),
DATA_RELOC_IMPURE_SYM,
TEXT_DATA_RELOC_IMPURE_SYM);
comp.data_relocs_ephemeral =
declare_imported_data_relocs (CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt),
DATA_RELOC_EPHEMERAL_SYM,
@ -2962,8 +2920,6 @@ declare_runtime_imported_funcs (void)
args[1] = comp.int_type;
ADD_IMPORTED (helper_PSEUDOVECTOR_TYPEP_XUNTAG, comp.bool_type, 2, args);
ADD_IMPORTED (pure_write_error, comp.void_type, 1, NULL);
args[0] = comp.lisp_obj_type;
args[1] = comp.int_type;
ADD_IMPORTED (push_handler, comp.handler_ptr_type, 2, args);
@ -3039,15 +2995,6 @@ emit_ctxt_code (void)
comp.bool_ptr_type,
F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM));
comp.pure_ptr =
gcc_jit_lvalue_as_rvalue (
gcc_jit_context_new_global (
comp.ctxt,
NULL,
GCC_JIT_GLOBAL_EXPORTED,
comp.void_ptr_type,
PURE_RELOC_SYM));
gcc_jit_context_new_global (
comp.ctxt,
NULL,
@ -3709,19 +3656,6 @@ define_setcar_setcdr (void)
/* CHECK_CONS (cell); */
emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell));
/* CHECK_IMPURE (cell, XCONS (cell)); */
gcc_jit_rvalue *args[] =
{ gcc_jit_param_as_rvalue (cell),
emit_XCONS (gcc_jit_param_as_rvalue (cell)) };
gcc_jit_block_add_eval (entry_block,
NULL,
gcc_jit_context_new_call (comp.ctxt,
NULL,
comp.check_impure,
2,
args));
/* XSETCDR (cell, newel); */
if (!i)
emit_XSETCAR (gcc_jit_param_as_rvalue (cell),
@ -4025,52 +3959,6 @@ static void define_SYMBOL_WITH_POS_SYM (void)
comp.lisp_symbol_with_position_sym));
}
static void
define_CHECK_IMPURE (void)
{
gcc_jit_param *param[] =
{ gcc_jit_context_new_param (comp.ctxt,
NULL,
comp.lisp_obj_type,
"obj"),
gcc_jit_context_new_param (comp.ctxt,
NULL,
comp.void_ptr_type,
"ptr") };
comp.check_impure =
gcc_jit_context_new_function (comp.ctxt, NULL,
GCC_JIT_FUNCTION_INTERNAL,
comp.void_type,
"CHECK_IMPURE",
2,
param,
0);
DECL_BLOCK (entry_block, comp.check_impure);
DECL_BLOCK (err_block, comp.check_impure);
DECL_BLOCK (ok_block, comp.check_impure);
comp.block = entry_block;
comp.func = comp.check_impure;
emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */
err_block,
ok_block);
gcc_jit_block_end_with_void_return (ok_block, NULL);
gcc_jit_rvalue *pure_write_error_arg =
gcc_jit_param_as_rvalue (param[0]);
comp.block = err_block;
gcc_jit_block_add_eval (comp.block,
NULL,
emit_call (intern_c_string ("pure_write_error"),
comp.void_type, 1,&pure_write_error_arg,
false));
gcc_jit_block_end_with_void_return (err_block, NULL);
}
static void
define_maybe_gc_or_quit (void)
{
@ -4948,8 +4836,6 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0,
comp.d_default_idx =
CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt));
comp.d_impure_idx =
CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-impure, Vcomp_ctxt));
comp.d_ephemeral_idx =
CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt));
@ -5281,17 +5167,12 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u)
{
dynlib_handle_ptr handle = comp_u->handle;
Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
for (ptrdiff_t i = 0; i < d_vec_len; i++)
if (!EQ (data_relocs[i], AREF (comp_u->data_vec, i)))
return false;
d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
for (ptrdiff_t i = 0; i < d_vec_len; i++)
{
Lisp_Object x = data_imp_relocs[i];
Lisp_Object x = data_relocs[i];
if (EQ (x, Qlambda_fixup))
return false;
else if (NATIVE_COMP_FUNCTIONP (x))
@ -5299,7 +5180,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u)
if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil)))
return false;
}
else if (!EQ (x, AREF (comp_u->data_impure_vec, i)))
else if (!EQ (x, AREF (comp_u->data_vec, i)))
return false;
}
return true;
@ -5363,7 +5244,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
/* Always set data_imp_relocs pointer in the compilation unit (in can be
used in 'dump_do_dump_relocation'). */
comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
comp_u->data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
if (!comp_u->loaded_once)
{
@ -5371,16 +5252,12 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM);
bool **f_symbols_with_pos_enabled_reloc =
dynlib_sym (handle, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM);
void **pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM);
Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs;
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
&& pure_reloc
&& data_relocs
&& data_imp_relocs
&& data_eph_relocs
&& freloc_link_table
&& top_level_run)
@ -5390,7 +5267,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
*current_thread_reloc = &current_thread;
*f_symbols_with_pos_enabled_reloc = &symbols_with_pos_enabled;
*pure_reloc = pure;
/* Imported functions. */
*freloc_link_table = freloc.link_table;
@ -5401,21 +5277,11 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
comp_u->optimize_qualities =
load_static_obj (comp_u, TEXT_OPTIM_QLY_SYM);
comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
comp_u->data_impure_vec =
load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM);
if (!NILP (Vpurify_flag))
/* Non impure can be copied into pure space. */
comp_u->data_vec = Fpurecopy (comp_u->data_vec);
}
EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
for (EMACS_INT i = 0; i < d_vec_len; i++)
data_relocs[i] = AREF (comp_u->data_vec, i);
d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
for (EMACS_INT i = 0; i < d_vec_len; i++)
data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
}
if (!loading_dump)
@ -5567,7 +5433,7 @@ 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. */
cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem;
cu->data_relocs[XFIXNUM (reloc_idx)] = tem;
return tem;
}
@ -5749,7 +5615,6 @@ natively-compiled one. */);
/* Allocation classes. */
DEFSYM (Qd_default, "d-default");
DEFSYM (Qd_impure, "d-impure");
DEFSYM (Qd_ephemeral, "d-ephemeral");
/* Others. */

10
src/comp.h
View file

@ -35,17 +35,15 @@ struct Lisp_Native_Comp_Unit
/* Guard anonymous lambdas against Garbage Collection and serve
sanity checks. */
Lisp_Object lambda_gc_guard_h;
/* Hash c_name -> d_reloc_imp index. */
/* 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. */
/* Analogous to the constant vector but per compilation unit. Must be
last. */
Lisp_Object data_vec;
/* 'data_impure_vec' must be last (see allocate_native_comp_unit).
Same as data_vec but for data that cannot be moved to pure space. */
Lisp_Object data_impure_vec;
/* STUFFS WE DO NOT DUMP!! */
Lisp_Object *data_imp_relocs;
Lisp_Object *data_relocs;
bool loaded_once;
bool load_ongoing;
dynlib_handle_ptr handle;

2
src/lisp.h
View file

@ -5498,7 +5498,7 @@ INLINE struct Lisp_Native_Comp_Unit *
allocate_native_comp_unit (void)
{
return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit,
data_impure_vec, PVEC_NATIVE_COMP_UNIT);
data_vec, PVEC_NATIVE_COMP_UNIT);
}
#else
INLINE bool

4
src/pdumper.c
View file

@ -5498,12 +5498,12 @@ dump_do_dump_relocation (const uintptr_t dump_base,
if (!NILP (lambda_data_idx))
{
/* This is an anonymous lambda.
We must fixup d_reloc_imp so the lambda can be referenced
We must fixup d_reloc so the lambda can be referenced
by code. */
Lisp_Object tem;
XSETSUBR (tem, subr);
Lisp_Object *fixup =
&(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]);
&(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]);
eassert (EQ (*fixup, Qlambda_fixup));
*fixup = tem;
Fputhash (tem, Qt, comp_u->lambda_gc_guard_h);