static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_not_a_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_out_of_range (const char *subr, SCM k) SCM_NORETURN SCM_NOINLINE;
static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE;
scm_wrong_type_arg_msg (subr, 1, x, "struct");
}
+static void
+vm_error_not_a_vector (const char *subr, SCM x)
+{
+ scm_wrong_type_arg_msg (subr, 1, x, "vector");
+}
+
+static void
+vm_error_out_of_range (const char *subr, SCM k)
+{
+ scm_to_size_t (k);
+ scm_out_of_range (subr, k);
+}
+
static void
vm_error_no_values (void)
{
* VM
*/
+/* The page size. */
+static size_t page_size;
+
/* Hard stack limit is 512M words: 2 gigabytes on 32-bit machines, 4 on
64-bit machines. */
static const size_t hard_max_stack_size = 512 * 1024 * 1024;
-/* Initial stack size: 4 or 8 kB. */
-static const size_t initial_stack_size = 1024;
+/* Initial stack size. Defaults to one page. */
+static size_t initial_stack_size;
/* Default soft stack limit is 1M words (4 or 8 megabytes). */
static size_t default_max_stack_size = 1024 * 1024;
static void
initialize_default_stack_size (void)
{
- int size = scm_getenv_int ("GUILE_STACK_SIZE", (int) default_max_stack_size);
- if (size >= initial_stack_size && (size_t) size < ((size_t) -1) / sizeof(SCM))
- default_max_stack_size = size;
+ initial_stack_size = page_size / sizeof (SCM);
+
+ {
+ int size;
+ size = scm_getenv_int ("GUILE_STACK_SIZE", (int) default_max_stack_size);
+ if (size >= initial_stack_size
+ && (size_t) size < ((size_t) -1) / sizeof(SCM))
+ default_max_stack_size = size;
+ }
}
#define VM_NAME vm_regular_engine
ret = mmap (NULL, size, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
if (ret == MAP_FAILED)
- SCM_SYSERROR;
+ ret = NULL;
#else
ret = malloc (size);
- if (!ret)
- SCM_SYSERROR;
#endif
+ if (!ret)
+ {
+ perror ("allocate_stack failed");
+ return NULL;
+ }
+
return (SCM *) ret;
}
#undef FUNC_NAME
new_stack = mremap (old_stack, old_size, new_size, MREMAP_MAYMOVE);
if (new_stack == MAP_FAILED)
- SCM_SYSERROR;
+ return NULL;
return (SCM *) new_stack;
#else
SCM *new_stack;
new_stack = allocate_stack (new_size);
+ if (!new_stack)
+ return NULL;
+
memcpy (new_stack, old_stack, old_size * sizeof (SCM));
free_stack (old_stack, old_size);
vp->stack_size = initial_stack_size;
vp->stack_base = allocate_stack (vp->stack_size);
+ if (!vp->stack_base)
+ /* As in expand_stack, we don't have any way to throw an exception
+ if we can't allocate one measely page -- there's no stack to
+ handle it. For now, abort. */
+ abort ();
vp->stack_limit = vp->stack_base + vp->stack_size;
vp->max_stack_size = default_max_stack_size;
vp->ip = NULL;
}
#undef FUNC_NAME
-static size_t page_size;
-
static void
return_unused_stack_to_os (struct scm_vm *vp)
{
/* 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);
+ {
+ int ret = 0;
+
+ do
+ ret = madvise ((void *) start, end - start, MADV_DONTNEED);
+ while (ret && errno == -EAGAIN);
+
+ if (ret)
+ perror ("madvise failed");
+ }
vp->sp_max_since_gc = vp->sp;
#endif
stack marker can trace the stack. */
if (stack_size > vp->stack_size)
{
- SCM *old_stack;
+ SCM *old_stack, *new_stack;
size_t new_size;
scm_t_ptrdiff reloc;
while (new_size < stack_size)
new_size *= 2;
old_stack = vp->stack_base;
- vp->stack_base = expand_stack (old_stack, vp->stack_size, new_size);
+ new_stack = expand_stack (vp->stack_base, vp->stack_size, new_size);
+ if (!new_stack)
+ /* It would be nice to throw an exception here, but that is
+ extraordinarily hard. Exceptionally hard, you might say!
+ "throw" is implemented in Scheme, and there may be arbitrary
+ pre-unwind handlers that push on more frames. We will
+ endeavor to do so in the future, but for now we just
+ abort. */
+ abort ();
+
+ vp->stack_base = new_stack;
vp->stack_size = new_size;
vp->stack_limit = vp->stack_base + new_size;
reloc = vp->stack_base - old_stack;