diff options
author | Andy Wingo <wingo@pobox.com> | 2012-05-11 14:31:17 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-05-11 14:31:17 +0200 |
commit | ee6207d6f5c8675dc8dee36dbdb815dbc5b71b4a (patch) | |
tree | 7b4585b495647ae48a832e97cfeb30bd0b70e65c | |
parent | 968a9add65c5e3a33ab9f5b7697051c5b9282060 (diff) | |
parent | da874e5415f2d9438e66b9989086465b6cbf578c (diff) | |
download | guile-ee6207d6f5c8675dc8dee36dbdb815dbc5b71b4a.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
-rw-r--r-- | libguile/frames.c | 21 | ||||
-rw-r--r-- | libguile/stacks.c | 1 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 3 | ||||
-rw-r--r-- | module/system/vm/frame.scm | 2 |
4 files changed, 20 insertions, 7 deletions
diff --git a/libguile/frames.c b/libguile/frames.c index b90b5a28c..0338d18db 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; diff --git a/libguile/stacks.c b/libguile/stacks.c index 3f3f132ce..c3ea624ce 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -276,6 +276,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, /* FIXME: is this even possible? */ if (scm_is_true (frame) + && SCM_PROGRAM_P (scm_frame_procedure (frame)) && SCM_PROGRAM_IS_BOOT (scm_frame_procedure (frame))) frame = scm_frame_previous (frame); diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 94538fe58..c30861d4b 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -875,7 +875,8 @@ information is unavailable." (let ((proc (frame-procedure frame))) (print-location frame port) (format port "In procedure ~a:\n" - (or (procedure-name proc) proc)))) + (or (false-if-exception (procedure-name proc)) + proc)))) (print-location frame port) (catch #t diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index f2ceae598..40d4080a3 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -99,7 +99,7 @@ (define (frame-call-representation frame) (let ((p (frame-procedure frame))) (cons - (or (procedure-name p) p) + (or (false-if-exception (procedure-name p)) p) (cond ((and (program? p) (program-arguments-alist p (frame-instruction-pointer frame))) |