[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/12: VM stack grows downward
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 03/12: VM stack grows downward |
|
Date: |
Wed, 21 Oct 2015 13:13:30 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 0007507340b10754cb307763cbc8eeb064853926
Author: Andy Wingo <address@hidden>
Date: Tue Sep 22 10:24:30 2015 +0000
VM stack grows downward
Adapt VM stack to grow downward. This will make native compilation look
more like the VM code, as we will be able to use native CALL
instructions, taking proper advantage of the return address buffer.
* libguile/continuations.c (scm_i_continuation_to_frame): Record offsets
from stack top.
* libguile/control.c (scm_i_prompt_pop_abort_args_x): Adapt for reversed
order of arguments, and instead of relying on the abort to push on the
number of arguments, make the caller save the stack depth, which
allows us to compute the number of arguments ourselves.
(reify_partial_continuation, scm_c_abort): Adapt to reversed stack
order.
* libguile/dynstack.c (scm_dynstack_wind_prompt): Since we wind the
stack in a downward direction, subtract the reloc instead of adding
it.
* libguile/dynstack.h (SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY): Remove flag;
instead rely on prompt-establishing code to save the stack depth.
* libguile/eval.c (eval): Remove extraneous "volatile" declarations for
variables that are not re-set between the setjmp and any longjmp.
Adapt to save stack depth before instating the prompt.
* libguile/foreign.c (scm_i_foreign_call): Adapt to receive arguments in
reverse order.
* libguile/frames.c (frame_stack_top, scm_i_frame_stack_top): Adapt to
compute stack top instead of stack bottom.
(scm_c_frame_closure): Adapt to stack growth change.
(scm_frame_num_locals, scm_frame_local_ref, scm_frame_set_x): Use
union data type to access stack.
(RELOC): Reformat.
(scm_c_frame_previous): Adapt to stack growth change.
* libguile/frames.h: Adapt stack diagram to indicate that the stack
grows up.
(union scm_vm_stack_element): New data type used to access items on
the stack.
(SCM_FRAME_PREVIOUS_SP)
(SCM_FRAME_RETURN_ADDRESS, SCM_FRAME_SET_RETURN_ADDRESS)
(SCM_FRAME_DYNAMIC_LINK, SCM_FRAME_SET_DYNAMIC_LINK)
(SCM_FRAME_LOCAL, SCM_FRAME_NUM_LOCALS): Adapt to stack representation
change.
(SCM_FRAME_SLOT): New helper.
(SCM_VM_FRAME_FP, SCM_VM_FRAME_SP): Adapt to stack growth change.
* libguile/stacks.c (scm_make_stack): Record offsets from top of stack.
* libguile/throw.c (catch): Adapt to scm_i_prompt_pop_abort_args_x
change.
* libguile/vm-engine.c (ALLOC_FRAME, RESET_FRAME):
(FRAME_LOCALS_COUNT_FROM): Adapt to stack growth change.
(LOCAL_ADDRESS): Use SCM_FRAME_SLOT to get the address as the proper
data type.
(RETURN_ONE_VALUE, RETURN_VALUE_LIST): Adapt to stack growth change.
(apply): Shuffling up the SMOB apply args can cause the stack to
expand, so use ALLOC_FRAME instead of RESET_FRAME.
(vm_engine): Adapt for stack growth change.
* libguile/vm.c (vm_increase_sp, vm_push_sp, vm_restore_sp): Adapt to
stack representation change.
(scm_i_vm_cont_to_frame): Adapt to take offsets from the top.
(scm_i_vm_capture_stack): Adapt to capture from the top.
(vm_return_to_continuation_inner): Adapt for data type changes.
(vm_return_to_continuation): Likewise, and instead of looping, just
splat the saved arguments on with memcpy.
(vm_dispatch_hook): Adapt to receive arguments in the reverse order.
Adapt callers.
(vm_abort): There is never a tail argument. Adapt to stack
representation change.
(vm_reinstate_partial_continuation)
(vm_reinstate_partial_continuation_inner): Adapt to stack growth
change.
(allocate_stack, free_stack): Adapt to data type change.
(expand_stack): Don't try to mremap(), as you can't grow a mapping
from the bottom. Without knowing that there's a free mapping space
right below the old stack, which there usually isn't on Linux, we have
to copy. We can't use MAP_GROWSDOWN because Linux is buggy.
(make_vm): Adapt to stack representation changes.
(return_unused_stack_to_os): Round down instead of up, as the stack
grows down.
(scm_i_vm_mark_stack): Adapt to walk up the stack.
(scm_i_vm_free_stack): Adapt to scm_vm changes.
(vm_expand_stack_inner, reset_stack_limit, vm_expand_stack): Adapt to
the stack growing down.
(scm_call_n): Adapt to the stack growing down. Don't allow argv to
point into the stack.
* libguile/vm.h (struct scm_vm, struct scm_vm_cont): Adapt to hold the
stack top and bottom.
---
libguile/continuations.c | 7 +-
libguile/control.c | 61 ++++----
libguile/control.h | 3 +-
libguile/dynstack.c | 4 +-
libguile/dynstack.h | 3 +-
libguile/eval.c | 18 +--
libguile/foreign.c | 4 +-
libguile/foreign.h | 5 +-
libguile/frames.c | 62 ++++----
libguile/frames.h | 76 +++++-----
libguile/stacks.c | 7 +-
libguile/throw.c | 9 +-
libguile/vm-engine.c | 112 +++++++------
libguile/vm.c | 394 +++++++++++++++++++++++-----------------------
libguile/vm.h | 25 ++--
15 files changed, 399 insertions(+), 391 deletions(-)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 8dca62e..7cc3cea 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -180,10 +180,13 @@ scm_i_continuation_to_frame (SCM continuation, struct
scm_frame *frame)
if (scm_is_true (cont->vm_cont))
{
struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
+ union scm_vm_stack_element *stack_top;
+ /* FIXME vm_cont should hold fp/sp offsets */
+ stack_top = data->stack_bottom + data->stack_size;
frame->stack_holder = data;
- frame->fp_offset = (data->fp + data->reloc) - data->stack_base;
- frame->sp_offset = (data->sp + data->reloc) - data->stack_base;
+ frame->fp_offset = stack_top - (data->fp + data->reloc);
+ frame->sp_offset = stack_top - (data->sp + data->reloc);
frame->ip = data->ra;
return 1;
diff --git a/libguile/control.c b/libguile/control.c
index 347d697..a345734 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -39,19 +39,22 @@
/* Only to be called if the SCM_I_SETJMP returns 1 */
SCM
-scm_i_prompt_pop_abort_args_x (struct scm_vm *vp)
+scm_i_prompt_pop_abort_args_x (struct scm_vm *vp,
+ scm_t_ptrdiff saved_stack_depth)
{
size_t i, n;
+ scm_t_ptrdiff stack_depth;
SCM vals = SCM_EOL;
- n = scm_to_size_t (vp->sp[0]);
+ stack_depth = vp->stack_top - vp->sp;
+ if (stack_depth < saved_stack_depth)
+ abort ();
+ n = stack_depth - saved_stack_depth;
+
for (i = 0; i < n; i++)
- vals = scm_cons (vp->sp[-(i + 1)], vals);
+ vals = scm_cons (vp->sp[i].scm, vals);
- /* The abort did reset the VM's registers, but then these values
- were pushed on; so we need to pop them ourselves. */
- vp->sp -= n + 1;
- /* FIXME NULLSTACK */
+ vp->sp += n;
return vals;
}
@@ -79,8 +82,8 @@ make_partial_continuation (SCM vm_cont)
static SCM
reify_partial_continuation (struct scm_vm *vp,
- SCM *saved_fp,
- SCM *saved_sp,
+ union scm_vm_stack_element *saved_fp,
+ union scm_vm_stack_element *saved_sp,
scm_t_uint32 *saved_ip,
scm_i_jmp_buf *saved_registers,
scm_t_dynstack *dynstack,
@@ -88,7 +91,7 @@ reify_partial_continuation (struct scm_vm *vp,
{
SCM vm_cont;
scm_t_uint32 flags;
- SCM *bottom_fp;
+ union scm_vm_stack_element *base_fp;
flags = SCM_F_VM_CONT_PARTIAL;
/* If we are aborting to a prompt that has the same registers as those
@@ -98,24 +101,20 @@ reify_partial_continuation (struct scm_vm *vp,
if (saved_registers && saved_registers == current_registers)
flags |= SCM_F_VM_CONT_REWINDABLE;
- /* Walk the stack down until we find the first frame after saved_fp.
- We will save the stack down to that frame. It used to be that we
- could determine the stack bottom in O(1) time, but that's no longer
+ /* Walk the stack until we find the first frame newer than saved_fp.
+ We will save the stack until that frame. It used to be that we
+ could determine the stack base in O(1) time, but that's no longer
the case, since the thunk application doesn't occur where the
prompt is saved. */
- for (bottom_fp = vp->fp;
- SCM_FRAME_DYNAMIC_LINK (bottom_fp) > saved_fp;
- bottom_fp = SCM_FRAME_DYNAMIC_LINK (bottom_fp));
+ for (base_fp = vp->fp;
+ SCM_FRAME_DYNAMIC_LINK (base_fp) < saved_fp;
+ base_fp = SCM_FRAME_DYNAMIC_LINK (base_fp));
- if (SCM_FRAME_DYNAMIC_LINK (bottom_fp) != saved_fp)
+ if (SCM_FRAME_DYNAMIC_LINK (base_fp) != saved_fp)
abort();
- /* Capture from the top of the thunk application frame up to the end. */
- vm_cont = scm_i_vm_capture_stack (&SCM_FRAME_LOCAL (bottom_fp, 0),
- vp->fp,
- vp->sp,
- vp->ip,
- dynstack,
+ /* Capture from the base_fp to the top thunk application frame. */
+ vm_cont = scm_i_vm_capture_stack (base_fp, vp->fp, vp->sp, vp->ip, dynstack,
flags);
return make_partial_continuation (vm_cont);
@@ -130,7 +129,7 @@ scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM
*argv,
scm_t_bits *prompt;
scm_t_dynstack_prompt_flags flags;
scm_t_ptrdiff fp_offset, sp_offset;
- SCM *fp, *sp;
+ union scm_vm_stack_element *fp, *sp;
scm_t_uint32 *ip;
scm_i_jmp_buf *registers;
size_t i;
@@ -142,8 +141,8 @@ scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM
*argv,
if (!prompt)
scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
- fp = vp->stack_base + fp_offset;
- sp = vp->stack_base + sp_offset;
+ fp = vp->stack_top - fp_offset;
+ sp = vp->stack_top - sp_offset;
/* Only reify if the continuation referenced in the handler. */
if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
@@ -162,19 +161,17 @@ scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM
*argv,
/* Restore VM regs */
vp->fp = fp;
- vp->sp = sp;
+ vp->sp = sp - n - 1;
vp->ip = ip;
/* Since we're jumping down, we should always have enough space. */
- if (vp->sp + n + 1 >= vp->stack_limit)
+ if (vp->sp < vp->stack_limit)
abort ();
/* Push vals */
- *(++(vp->sp)) = cont;
+ vp->sp[n].scm = cont;
for (i = 0; i < n; i++)
- *(++(vp->sp)) = argv[i];
- if (flags & SCM_F_DYNSTACK_PROMPT_PUSH_NARGS)
- *(++(vp->sp)) = scm_from_size_t (n+1); /* +1 for continuation */
+ vp->sp[n - i - 1].scm = argv[i];
/* Jump! */
SCM_I_LONGJMP (*registers, 1);
diff --git a/libguile/control.h b/libguile/control.h
index 4b76591..84990ab 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -22,7 +22,8 @@
#include "libguile/vm.h"
-SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (struct scm_vm *vp);
+SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (struct scm_vm *vp,
+ scm_t_ptrdiff
saved_stack_depth);
SCM_INTERNAL void scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
scm_i_jmp_buf *registers) SCM_NORETURN;
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 9235ec4..bda1a16 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -484,8 +484,8 @@ scm_dynstack_wind_prompt (scm_t_dynstack *dynstack,
scm_t_bits *item,
scm_dynstack_push_prompt (dynstack,
SCM_DYNSTACK_TAG_FLAGS (tag),
PROMPT_KEY (item),
- PROMPT_FP (item) + reloc,
- PROMPT_SP (item) + reloc,
+ PROMPT_FP (item) - reloc,
+ PROMPT_SP (item) - reloc,
PROMPT_IP (item),
registers);
}
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index 7b31ace..853f068 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -129,8 +129,7 @@ typedef enum {
} scm_t_dynstack_winder_flags;
typedef enum {
- SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT),
- SCM_F_DYNSTACK_PROMPT_PUSH_NARGS = (2 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
} scm_t_dynstack_prompt_flags;
typedef void (*scm_t_guard) (void *);
diff --git a/libguile/eval.c b/libguile/eval.c
index 735e6c0..09fa71d 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -424,23 +424,22 @@ eval (SCM x, SCM env)
case SCM_M_CALL_WITH_PROMPT:
{
struct scm_vm *vp;
- SCM k, res;
+ SCM k, handler, res;
scm_i_jmp_buf registers;
- /* We need the handler after nonlocal return to the setjmp, so
- make sure it is volatile. */
- volatile SCM handler;
+ scm_t_ptrdiff saved_stack_depth;
k = EVAL1 (CAR (mx), env);
handler = EVAL1 (CDDR (mx), env);
vp = scm_the_vm ();
+ saved_stack_depth = vp->stack_top - vp->sp;
+
/* Push the prompt onto the dynamic stack. */
scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
- SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
- | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
k,
- vp->fp - vp->stack_base,
- vp->sp - vp->stack_base,
+ vp->stack_top - vp->fp,
+ saved_stack_depth,
vp->ip,
®isters);
@@ -449,8 +448,7 @@ eval (SCM x, SCM env)
/* The prompt exited nonlocally. */
scm_gc_after_nonlocal_exit ();
proc = handler;
- vp = scm_the_vm ();
- args = scm_i_prompt_pop_abort_args_x (vp);
+ args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth);
goto apply_proc;
}
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 0cab6b8..3ac0659 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -977,7 +977,7 @@ pack (const ffi_type * type, const void *loc, int
return_value_p)
SCM
-scm_i_foreign_call (SCM foreign, const SCM *argv)
+scm_i_foreign_call (SCM foreign, const union scm_vm_stack_element *argv)
{
/* FOREIGN is the pair that cif_to_procedure set as the 0th element of the
objtable. */
@@ -1016,7 +1016,7 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
args[i] = (void *) ROUND_UP ((scm_t_uintptr) data + off,
cif->arg_types[i]->alignment);
assert ((scm_t_uintptr) args[i] % cif->arg_types[i]->alignment == 0);
- unpack (cif->arg_types[i], args[i], argv[i], 0);
+ unpack (cif->arg_types[i], args[i], argv[cif->nargs - i - 1].scm, 0);
}
/* Prepare space for the return value. On some platforms, such as
diff --git a/libguile/foreign.h b/libguile/foreign.h
index fbb9764..53f39d5 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -93,11 +93,14 @@ SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer, SCM
length, SCM encoding);
arguments.
*/
+union scm_vm_stack_element;
+
SCM_API SCM scm_pointer_to_procedure (SCM return_type, SCM func_ptr,
SCM arg_types);
SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr,
SCM arg_types);
-SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign, const SCM *argv);
+SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign,
+ const union scm_vm_stack_element *argv);
SCM_INTERNAL int scm_i_foreign_arity (SCM foreign,
int *req, int *opt, int *rest);
diff --git a/libguile/frames.c b/libguile/frames.c
index 2162f49..f89b0fd 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 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
@@ -25,14 +25,6 @@
#include "_scm.h"
#include "frames.h"
#include "vm.h"
-#include <verify.h>
-
-/* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */
-verify (sizeof (SCM) == sizeof (SCM *));
-verify (sizeof (struct scm_vm_frame) == 3 * sizeof (SCM));
-verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
-
-
SCM
scm_c_make_frame (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
@@ -57,16 +49,19 @@ scm_i_frame_print (SCM frame, SCM port, scm_print_state
*pstate)
scm_puts_unlocked (">", port);
}
-static SCM*
-frame_stack_base (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
+static union scm_vm_stack_element*
+frame_stack_top (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
{
switch (kind)
{
- case SCM_VM_FRAME_KIND_CONT:
- return ((struct scm_vm_cont *) frame->stack_holder)->stack_base;
+ case SCM_VM_FRAME_KIND_CONT:
+ {
+ struct scm_vm_cont *cont = frame->stack_holder;
+ return cont->stack_bottom + cont->stack_size;
+ }
case SCM_VM_FRAME_KIND_VM:
- return ((struct scm_vm *) frame->stack_holder)->stack_base;
+ return ((struct scm_vm *) frame->stack_holder)->stack_top;
default:
abort ();
@@ -89,14 +84,14 @@ frame_offset (enum scm_vm_frame_kind kind, const struct
scm_frame *frame)
}
}
-SCM*
-scm_i_frame_stack_base (SCM frame)
-#define FUNC_NAME "frame-stack-base"
+union scm_vm_stack_element*
+scm_i_frame_stack_top (SCM frame)
+#define FUNC_NAME "frame-stack-top"
{
SCM_VALIDATE_VM_FRAME (1, frame);
- return frame_stack_base (SCM_VM_FRAME_KIND (frame),
- SCM_VM_FRAME_DATA (frame));
+ return frame_stack_top (SCM_VM_FRAME_KIND (frame),
+ SCM_VM_FRAME_DATA (frame));
}
#undef FUNC_NAME
@@ -130,10 +125,10 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
SCM
scm_c_frame_closure (enum scm_vm_frame_kind kind, const struct scm_frame
*frame)
{
- SCM *fp, *sp;
+ union scm_vm_stack_element *fp, *sp;
- fp = frame_stack_base (kind, frame) + frame->fp_offset;
- sp = frame_stack_base (kind, frame) + frame->sp_offset;
+ fp = frame_stack_top (kind, frame) - frame->fp_offset;
+ sp = frame_stack_top (kind, frame) - frame->sp_offset;
if (SCM_FRAME_NUM_LOCALS (fp, sp) > 0)
return SCM_FRAME_LOCAL (fp, 0);
@@ -214,7 +209,7 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0,
0,
"")
#define FUNC_NAME s_scm_frame_num_locals
{
- SCM *fp, *sp;
+ union scm_vm_stack_element *fp, *sp;
SCM_VALIDATE_VM_FRAME (1, frame);
@@ -230,7 +225,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
"")
#define FUNC_NAME s_scm_frame_local_ref
{
- SCM *fp, *sp;
+ union scm_vm_stack_element *fp, *sp;
unsigned int i;
SCM_VALIDATE_VM_FRAME (1, frame);
@@ -252,7 +247,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3,
0, 0,
"")
#define FUNC_NAME s_scm_frame_local_set_x
{
- SCM *fp, *sp;
+ union scm_vm_stack_element *fp, *sp;
unsigned int i;
SCM_VALIDATE_VM_FRAME (1, frame);
@@ -314,8 +309,7 @@ SCM_DEFINE (scm_frame_return_address,
"frame-return-address", 1, 0, 0,
}
#undef FUNC_NAME
-#define RELOC(kind, frame, val) \
- (((SCM *) (val)) + frame_offset (kind, frame))
+#define RELOC(kind, frame, val) ((val) + frame_offset (kind, frame))
SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
(SCM frame),
@@ -334,13 +328,13 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link",
1, 0, 0,
int
scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame)
{
- SCM *this_fp, *new_fp, *new_sp;
- SCM *stack_base = frame_stack_base (kind, frame);
+ union scm_vm_stack_element *this_fp, *new_fp, *new_sp;
+ union scm_vm_stack_element *stack_top = frame_stack_top (kind, frame);
again:
- this_fp = frame->fp_offset + stack_base;
+ this_fp = stack_top - frame->fp_offset;
- if (this_fp == stack_base)
+ if (this_fp == stack_top)
return 0;
new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
@@ -350,12 +344,12 @@ scm_c_frame_previous (enum scm_vm_frame_kind kind, struct
scm_frame *frame)
new_fp = RELOC (kind, frame, new_fp);
- if (new_fp < stack_base)
+ if (new_fp > stack_top)
return 0;
new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
- frame->fp_offset = new_fp - stack_base;
- frame->sp_offset = new_sp - stack_base;
+ frame->fp_offset = stack_top - new_fp;
+ frame->sp_offset = stack_top - new_sp;
frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp);
{
diff --git a/libguile/frames.h b/libguile/frames.h
index 31f8634..c2f1e57 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 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
@@ -38,24 +38,29 @@
Stack frame layout
------------------
- /------------------\
- | Local N-1 | <- sp
| ... |
- | Local 1 |
- | Local 0 | <- fp = SCM_FRAME_LOCALS_ADDRESS (fp)
- +==================+
+ +==================+ <- fp + 2 = SCM_FRAME_PREVIOUS_SP (fp)
+ | Dynamic link |
+ +------------------+
| Return address |
- | Dynamic link | <- fp - 2 = SCM_FRAME_LOWER_ADDRESS (fp)
- +==================+
- | | <- fp - 3 = SCM_FRAME_PREVIOUS_SP (fp)
+ +==================+ <- fp
+ | Local 0 |
+ +------------------+
+ | Local 1 |
+ +------------------+
+ | ... |
+ +------------------+
+ | Local N-1 |
+ \------------------/ <- sp
+
+ The stack grows down.
The calling convention is that a caller prepares a stack frame
consisting of the saved FP and the return address, followed by the
procedure and then the arguments to the call, in order. Thus in the
beginning of a call, the procedure being called is in slot 0, the
first argument is in slot 1, and the SP points to the last argument.
- The number of arguments, including the procedure, is thus SP - FP +
- 1.
+ The number of arguments, including the procedure, is thus FP - SP.
After ensuring that the correct number of arguments have been passed,
a function will set the stack pointer to point to the last local
@@ -80,35 +85,26 @@
-/* This structure maps to the contents of a VM stack frame. It can
- alias a frame directly. */
-struct scm_vm_frame
+/* Each element on the stack occupies the same amount of space. */
+union scm_vm_stack_element
{
- SCM *dynamic_link;
- scm_t_uint32 *return_address;
- SCM locals[1]; /* Variable-length */
-};
-
-#define SCM_FRAME_LOWER_ADDRESS(fp) (((SCM *) (fp)) - 2)
-#define SCM_FRAME_STRUCT(fp) \
- ((struct scm_vm_frame *) SCM_FRAME_LOWER_ADDRESS (fp))
-#define SCM_FRAME_LOCALS_ADDRESS(fp) (SCM_FRAME_STRUCT (fp)->locals)
-
-#define SCM_FRAME_PREVIOUS_SP(fp) (((SCM *) (fp)) - 3)
+ union scm_vm_stack_element *fp;
+ scm_t_uint32 *ip;
+ SCM scm;
-#define SCM_FRAME_RETURN_ADDRESS(fp) \
- (SCM_FRAME_STRUCT (fp)->return_address)
-#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra) \
- SCM_FRAME_STRUCT (fp)->return_address = (ra)
-#define SCM_FRAME_DYNAMIC_LINK(fp) \
- (SCM_FRAME_STRUCT (fp)->dynamic_link)
-#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
- SCM_FRAME_DYNAMIC_LINK (fp) = (dl)
-#define SCM_FRAME_LOCAL(fp,i) \
- (SCM_FRAME_STRUCT (fp)->locals[i])
+ /* For GC purposes. */
+ void *ptr;
+ scm_t_bits bits;
+};
-#define SCM_FRAME_NUM_LOCALS(fp, sp) \
- ((sp) + 1 - &SCM_FRAME_LOCAL (fp, 0))
+#define SCM_FRAME_PREVIOUS_SP(fp_) ((fp_) + 2)
+#define SCM_FRAME_RETURN_ADDRESS(fp_) ((fp_)[0].ip)
+#define SCM_FRAME_SET_RETURN_ADDRESS(fp_, ra) ((fp_)[0].ip = (ra))
+#define SCM_FRAME_DYNAMIC_LINK(fp_) ((fp_)[1].fp)
+#define SCM_FRAME_SET_DYNAMIC_LINK(fp_, dl) ((fp_)[1].fp = (dl))
+#define SCM_FRAME_SLOT(fp_,i) ((fp_) - (i) - 1)
+#define SCM_FRAME_LOCAL(fp_,i) (SCM_FRAME_SLOT (fp_, i)->scm)
+#define SCM_FRAME_NUM_LOCALS(fp_, sp) ((fp_) - (sp))
/*
@@ -137,13 +133,13 @@ enum scm_vm_frame_kind
#define SCM_VM_FRAME_STACK_HOLDER(f) SCM_VM_FRAME_DATA (f)->stack_holder
#define SCM_VM_FRAME_FP_OFFSET(f) SCM_VM_FRAME_DATA (f)->fp_offset
#define SCM_VM_FRAME_SP_OFFSET(f) SCM_VM_FRAME_DATA (f)->sp_offset
-#define SCM_VM_FRAME_FP(f) (SCM_VM_FRAME_FP_OFFSET (f) +
scm_i_frame_stack_base (f))
-#define SCM_VM_FRAME_SP(f) (SCM_VM_FRAME_SP_OFFSET (f) +
scm_i_frame_stack_base (f))
+#define SCM_VM_FRAME_FP(f) (scm_i_frame_stack_top (f) -
SCM_VM_FRAME_FP_OFFSET (f))
+#define SCM_VM_FRAME_SP(f) (scm_i_frame_stack_top (f) -
SCM_VM_FRAME_SP_OFFSET (f))
#define SCM_VM_FRAME_IP(f) SCM_VM_FRAME_DATA (f)->ip
#define SCM_VM_FRAME_OFFSET(f) scm_i_frame_offset (f)
#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
-SCM_INTERNAL SCM* scm_i_frame_stack_base (SCM frame);
+SCM_INTERNAL union scm_vm_stack_element* scm_i_frame_stack_top (SCM frame);
SCM_INTERNAL scm_t_ptrdiff scm_i_frame_offset (SCM frame);
/* See notes in frames.c before using this. */
diff --git a/libguile/stacks.c b/libguile/stacks.c
index a09c3b9..ec3ec78 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -320,14 +320,17 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
{
SCM cont;
struct scm_vm_cont *c;
+ union scm_vm_stack_element *stack_top;
cont = scm_i_capture_current_stack ();
c = SCM_VM_CONT_DATA (cont);
+ /* FIXME vm_cont should hold fp/sp offsets */
+ stack_top = c->stack_bottom + c->stack_size;
kind = SCM_VM_FRAME_KIND_CONT;
frame.stack_holder = c;
- frame.fp_offset = (c->fp + c->reloc) - c->stack_base;
- frame.sp_offset = (c->sp + c->reloc) - c->stack_base;
+ frame.fp_offset = stack_top - (c->fp + c->reloc);
+ frame.sp_offset = stack_top - (c->sp + c->reloc);
frame.ip = c->ra;
}
else if (SCM_VM_FRAME_P (obj))
diff --git a/libguile/throw.c b/libguile/throw.c
index bbde5e0..773ac27 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -102,14 +102,13 @@ catch (SCM tag, SCM thunk, SCM handler, SCM
pre_unwind_handler)
scm_c_vector_set_x (eh, 3, pre_unwind_handler);
vp = scm_the_vm ();
- saved_stack_depth = vp->sp - vp->stack_base;
+ saved_stack_depth = vp->stack_top - vp->sp;
/* Push the prompt and exception handler onto the dynamic stack. */
scm_dynstack_push_prompt (dynstack,
- SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
- | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
prompt_tag,
- vp->fp - vp->stack_base,
+ vp->stack_top - vp->fp,
saved_stack_depth,
vp->ip,
®isters);
@@ -125,7 +124,7 @@ catch (SCM tag, SCM thunk, SCM handler, SCM
pre_unwind_handler)
/* FIXME: We know where the args will be on the stack; we could
avoid consing them. */
- args = scm_i_prompt_pop_abort_args_x (vp);
+ args = scm_i_prompt_pop_abort_args_x (vp, saved_stack_depth);
/* Cdr past the continuation. */
args = scm_cdr (args);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 7e752dd..f6cb0c4 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -134,10 +134,10 @@
/* Virtual Machine
The VM has three state bits: the instruction pointer (IP), the frame
- pointer (FP), and the top-of-stack pointer (SP). We cache the first
- two of these in machine registers, local to the VM, because they are
- used extensively by the VM. As the SP is used more by code outside
- the VM than by the VM itself, we don't bother caching it locally.
+ pointer (FP), and the stack pointer (SP). We cache the first two of
+ these in machine registers, local to the VM, because they are used
+ extensively by the VM. As the SP is used more by code outside the VM
+ than by the VM itself, we don't bother caching it locally.
Since the FP changes infrequently, relative to the IP, we keep vp->fp
in sync with the local FP. This would be a big lose for the IP,
@@ -172,17 +172,17 @@
FP is valid across an ALLOC_FRAME call. Be careful! */
#define ALLOC_FRAME(n) \
do { \
- SCM *new_sp = LOCAL_ADDRESS (n - 1); \
- if (new_sp > vp->sp_max_since_gc) \
+ union scm_vm_stack_element *new_sp = LOCAL_ADDRESS (n - 1); \
+ if (new_sp < vp->sp_min_since_gc) \
{ \
- if (SCM_UNLIKELY (new_sp >= vp->stack_limit)) \
+ if (SCM_UNLIKELY (new_sp < vp->stack_limit)) \
{ \
SYNC_IP (); \
vm_expand_stack (vp, new_sp); \
CACHE_FP (); \
} \
else \
- vp->sp_max_since_gc = vp->sp = new_sp; \
+ vp->sp_min_since_gc = vp->sp = new_sp; \
} \
else \
vp->sp = new_sp; \
@@ -193,15 +193,15 @@
#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; \
+ if (vp->sp < vp->sp_min_since_gc) \
+ vp->sp_min_since_gc = vp->sp; \
} while (0)
/* Compute the number of locals in the frame. At a call, this is equal
to the number of actual arguments when a function is first called,
plus one for the function. */
#define FRAME_LOCALS_COUNT_FROM(slot) \
- (vp->sp + 1 - LOCAL_ADDRESS (slot))
+ (LOCAL_ADDRESS (slot) + 1 - vp->sp)
#define FRAME_LOCALS_COUNT() \
FRAME_LOCALS_COUNT_FROM (0)
@@ -246,7 +246,7 @@
case opcode:
#endif
-#define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
+#define LOCAL_ADDRESS(i) SCM_FRAME_SLOT (fp, i)
#define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
#define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
@@ -257,18 +257,18 @@
#define RETURN_ONE_VALUE(ret) \
do { \
SCM val = ret; \
- SCM *old_fp; \
+ union scm_vm_stack_element *old_fp; \
VM_HANDLE_INTERRUPTS; \
ALLOC_FRAME (2); \
old_fp = fp; \
ip = SCM_FRAME_RETURN_ADDRESS (fp); \
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
/* Clear frame. */ \
- old_fp[-1] = SCM_BOOL_F; \
- old_fp[-2] = SCM_BOOL_F; \
+ old_fp[0].scm = SCM_BOOL_F; \
+ old_fp[1].scm = SCM_BOOL_F; \
/* Leave proc. */ \
SCM_FRAME_LOCAL (old_fp, 1) = val; \
- vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
+ vp->sp = SCM_FRAME_SLOT (old_fp, 1); \
POP_CONTINUATION_HOOK (old_fp); \
NEXT (0); \
} while (0)
@@ -279,10 +279,10 @@
do { \
SCM vals = vals_; \
VM_HANDLE_INTERRUPTS; \
- ALLOC_FRAME (3); \
- fp[0] = vm_builtin_apply; \
- fp[1] = vm_builtin_values; \
- fp[2] = vals; \
+ ALLOC_FRAME (3); \
+ SCM_FRAME_LOCAL (fp, 0) = vm_builtin_apply; \
+ SCM_FRAME_LOCAL (fp, 1) = vm_builtin_values; \
+ SCM_FRAME_LOCAL (fp, 2) = vals; \
ip = (scm_t_uint32 *) vm_builtin_apply_code; \
goto op_tail_apply; \
} while (0)
@@ -429,7 +429,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
/* Frame pointer: A pointer into the stack, off of which we index
arguments and local variables. Pushed at function calls, popped on
returns. */
- register SCM *fp FP_REG;
+ register union scm_vm_stack_element *fp FP_REG;
/* Current opcode: A cache of *ip. */
register scm_t_uint32 op;
@@ -472,8 +472,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{
scm_t_uint32 n = FRAME_LOCALS_COUNT();
- /* Shuffle args up. */
- RESET_FRAME (n + 1);
+ /* Shuffle args up. (FIXME: no real need to shuffle; just set
+ IP and go. ) */
+ ALLOC_FRAME (n + 1);
while (n--)
LOCAL_SET (n + 1, LOCAL_REF (n));
@@ -546,7 +547,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (1, call, "call", OP2 (U8_U24, X8_U24))
{
scm_t_uint32 proc, nlocals;
- SCM *old_fp;
+ union scm_vm_stack_element *old_fp;
UNPACK_24 (op, proc);
UNPACK_24 (ip[1], nlocals);
@@ -556,7 +557,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
PUSH_CONTINUATION_HOOK ();
old_fp = fp;
- fp = vp->fp = old_fp + proc;
+ fp = vp->fp = SCM_FRAME_SLOT (old_fp, proc - 1);
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
@@ -586,7 +587,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{
scm_t_uint32 proc, nlocals;
scm_t_int32 label;
- SCM *old_fp;
+ union scm_vm_stack_element *old_fp;
UNPACK_24 (op, proc);
UNPACK_24 (ip[1], nlocals);
@@ -597,7 +598,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
PUSH_CONTINUATION_HOOK ();
old_fp = fp;
- fp = vp->fp = old_fp + proc;
+ fp = vp->fp = SCM_FRAME_SLOT (old_fp, proc - 1);
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 3);
@@ -754,7 +755,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
*/
VM_DEFINE_OP (9, return_values, "return-values", OP1 (U8_X24))
{
- SCM *old_fp;
+ union scm_vm_stack_element *old_fp;
VM_HANDLE_INTERRUPTS;
@@ -763,8 +764,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Clear stack frame. */
- old_fp[-1] = SCM_BOOL_F;
- old_fp[-2] = SCM_BOOL_F;
+ old_fp[0].scm = SCM_BOOL_F;
+ old_fp[1].scm = SCM_BOOL_F;
POP_CONTINUATION_HOOK (old_fp);
@@ -804,34 +805,46 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
ret = subr ();
break;
case 1:
- ret = subr (fp[1]);
+ ret = subr (LOCAL_REF (1));
break;
case 2:
- ret = subr (fp[1], fp[2]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2));
break;
case 3:
- ret = subr (fp[1], fp[2], fp[3]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3));
break;
case 4:
- ret = subr (fp[1], fp[2], fp[3], fp[4]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4));
break;
case 5:
- ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4), LOCAL_REF (5));
break;
case 6:
- ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4), LOCAL_REF (5), LOCAL_REF (6));
break;
case 7:
- ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4), LOCAL_REF (5), LOCAL_REF (6),
+ LOCAL_REF (7));
break;
case 8:
- ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4), LOCAL_REF (5), LOCAL_REF (6),
+ LOCAL_REF (7), LOCAL_REF (8));
break;
case 9:
- ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8],
fp[9]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4), LOCAL_REF (5), LOCAL_REF (6),
+ LOCAL_REF (7), LOCAL_REF (8), LOCAL_REF (9));
break;
case 10:
- ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8],
fp[9], fp[10]);
+ ret = subr (LOCAL_REF (1), LOCAL_REF (2), LOCAL_REF (3),
+ LOCAL_REF (4), LOCAL_REF (5), LOCAL_REF (6),
+ LOCAL_REF (7), LOCAL_REF (8), LOCAL_REF (9),
+ LOCAL_REF (10));
break;
default:
abort ();
@@ -869,7 +882,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
// FIXME: separate args
ret = scm_i_foreign_call (scm_inline_cons (thread, cif, pointer),
- LOCAL_ADDRESS (1));
+ vp->sp);
CACHE_FP ();
@@ -903,7 +916,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
vm_return_to_continuation (scm_i_contregs_vp (contregs),
scm_i_contregs_vm_cont (contregs),
FRAME_LOCALS_COUNT_FROM (1),
- LOCAL_ADDRESS (1));
+ vp->sp);
scm_i_reinstate_continuation (contregs);
/* no NEXT */
@@ -912,7 +925,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
/* compose-continuation cont:24
*
- * Compose a partial continution with the current continuation. The
+ * Compose a partial continuation with the current continuation. The
* arguments to the continuation are taken from the stack. CONT is a
* free variable containing the reified continuation. This
* instruction is part of the implementation of partial continuations,
@@ -930,9 +943,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
vm_error_continuation_not_rewindable (vmcont));
vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM
(1),
- LOCAL_ADDRESS (1),
- &thread->dynstack,
- registers);
+ &thread->dynstack, registers);
CACHE_REGISTER ();
NEXT (0);
}
@@ -999,7 +1010,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
SYNC_IP ();
dynstack = scm_dynstack_capture_all (&thread->dynstack);
- vm_cont = scm_i_vm_capture_stack (vp->stack_base,
+ vm_cont = scm_i_vm_capture_stack (vp->stack_top,
SCM_FRAME_DYNAMIC_LINK (fp),
SCM_FRAME_PREVIOUS_SP (fp),
SCM_FRAME_RETURN_ADDRESS (fp),
@@ -1051,8 +1062,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
it continues with the next instruction. */
ip++;
SYNC_IP ();
- vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
- SCM_EOL, LOCAL_ADDRESS (0), registers);
+ vm_abort (vp, LOCAL_REF (1), nlocals - 2, registers);
/* vm_abort should not return */
abort ();
@@ -2065,8 +2075,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
scm_dynstack_push_prompt (&thread->dynstack, flags,
LOCAL_REF (tag),
- fp - vp->stack_base,
- LOCAL_ADDRESS (proc_slot) - vp->stack_base,
+ vp->stack_top - fp,
+ vp->stack_top - LOCAL_ADDRESS (proc_slot),
ip + offset,
registers);
NEXT (3);
diff --git a/libguile/vm.c b/libguile/vm.c
index 0e59835..d5a7272 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -16,9 +16,6 @@
* 02110-1301 USA
*/
-/* For mremap(2) on GNU/Linux systems. */
-#define _GNU_SOURCE
-
#if HAVE_CONFIG_H
# include <config.h>
#endif
@@ -65,7 +62,8 @@ static size_t page_size;
necessary, but might be if you think you found a bug in the VM. */
/* #define VM_ENABLE_ASSERTIONS */
-static void vm_expand_stack (struct scm_vm *vp, SCM *new_sp) SCM_NOINLINE;
+static void vm_expand_stack (struct scm_vm *vp,
+ union scm_vm_stack_element *new_sp) SCM_NOINLINE;
/* RESTORE is for the case where we know we have done a PUSH of equal or
greater stack size in the past. Otherwise PUSH is the thing, which
@@ -73,28 +71,29 @@ static void vm_expand_stack (struct scm_vm *vp, SCM
*new_sp) SCM_NOINLINE;
enum vm_increase_sp_kind { VM_SP_PUSH, VM_SP_RESTORE };
static inline void
-vm_increase_sp (struct scm_vm *vp, SCM *new_sp, enum vm_increase_sp_kind kind)
+vm_increase_sp (struct scm_vm *vp, union scm_vm_stack_element *new_sp,
+ enum vm_increase_sp_kind kind)
{
- if (new_sp <= vp->sp_max_since_gc)
+ if (new_sp >= vp->sp_min_since_gc)
{
vp->sp = new_sp;
return;
}
- if (kind == VM_SP_PUSH && new_sp >= vp->stack_limit)
+ if (kind == VM_SP_PUSH && new_sp < vp->stack_limit)
vm_expand_stack (vp, new_sp);
else
- vp->sp_max_since_gc = vp->sp = new_sp;
+ vp->sp_min_since_gc = vp->sp = new_sp;
}
static inline void
-vm_push_sp (struct scm_vm *vp, SCM *new_sp)
+vm_push_sp (struct scm_vm *vp, union scm_vm_stack_element *new_sp)
{
vm_increase_sp (vp, new_sp, VM_SP_PUSH);
}
static inline void
-vm_restore_sp (struct scm_vm *vp, SCM *new_sp)
+vm_restore_sp (struct scm_vm *vp, union scm_vm_stack_element *new_sp)
{
vm_increase_sp (vp, new_sp, VM_SP_RESTORE);
}
@@ -116,10 +115,12 @@ int
scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
{
struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont);
+ union scm_vm_stack_element *stack_top;
+ stack_top = data->stack_bottom + data->stack_size;
frame->stack_holder = data;
- frame->fp_offset = (data->fp + data->reloc) - data->stack_base;
- frame->sp_offset = (data->sp + data->reloc) - data->stack_base;
+ frame->fp_offset = stack_top - (data->fp + data->reloc);
+ frame->sp_offset = stack_top - (data->sp + data->reloc);
frame->ip = data->ra;
return 1;
@@ -129,23 +130,25 @@ scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
is inside VM code, and call/cc was invoked within that same call to
vm_run. That's currently not implemented. */
SCM
-scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp, scm_t_uint32 *ra,
+scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
+ union scm_vm_stack_element *fp,
+ union scm_vm_stack_element *sp, scm_t_uint32 *ra,
scm_t_dynstack *dynstack, scm_t_uint32 flags)
{
struct scm_vm_cont *p;
p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
- p->stack_size = sp - stack_base + 1;
- p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
- "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");
p->ra = ra;
p->sp = sp;
p->fp = fp;
- memcpy (p->stack_base, stack_base, (sp + 1 - stack_base) * sizeof (SCM));
- p->reloc = p->stack_base - stack_base;
+ memcpy (p->stack_bottom, sp, p->stack_size * sizeof (*p->stack_bottom));
+ p->reloc = (p->stack_bottom + p->stack_size) - stack_top;
p->dynstack = dynstack;
p->flags = flags;
- return scm_cell (scm_tc7_vm_cont, (scm_t_bits)p);
+ return scm_cell (scm_tc7_vm_cont, (scm_t_bits) p);
}
struct return_to_continuation_data
@@ -162,23 +165,27 @@ vm_return_to_continuation_inner (void *data_ptr)
struct return_to_continuation_data *data = data_ptr;
struct scm_vm *vp = data->vp;
struct scm_vm_cont *cp = data->cp;
+ union scm_vm_stack_element *cp_stack_top;
scm_t_ptrdiff reloc;
/* We know that there is enough space for the continuation, because we
captured it in the past. However there may have been an expansion
since the capture, so we may have to re-link the frame
pointers. */
- reloc = (vp->stack_base - (cp->stack_base - cp->reloc));
+ cp_stack_top = cp->stack_bottom + cp->stack_size;
+ reloc = (vp->stack_top - (cp_stack_top - cp->reloc));
vp->fp = cp->fp + reloc;
- memcpy (vp->stack_base, cp->stack_base, cp->stack_size * sizeof (SCM));
+ memcpy (vp->stack_top - cp->stack_size,
+ cp->stack_bottom,
+ cp->stack_size * sizeof (*cp->stack_bottom));
vm_restore_sp (vp, cp->sp + reloc);
if (reloc)
{
- SCM *fp = vp->fp;
+ union scm_vm_stack_element *fp = vp->fp;
while (fp)
{
- SCM *next_fp = SCM_FRAME_DYNAMIC_LINK (fp);
+ union scm_vm_stack_element *next_fp = SCM_FRAME_DYNAMIC_LINK (fp);
if (next_fp)
{
next_fp += reloc;
@@ -192,14 +199,15 @@ vm_return_to_continuation_inner (void *data_ptr)
}
static void
-vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n, SCM *argv)
+vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n,
+ union scm_vm_stack_element *argv)
{
struct scm_vm_cont *cp;
- SCM *argv_copy;
+ union scm_vm_stack_element *argv_copy;
struct return_to_continuation_data data;
- argv_copy = alloca (n * sizeof(SCM));
- memcpy (argv_copy, argv, n * sizeof(SCM));
+ argv_copy = alloca (n * sizeof (*argv));
+ memcpy (argv_copy, argv, n * sizeof (*argv));
cp = SCM_VM_CONT_DATA (cont);
@@ -208,22 +216,13 @@ vm_return_to_continuation (struct scm_vm *vp, SCM cont,
size_t n, SCM *argv)
GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data);
/* Now we have the continuation properly copied over. We just need to
- copy the arguments. It is not guaranteed that there is actually
- space for the arguments, though, so we have to bump the SP first. */
- vm_push_sp (vp, vp->sp + 3 + n);
-
- /* Now copy on an empty frame and the return values, as the
- continuation expects. */
- {
- SCM *base = vp->sp + 1 - 3 - n;
- size_t i;
-
- for (i = 0; i < 3; i++)
- base[i] = SCM_BOOL_F;
-
- for (i = 0; i < n; i++)
- base[i + 3] = argv_copy[i];
- }
+ copy on an empty frame and the return values, as the continuation
+ expects. */
+ vm_push_sp (vp, vp->sp - 3 - n);
+ vp->sp[n+2].scm = SCM_BOOL_F;
+ vp->sp[n+1].scm = SCM_BOOL_F;
+ vp->sp[n].scm = SCM_BOOL_F;
+ memcpy(vp->sp, argv_copy, n * sizeof (union scm_vm_stack_element));
vp->ip = cp->ra;
}
@@ -238,19 +237,21 @@ scm_i_capture_current_stack (void)
thread = SCM_I_CURRENT_THREAD;
vp = thread_vm (thread);
- return scm_i_vm_capture_stack (vp->stack_base, vp->fp, vp->sp, vp->ip,
+ return scm_i_vm_capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip,
scm_dynstack_capture_all (&thread->dynstack),
0);
}
static void vm_dispatch_apply_hook (struct scm_vm *vp) SCM_NOINLINE;
static void vm_dispatch_push_continuation_hook (struct scm_vm *vp)
SCM_NOINLINE;
-static void vm_dispatch_pop_continuation_hook (struct scm_vm *vp, SCM *old_fp)
SCM_NOINLINE;
+static void vm_dispatch_pop_continuation_hook
+ (struct scm_vm *vp, union scm_vm_stack_element *old_fp) SCM_NOINLINE;
static void vm_dispatch_next_hook (struct scm_vm *vp) SCM_NOINLINE;
static void vm_dispatch_abort_hook (struct scm_vm *vp) SCM_NOINLINE;
static void
-vm_dispatch_hook (struct scm_vm *vp, int hook_num, SCM *argv, int n)
+vm_dispatch_hook (struct scm_vm *vp, int hook_num,
+ union scm_vm_stack_element *argv, int n)
{
SCM hook;
struct scm_frame c_frame;
@@ -275,8 +276,8 @@ vm_dispatch_hook (struct scm_vm *vp, int hook_num, SCM
*argv, int n)
seems reasonable to limit the lifetime of frame objects. */
c_frame.stack_holder = vp;
- c_frame.fp_offset = vp->fp - vp->stack_base;
- c_frame.sp_offset = vp->sp - vp->stack_base;
+ c_frame.fp_offset = vp->stack_top - vp->fp;
+ c_frame.sp_offset = vp->stack_top - vp->sp;
c_frame.ip = vp->ip;
/* Arrange for FRAME to be 8-byte aligned, like any other cell. */
@@ -298,15 +299,16 @@ vm_dispatch_hook (struct scm_vm *vp, int hook_num, SCM
*argv, int n)
SCM args[2];
args[0] = SCM_PACK_POINTER (frame);
- args[1] = argv[0];
+ args[1] = argv[0].scm;
scm_c_run_hookn (hook, args, 2);
}
else
{
SCM args = SCM_EOL;
+ int i;
- while (n--)
- args = scm_cons (argv[n], args);
+ for (i = 0; i < n; i++)
+ args = scm_cons (argv[i].scm, args);
scm_c_run_hook (hook, scm_cons (SCM_PACK_POINTER (frame), args));
}
@@ -322,11 +324,11 @@ static void vm_dispatch_push_continuation_hook (struct
scm_vm *vp)
{
return vm_dispatch_hook (vp, SCM_VM_PUSH_CONTINUATION_HOOK, NULL, 0);
}
-static void vm_dispatch_pop_continuation_hook (struct scm_vm *vp, SCM *old_fp)
+static void vm_dispatch_pop_continuation_hook (struct scm_vm *vp,
+ union scm_vm_stack_element
*old_fp)
{
return vm_dispatch_hook (vp, SCM_VM_POP_CONTINUATION_HOOK,
- &SCM_FRAME_LOCAL (old_fp, 1),
- SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1);
+ vp->sp, SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1);
}
static void vm_dispatch_next_hook (struct scm_vm *vp)
{
@@ -335,38 +337,27 @@ static void vm_dispatch_next_hook (struct scm_vm *vp)
static void vm_dispatch_abort_hook (struct scm_vm *vp)
{
return vm_dispatch_hook (vp, SCM_VM_ABORT_CONTINUATION_HOOK,
- &SCM_FRAME_LOCAL (vp->fp, 1),
- SCM_FRAME_NUM_LOCALS (vp->fp, vp->sp) - 1);
+ vp->sp, SCM_FRAME_NUM_LOCALS (vp->fp, vp->sp) - 1);
}
static void
-vm_abort (struct scm_vm *vp, SCM tag,
- size_t nstack, SCM *stack_args, SCM tail, SCM *sp,
+vm_abort (struct scm_vm *vp, SCM tag, size_t nargs,
scm_i_jmp_buf *current_registers) SCM_NORETURN;
static void
-vm_abort (struct scm_vm *vp, SCM tag,
- size_t nstack, SCM *stack_args, SCM tail, SCM *sp,
+vm_abort (struct scm_vm *vp, SCM tag, size_t nargs,
scm_i_jmp_buf *current_registers)
{
size_t i;
- ssize_t tail_len;
SCM *argv;
- tail_len = scm_ilength (tail);
- if (tail_len < 0)
- scm_misc_error ("vm-engine", "tail values to abort should be a list",
- scm_list_1 (tail));
+ argv = alloca (nargs * sizeof (SCM));
+ for (i = 0; i < nargs; i++)
+ argv[i] = vp->sp[nargs - i - 1].scm;
- argv = alloca ((nstack + tail_len) * sizeof (SCM));
- for (i = 0; i < nstack; i++)
- argv[i] = stack_args[i];
- for (; i < nstack + tail_len; i++, tail = scm_cdr (tail))
- argv[i] = scm_car (tail);
+ vp->sp = vp->fp;
- vp->sp = sp;
-
- scm_c_abort (vp, tag, nstack + tail_len, argv, current_registers);
+ scm_c_abort (vp, tag, nargs, argv, current_registers);
}
struct vm_reinstate_partial_continuation_data
@@ -382,23 +373,23 @@ vm_reinstate_partial_continuation_inner (void *data_ptr)
struct vm_reinstate_partial_continuation_data *data = data_ptr;
struct scm_vm *vp = data->vp;
struct scm_vm_cont *cp = data->cp;
- SCM *base;
+ union scm_vm_stack_element *base_fp;
scm_t_ptrdiff reloc;
- base = SCM_FRAME_LOCALS_ADDRESS (vp->fp);
- reloc = cp->reloc + (base - cp->stack_base);
+ base_fp = vp->fp;
+ reloc = cp->reloc + (base_fp - (cp->stack_bottom + cp->stack_size));
- memcpy (base, cp->stack_base, cp->stack_size * sizeof (SCM));
+ memcpy (base_fp - cp->stack_size,
+ cp->stack_bottom,
+ cp->stack_size * sizeof (*cp->stack_bottom));
vp->fp = cp->fp + reloc;
vp->ip = cp->ra;
/* now relocate frame pointers */
{
- SCM *fp;
- for (fp = vp->fp;
- SCM_FRAME_LOWER_ADDRESS (fp) >= base;
- fp = SCM_FRAME_DYNAMIC_LINK (fp))
+ union scm_vm_stack_element *fp;
+ for (fp = vp->fp; fp < base_fp; fp = SCM_FRAME_DYNAMIC_LINK (fp))
SCM_FRAME_SET_DYNAMIC_LINK (fp, SCM_FRAME_DYNAMIC_LINK (fp) + reloc);
}
@@ -408,32 +399,32 @@ vm_reinstate_partial_continuation_inner (void *data_ptr)
}
static void
-vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont,
- size_t n, SCM *argv,
+vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont, size_t nargs,
scm_t_dynstack *dynstack,
scm_i_jmp_buf *registers)
{
struct vm_reinstate_partial_continuation_data data;
struct scm_vm_cont *cp;
- SCM *argv_copy;
+ union scm_vm_stack_element *args;
scm_t_ptrdiff reloc;
- size_t i;
- argv_copy = alloca (n * sizeof(SCM));
- memcpy (argv_copy, argv, n * sizeof(SCM));
+ args = alloca (nargs * sizeof (*args));
+ memcpy (args, vp->sp, nargs * sizeof (*args));
cp = SCM_VM_CONT_DATA (cont);
- vm_push_sp (vp, SCM_FRAME_LOCALS_ADDRESS (vp->fp) + cp->stack_size + n - 1);
+ vm_push_sp (vp, vp->fp - (cp->stack_size + nargs + 1));
data.vp = vp;
data.cp = cp;
GC_call_with_alloc_lock (vm_reinstate_partial_continuation_inner, &data);
reloc = data.reloc;
- /* Push the arguments. */
- for (i = 0; i < n; i++)
- vp->sp[i + 1 - n] = argv_copy[i];
+ /* The resume continuation will expect ARGS on the stack as if from a
+ multiple-value return. Fill in the closure slot with #f, and copy
+ the arguments into place. */
+ vp->sp[nargs].scm = SCM_BOOL_F;
+ memcpy (vp->sp, args, nargs * sizeof (*args));
/* The prompt captured a slice of the dynamic stack. Here we wind
those entries onto the current thread's stack. We also have to
@@ -789,20 +780,22 @@ typedef SCM (*scm_t_vm_engine) (scm_i_thread
*current_thread, struct scm_vm *vp,
static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] =
{ vm_regular_engine, vm_debug_engine };
-static SCM*
+static union scm_vm_stack_element*
allocate_stack (size_t size)
-#define FUNC_NAME "make_vm"
{
void *ret;
- if (size >= ((size_t) -1) / sizeof (SCM))
+ if (size >= ((size_t) -1) / sizeof (union scm_vm_stack_element))
abort ();
- size *= sizeof (SCM);
+ size *= sizeof (union scm_vm_stack_element);
#if HAVE_SYS_MMAN_H
ret = mmap (NULL, size, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+ if (ret == NULL)
+ /* Shouldn't happen. */
+ abort ();
if (ret == MAP_FAILED)
ret = NULL;
#else
@@ -810,19 +803,15 @@ allocate_stack (size_t size)
#endif
if (!ret)
- {
- perror ("allocate_stack failed");
- return NULL;
- }
+ perror ("allocate_stack failed");
- return (SCM *) ret;
+ return (union scm_vm_stack_element *) ret;
}
-#undef FUNC_NAME
static void
-free_stack (SCM *stack, size_t size)
+free_stack (union scm_vm_stack_element *stack, size_t size)
{
- size *= sizeof (SCM);
+ size *= sizeof (*stack);
#if HAVE_SYS_MMAN_H
munmap (stack, size);
@@ -831,36 +820,38 @@ free_stack (SCM *stack, size_t size)
#endif
}
-static SCM*
-expand_stack (SCM *old_stack, size_t old_size, size_t new_size)
+/* Ideally what we would like is an mremap or a realloc that grows at
+ the bottom, not the top. Oh well; mmap and memcpy are fast enough,
+ considering that they run very infrequently. */
+static union scm_vm_stack_element*
+expand_stack (union scm_vm_stack_element *old_bottom, size_t old_size,
+ size_t new_size)
#define FUNC_NAME "expand_stack"
{
-#if defined MREMAP_MAYMOVE
- void *new_stack;
+ union scm_vm_stack_element *new_bottom;
+ size_t extension_size;
- if (new_size >= ((size_t) -1) / sizeof (SCM))
+ if (new_size >= ((size_t) -1) / sizeof (union scm_vm_stack_element))
+ abort ();
+ if (new_size <= old_size)
abort ();
- old_size *= sizeof (SCM);
- new_size *= sizeof (SCM);
+ extension_size = new_size - old_size;
- new_stack = mremap (old_stack, old_size, new_size, MREMAP_MAYMOVE);
- if (new_stack == MAP_FAILED)
- return NULL;
+ if ((size_t)old_bottom < extension_size * sizeof (union
scm_vm_stack_element))
+ abort ();
- return (SCM *) new_stack;
-#else
- SCM *new_stack;
+ new_bottom = allocate_stack (new_size);
- new_stack = allocate_stack (new_size);
- if (!new_stack)
+ if (!new_bottom)
return NULL;
- memcpy (new_stack, old_stack, old_size * sizeof (SCM));
- free_stack (old_stack, old_size);
+ memcpy (new_bottom + extension_size,
+ old_bottom,
+ old_size * sizeof (union scm_vm_stack_element));
+ free_stack (old_bottom, old_size);
- return new_stack;
-#endif
+ return new_bottom;
}
#undef FUNC_NAME
@@ -873,19 +864,21 @@ make_vm (void)
vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
- vp->stack_size = page_size / sizeof (SCM);
- vp->stack_base = allocate_stack (vp->stack_size);
- if (!vp->stack_base)
+ vp->stack_size = page_size / sizeof (union scm_vm_stack_element);
+ vp->stack_bottom = allocate_stack (vp->stack_size);
+ if (!vp->stack_bottom)
/* 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->stack_top = vp->stack_bottom + vp->stack_size;
+ vp->stack_limit = vp->stack_bottom;
vp->overflow_handler_stack = SCM_EOL;
- vp->ip = NULL;
- vp->sp = vp->stack_base - 1;
- vp->fp = NULL;
- vp->engine = vm_default_engine;
+ vp->ip = NULL;
+ vp->sp = vp->stack_top;
+ vp->sp_min_since_gc = vp->sp;
+ vp->fp = NULL;
+ vp->engine = vm_default_engine;
vp->trace_level = 0;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
vp->hooks[i] = SCM_BOOL_F;
@@ -898,30 +891,30 @@ 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 + 1);
- scm_t_uintptr end = (scm_t_uintptr) vp->stack_limit;
+ scm_t_uintptr lo = (scm_t_uintptr) vp->stack_bottom;
+ scm_t_uintptr hi = (scm_t_uintptr) vp->sp;
/* The second condition is needed to protect against wrap-around. */
- if (vp->sp_max_since_gc < vp->stack_limit && vp->sp < vp->sp_max_since_gc)
- end = (scm_t_uintptr) (vp->sp_max_since_gc + 1);
+ if (vp->sp_min_since_gc >= vp->stack_bottom && vp->sp >= vp->sp_min_since_gc)
+ lo = (scm_t_uintptr) vp->sp_min_since_gc;
- start = ((start - 1U) | (page_size - 1U)) + 1U; /* round up */
- end = ((end - 1U) | (page_size - 1U)) + 1U; /* round up */
+ lo &= ~(page_size - 1U); /* round down */
+ hi &= ~(page_size - 1U); /* round down */
/* Return these pages to the OS. The next time they are paged in,
they will be zeroed. */
- if (start < end)
+ if (lo < hi)
{
int ret = 0;
do
- ret = madvise ((void *) start, end - start, MADV_DONTNEED);
+ ret = madvise ((void *) lo, hi - lo, MADV_DONTNEED);
while (ret && errno == -EAGAIN);
if (ret)
perror ("madvise failed");
}
- vp->sp_max_since_gc = vp->sp;
+ vp->sp_min_since_gc = vp->sp;
#endif
}
@@ -957,45 +950,44 @@ find_dead_slot_map (scm_t_uint32 *ip, struct
dead_slot_map_cache *cache)
return map;
}
-/* Mark the VM stack region between its base and its current top. */
+/* Mark the active VM stack region. */
struct GC_ms_entry *
scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
struct GC_ms_entry *mark_stack_limit)
{
- SCM *sp, *fp;
+ union scm_vm_stack_element *sp, *fp;
/* The first frame will be marked conservatively (without a dead
slot map). This is because GC can happen at any point within the
hottest activation, due to multiple threads or per-instruction
hooks, and providing dead slot maps for all points in a program
would take a prohibitive amount of space. */
const scm_t_uint8 *dead_slots = NULL;
- scm_t_uintptr upper = (scm_t_uintptr) GC_greatest_plausible_heap_addr;
- scm_t_uintptr lower = (scm_t_uintptr) GC_least_plausible_heap_addr;
+ void *upper = (void *) GC_greatest_plausible_heap_addr;
+ void *lower = (void *) GC_least_plausible_heap_addr;
struct dead_slot_map_cache cache;
memset (&cache, 0, sizeof (cache));
for (fp = vp->fp, sp = vp->sp; fp; fp = SCM_FRAME_DYNAMIC_LINK (fp))
{
- for (; sp >= &SCM_FRAME_LOCAL (fp, 0); sp--)
+ scm_t_ptrdiff nlocals = SCM_FRAME_NUM_LOCALS (fp, sp);
+ size_t slot = nlocals - 1;
+ for (slot = nlocals - 1; sp < fp; sp++, slot--)
{
- SCM elt = *sp;
- if (SCM_NIMP (elt)
- && SCM_UNPACK (elt) >= lower && SCM_UNPACK (elt) <= upper)
+ if (SCM_NIMP (sp->scm) && sp->ptr >= lower && sp->ptr <= upper)
{
if (dead_slots)
{
- size_t slot = sp - &SCM_FRAME_LOCAL (fp, 0);
if (dead_slots[slot / 8U] & (1U << (slot % 8U)))
{
/* This value may become dead as a result of GC,
so we can't just leave it on the stack. */
- *sp = SCM_UNSPECIFIED;
+ sp->scm = SCM_UNSPECIFIED;
continue;
}
}
- mark_stack_ptr = GC_mark_and_push ((void *) elt,
+ mark_stack_ptr = GC_mark_and_push (sp->ptr,
mark_stack_ptr,
mark_stack_limit,
NULL);
@@ -1018,8 +1010,8 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct
GC_ms_entry *mark_stack_ptr,
void
scm_i_vm_free_stack (struct scm_vm *vp)
{
- free_stack (vp->stack_base, vp->stack_size);
- vp->stack_base = vp->stack_limit = NULL;
+ free_stack (vp->stack_bottom, vp->stack_size);
+ vp->stack_bottom = vp->stack_top = vp->stack_limit = NULL;
vp->stack_size = 0;
}
@@ -1027,7 +1019,7 @@ struct vm_expand_stack_data
{
struct scm_vm *vp;
size_t stack_size;
- SCM *new_sp;
+ union scm_vm_stack_element *new_sp;
};
static void *
@@ -1036,34 +1028,35 @@ vm_expand_stack_inner (void *data_ptr)
struct vm_expand_stack_data *data = data_ptr;
struct scm_vm *vp = data->vp;
- SCM *old_stack, *new_stack;
+ union scm_vm_stack_element *old_top, *new_bottom;
size_t new_size;
scm_t_ptrdiff reloc;
+ old_top = vp->stack_top;
new_size = vp->stack_size;
while (new_size < data->stack_size)
new_size *= 2;
- old_stack = vp->stack_base;
- new_stack = expand_stack (vp->stack_base, vp->stack_size, new_size);
- if (!new_stack)
+ new_bottom = expand_stack (vp->stack_bottom, vp->stack_size, new_size);
+ if (!new_bottom)
return NULL;
- vp->stack_base = new_stack;
+ vp->stack_bottom = new_bottom;
vp->stack_size = new_size;
- vp->stack_limit = vp->stack_base + new_size;
- reloc = vp->stack_base - old_stack;
+ vp->stack_top = vp->stack_bottom + new_size;
+ vp->stack_limit = vp->stack_bottom;
+ reloc = vp->stack_top - old_top;
if (reloc)
{
- SCM *fp;
+ union scm_vm_stack_element *fp;
if (vp->fp)
vp->fp += reloc;
data->new_sp += reloc;
fp = vp->fp;
while (fp)
{
- SCM *next_fp = SCM_FRAME_DYNAMIC_LINK (fp);
+ union scm_vm_stack_element *next_fp = SCM_FRAME_DYNAMIC_LINK (fp);
if (next_fp)
{
next_fp += reloc;
@@ -1073,7 +1066,7 @@ vm_expand_stack_inner (void *data_ptr)
}
}
- return new_stack;
+ return new_bottom;
}
static scm_t_ptrdiff
@@ -1095,9 +1088,9 @@ static void
reset_stack_limit (struct scm_vm *vp)
{
if (should_handle_stack_overflow (vp, vp->stack_size))
- vp->stack_limit = vp->stack_base + current_overflow_size (vp);
+ vp->stack_limit = vp->stack_top - current_overflow_size (vp);
else
- vp->stack_limit = vp->stack_base + vp->stack_size;
+ vp->stack_limit = vp->stack_bottom;
}
struct overflow_handler_data
@@ -1127,9 +1120,9 @@ unwind_overflow_handler (void *ptr)
}
static void
-vm_expand_stack (struct scm_vm *vp, SCM *new_sp)
+vm_expand_stack (struct scm_vm *vp, union scm_vm_stack_element *new_sp)
{
- scm_t_ptrdiff stack_size = new_sp + 1 - vp->stack_base;
+ scm_t_ptrdiff stack_size = vp->stack_top - new_sp;
if (stack_size > vp->stack_size)
{
@@ -1146,7 +1139,7 @@ vm_expand_stack (struct scm_vm *vp, SCM *new_sp)
new_sp = data.new_sp;
}
- vp->sp_max_since_gc = vp->sp = new_sp;
+ vp->sp_min_since_gc = vp->sp = new_sp;
if (should_handle_stack_overflow (vp, stack_size))
{
@@ -1184,7 +1177,7 @@ vm_expand_stack (struct scm_vm *vp, SCM *new_sp)
scm_dynwind_end ();
- /* Recurse */
+ /* Recurse. */
return vm_expand_stack (vp, new_sp);
}
}
@@ -1209,10 +1202,13 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
{
scm_i_thread *thread;
struct scm_vm *vp;
- SCM *base;
- ptrdiff_t base_frame_size;
- /* Cached variables. */
- scm_i_jmp_buf registers; /* used for prompts */
+ union scm_vm_stack_element *return_fp, *call_fp;
+ /* Since nargs can only describe the length of a valid argv array in
+ elements and each element is at least 4 bytes, nargs will not be
+ greater than INTMAX/2 and therefore we don't have to check for
+ overflow here or below. */
+ size_t return_nlocals = 1, call_nlocals = nargs + 1, frame_size = 2;
+ scm_t_ptrdiff stack_reserve_words;
size_t i;
thread = SCM_I_CURRENT_THREAD;
@@ -1220,32 +1216,36 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
SCM_CHECK_STACK;
- /* Check that we have enough space: 3 words for the boot continuation,
- and 3 + nargs for the procedure application. */
- base_frame_size = 3 + 3 + nargs;
- vm_push_sp (vp, vp->sp + base_frame_size);
- base = vp->sp + 1 - base_frame_size;
-
- /* Since it's possible to receive the arguments on the stack itself,
- shuffle up the arguments first. */
- for (i = nargs; i > 0; i--)
- base[6 + i - 1] = argv[i - 1];
-
- /* Push the boot continuation, which calls PROC and returns its
- result(s). */
- base[0] = SCM_PACK (vp->fp); /* dynamic link */
- base[1] = SCM_PACK (vp->ip); /* ra */
- base[2] = vm_boot_continuation;
- vp->fp = &base[2];
+ /* It's not valid for argv to point into the stack already. */
+ if ((void *) argv < (void *) vp->stack_top &&
+ (void *) argv >= (void *) vp->sp)
+ abort();
+
+ /* Check that we have enough space for the two stack frames: the
+ innermost one that makes the call, and its continuation which
+ receives the resulting value(s) and returns from the engine
+ call. */
+ stack_reserve_words = call_nlocals + frame_size + return_nlocals +
frame_size;
+ vm_push_sp (vp, vp->sp - stack_reserve_words);
+
+ call_fp = vp->sp + call_nlocals;
+ return_fp = call_fp + frame_size + return_nlocals;
+
+ SCM_FRAME_SET_RETURN_ADDRESS (return_fp, vp->ip);
+ SCM_FRAME_SET_DYNAMIC_LINK (return_fp, vp->fp);
+ SCM_FRAME_LOCAL (return_fp, 0) = vm_boot_continuation;
+
vp->ip = (scm_t_uint32 *) vm_boot_continuation_code;
+ vp->fp = call_fp;
- /* The pending call to PROC. */
- base[3] = SCM_PACK (vp->fp); /* dynamic link */
- base[4] = SCM_PACK (vp->ip); /* ra */
- base[5] = proc;
- vp->fp = &base[5];
+ SCM_FRAME_SET_RETURN_ADDRESS (call_fp, vp->ip);
+ SCM_FRAME_SET_DYNAMIC_LINK (call_fp, return_fp);
+ SCM_FRAME_LOCAL (call_fp, 0) = proc;
+ for (i = 0; i < nargs; i++)
+ SCM_FRAME_LOCAL (call_fp, i + 1) = argv[i];
{
+ scm_i_jmp_buf registers;
int resume = SCM_I_SETJMP (registers);
if (SCM_UNLIKELY (resume))
@@ -1449,7 +1449,7 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
SCM new_limit, ret;
vp = scm_the_vm ();
- stack_size = vp->sp - vp->stack_base;
+ stack_size = vp->stack_top - vp->sp;
c_limit = scm_to_ptrdiff_t (limit);
if (c_limit <= 0)
@@ -1474,7 +1474,7 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
scm_dynwind_unwind_handler (unwind_overflow_handler, &data,
SCM_F_WIND_EXPLICITLY);
- /* Reset vp->sp_max_since_gc so that the VM checks actually
+ /* Reset vp->sp_min_since_gc so that the VM checks actually
trigger. */
return_unused_stack_to_os (vp);
diff --git a/libguile/vm.h b/libguile/vm.h
index 8f88d0c..adac085 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 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
@@ -37,13 +37,14 @@ enum {
struct scm_vm {
scm_t_uint32 *ip; /* instruction pointer */
- SCM *sp; /* stack pointer */
- SCM *fp; /* frame pointer */
- SCM *stack_limit; /* stack limit address */
+ union scm_vm_stack_element *sp; /* stack pointer */
+ union scm_vm_stack_element *fp; /* frame pointer */
+ union scm_vm_stack_element *stack_limit; /* stack limit address */
int trace_level; /* traces enabled if trace_level > 0 */
- SCM *sp_max_since_gc; /* highest sp since last gc */
+ union scm_vm_stack_element *sp_min_since_gc; /* deepest sp since last gc */
size_t stack_size; /* stack size */
- SCM *stack_base; /* stack base address */
+ union scm_vm_stack_element *stack_bottom; /* lowest address in allocated
stack */
+ union scm_vm_stack_element *stack_top; /* highest address in allocated stack
*/
SCM overflow_handler_stack; /* alist of max-stack-size -> thunk */
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
int engine; /* which vm engine we're using */
@@ -78,11 +79,13 @@ SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
#define SCM_F_VM_CONT_REWINDABLE 0x2
struct scm_vm_cont {
- SCM *sp;
- SCM *fp;
+ /* FIXME: sp isn't needed, it's effectively the same as
+ stack_bottom */
+ union scm_vm_stack_element *sp;
+ union scm_vm_stack_element *fp;
scm_t_uint32 *ra;
scm_t_ptrdiff stack_size;
- SCM *stack_base;
+ union scm_vm_stack_element *stack_bottom;
scm_t_ptrdiff reloc;
scm_t_dynstack *dynstack;
scm_t_uint32 flags;
@@ -97,7 +100,9 @@ SCM_API SCM scm_load_compiled_with_vm (SCM file);
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
SCM_INTERNAL SCM scm_i_capture_current_stack (void);
-SCM_INTERNAL SCM scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp,
+SCM_INTERNAL SCM scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top,
+ union scm_vm_stack_element *fp,
+ union scm_vm_stack_element *sp,
scm_t_uint32 *ra,
scm_t_dynstack *dynstack,
scm_t_uint32 flags);
- [Guile-commits] branch master updated (315adb6 -> f039604), Andy Wingo, 2015/10/22
- [Guile-commits] 11/12: Minor assembler cleanups, Andy Wingo, 2015/10/21
- [Guile-commits] 02/12: Fix prompt miscompilation, Andy Wingo, 2015/10/21
- [Guile-commits] 04/12: VM caches address of local 0 instead of FP, Andy Wingo, 2015/10/21
- [Guile-commits] 03/12: VM stack grows downward,
Andy Wingo <=
- [Guile-commits] 12/12: Add stack size computation to disassembler, Andy Wingo, 2015/10/21
- [Guile-commits] 05/12: Remove sp from scm_vm_cont, Andy Wingo, 2015/10/21
- [Guile-commits] 08/12: Prepare for SP-addressed locals, Andy Wingo, 2015/10/21
- [Guile-commits] 09/12: Fix boot closure wrong-num-args error, Andy Wingo, 2015/10/21
- [Guile-commits] 10/12: SP-relative local addressing, Andy Wingo, 2015/10/21
- [Guile-commits] 06/12: Rename union scm_vm_stack_element members, Andy Wingo, 2015/10/21
- [Guile-commits] 01/12: Minor VM documentation updates, Andy Wingo, 2015/10/22
- [Guile-commits] 07/12: Replace dynamic link on stack with previous frame size, Andy Wingo, 2015/10/22