From 4819276185a35001d56af93177fc29a6a7700000 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 16 Apr 2014 14:33:20 +0200
Subject: [PATCH] Better backtraces from C, especially for optimized closures

* libguile/frames.h:
* libguile/frames.c (scm_frame_call_representation): New interface;
  dispatches to Scheme.

* libguile/backtrace.c (display_application): Use
  scm_frame_call_representation.  This should be monotonically better,
  given that scm_frame_arguments (which was previously called) also
  dispatched to Scheme and actually ended up calling
  frame-call-representation.
---
 libguile/backtrace.c | 11 ++---------
 libguile/frames.c    | 21 +++++++++++++++++++++
 libguile/frames.h    |  1 +
 3 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index e247aa7af..fa12a5dd0 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -1,5 +1,5 @@
 /* Printing of backtraces and error messages
- * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 2011 Free Software Foundation
+ * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 2011, 2014 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
@@ -262,14 +262,7 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S
 static void
 display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate)
 {
-  SCM proc = scm_frame_procedure (frame);
-  SCM name = (scm_is_true (scm_procedure_p (proc))
-	      ? scm_procedure_name (proc)
-	      : SCM_BOOL_F);
-  display_frame_expr ("[",
-		      scm_cons (scm_is_true (name) ? name : proc,
-				scm_frame_arguments (frame)),
-		      "]",
+  display_frame_expr ("[", scm_frame_call_representation (frame), "]",
 		      indentation,
 		      sport,
 		      port,
diff --git a/libguile/frames.c b/libguile/frames.c
index 6096824c7..105b15455 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -171,6 +171,27 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM frame_call_representation_var;
+
+static void
+init_frame_call_representation_var (void)
+{
+  frame_call_representation_var
+    = scm_c_private_lookup ("system vm frame", "frame-call-representation");
+}
+
+SCM scm_frame_call_representation (SCM frame)
+#define FUNC_NAME "frame-call-representation"
+{
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_frame_call_representation_var);
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  return scm_call_1 (scm_variable_ref (frame_call_representation_var), frame);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
 	    (SCM frame),
 	    "")
diff --git a/libguile/frames.h b/libguile/frames.h
index 6defff5fd..394fddc74 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -181,6 +181,7 @@ SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
 
 SCM_API SCM scm_frame_p (SCM obj);
 SCM_API SCM scm_frame_procedure (SCM frame);
+SCM_API SCM scm_frame_call_representation (SCM frame);
 SCM_API SCM scm_frame_arguments (SCM frame);
 SCM_API SCM scm_frame_source (SCM frame);
 SCM_API SCM scm_frame_num_locals (SCM frame);