more byte-code optimizations

[Paul Pogonyshev]

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)