From 3a7aa06d1575750a498c453bec321a69c2b3bb48 Mon Sep 17 00:00:00 2001 From: AndreaCorallo Date: Fri, 21 Feb 2020 14:28:05 +0000 Subject: [PATCH] Emit 'top_level_run' objects as impure --- lisp/emacs-lisp/comp.el | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index eabba243c2e..edbc98f190b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -99,6 +99,8 @@ Can be used by code that wants to expand differently in this case.") (defvar comp-pass nil "Every pass has the right to bind what it likes here.") +(defvar comp-emitting-impure nil "Non nil to emit only impure objects.") + (defconst comp-passes '(comp-spill-lap comp-limplify comp-ssa @@ -336,14 +338,13 @@ The corresponding index is returned." (push obj (comp-data-container-l cont)) (puthash obj (hash-table-count h) h)))) -(defun comp-add-const-to-relocs (obj &optional impure) +(defun comp-add-const-to-relocs (obj) "Keep track of OBJ into the ctxt relocations. -When IMPURE is non nil OBJ cannot be copied into pure space. The corresponding index is returned." (comp-add-const-to-relocs-to-cont obj - (if impure + (if comp-emitting-impure (comp-ctxt-d-impure comp-ctxt) - (comp-ctxt-d-base comp-ctxt)))) + (comp-ctxt-d-base comp-ctxt)))) (defmacro comp-within-log-buff (&rest body) "Execute BODY while at the end the log-buffer. @@ -526,7 +527,7 @@ Points to the next slot to be filled.") (label-to-addr nil :type hash-table :documentation "LAP hash table -> address.") (pending-blocks () :type list - :documentation "List of blocks waiting for limplification.")) + :documentation "List of blocks waiting for limplification.")) (defconst comp-lap-eob-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop @@ -613,12 +614,11 @@ STACK-OFF is the index of the first slot frame involved." for sp from stack-off collect (comp-slot-n sp)))) -(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type - impure) +(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type) (when const-vld - (comp-add-const-to-relocs constant impure)) + (comp-add-const-to-relocs constant)) (make--comp-mvar :slot slot :const-vld const-vld :constant constant - :type type :impure impure)) + :type type :impure comp-emitting-impure)) (defun comp-new-frame (size &optional ssa) "Return a clean frame of meta variables of size SIZE. @@ -1129,7 +1129,8 @@ the annotation emission." (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level)) (let ((form (byte-to-native-top-level-form form))) (comp-emit (comp-call 'eval - (make-comp-mvar :constant form :impure t) + (let ((comp-emitting-impure t)) + (make-comp-mvar :constant form)) (make-comp-mvar :constant t))))) (defun comp-limplify-top-level () @@ -1140,7 +1141,11 @@ Synthesize a function called 'top_level_run' that gets one single parameter (the compilation unit it-self). To define native functions 'top_level_run' will call back `comp--register-subr' into the C code forwarding the compilation unit." - (let* ((func (make-comp-func :name 'top-level-run + ;; Once an .eln is loaded and Emacs is dumped 'top_level_run' has no + ;; reasons to be execute ever again. Therefore all objects can be + ;; just impure. + (let* ((comp-emitting-impure t) + (func (make-comp-func :name 'top-level-run :c-name "top_level_run" :args (make-comp-args :min 1 :max 1) :frame-size 1)) -- 2.39.5