From 423fca76e6100cf9584a5a974b1c0bbaf0b1cb85 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 11 Feb 2011 12:43:05 +0100
Subject: [PATCH] frame-source available in default environment

* libguile/frames.c (scm_frame_source): Don't call out to (system vm
  frames), as this routine is used when printing exceptions.  Make
  available in the default environment (ugh).

* module/system/vm/frame.scm: Remove frame-source definition and
  export.
---
 libguile/frames.c          | 19 ++++++++++---------
 module/system/vm/frame.scm | 10 ++--------
 2 files changed, 12 insertions(+), 17 deletions(-)

diff --git a/libguile/frames.c b/libguile/frames.c
index 2f870843b..bc1bb82a8 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -92,17 +92,18 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_frame_source (SCM frame)
+SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_frame_source
 {
-  static SCM var = SCM_BOOL_F;
-  
-  if (scm_is_false (var))
-    var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
-                               "frame-source");
+  SCM_VALIDATE_VM_FRAME (1, frame);
 
-  return scm_call_1 (SCM_VARIABLE_REF (var), frame);
+  return scm_program_source (scm_frame_procedure (frame),
+                             scm_frame_instruction_pointer (frame),
+                             SCM_UNDEFINED);
 }
+#undef FUNC_NAME
 
 /* The number of locals would be a simple thing to compute, if it weren't for
    the presence of not-yet-active frames on the stack. So we have a cheap
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 94619badf..37f621b90 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM frame functions
 
-;;; Copyright (C) 2001, 2005, 2009, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2005, 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -26,7 +26,7 @@
   #:export (frame-bindings
             frame-lookup-binding
             frame-binding-ref frame-binding-set!
-            frame-source frame-next-source frame-call-representation
+            frame-next-source frame-call-representation
             frame-environment
             frame-object-binding frame-object-name
             frame-return-values))
@@ -70,12 +70,6 @@
 ;;; Pretty printing
 ;;;
 
-(define (frame-source frame)
-  (let ((proc (frame-procedure frame)))
-    (program-source proc
-                    (frame-instruction-pointer frame)
-                    (program-sources proc))))
-
 (define (frame-next-source frame)
   (let ((proc (frame-procedure frame)))
     (program-source proc