summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2021-01-20 13:59:58 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2021-01-20 14:13:15 -0500
commit4dfebf25c743d4ba4506919b58591f74debfb334 (patch)
treef3361f7de3eb683e9cd0079c5a47a75d8a722ecf /lisp/emacs-lisp
parent09bfb12edc57ace138090861e335366d8f1cc4b2 (diff)
downloademacs-4dfebf25c743d4ba4506919b58591f74debfb334.tar.gz
* lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Move some opts.
This moves two optimizations from the final pass to the main loop. Both may enable further optimizations (and the second can be applied repeatedly but "from the end", so the loop in the final pass only gets to apply it once).
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/byte-opt.el99
1 files changed, 50 insertions, 49 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 6d1f4179ce1..620bd91b646 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -2021,6 +2021,56 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
byte-goto byte-goto))))
)
(setq keep-going t))
+
+ ;;
+ ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
+ ;; stack-set-M [discard/discardN ...] --> discardN
+ ;;
+ ((and (eq (car lap0) 'byte-stack-set)
+ (memq (car lap1) '(byte-discard byte-discardN))
+ (progn
+ ;; See if enough discard operations follow to expose or
+ ;; destroy the value stored by the stack-set.
+ (setq tmp (cdr rest))
+ (setq tmp2 (1- (cdr lap0)))
+ (setq tmp3 0)
+ (while (memq (car (car tmp)) '(byte-discard byte-discardN))
+ (setq tmp3
+ (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
+ 1
+ (cdr (car tmp)))))
+ (setq tmp (cdr tmp)))
+ (>= tmp3 tmp2)))
+ ;; Do the optimization.
+ (setq lap (delq lap0 lap))
+ (setcar lap1
+ (if (= tmp2 tmp3)
+ ;; The value stored is the new TOS, so pop one more
+ ;; value (to get rid of the old value) using the
+ ;; TOS-preserving discard operator.
+ 'byte-discardN-preserve-tos
+ ;; Otherwise, the value stored is lost, so just use a
+ ;; normal discard.
+ 'byte-discardN))
+ (setcdr lap1 (1+ tmp3))
+ (setcdr (cdr rest) tmp)
+ (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s"
+ lap0 lap1))
+ ;;
+ ;; discardN-preserve-tos return --> return
+ ;; dup return --> return
+ ;; stack-set-N return --> return ; where N is TOS-1
+ ;;
+ ((and (eq (car lap1) 'byte-return)
+ (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
+ (and (eq (car lap0) 'byte-stack-set)
+ (= (cdr lap0) 1))))
+ (setq keep-going t)
+ ;; The byte-code interpreter will pop the stack for us, so
+ ;; we can just leave stuff on it.
+ (setq lap (delq lap0 lap))
+ (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1))
+
)
(setq rest (cdr rest)))
)
@@ -2085,41 +2135,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(setcdr lap1 (+ (cdr lap1) (cdr lap0))))
;;
- ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
- ;; stack-set-M [discard/discardN ...] --> discardN
- ;;
- ((and (eq (car lap0) 'byte-stack-set)
- (memq (car lap1) '(byte-discard byte-discardN))
- (progn
- ;; See if enough discard operations follow to expose or
- ;; destroy the value stored by the stack-set.
- (setq tmp (cdr rest))
- (setq tmp2 (1- (cdr lap0)))
- (setq tmp3 0)
- (while (memq (car (car tmp)) '(byte-discard byte-discardN))
- (setq tmp3
- (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
- 1
- (cdr (car tmp)))))
- (setq tmp (cdr tmp)))
- (>= tmp3 tmp2)))
- ;; Do the optimization.
- (setq lap (delq lap0 lap))
- (setcar lap1
- (if (= tmp2 tmp3)
- ;; The value stored is the new TOS, so pop one more
- ;; value (to get rid of the old value) using the
- ;; TOS-preserving discard operator.
- 'byte-discardN-preserve-tos
- ;; Otherwise, the value stored is lost, so just use a
- ;; normal discard.
- 'byte-discardN))
- (setcdr lap1 (1+ tmp3))
- (setcdr (cdr rest) tmp)
- (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s"
- lap0 lap1))
-
- ;;
;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y -->
;; discardN-(X+Y)
;;
@@ -2146,20 +2161,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(setq lap (delq lap0 lap))
(setcdr lap1 (+ (cdr lap0) (cdr lap1)))
(byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (car rest)))
-
- ;;
- ;; discardN-preserve-tos return --> return
- ;; dup return --> return
- ;; stack-set-N return --> return ; where N is TOS-1
- ;;
- ((and (eq (car lap1) 'byte-return)
- (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
- (and (eq (car lap0) 'byte-stack-set)
- (= (cdr lap0) 1))))
- ;; The byte-code interpreter will pop the stack for us, so
- ;; we can just leave stuff on it.
- (setq lap (delq lap0 lap))
- (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1))
)
(setq rest (cdr rest)))
(setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))