mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

The dynamic stack records SP and FP values as offsets

Browse source 
* libguile/dynstack.h:
* libguile/dynstack.c (PROMPT_FP, PROMPT_SP):
  (scm_dynstack_push_prompt, scm_dynstack_find_prompt): Prompts on the
  dynstack are recorded as offsets from the base stack address in this
  thread.

* libguile/control.c (scm_c_abort):
* libguile/eval.c (eval):
* libguile/stacks.c (find_prompt, narrow_stack):
* libguile/throw.c (pre_init_catch):
* libguile/vm-engine.c (prompt): Adapt.
This commit is contained in:
Andy Wingo 2013-11-21 12:12:38 +01:00
parent a3da449801
commit 0bca90aac9
8 changed files with 50 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/control.c
View file

@ -129,17 +129,22 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack; scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
scm_t_bits *prompt; scm_t_bits *prompt;
scm_t_dynstack_prompt_flags flags; scm_t_dynstack_prompt_flags flags;
scm_t_ptrdiff fp_offset, sp_offset;
SCM *fp, *sp; SCM *fp, *sp;
scm_t_uint32 *ip; scm_t_uint32 *ip;
scm_i_jmp_buf *registers; scm_i_jmp_buf *registers;
size_t i; size_t i;
prompt = scm_dynstack_find_prompt (dynstack, tag, prompt = scm_dynstack_find_prompt (dynstack, tag,
&flags, &fp, &sp, &ip, &registers); &flags, &fp_offset, &sp_offset, &ip,
&registers);
if (!prompt) if (!prompt)
scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag)); scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
fp = SCM_VM_DATA (vm)->stack_base + fp_offset;
sp = SCM_VM_DATA (vm)->stack_base + sp_offset;
/* Only reify if the continuation referenced in the handler. */ /* Only reify if the continuation referenced in the handler. */
if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY) if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
cont = SCM_BOOL_F; cont = SCM_BOOL_F;

24
libguile/dynstack.c
View file

@ -36,8 +36,8 @@
#define PROMPT_WORDS 5 #define PROMPT_WORDS 5
#define PROMPT_KEY(top) (SCM_PACK ((top)[0])) #define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
#define PROMPT_FP(top) ((SCM *) ((top)[1])) #define PROMPT_FP(top) ((scm_t_ptrdiff) ((top)[1]))
#define PROMPT_SP(top) ((SCM *) ((top)[2])) #define PROMPT_SP(top) ((scm_t_ptrdiff) ((top)[2]))
#define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3])) #define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3]))
#define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4])) #define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4]))
@ -186,16 +186,16 @@ void
scm_dynstack_push_prompt (scm_t_dynstack *dynstack, scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
scm_t_dynstack_prompt_flags flags, scm_t_dynstack_prompt_flags flags,
SCM key, SCM key,
SCM *fp, SCM *sp, scm_t_uint32 *ip, scm_t_ptrdiff fp_offset, scm_t_ptrdiff sp_offset,
scm_i_jmp_buf *registers) scm_t_uint32 *ip, scm_i_jmp_buf *registers)
{ {
scm_t_bits *words; scm_t_bits *words;
words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags, words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags,
PROMPT_WORDS); PROMPT_WORDS);
words[0] = SCM_UNPACK (key); words[0] = SCM_UNPACK (key);
words[1] = (scm_t_bits) fp; words[1] = (scm_t_bits) fp_offset;
words[2] = (scm_t_bits) sp; words[2] = (scm_t_bits) sp_offset;
words[3] = (scm_t_bits) ip; words[3] = (scm_t_bits) ip;
words[4] = (scm_t_bits) registers; words[4] = (scm_t_bits) registers;
} }
@ -442,8 +442,8 @@ scm_dynstack_unwind_fork (scm_t_dynstack *dynstack, scm_t_dynstack *branch)
scm_t_bits* scm_t_bits*
scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key, scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
scm_t_dynstack_prompt_flags *flags, scm_t_dynstack_prompt_flags *flags,
SCM **fp, SCM **sp, scm_t_uint32 **ip, scm_t_ptrdiff *fp_offset, scm_t_ptrdiff *sp_offset,
scm_i_jmp_buf **registers) scm_t_uint32 **ip, scm_i_jmp_buf **registers)
{ {
scm_t_bits *walk; scm_t_bits *walk;
@ -457,10 +457,10 @@ scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
{ {
if (flags) if (flags)
*flags = SCM_DYNSTACK_TAG_FLAGS (tag); *flags = SCM_DYNSTACK_TAG_FLAGS (tag);
if (fp) if (fp_offset)
*fp = PROMPT_FP (walk); *fp_offset = PROMPT_FP (walk);
if (sp) if (sp_offset)
*sp = PROMPT_SP (walk); *sp_offset = PROMPT_SP (walk);
if (ip) if (ip)
*ip = PROMPT_IP (walk); *ip = PROMPT_IP (walk);
if (registers) if (registers)

8
libguile/dynstack.h
View file

@ -155,7 +155,9 @@ SCM_INTERNAL void scm_dynstack_push_fluid (scm_t_dynstack *,
SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *, SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
scm_t_dynstack_prompt_flags, scm_t_dynstack_prompt_flags,
SCM key, SCM key,
SCM *fp, SCM *sp, scm_t_uint32 *ip, scm_t_ptrdiff fp_offset,
scm_t_ptrdiff sp_offset,
scm_t_uint32 *ip,
scm_i_jmp_buf *registers); scm_i_jmp_buf *registers);
SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *, SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *,
SCM enter, SCM leave); SCM enter, SCM leave);
@ -191,7 +193,9 @@ SCM_INTERNAL void scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack,
SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM, SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
scm_t_dynstack_prompt_flags *, scm_t_dynstack_prompt_flags *,
SCM **, SCM **, scm_t_uint32 **, scm_t_ptrdiff *,
scm_t_ptrdiff *,
scm_t_uint32 **,
scm_i_jmp_buf **); scm_i_jmp_buf **);
SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *, SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *,

10
libguile/eval.c
View file

@ -449,12 +449,12 @@ eval (SCM x, SCM env)
vm = scm_the_vm (); vm = scm_the_vm ();
/* Push the prompt onto the dynamic stack. */ /* Push the prompt onto the dynamic stack. */
scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack, scm_dynstack_push_prompt
SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY (&SCM_I_CURRENT_THREAD->dynstack,
| SCM_F_DYNSTACK_PROMPT_PUSH_NARGS, SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
k, k,
SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->fp - SCM_VM_DATA (vm)->stack_base,
SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->sp - SCM_VM_DATA (vm)->stack_base,
SCM_VM_DATA (vm)->ip, SCM_VM_DATA (vm)->ip,
&registers); &registers);

10
libguile/frames.h
View file

@ -148,10 +148,12 @@ struct scm_frame
#define SCM_VM_FRAME_P(x) (SCM_HAS_TYP7 (x, scm_tc7_frame)) #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_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_STACK_HOLDER(f) SCM_VM_FRAME_DATA (f)->stack_holder
#define SCM_VM_FRAME_FP(f) (SCM_VM_FRAME_DATA(f)->fp_offset + scm_i_frame_stack_base(f)) #define SCM_VM_FRAME_FP_OFFSET(f) SCM_VM_FRAME_DATA (f)->fp_offset
#define SCM_VM_FRAME_SP(f) (SCM_VM_FRAME_DATA(f)->sp_offset + scm_i_frame_stack_base(f)) #define SCM_VM_FRAME_SP_OFFSET(f) SCM_VM_FRAME_DATA (f)->sp_offset
#define SCM_VM_FRAME_IP(f) SCM_VM_FRAME_DATA(f)->ip #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_IP(f) SCM_VM_FRAME_DATA (f)->ip
#define SCM_VM_FRAME_OFFSET(f) scm_i_frame_offset (f) #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) #define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)

16
libguile/stacks.c
View file

@ -95,17 +95,17 @@ stack_depth (SCM frame)
* encountered. * encountered.
*/ */
static SCM* static scm_t_ptrdiff
find_prompt (SCM key) find_prompt (SCM key)
{ {
SCM *fp; scm_t_ptrdiff fp_offset;
if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key, if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
NULL, &fp, NULL, NULL, NULL)) NULL, &fp_offset, NULL, NULL, NULL))
scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack", scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
scm_list_1 (key)); scm_list_1 (key));
return fp; return fp_offset;
} }
static void static void
@ -144,9 +144,9 @@ narrow_stack (SCM stack, SCM inner_cut, SCM outer_cut)
else else
{ {
/* Cut until the given prompt tag is seen. */ /* Cut until the given prompt tag is seen. */
SCM *fp = find_prompt (inner_cut); scm_t_ptrdiff fp_offset = find_prompt (inner_cut);
for (; len; len--, frame = scm_frame_previous (frame)) for (; len; len--, frame = scm_frame_previous (frame))
if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame)) if (fp_offset == SCM_VM_FRAME_FP_OFFSET (frame))
break; break;
} }
@ -178,12 +178,12 @@ narrow_stack (SCM stack, SCM inner_cut, SCM outer_cut)
else else
{ {
/* Cut until the given prompt tag is seen. */ /* Cut until the given prompt tag is seen. */
SCM *fp = find_prompt (outer_cut); scm_t_ptrdiff fp_offset = find_prompt (outer_cut);
while (len) while (len)
{ {
frame = scm_stack_ref (stack, scm_from_long (len - 1)); frame = scm_stack_ref (stack, scm_from_long (len - 1));
len--; len--;
if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame)) if (fp_offset == SCM_VM_FRAME_FP_OFFSET (frame))
break; break;
} }
} }

4
libguile/throw.c
View file

@ -477,8 +477,8 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
| SCM_F_DYNSTACK_PROMPT_PUSH_NARGS, | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
sym_pre_init_catch_tag, sym_pre_init_catch_tag,
SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->fp - SCM_VM_DATA (vm)->stack_base,
SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->sp - SCM_VM_DATA (vm)->stack_base,
SCM_VM_DATA (vm)->ip, SCM_VM_DATA (vm)->ip,
&registers); &registers);

4
libguile/vm-engine.c
View file

@ -2050,8 +2050,8 @@ VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0; flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
scm_dynstack_push_prompt (&current_thread->dynstack, flags, scm_dynstack_push_prompt (&current_thread->dynstack, flags,
LOCAL_REF (tag), LOCAL_REF (tag),
fp, fp - vp->stack_base,
LOCAL_ADDRESS (proc_slot), LOCAL_ADDRESS (proc_slot) - vp->stack_base,
ip + offset, ip + offset,
&registers); &registers);
NEXT (3); NEXT (3);