Return unused parts of the stack to the OS

* libguile/vm.h (struct scm_vm): Reorder fields.  Add "sp_max_since_gc"
  field.
* libguile/vm-engine.c (ALLOC_FRAME, RESET_FRAME):
* libguile/vm.c (vm_return_to_continuation)
  (vm_reinstate_partial_continuation, scm_call_n): In places where we
  could increase the stack height, update sp_max_since_gc.
  (vm_expand_stack): Relocate sp_max_since_gc on expansion.
  (scm_bootstrap_vm): Record the page size using gnulib's getpagesize.
  (return_unused_stack_to_os): New routine, run when marking stacks.

libguile/vm-engine.c

@@ -196,6 +196,8 @@
   do {                                                              \
     vp->sp = LOCAL_ADDRESS (n - 1);                                 \
     CHECK_OVERFLOW ();                                              \
+    if (vp->sp > vp->sp_max_since_gc)                               \
+      vp->sp_max_since_gc = vp->sp;                                 \
   } while (0)
 
 /* Reset the current frame to hold N locals.  Used when we know that no
@@ -203,6 +205,8 @@
 #define RESET_FRAME(n)                                              \
   do {                                                              \
     vp->sp = LOCAL_ADDRESS (n - 1);                                 \
+    if (vp->sp > vp->sp_max_since_gc)                               \
+      vp->sp_max_since_gc = vp->sp;                                 \
   } while (0)
 
 /* Compute the number of locals in the frame.  At a call, this is equal

libguile/vm.c

@@ -28,6 +28,7 @@
 #include <alignof.h>
 #include <string.h>
 #include <stdint.h>
+#include <unistd.h>
 
 #ifdef HAVE_SYS_MMAN_H
 #include <sys/mman.h>
@@ -142,6 +143,8 @@ vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n, SCM *argv)
         vp->sp++;
         *vp->sp = argv_copy[i];
       }
+    if (vp->sp > vp->sp_max_since_gc)
+      vp->sp_max_since_gc = vp->sp;
     vp->ip = cp->ra;
   }
 }
@@ -288,6 +291,8 @@ vm_abort (struct scm_vm *vp, SCM tag,
   scm_c_abort (vp, tag, nstack + tail_len, argv, current_registers);
 }
 
+static void vm_expand_stack (struct scm_vm *vp) SCM_NOINLINE;
+
 static void
 vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont,
                                    size_t n, SCM *argv,
@@ -303,17 +308,25 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont,
   memcpy (argv_copy, argv, n * sizeof(SCM));
 
   cp = SCM_VM_CONT_DATA (cont);
+
+  while (1)
+    {
+      scm_t_ptrdiff saved_stack_height = vp->sp - vp->stack_base;
+
       base = SCM_FRAME_LOCALS_ADDRESS (vp->fp);
       reloc = cp->reloc + (base - cp->stack_base);
 
+      vp->sp = base + cp->stack_size + n + 1;
+      if (vp->sp < vp->stack_limit)
+        break;
+
+      vm_expand_stack (vp);
+      vp->sp = vp->stack_base + saved_stack_height;
+    }
+
 #define RELOC(scm_p)						\
   (((SCM *) (scm_p)) + reloc)
 
-  if ((base - vp->stack_base) + cp->stack_size + n + 1 > vp->stack_size)
-    scm_misc_error ("vm-engine",
-                    "not enough space to instate partial continuation",
-                    scm_list_1 (cont));
-
   memcpy (base, cp->stack_base, cp->stack_size * sizeof (SCM));
 
   /* now relocate frame pointers */
@@ -336,6 +349,9 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont,
       *vp->sp = argv_copy[i];
     }
 
+  if (vp->sp > vp->sp_max_since_gc)
+      vp->sp_max_since_gc = vp->sp;
+
   /* The prompt captured a slice of the dynamic stack.  Here we wind
      those entries onto the current thread's stack.  We also have to
      relocate any prompts that we see along the way.  */
@@ -672,7 +688,6 @@ initialize_default_stack_size (void)
     default_max_stack_size = size;
 }
 
-static void vm_expand_stack (struct scm_vm *vp) SCM_NOINLINE;
 #define VM_NAME vm_regular_engine
 #define VM_USE_HOOKS 0
 #define FUNC_NAME "vm-regular-engine"
@@ -788,6 +803,27 @@ make_vm (void)
 }
 #undef FUNC_NAME
 
+static size_t page_size;
+
+static void
+return_unused_stack_to_os (struct scm_vm *vp)
+{
+#if HAVE_SYS_MMAN_H
+  scm_t_uintptr start = (scm_t_uintptr) vp->sp;
+  scm_t_uintptr end = (scm_t_uintptr) vp->sp_max_since_gc;
+
+  start = ((start - 1U) | (page_size - 1U)) + 1U; /* round up */
+  end = ((end - 1U) | (page_size - 1U)) + 1U; /* round up */
+
+  /* Return these pages to the OS.  The next time they are paged in,
+     they will be zeroed.  */
+  if (start < end)
+    madvise ((void *) start, end - start, MADV_DONTNEED);
+
+  vp->sp_max_since_gc = vp->sp;
+#endif
+}
+
 /* Mark the VM stack region between its base and its current top.  */
 struct GC_ms_entry *
 scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
@@ -838,6 +874,8 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
         scm_find_dead_slot_map_unlocked (SCM_FRAME_RETURN_ADDRESS (fp));
     }
 
+  return_unused_stack_to_os (vp);
+
   return mark_stack_ptr;
 }
 
@@ -884,6 +922,7 @@ vm_expand_stack (struct scm_vm *vp)
           SCM *fp;
           vp->fp += reloc;
           vp->sp += reloc;
+          vp->sp_max_since_gc += reloc;
           fp = vp->fp;
           while (fp)
             {
@@ -982,6 +1021,9 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
   vp->fp = &base[5];
   vp->sp = &SCM_FRAME_LOCAL (vp->fp, nargs);
 
+  if (vp->sp > vp->sp_max_since_gc)
+    vp->sp_max_since_gc = vp->sp;
+
   {
     int resume = SCM_I_SETJMP (registers);
       
@@ -1210,6 +1252,11 @@ scm_bootstrap_vm (void)
                             (scm_t_extension_init_func)scm_init_vm_builtins,
                             NULL);
 
+  page_size = getpagesize ();
+  /* page_size should be a power of two.  */
+  if (page_size & (page_size - 1))
+    abort ();
+
   initialize_default_stack_size ();
 
   sym_vm_run = scm_from_latin1_symbol ("vm-run");

libguile/vm.h

@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 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 License
@@ -39,10 +39,11 @@ struct scm_vm {
   scm_t_uint32 *ip;		/* instruction pointer */
   SCM *sp;			/* stack pointer */
   SCM *fp;			/* frame pointer */
-  size_t stack_size;		/* stack size */
-  SCM *stack_base;		/* stack base address */
   SCM *stack_limit;		/* stack limit address */
   int trace_level;              /* traces enabled if trace_level > 0 */
+  SCM *sp_max_since_gc;         /* highest sp since last gc */
+  size_t stack_size;		/* stack size */
+  SCM *stack_base;		/* stack base address */
   size_t max_stack_size;
   SCM hooks[SCM_VM_NUM_HOOKS];	/* hooks */
   int engine;                   /* which vm engine we're using */