diff options
-rw-r--r-- | libguile/continuations.c | 7 | ||||
-rw-r--r-- | libguile/frames.c | 51 | ||||
-rw-r--r-- | libguile/frames.h | 23 | ||||
-rw-r--r-- | libguile/stacks.c | 7 | ||||
-rw-r--r-- | libguile/vm.c | 5 |
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); |