1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

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

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