Pure storage removal: Adjust nativecomp code

* 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.

4 files changed, 12 insertions, 149 deletions

diff --git a/src/comp.c b/src/comp.c
index e43732f369e..5e8b49f7ffc 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -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),
@@ -4026,52 +3960,6 @@ static void define_SYMBOL_WITH_POS_SYM (void)
 }
 
 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.  */
diff --git a/src/comp.h b/src/comp.h
index 158ed0b46df..2a60cb38955 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -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;
diff --git a/src/lisp.h b/src/lisp.h
index 5ebbe4f9860..695d5f200ea 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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
diff --git a/src/pdumper.c b/src/pdumper.c
index 5bd0d8ca44a..40798ff48e9 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -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);