X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/c04bf4337b88ea45641065b7fe70dd0973b8ce94..7974c57937104b0617d93fa492d3bd323b053f20:/libguile/backtrace.c diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 11a0cb1ee..0c0f11007 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -1,5 +1,6 @@ /* 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 @@ -26,9 +27,7 @@ #include "libguile/_scm.h" -#ifdef HAVE_UNISTD_H #include -#endif #ifdef HAVE_IO_H #include #endif @@ -67,24 +66,30 @@ boot_print_exception (SCM port, SCM frame, SCM key, SCM args) } #undef FUNC_NAME +static SCM print_exception_var; + +static void +init_print_exception_var (void) +{ + print_exception_var + = scm_module_variable (scm_the_root_module (), + scm_from_latin1_symbol ("print-exception")); +} + SCM scm_print_exception (SCM port, SCM frame, SCM key, SCM args) #define FUNC_NAME "print-exception" { - static SCM print_exception = SCM_BOOL_F; + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_print_exception_var); SCM_VALIDATE_OPOUTPORT (1, port); if (scm_is_true (frame)) SCM_VALIDATE_FRAME (2, frame); SCM_VALIDATE_SYMBOL (3, key); SCM_VALIDATE_LIST (4, args); - - if (scm_is_false (print_exception)) - print_exception = - scm_module_variable (scm_the_root_module (), - scm_from_latin1_symbol ("print-exception")); - return scm_call_4 (scm_variable_ref (print_exception), + return scm_call_4 (scm_variable_ref (print_exception_var), port, frame, key, args); } #undef FUNC_NAME @@ -256,14 +261,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,