diff options
Diffstat (limited to 'lisp/emacs-lisp/comp.el')
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 46 |
1 files changed, 20 insertions, 26 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a363bed3642..74b0b1197be 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1831,9 +1831,7 @@ and the annotation emission." (byte-listp auto) (byte-eq auto) (byte-memq auto) - (byte-not - (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) - (make-comp-mvar :constant nil)))) + (byte-not null) (byte-car auto) (byte-cdr auto) (byte-cons auto) @@ -3088,13 +3086,6 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or (`(setimm ,lval ,v) (setf (comp-cstr-imm lval) v)))))) -(defun comp-mvar-propagate (lval rval) - "Propagate into LVAL properties of RVAL." - (setf (comp-mvar-typeset lval) (comp-mvar-typeset rval) - (comp-mvar-valset lval) (comp-mvar-valset rval) - (comp-mvar-range lval) (comp-mvar-range rval) - (comp-mvar-neg lval) (comp-mvar-neg rval))) - (defun comp-function-foldable-p (f args) "Given function F called with ARGS, return non-nil when optimizable." (and (comp-function-pure-p f) @@ -3144,10 +3135,7 @@ Fold the call in case." (when (comp-cstr-empty-p cstr) ;; Store it to be rewritten as non local exit. (setf (comp-block-lap-non-ret-insn comp-block) insn)) - (setf (comp-mvar-range lval) (comp-cstr-range cstr) - (comp-mvar-valset lval) (comp-cstr-valset cstr) - (comp-mvar-typeset lval) (comp-cstr-typeset cstr) - (comp-mvar-neg lval) (comp-cstr-neg cstr)))) + (comp-cstr-shallow-copy lval cstr))) (cl-case f (+ (comp-cstr-add lval args)) (- (comp-cstr-sub lval args)) @@ -3165,9 +3153,9 @@ Fold the call in case." (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) (comp-fwprop-call insn lval f args))) (_ - (comp-mvar-propagate lval rval)))) + (comp-cstr-shallow-copy lval rval)))) (`(assume ,lval ,(and (pred comp-mvar-p) rval)) - (comp-mvar-propagate lval rval)) + (comp-cstr-shallow-copy lval rval)) (`(assume ,lval (,kind . ,operands)) (cl-case kind (and @@ -3580,7 +3568,7 @@ Update all insn accordingly." ;; Symbols imported by C inlined functions. We do this here because ;; is better to add all objs to the relocation containers before we ;; compacting them. - (mapc #'comp-add-const-to-relocs '(nil t consp listp)) + (mapc #'comp-add-const-to-relocs '(nil t consp listp symbol-with-pos-p)) (let* ((d-default (comp-ctxt-d-default comp-ctxt)) (d-default-idx (comp-data-container-idx d-default)) @@ -4016,9 +4004,12 @@ the deferred compilation mechanism." (signal 'native-compiler-error (list "Not a function symbol or file" function-or-file))) (catch 'no-native-compile - (let* ((data function-or-file) + (let* ((print-symbols-bare t) + (max-specpdl-size (max max-specpdl-size 5000)) + (data function-or-file) (comp-native-compiling t) (byte-native-qualities nil) + (symbols-with-pos-enabled t) ;; Have byte compiler signal an error when compilation fails. (byte-compile-debug t) (comp-ctxt (make-comp-ctxt :output output @@ -4062,10 +4053,10 @@ the deferred compilation mechanism." (signal (car err) (if (consp err-val) (cons function-or-file err-val) (list function-or-file err-val))))))) - (if (stringp function-or-file) - data - ;; So we return the compiled function. - (native-elisp-load data))))) + (if (stringp function-or-file) + data + ;; So we return the compiled function. + (native-elisp-load data))))) (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. @@ -4222,11 +4213,14 @@ variable 'NATIVE_DISABLED' is set, only byte compile." (batch-byte-compile) (cl-assert (length= command-line-args-left 1)) (let ((byte+native-compile t) - (byte-to-native-output-file nil)) + (byte-to-native-output-buffer-file nil)) (batch-native-compile) - (pcase byte-to-native-output-file - (`(,tempfile . ,target-file) - (rename-file tempfile target-file t)))))) + (pcase byte-to-native-output-buffer-file + (`(,temp-buffer . ,target-file) + (unwind-protect + (byte-write-target-file temp-buffer target-file)) + (kill-buffer temp-buffer))) + (setq command-line-args-left (cdr command-line-args-left))))) ;;;###autoload (defun native-compile-async (files &optional recursively load selector) |