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

frame-previous, frame-procedure robustness

Browse source 
* libguile/frames.c (scm_c_frame_closure): Don't use SCM_FRAME_PROGRAM,
  as we don't know if the frame actually has any locals.
  (scm_c_frame_previous): More robustly detect end-of-stack.  Allows
  scm_c_frame_previous to work on partial continuations.
This commit is contained in:
Andy Wingo 2014-04-16 19:17:38 +02:00
parent 4cfa92d60f
commit deb2df5323
1 changed files with 34 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

39
libguile/frames.c
View file

@ -130,9 +130,15 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
SCM SCM
scm_c_frame_closure (enum scm_vm_frame_kind kind, const struct scm_frame *frame) scm_c_frame_closure (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
{ {
SCM *fp = frame_stack_base (kind, frame) + frame->fp_offset; SCM *fp, *sp;
return SCM_FRAME_PROGRAM (fp); fp = frame_stack_base (kind, frame) + frame->fp_offset;
sp = frame_stack_base (kind, frame) + frame->sp_offset;
if (SCM_FRAME_NUM_LOCALS (fp, sp) > 0)
return SCM_FRAME_LOCAL (fp, 0);
return SCM_BOOL_F;
} }
SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0, SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
@ -329,29 +335,36 @@ int
scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame) scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame)
{ {
SCM *this_fp, *new_fp, *new_sp; SCM *this_fp, *new_fp, *new_sp;
SCM proc; SCM *stack_base = frame_stack_base (kind, frame);
again: again:
this_fp = frame->fp_offset + frame_stack_base (kind, frame); this_fp = frame->fp_offset + stack_base;
if (this_fp == stack_base)
return 0;
new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp); new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
if (new_fp)
{ if (!new_fp)
SCM *stack_base = frame_stack_base (kind, frame); return 0;
new_fp = RELOC (kind, frame, new_fp); new_fp = RELOC (kind, frame, new_fp);
if (new_fp < stack_base)
return 0;
new_sp = SCM_FRAME_PREVIOUS_SP (this_fp); new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
frame->fp_offset = new_fp - stack_base; frame->fp_offset = new_fp - stack_base;
frame->sp_offset = new_sp - stack_base; frame->sp_offset = new_sp - stack_base;
frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp); frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp);
proc = SCM_FRAME_PROGRAM (new_fp); {
SCM proc = scm_c_frame_closure (kind, frame);
if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc)) if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
goto again; goto again;
else
return 1;
} }
else
return 0; return 1;
} }
SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,