[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Small LAP peephole optimization
From: |
Dmitry Antipov |
Subject: |
Small LAP peephole optimization |
Date: |
Wed, 09 May 2007 14:19:09 +0400 |
User-agent: |
Thunderbird 1.5.0.7 (X11/20061008) |
Hello again,
this is a minor LAP peephole optimization intended to remove redundant
'(byte-constant 0) (byte-plus . 0)' byte code insns. As an obvious
example, for
(disassemble (byte-compile '(lambda (x y) (+ x (* 2 y)))))
it will produce
0 varref x
1 varref y
2 dup
3 plus
4 plus
5 return
instead of current
0 varref x
1 varref y
2 dup
3 plus
4 constant 0
5 plus
6 plus
7 return
During full bootstrap, this small optimization is performed for more
than 100 LAPs, thus removing ~400 byte code insns. It was also tested by
byte-force-recompile of all lisp, and hopefully it works.
There are also a few cosmetic cleanups.
Dmitry
Index: lisp/emacs-lisp/byte-opt.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/emacs-lisp/byte-opt.el,v
retrieving revision 1.94
diff -u -r1.94 byte-opt.el
--- lisp/emacs-lisp/byte-opt.el 11 Apr 2007 17:10:42 -0000 1.94
+++ lisp/emacs-lisp/byte-opt.el 9 May 2007 06:43:58 -0000
@@ -1526,6 +1526,21 @@
(setcdr lap0 0))
((error "Optimizer error: too much on the stack"))))
;;
+ ;; constant 0 plus --> <deleted>
+ ;;
+ ((and (eq (car lap0) 'byte-constant)
+ (numberp (cadr lap0))
+ (zerop (cadr lap0))
+ (eq (car lap1) 'byte-plus))
+ (let ((tmp lap) (head nil))
+ (while (not (eq lap0 (car tmp)))
+ (setq head (append head (list (car tmp)))
+ tmp (cdr tmp)))
+ (byte-compile-log-lap " %s %s\t-->\t<deleted>" lap0 lap1)
+ (setq rest (cddr rest)
+ lap (nconc head rest)
+ keep-going t)))
+ ;;
;; goto*-X X: --> X:
;;
((and (memq (car lap0) byte-goto-ops)
@@ -1537,10 +1552,9 @@
(setcar lap0 (setq tmp 'byte-discard))
(setcdr lap0 0))
((error "Depth conflict at tag %d" (nth 2 lap0))))
- (and (memq byte-optimize-log '(t byte))
- (byte-compile-log " (goto %s) %s:\t-->\t%s %s:"
- (nth 1 lap1) (nth 1 lap1)
- tmp (nth 1 lap1)))
+ (byte-compile-log-lap " (goto %s) %s:\t-->\t%s %s:"
+ (nth 1 lap1) (nth 1 lap1)
+ tmp (nth 1 lap1))
(setq keep-going t))
;;
;; varset-X varref-X --> dup varset-X
@@ -1672,8 +1686,8 @@
(while (not (eq tmp tmp2))
(setq tmp2 (cdr tmp2)
str (concat str " dup")))
- (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup"
- lap0 str lap0 lap0 str)))
+ (byte-compile-log-lap-1 " %s%s %s\t-->\t%s%s dup"
+ lap0 str lap0 lap0 str)))
(setq keep-going t)
(setcar (car tmp) 'byte-dup)
(setcdr (car tmp) 0)
@@ -1684,9 +1698,8 @@
;;
((and (eq (car lap0) 'TAG)
(eq (car lap1) 'TAG))
- (and (memq byte-optimize-log '(t byte))
- (byte-compile-log " adjacent tags %d and %d merged"
- (nth 1 lap1) (nth 1 lap0)))
+ (byte-compile-log-lap " adjacent tags %d and %d merged"
+ (nth 1 lap1) (nth 1 lap0))
(setq tmp3 lap)
(while (setq tmp2 (rassq lap0 tmp3))
(setcdr tmp2 lap1)
@@ -1698,8 +1711,7 @@
;;
((and (eq 'TAG (car lap0))
(not (rassq lap0 lap)))
- (and (memq byte-optimize-log '(t byte))
- (byte-compile-log " unused tag %d removed" (nth 1 lap0)))
+ (byte-compile-log-lap " unused tag %d removed" (nth 1 lap0))
(setq lap (delq lap0 lap)
keep-going t))
;;
- Small LAP peephole optimization,
Dmitry Antipov <=