diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 8c5ae9495..d097331ed 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -247,6 +247,19 @@ references to the new symbols."
            counter
            (find-counter data (counter-prev counter)))))
 
+(define* (transfer! from to #:optional
+                    (effort (variable-ref (effort-counter from)))
+                    (size (variable-ref (size-counter from))))
+  (define (transfer-counter! from-v to-v amount)
+    (let* ((from-balance (variable-ref from-v))
+           (to-balance (variable-ref to-v))
+           (amount (min amount from-balance)))
+      (variable-set! from-v (- from-balance amount))
+      (variable-set! to-v (+ to-balance amount))))
+
+  (transfer-counter! (effort-counter from) (effort-counter to) effort)
+  (transfer-counter! (size-counter from) (size-counter to) size))
+
 (define (make-top-counter effort-limit size-limit continuation data)
   (%make-counter (make-variable effort-limit)
                  (make-variable size-limit)
@@ -256,20 +269,24 @@ references to the new symbols."
                  #f))
 
 (define (make-nested-counter continuation data current)
-  (%make-counter (effort-counter current)
-                 (size-counter current)
-                 continuation
-                 #f
-                 data
-                 current))
+  (let ((c (%make-counter (make-variable 0)
+                          (make-variable 0)
+                          continuation
+                          #f
+                          data
+                          current)))
+    (transfer! current c)
+    c))
 
 (define (make-recursive-counter effort-limit size-limit orig current)
-  (%make-counter (make-variable effort-limit)
-                 (make-variable size-limit)
-                 (counter-continuation orig)
-                 #t
-                 (counter-data orig)
-                 current))
+  (let ((c (%make-counter (make-variable 0)
+                          (make-variable 0)
+                          (counter-continuation orig)
+                          #t
+                          (counter-data orig)
+                          current)))
+    (transfer! current c effort-limit size-limit)
+    c))
 
 (define* (peval exp #:optional (cenv (current-module)) (env vlist-null)
                 #:key
@@ -837,29 +854,43 @@ it does not handle <fix> and <let-values>, it should be called before
                     ;; integration of a procedure that hasn't been seen
                     ;; yet.
                     (let/ec k
-                      (let ((abort (lambda ()
-                                     (k (make-application
-                                         src
-                                         (for-value orig-proc)
-                                         (map for-value orig-args))))))
+                      (define (abort)
+                        (k (make-application src
+                                             (for-value orig-proc)
+                                             (map for-value orig-args))))
+                      (define new-counter
+                        (cond
+                         ;; These first two cases will transfer effort
+                         ;; from the current counter into the new
+                         ;; counter.
+                         ((find-counter key counter)
+                          => (lambda (prev)
+                               (make-recursive-counter recursive-effort-limit
+                                                       operand-size-limit
+                                                       prev counter)))
+                         (counter
+                          (make-nested-counter abort key counter))
+                         ;; This case opens a new account, effectively
+                         ;; printing money.  It should only do so once
+                         ;; for each call site in the source program.
+                         (else
+                          (make-top-counter effort-limit operand-size-limit
+                                            abort key))))
+                      (define result
                         (loop (make-let src (append req (or opt '()))
                                         gensyms
                                         (append orig-args
                                                 (drop inits (- nargs nreq)))
                                         body)
-                          env
-                          (cond
-                           ((find-counter key counter)
-                            => (lambda (prev)
-                                 (make-recursive-counter recursive-effort-limit
-                                                         operand-size-limit
-                                                         prev counter)))
-                           (counter
-                            (make-nested-counter abort key counter))
-                           (else
-                            (make-top-counter effort-limit operand-size-limit
-                                              abort key)))
-                          ctx)))))))
+                          env new-counter ctx))
+                      
+                      (if counter
+                          ;; The nested inlining attempt succeeded.
+                          ;; Deposit the unspent effort and size back
+                          ;; into the current counter.
+                          (transfer! new-counter counter))
+
+                      result)))))
                ((or ($ <primitive-ref>)
                     ($ <lambda>)
                     ($ <toplevel-ref>)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 4c5b6d685..290a48377 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -793,12 +793,14 @@
   (pass-if-peval
    ;; Infinite recursion
    ((lambda (x) (x x)) (lambda (x) (x x)))
-   (let (x) (_)
-        ((lambda _
+   (apply (lambda _
            (lambda-case
             (((x) _ _ _ _ _)
-             (apply (lexical x _) (lexical x _))))))
-        (apply (lexical x _) (lexical x _))))
+             (apply (lexical x _) (lexical x _)))))
+          (lambda _
+           (lambda-case
+            (((x) _ _ _ _ _)
+             (apply (lexical x _) (lexical x _)))))))
 
   (pass-if-peval
     ;; First order, aliased primitive.