[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-141-gda874e5

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=da874e5415f2d9438e66b9989086465b6cbf578c

The branch, stable-2.0 has been updated
       via  da874e5415f2d9438e66b9989086465b6cbf578c (commit)
      from  7aa43cde6a73dedfb47e29cb0da495626bff6862 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit da874e5415f2d9438e66b9989086465b6cbf578c
Author: Andy Wingo <address@hidden>
Date:   Fri May 11 14:30:43 2012 +0200

    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.

-----------------------------------------------------------------------

Summary of changes:
 libguile/frames.c          |   21 ++++++++++++++++-----
 libguile/stacks.c          |    3 ++-
 module/ice-9/boot-9.scm    |    3 ++-
 module/system/vm/frame.scm |    2 +-
 4 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/libguile/frames.c b/libguile/frames.c
index 45f1c8d..a7143c4 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 9599554..37a9161 100644
--- 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
--- 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
--- 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)))


hooks/post-receive
-- 
GNU Guile