more byte-code optimizations

[Paul Pogonyshev <pogonyshev@gmx.net>]

This patch reduces the number of duplicate command sequences
in generated byte-code.

For instance, for function

	(lambda (x)
	  (if x
	      (foo)
	    (bar))
	  x)

current byte-compiler generates

0	varref	  x
1	goto-if-nil 1
4	constant  foo
5	call	  0
6	discard	  
7	goto	  2
10:1	constant  bar
11	call	  0
12	discard	  
13:2	varref	  x
14	return	  

After the patch, two commands are squeezed out:

0	varref	  x
1	goto-if-nil 1
4	constant  foo
5	goto	  2
8:1	constant  bar
9:2	call	  0
10	discard	  
11	varref	  x
12	return	  

This patch looks much less controversial and safer than
the one about binding elimination.

However, this optimization is size-only, commands executed
in all code branches remain the same, only some `goto's
are executed earlier.

Here is some statistic for a few long functions (length
is measured in lapcode commands):

byte-optimize-form-code-walker	 641 --> 619	-3.4%
c-forward-<>-arglist-recur	 484 --> 469	-3.1%
c-guess-basic-syntax		3334 --> 3272	-1.9%
c-guess-fill-prefix		 691 --> 679	-1.7%
edebug-display			 424 --> 408	-3.8%
Info-fontify-node		1039 --> 1025	-1.3%

Paul



--- byte-opt.el	22 Mar 2004 13:21:08 -0200	1.75
+++ byte-opt.el	19 Sep 2004 17:40:02 -0200	
@@ -2005,6 +2005,68 @@ If FOR-EFFECT is non-nil, the return val
 	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
 	    )
       (setq rest (cdr rest)))
+
+    ;; Optimize certain duplicated sequences:
+    ;;   command-N ... command-1 goto-X   ...   command-N ... command-1 X:
+    ;;     -->  goto-Y   ...   Y: command-N ... command-1 X:
+    ;;
+    ;; Commands before the X tag can be spiced with other tags, but
+    ;; commands before goto-X cannot be.
+    ;;
+    (let* ((double-linked (cons (car lap) (cons nil nil)))
+	   (link	  double-linked))
+      ;; Build double-linked list.  The structure of each list link is
+      ;; like this: (value . (previous . next))
+      (while (setq lap (cdr lap))
+	(setq link (setcdr (cdr link) (cons (car lap) (cons link nil)))))
+      ;;
+      ;; Search for duplicated sequences.
+      (setq link double-linked)
+      (while link
+	(when (eq (caar link) 'byte-goto)
+	  ;; This is somewhat hackish, but `memq' will work on
+	  ;; double-linked list as well (searching forward).
+	  (let ((pre-goto link)
+		(pre-tag  (memq (cdar link) double-linked)))
+	    (while (and (setq pre-goto (cadr pre-goto))
+			(progn   ;; Skip tags (they don't hurt).
+			  (while (eq (caar (setq pre-tag (cadr pre-tag)))
+				     'TAG))
+			  pre-tag)
+			(eq (caar pre-goto) (caar pre-tag))
+			(eq (cdar pre-goto) (cdar pre-tag))))
+	    (when (not (eq pre-goto (cadr link)))
+	      ;; At least one command is duplicated.
+	      ;;
+	      ;; First, change the goto tag (insert new if needed).
+	      (setq pre-tag (if pre-tag (cddr pre-tag) double-linked))
+	      (if (eq (caar pre-tag) 'TAG)
+		  ;; We don't need a new tag as there's already one.
+		  (setcdr (car link) (car pre-tag))
+		;; Else insert a new tag into the double-linked list.
+		(let ((new-tag (cons (byte-compile-make-tag)
+				 (cons (cadr pre-tag) pre-tag))))
+		  (setcar (cdr pre-tag) new-tag)
+		  (if (cadr new-tag)
+		      (setcdr (cdr (cadr new-tag)) new-tag)
+		    (setq double-linked new-tag))
+		  (setcdr (car link) (car new-tag))))
+	      ;; Now, remove the duplicated commands before goto.
+	      (setcar (cdr link) pre-goto)
+	      (if pre-goto
+		  (setcdr (cdr pre-goto) link)
+		(setq double-linked link))
+	      (byte-compile-log-lap
+	       "  [command ...] goto-X   ...   [command ...] X:
+    --> goto-Y    ...   Y: [command ...] X:"))))
+	(setq link (cddr link)))
+      ;;
+      ;; Reconstruct normal list from double-linked list.
+      (while double-linked
+	(setq lap	    (cons (car double-linked) lap)
+	      double-linked (cddr double-linked)))
+      (setq lap (nreverse lap)))
+
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)