From deb2df53233e44a097741a824330a8e5a82d8053 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 16 Apr 2014 19:17:38 +0200 Subject: [PATCH] frame-previous, frame-procedure robustness * 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. --- libguile/frames.c | 55 +++++++++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 21 deletions(-) diff --git a/libguile/frames.c b/libguile/frames.c index 105b15455..cf9648d57 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -130,9 +130,15 @@ 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 = frame_stack_base (kind, frame) + frame->fp_offset; + SCM *fp, *sp; + + fp = frame_stack_base (kind, frame) + frame->fp_offset; + sp = frame_stack_base (kind, frame) + frame->sp_offset; - return SCM_FRAME_PROGRAM (fp); + 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, @@ -329,29 +335,36 @@ int scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame) { SCM *this_fp, *new_fp, *new_sp; - SCM proc; + SCM *stack_base = frame_stack_base (kind, frame); 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); - if (new_fp) - { - SCM *stack_base = frame_stack_base (kind, frame); - new_fp = RELOC (kind, frame, new_fp); - new_sp = SCM_FRAME_PREVIOUS_SP (this_fp); - frame->fp_offset = new_fp - stack_base; - frame->sp_offset = new_sp - stack_base; - frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp); - - proc = SCM_FRAME_PROGRAM (new_fp); - - if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc)) - goto again; - else - return 1; - } - else + + if (!new_fp) + return 0; + + new_fp = RELOC (kind, frame, new_fp); + + if (new_fp < stack_base) 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->ip = SCM_FRAME_RETURN_ADDRESS (this_fp); + + { + SCM proc = scm_c_frame_closure (kind, frame); + if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc)) + goto again; + } + + return 1; } SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, -- 2.20.1