bug#59021: Unbounded heap growth when combining dynamic states & delimited continuation

Ludovic Courtès <[email protected]> skribis:

> Consider this code:
>
> ;; https://issues.guix.gnu.org/58631
> ;; https://github.com/wingo/fibers/issues/65
>
> (define loss
>   (make-vector 1000000))
>
> (let ((tag (make-prompt-tag "my prompt")))
>   (define handler
>     (lambda (k i)
>       (when (zero? (modulo i 2000000))
>         (pk 'heap-size (assoc-ref (gc-stats) 'heap-size)))
>
>       (call-with-prompt tag
>         (lambda ()
>           (k (modulo (+ 1 i) 10000000)))
>         handler)))
>
>   (call-with-prompt tag
>     (let ((state (current-dynamic-state)))
>       (lambda ()
>         ;; (define (with-dynamic-state state thunk)
>         ;;   (let ((previous #f))
>         ;;     (dynamic-wind
>         ;;       (lambda () (set! previous (set-current-dynamic-state state)))
>         ;;       thunk
>         ;;       (lambda () (set-current-dynamic-state previous)))))
>         (with-dynamic-state state
>                             (lambda ()
>                               (let loop ((i 0))
>                                 (loop (abort-to-prompt tag i)))))))
>     handler))
>
> On Guile 3.0.8, this program exhibits seemingly unbounded heap growth.

This is fixed by the patch below (tested against the test case above and
the Fibers and Shepherd test cases mentioned before):


Using a simple heap profiler (more on that later), I noticed that the
stacks allocated at ‘p->stack_bottom’ would be partly retained,
explaining the heap growth.

I couldn’t pinpoint what exactly is keeping a pointer to the stack, but
what I can tell is that the trick above makes that impossible (because
we disable interior pointer tracing), hence the difference.

Also, why changing the SCM_DYNSTACK_TYPE_DYNAMIC_STATE entry to an
SCM_DYNSTACK_TYPE_UNWINDER entry would make a difference remains a
mystery to me.

I’m interested in theories that would explain all this in more detail!
I’ll go ahead with the fix above if there are no objections.

It’s not fully satisfying but still it’s a relief.

Ludo’.

diff --git a/libguile/vm.c b/libguile/vm.c
index 6fd5c554f..516bae773 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -165,11 +165,13 @@ capture_stack (union scm_vm_stack_element *stack_top,
                scm_t_dynstack *dynstack, uint32_t flags)
 {
   struct scm_vm_cont *p;
+  size_t stack_size;
 
-  p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
-  p->stack_size = stack_top - sp;
-  p->stack_bottom = scm_gc_malloc (p->stack_size * sizeof (*p->stack_bottom),
-                                   "capture_vm_cont");
+  stack_size = stack_top - sp;
+  p = scm_gc_malloc (sizeof (*p) + stack_size * sizeof (*p->stack_bottom),
+                     "capture_vm_cont");
+  p->stack_size = stack_size;
+  p->stack_bottom = (void *) ((char *) p + sizeof (*p));
   p->vra = vra;
   p->mra = mra;
   p->fp_offset = stack_top - fp;