summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/continuations.c7
-rw-r--r--libguile/frames.c51
-rw-r--r--libguile/frames.h23
-rw-r--r--libguile/stacks.c7
-rw-r--r--libguile/vm.c5
5 files changed, 67 insertions, 26 deletions
diff --git a/libguile/continuations.c b/libguile/continuations.c
index cb586e32b..7c40dbfe3 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -178,10 +178,9 @@ scm_i_continuation_to_frame (SCM continuation)
{
struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
return scm_c_make_frame (cont->vm_cont,
- data->fp + data->reloc,
- data->sp + data->reloc,
- data->ra,
- data->reloc);
+ (data->fp + data->reloc) - data->stack_base,
+ (data->sp + data->reloc) - data->stack_base,
+ data->ra);
}
else
return SCM_BOOL_F;
diff --git a/libguile/frames.c b/libguile/frames.c
index 776ded5da..0fc0b9ec1 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -24,6 +24,7 @@
#include <string.h>
#include "_scm.h"
#include "frames.h"
+#include "vm.h"
#include <verify.h>
/* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */
@@ -36,16 +37,15 @@ verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
(((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame))
SCM
-scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
- scm_t_uint32 *ip, scm_t_ptrdiff offset)
+scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
+ scm_t_ptrdiff sp_offset, scm_t_uint32 *ip)
{
struct scm_frame *p = scm_gc_malloc (sizeof (struct scm_frame),
"vmframe");
p->stack_holder = stack_holder;
- p->fp = fp;
- p->sp = sp;
+ p->fp_offset = fp_offset;
+ p->sp_offset = sp_offset;
p->ip = ip;
- p->offset = offset;
return scm_cell (scm_tc7_frame, (scm_t_bits)p);
}
@@ -60,6 +60,41 @@ scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate)
scm_puts_unlocked (">", port);
}
+SCM*
+scm_i_frame_stack_base (SCM frame)
+#define FUNC_NAME "frame-stack-base"
+{
+ SCM stack_holder;
+
+ SCM_VALIDATE_VM_FRAME (1, frame);
+
+ stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame);
+
+ if (SCM_VM_CONT_P (stack_holder))
+ return SCM_VM_CONT_DATA (stack_holder)->stack_base;
+
+ return SCM_VM_DATA (stack_holder)->stack_base;
+}
+#undef FUNC_NAME
+
+
+scm_t_ptrdiff
+scm_i_frame_offset (SCM frame)
+#define FUNC_NAME "frame-offset"
+{
+ SCM stack_holder;
+
+ SCM_VALIDATE_VM_FRAME (1, frame);
+
+ stack_holder = SCM_VM_FRAME_STACK_HOLDER (frame);
+
+ if (SCM_VM_CONT_P (stack_holder))
+ return SCM_VM_CONT_DATA (stack_holder)->reloc;
+
+ return 0;
+}
+#undef FUNC_NAME
+
/* Scheme interface */
@@ -244,12 +279,12 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
if (new_fp)
{
+ SCM *stack_base = scm_i_frame_stack_base (frame);
new_fp = RELOC (frame, new_fp);
new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
- new_fp, new_sp,
- SCM_FRAME_RETURN_ADDRESS (this_fp),
- SCM_VM_FRAME_OFFSET (frame));
+ new_fp - stack_base, new_sp - stack_base,
+ SCM_FRAME_RETURN_ADDRESS (this_fp));
proc = scm_frame_procedure (frame);
if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
diff --git a/libguile/frames.h b/libguile/frames.h
index d425b9439..bd85b7e89 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -136,26 +136,33 @@ struct scm_vm_frame
* Heap frames
*/
+#ifdef BUILDING_LIBGUILE
+
struct scm_frame
{
SCM stack_holder;
- SCM *fp;
- SCM *sp;
+ scm_t_ptrdiff fp_offset;
+ scm_t_ptrdiff sp_offset;
scm_t_uint32 *ip;
- scm_t_ptrdiff offset;
};
#define SCM_VM_FRAME_P(x) (SCM_HAS_TYP7 (x, scm_tc7_frame))
#define SCM_VM_FRAME_DATA(x) ((struct scm_frame*)SCM_CELL_WORD_1 (x))
#define SCM_VM_FRAME_STACK_HOLDER(f) SCM_VM_FRAME_DATA(f)->stack_holder
-#define SCM_VM_FRAME_FP(f) SCM_VM_FRAME_DATA(f)->fp
-#define SCM_VM_FRAME_SP(f) SCM_VM_FRAME_DATA(f)->sp
+#define SCM_VM_FRAME_FP(f) (SCM_VM_FRAME_DATA(f)->fp_offset + scm_i_frame_stack_base(f))
+#define SCM_VM_FRAME_SP(f) (SCM_VM_FRAME_DATA(f)->sp_offset + scm_i_frame_stack_base(f))
#define SCM_VM_FRAME_IP(f) SCM_VM_FRAME_DATA(f)->ip
-#define SCM_VM_FRAME_OFFSET(f) SCM_VM_FRAME_DATA(f)->offset
+#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_API SCM scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
- scm_t_uint32 *ip, scm_t_ptrdiff offset);
+SCM_INTERNAL SCM* scm_i_frame_stack_base (SCM frame);
+SCM_INTERNAL scm_t_ptrdiff scm_i_frame_offset (SCM frame);
+
+SCM_INTERNAL SCM scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
+ scm_t_ptrdiff sp_offset, scm_t_uint32 *ip);
+
+#endif
+
SCM_API SCM scm_frame_p (SCM obj);
SCM_API SCM scm_frame_procedure (SCM frame);
SCM_API SCM scm_frame_arguments (SCM frame);
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 20b67ef56..4b3016a4f 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -258,9 +258,10 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
cont = scm_i_capture_current_stack ();
c = SCM_VM_CONT_DATA (cont);
- frame = scm_c_make_frame (cont, c->fp + c->reloc,
- c->sp + c->reloc, c->ra,
- c->reloc);
+ frame = scm_c_make_frame (cont,
+ (c->fp + c->reloc) - c->stack_base,
+ (c->sp + c->reloc) - c->stack_base,
+ c->ra);
}
else if (SCM_VM_FRAME_P (obj))
frame = obj;
diff --git a/libguile/vm.c b/libguile/vm.c
index b1b594133..acb325044 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -203,10 +203,9 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
seems reasonable to limit the lifetime of frame objects. */
c_frame.stack_holder = vm;
- c_frame.fp = vp->fp;
- c_frame.sp = vp->sp;
+ c_frame.fp_offset = vp->fp - vp->stack_base;
+ c_frame.sp_offset = vp->sp - vp->stack_base;
c_frame.ip = vp->ip;
- c_frame.offset = 0;
/* Arrange for FRAME to be 8-byte aligned, like any other cell. */
frame = alloca (sizeof (*frame) + 8);