From da874e5415f2d9438e66b9989086465b6cbf578c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 11 May 2012 14:30:43 +0200 Subject: fix more assumptions that the frame-procedure is a procedure * libguile/frames.c (scm_frame_source, scm_frame_previous): * libguile/stacks.c (scm_make_stack): * module/ice-9/boot-9.scm (exception-printers): * module/system/vm/frame.scm (frame-call-representation): Fix more assumptions that frame-procedure is a program, or even a procedure. --- libguile/frames.c | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'libguile/frames.c') diff --git a/libguile/frames.c b/libguile/frames.c index 45f1c8d92..a7143c411 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -104,11 +104,18 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0, "") #define FUNC_NAME s_scm_frame_source { + SCM proc; + SCM_VALIDATE_VM_FRAME (1, frame); - return scm_program_source (scm_frame_procedure (frame), - scm_frame_instruction_pointer (frame), - SCM_UNDEFINED); + proc = scm_frame_procedure (frame); + + if (SCM_PROGRAM_P (proc)) + return scm_program_source (scm_frame_procedure (frame), + scm_frame_instruction_pointer (frame), + SCM_UNDEFINED); + + return SCM_BOOL_F; } #undef FUNC_NAME @@ -296,6 +303,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, #define FUNC_NAME s_scm_frame_previous { SCM *this_fp, *new_fp, *new_sp; + SCM proc; SCM_VALIDATE_VM_FRAME (1, frame); @@ -303,13 +311,16 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, this_fp = SCM_VM_FRAME_FP (frame); new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp); if (new_fp) - { new_fp = RELOC (frame, new_fp); + { + new_fp = RELOC (frame, new_fp); new_sp = SCM_FRAME_LOWER_ADDRESS (this_fp) - 1; 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)); - if (SCM_PROGRAM_IS_BOOT (scm_frame_procedure (frame))) + proc = scm_frame_procedure (frame); + + if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc)) goto again; else return frame; -- cgit v1.2.3