Be more careful when `sblock-continuation' is known. If the

continuation has already been generated, we were previously generating
a jump to the continuation at this point.  This jump was dead code
because nobody referenced it.

diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm
index 12db4faaed4c8084a12d8782fb1af17ad93aebce..6ce15416301f19c1f18393cc07bc1c6ab202480f 100644 (file)
--- a/v7/src/compiler/back/linear.scm
+++ b/v7/src/compiler/back/linear.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.5 1988/09/15 08:39:07 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.6 1988/11/02 21:49:33 cph Exp $
 
 Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
@@ -48,9 +48,13 @@ MIT in each case. |#
           (lambda ()
             (LAP ,@(bblock-instructions bblock)
                  ,@(if (sblock? bblock)
-                       (linearize-sblock-next
-                        (or (snode-next bblock)
-                            (sblock-continuation bblock)))
+                       (let ((next (snode-next bblock)))
+                         (if next
+                             (linearize-sblock-next next (bblock-label next))
+                             (let ((bblock (sblock-continuation bblock)))
+                               (if (and bblock (not (node-marked? bblock)))
+                                   (linearize-bblock bblock)
+                                   (LAP)))))
                        (linearize-pblock bblock
                                          (pnode-consequent bblock)
                                          (pnode-alternative bblock)))))))
@@ -58,13 +62,10 @@ MIT in each case. |#
          (LAP ,(lap:make-label-statement (bblock-label bblock)) ,@(kernel))
          (kernel))))
 
-  (define (linearize-sblock-next bblock)
-    (cond ((not bblock)
-          (LAP))
-         ((node-marked? bblock)
-          (LAP ,(lap:make-unconditional-branch (bblock-label bblock))))
-         (else
-          (linearize-bblock bblock))))
+  (define (linearize-sblock-next bblock label)
+    (if (node-marked? bblock)
+       (LAP ,(lap:make-unconditional-branch label))
+       (linearize-bblock bblock)))
 
   (define (linearize-pblock pblock cn an)
     (if (node-marked? cn)

diff --git a/v7/src/compiler/rtlbase/rtline.scm b/v7/src/compiler/rtlbase/rtline.scm
index 0eb474acf9841af27d57e0c787c1a2b2d2e6928a..2b624ecc68d43da1c74b5120cc2e7617581f3d3a 100644 (file)
--- a/v7/src/compiler/rtlbase/rtline.scm
+++ b/v7/src/compiler/rtlbase/rtline.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtline.scm,v 4.6 1988/09/15 08:41:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtline.scm,v 4.7 1988/11/02 21:48:58 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -132,9 +132,14 @@ MIT in each case. |#
                            (loop (rinst-next rinst))))
                     ((sblock? bblock)
                      (cons (rinst-rtl rinst)
-                           (linearize-sblock-next
-                            (or (snode-next bblock)
-                                (sblock-continuation bblock)))))
+                           (let ((next (snode-next bblock)))
+                             (if next
+                                 (linearize-sblock-next next)
+                                 (let ((bblock (sblock-continuation bblock)))
+                                   (if (and bblock
+                                            (not (node-marked? bblock)))
+                                       (linearize-bblock bblock)
+                                       '()))))))
                     (else
                      (linearize-pblock bblock
                                        (rinst-rtl rinst)
@@ -144,13 +149,10 @@ MIT in each case. |#
          `(,(rtl:make-label-statement (bblock-label bblock)) ,@(kernel))
          (kernel))))
 
-  (define (linearize-sblock-next sblock)
-    (cond ((not sblock)
-          '())
-         ((node-marked? sblock)
-          `(,(rtl:make-jump-statement (bblock-label sblock))))
-         (else
-          (linearize-bblock sblock))))
+  (define (linearize-sblock-next bblock)
+    (if (node-marked? bblock)
+       `(,(rtl:make-jump-statement (bblock-label bblock)))
+       (linearize-bblock bblock)))
 
   (define (linearize-pblock pblock predicate cn an)
     pblock