diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index f193e9dcd..b137afacf 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -207,10 +207,12 @@
          ;; write source info for proc
          (if src (emit-code #f (make-glil-source src)))
          ;; compile the body, yo
-         (flatten body allocation x self-label (car (hashq-ref allocation x))
-                  emit-code)))))))
+         (flatten-lambda-case body allocation x self-label
+                              (car (hashq-ref allocation x))
+                              emit-code)))))))
 
-(define (flatten x allocation self self-label fix-labels emit-code)
+(define (flatten-lambda-case lcase allocation self self-label fix-labels
+                             emit-code)
   (define (emit-label label)
     (emit-code #f (make-glil-label label)))
   (define (emit-branch src inst label)
@@ -218,7 +220,7 @@
 
   ;; RA: "return address"; #f unless we're in a non-tail fix with labels
   ;; MVRA: "multiple-values return address"; #f unless we're in a let-values
-  (let comp ((x x) (context 'tail) (RA #f) (MVRA #f))
+  (let comp ((x lcase) (context 'tail) (RA #f) (MVRA #f))
     (define (comp-tail tree) (comp tree context RA MVRA))
     (define (comp-push tree) (comp tree 'push #f #f))
     (define (comp-drop tree) (comp tree 'drop #f #f))
@@ -422,41 +424,26 @@
                  (error "bad primitive op: too many pushes"
                         op (instruction-pushes op))))))
         
-        ;; self-call in tail position
+        ;; call to the same lambda-case in tail position
         ((and (lexical-ref? proc)
               self-label (eq? (lexical-ref-gensym proc) self-label)
-              (eq? context 'tail))
-         (let lp ((lcase (lambda-body self)))
-           (cond
-            ((and (lambda-case? lcase)
-                  (not (lambda-case-kw lcase))
-                  (not (lambda-case-rest lcase))
-                  (= (length args)
-                     (+ (length (lambda-case-req lcase))
-                        (or (and=> (lambda-case-opt lcase) length) 0))))
-             ;; we have a case that matches the args; evaluate new
-             ;; values, rename variables and goto the case label
-             (for-each comp-push args)
-             (for-each (lambda (sym)
-                         (pmatch (hashq-ref (hashq-ref allocation sym) self)
-                           ((#t #f . ,index) ; unboxed
-                            (emit-code #f (make-glil-lexical #t #f 'set index)))
-                           ((#t #t . ,index) ; boxed
-                            ;; new box
-                            (emit-code #f (make-glil-lexical #t #t 'box index)))
-                           (,x (error "bad lambda-case arg allocation" x))))
-                       (reverse (lambda-case-gensyms lcase)))
-             (emit-branch src 'br (car (hashq-ref allocation lcase))))
-            ((lambda-case? lcase)
-             ;; no match, try next case
-             (lp (lambda-case-alternate lcase)))
-            (else
-             ;; no cases left -- use the normal tail call mechanism. we
-             ;; can't just shuffle the args down and jump back to the
-             ;; self label, because we don't have space.
-             (comp-push proc)
-             (for-each comp-push args)
-             (emit-code src (make-glil-call 'tail-call (length args)))))))
+              (eq? context 'tail)
+              (not (lambda-case-kw lcase))
+              (not (lambda-case-rest lcase))
+              (= (length args)
+                 (+ (length (lambda-case-req lcase))
+                    (or (and=> (lambda-case-opt lcase) length) 0))))
+         (for-each comp-push args)
+         (for-each (lambda (sym)
+                     (pmatch (hashq-ref (hashq-ref allocation sym) self)
+                       ((#t #f . ,index) ; unboxed
+                        (emit-code #f (make-glil-lexical #t #f 'set index)))
+                       ((#t #t . ,index) ; boxed
+                        ;; new box
+                        (emit-code #f (make-glil-lexical #t #t 'box index)))
+                       (,x (error "bad lambda-case arg allocation" x))))
+                   (reverse (lambda-case-gensyms lcase)))
+         (emit-branch src 'br (car (hashq-ref allocation lcase))))
         
         ;; lambda, the ultimate goto
         ((and (lexical-ref? proc)
@@ -780,7 +767,8 @@
          (if alternate-label
              (begin
                (emit-label alternate-label)
-               (comp-tail alternate)))))
+               (flatten-lambda-case alternate allocation self self-label
+                                    fix-labels emit-code)))))
       
       ((<let> src names gensyms vals body)
        (for-each comp-push vals)
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 6b47086be..ee688c00a 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
 ;;;; compiler.test --- tests for the compiler      -*- scheme -*-
-;;;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -149,3 +149,18 @@
                                        ((y)   y)
                                        ((y z) (list y z)))))))
         (not (not (memv 0 (map source:addr s))))))))
+
+(with-test-prefix "case-lambda"
+  (pass-if "self recursion to different clause"
+    (equal? (with-output-to-string
+              (lambda ()
+                (let ()
+                  (define t
+                    (case-lambda
+                      ((x)
+                       (t x 'y))
+                      ((x y)
+                       (display (list x y))
+                       (list x y))))
+                  (display (t 'x)))))
+            "(x y)(x y)")))