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.

diff --git a/libguile/frames.c b/libguile/frames.c
index 45f1c8d..a7143c4 100644 (file)
--- 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 9599554..37a9161 100644 (file)
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
 /* A stack holds a frame chain
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -278,6 +278,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 41ce924..a13e925 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -780,7 +780,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 f2ceae5..40d4080 100644 (file)
--- 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)))