From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sun, 2 Jun 2013 01:53:24 +0000 (-0700)
Subject: compiler: Don't let continuation-analysis add a cycle...
X-Git-Tag: release-9.2.0~175
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=78d42fabf21ab81ddf2cec96e33894bfa18b42fd;p=mit-scheme.git

compiler: Don't let continuation-analysis add a cycle...

...to the block tree, which it would do (causing a "maximum recursion
depth exceeded" abort during block->dbg-block) when compiling crazy
code like:

      (define (fubar param)
	(define (closure) param)
	(define (loop)
	  (closure)
	  (loop)
	  ;; It doesn't break without this
	  (tail-call)))
      (fubar sumpn)

This patch checks that the "Acceptable substitute" for a block's
stack-link is not inside the block.
---

diff --git a/src/compiler/fgopt/contan.scm b/src/compiler/fgopt/contan.scm
index 3d8825fe4..6ff5cec29 100644
--- a/src/compiler/fgopt/contan.scm
+++ b/src/compiler/fgopt/contan.scm
@@ -124,12 +124,14 @@ may change if call-with-current-continuation is handled specially.
 	     parent
 
 	     ;; Acceptable substitute: we're a subproblem of someone
-	     ;; who is a child of the parent.
+	     ;; who is a child of the parent (but not a subproblem of
+	     ;; ourselves!).
 	     (let ((value (lvalue-known-value lvalue)))
 	       (and value
-		    (let ((block (continuation/block value)))
-		      (and (block-ancestor? block parent)
-			   block))))))))
+		    (let ((link (continuation/block value)))
+		      (and (block-ancestor? link parent)
+			   (not (block-ancestor-or-self? link block))
+			   link))))))))
 
 (define (setup-block-static-links! blocks)
   (for-each