Add C backtrace API.

Useful for at least debugging.

Supported in Linux and OS X (possibly to some extent in *BSD).

See perlhacktips for details.

22 files changed, 986 insertions, 2 deletions

diff --git a/Configure b/Configure
index f3f648b89c..f7056ef3b5 100755
--- a/Configure
+++ b/Configure
@@ -422,9 +422,11 @@ d_dbminitproto=''
 d_difftime=''
 d_dir_dd_fd=''
 d_dirfd=''
+d_dladdr=''
 d_dlerror=''
 d_dlopen=''
 d_dlsymun=''
+d_backtrace=''
 d_dosuid=''
 d_suidsafe=''
 d_drand48_r=''
@@ -883,6 +885,7 @@ html3direxp=''
 installhtml3dir=''
 i_arpainet=''
 i_assert=''
+i_bfd=''
 i_crypt=''
 db_hashtype=''
 db_prefixtype=''
@@ -896,6 +899,7 @@ d_dirnamlen=''
 direntrytype=''
 i_dirent=''
 i_dlfcn=''
+i_execinfo=''
 i_fcntl=''
 i_float=''
 i_fp=''
@@ -1233,6 +1237,7 @@ uidtype=''
 archname64=''
 use64bitall=''
 use64bitint=''
+usecbacktrace=''
 dtrace=''
 usedtrace=''
 usefaststdio=''
@@ -5152,6 +5157,9 @@ esac
 case "$usesocks" in
 "$define") libswanted="$libswanted socks5 socks5_sh" ;;
 esac
+case "$usecbacktrace" in
+"$define") libswanted="$libswanted bfd" ;;
+esac
 libsfound=''
 libsfiles=''
 libsdirs=''
@@ -12209,6 +12217,10 @@ set d_dirfd
 eval $setvar
 $rm -f dirfd*
 
+: see if dladdr exists
+set dladdr d_dladdr
+eval $inlibc
+
 : see if dlerror exists
 xxx_runnm="$runnm"
 runnm=false
@@ -12331,6 +12343,21 @@ $rm -f fred fred.* dyna.$dlext dyna.* tmp-dyna.*
 set d_dlsymun
 eval $setvar
 
+: see if backtrace exists
+set backtrace d_backtrace
+eval $inlibc
+
+: add flags if using c backtrace
+case "$usecbacktrace" in
+[yY]*|true|$define)
+  case " $ccflags " in
+  *" -DUSE_C_BACKTRACE "*) ;; # Already there.
+  *) ccflags="$ccflags -DUSE_C_BACKTRACE -g"
+     ;;
+  esac
+  ;;
+esac
+
 : see if drand48_r exists
 set drand48_r d_drand48_r
 eval $inlibc
@@ -12796,6 +12823,10 @@ case "$d_endservent_r" in
 	;;
 esac
 
+: see if this is an execinfo.h system
+set execinfo.h i_execinfo
+eval $inhdr
+
 : Locate the flags for 'open()'
 echo " "
 $cat >try.c <<EOCP
@@ -21924,6 +21955,10 @@ esac
 set assert.h i_assert
 eval $inhdr
 
+: see if this is a bfd.h system
+set bfd.h i_bfd
+eval $inhdr
+
 : see if this is a fp.h system
 set fp.h i_fp
 eval $inhdr
@@ -23084,9 +23119,11 @@ d_difftime='$d_difftime'
 d_dir_dd_fd='$d_dir_dd_fd'
 d_dirfd='$d_dirfd'
 d_dirnamlen='$d_dirnamlen'
+d_dladdr='$d_dladdr'
 d_dlerror='$d_dlerror'
 d_dlopen='$d_dlopen'
 d_dlsymun='$d_dlsymun'
+d_backtrace='$d_backtrace'
 d_dosuid='$d_dosuid'
 d_drand48_r='$d_drand48_r'
 d_drand48proto='$d_drand48proto'
@@ -23573,12 +23610,14 @@ i8size='$i8size'
 i8type='$i8type'
 i_arpainet='$i_arpainet'
 i_assert='$i_assert'
+i_bfd='$i_assert'
 i_bsdioctl='$i_bsdioctl'
 i_crypt='$i_crypt'
 i_db='$i_db'
 i_dbm='$i_dbm'
 i_dirent='$i_dirent'
 i_dlfcn='$i_dlfcn'
+i_execinfo='$i_execinfo'
 i_fcntl='$i_fcntl'
 i_float='$i_float'
 i_fp='$i_fp'
@@ -23969,6 +24008,7 @@ uquadtype='$uquadtype'
 use5005threads='$use5005threads'
 use64bitall='$use64bitall'
 use64bitint='$use64bitint'
+usecbacktrace='$usecbacktrace'
 usecrosscompile='$usecrosscompile'
 usedevel='$usedevel'
 usedl='$usedl'
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index 5901eaca5d..1aad80db29 100644
--- a/Cross/config.sh-arm-linux
+++ b/Cross/config.sh-arm-linux
@@ -121,6 +121,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='define'
 d_bcopy='define'
 d_bsd='undef'
@@ -158,6 +159,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='define'
 d_dirnamlen='undef'
+d_dladdr='undef'
 d_dlerror='define'
 d_dlopen='define'
 d_dlsymun='undef'
@@ -641,12 +643,14 @@ i8size='1'
 i8type='char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='define'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='define'
+i_execinfo='undef'
 i_fcntl='undef'
 i_float='define'
 i_fp='undef'
diff --git a/NetWare/config.wc b/NetWare/config.wc
index 95cf59c8b8..f37517d5a3 100644
--- a/NetWare/config.wc
+++ b/NetWare/config.wc
@@ -108,6 +108,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='define'
@@ -145,6 +146,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='undef'
+d_dladdr='undef'
 d_dlerror='define'
 d_dlopen='define'
 d_dlsymun='undef'
@@ -623,12 +625,14 @@ i8size='1'
 i8type='char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='define'
+i_execinfo='undef'
 i_fcntl='define'
 i_float='define'
 i_fp='undef'
diff --git a/Porting/config.sh b/Porting/config.sh
index a1e869637e..f20ad5a513 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -130,6 +130,7 @@ d_attribute_noreturn='define'
 d_attribute_pure='define'
 d_attribute_unused='define'
 d_attribute_warn_unused_result='define'
+d_backtrace='undef'
 d_bcmp='define'
 d_bcopy='define'
 d_bsd='undef'
@@ -167,6 +168,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='define'
 d_dirnamlen='undef'
+d_dladdr='undef'
 d_dlerror='define'
 d_dlopen='define'
 d_dlsymun='undef'
@@ -656,12 +658,14 @@ i8size='1'
 i8type='signed char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='define'
 i_db='define'
 i_dbm='define'
 i_dirent='define'
 i_dlfcn='define'
+i_execinfo='undef'
 i_fcntl='undef'
 i_float='define'
 i_fp='undef'
diff --git a/config_h.SH b/config_h.SH
index 5b38733d33..5e8432baa9 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -131,6 +131,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  */
 #$d_difftime HAS_DIFFTIME		/**/
 
+/* HAS_DLADDR:
+ *	This symbol, if defined, indicates that the dladdr routine is
+ *	available to return information about stack addresses.
+ */
+#$d_dladdr HAS_DLADDR	/**/
+
 /* HAS_DLERROR:
  *	This symbol, if defined, indicates that the dlerror routine is
  *	available to return a string describing the last error that
@@ -138,6 +144,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  */
 #$d_dlerror HAS_DLERROR	/**/
 
+/* HAS_BACKTRACE:
+ *	This symbol, if defined, indicates that the backtrace routine is
+ *	available to return backtrace information about the C stack.
+ */
+#$d_backtrace HAS_BACKTRACE	/**/
+
 /* HAS_DUP2:
  *	This symbol, if defined, indicates that the dup2 routine is
  *	available to duplicate file descriptors.
@@ -689,6 +701,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  */
 #$i_dlfcn I_DLFCN		/**/
 
+/* I_EXECINFO:
+ *	This symbol, if defined, indicates that <execinfo.h> exists and should
+ *	be included.
+ */
+#$i_execinfo I_EXECINFO		/**/
+
 /* I_FCNTL:
  *	This manifest constant tells the C program to include <fcntl.h>.
  */
@@ -4212,6 +4230,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  */
 #$i_assert	I_ASSERT		/**/
 
+/* I_BFD:
+ *	This symbol, if defined, indicates that <bfd.h> exists and
+ *	could be included by the C program to use the BFD library.
+ */
+#$i_bfd	I_BFD		/**/
+
 /* I_CRYPT:
  *	This symbol, if defined, indicates that <crypt.h> exists and
  *	should be included.
diff --git a/configure.com b/configure.com
index 355946731b..deade6d4f9 100644
--- a/configure.com
+++ b/configure.com
@@ -5932,6 +5932,7 @@ $ WC "d_difftime64='undef'"
 $ WC "d_dir_dd_fd='undef'"
 $ WC "d_dirfd='undef'"
 $ WC "d_dirnamlen='define'"
+$ WC "d_dladdr='undef'"
 $ IF ("''F$EXTRACT(1,3, F$GETSYI(""VERSION""))'".GES."7.2")
 $ THEN
 $   WC "d_dlerror='define'"
@@ -5941,6 +5942,7 @@ $   WC "d_dlerror='undef'"
 $   WC "d_dlopen='undef'"
 $ ENDIF
 $ WC "d_dlsymun='undef'"
+$ WC "d_backtrace='undef'"
 $ WC "d_dosuid='undef'"
 $ WC "d_drand48proto='" + d_drand48proto + "'"
 $ WC "d_dup2='define'"
@@ -6377,12 +6379,14 @@ $ WC "i8size='" + i8size + "'"
 $ WC "i8type='" + i8type + "'"
 $ WC "i_arpainet='" + i_arpainet + "'"
 $ WC "i_assert='define'"
+$ WC "i_bfd='undef'"
 $ WC "i_bsdioctl='undef'"
 $ WC "i_crypt='undef'"
 $ WC "i_db='undef'"
 $ WC "i_dbm='undef'"
 $ WC "i_dirent='undef'"	! we roll our own
 $ WC "i_dlfcn='undef'"
+$ WC "i_execinfo='undef'"
 $ WC "i_fcntl='" + i_fcntl + "'"
 $ WC "i_float='define'"
 $ WC "i_fp='undef'"
diff --git a/embed.fnc b/embed.fnc
index c87a9118e9..50bb964b2b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1643,6 +1643,12 @@ Afp	|void	|warner		|U32 err|NN const char* pat|...
 Afp	|void	|ck_warner	|U32 err|NN const char* pat|...
 Afp	|void	|ck_warner_d	|U32 err|NN const char* pat|...
 Ap	|void	|vwarner	|U32 err|NN const char* pat|NULLOK va_list* args
+#ifdef USE_C_BACKTRACE
+pd	|Perl_c_backtrace*|get_c_backtrace|int max_depth|int skip
+dm	|void	|free_c_backtrace|NN Perl_c_backtrace* bt
+Apd	|SV*	|get_c_backtrace_dump|int max_depth|int skip
+Apd	|bool	|dump_c_backtrace|NN PerlIO* fp|int max_depth|int skip
+#endif
 : FIXME
 p	|void	|watch		|NN char** addr
 Am	|I32	|whichsig	|NN const char* sig
diff --git a/embed.h b/embed.h
index fbdb4ed393..5710e0aa64 100644
--- a/embed.h
+++ b/embed.h
@@ -812,6 +812,10 @@
 #if defined(UNLINK_ALL_VERSIONS)
 #define unlnk(a)		Perl_unlnk(aTHX_ a)
 #endif
+#if defined(USE_C_BACKTRACE)
+#define dump_c_backtrace(a,b,c)	Perl_dump_c_backtrace(aTHX_ a,b,c)
+#define get_c_backtrace_dump(a,b)	Perl_get_c_backtrace_dump(aTHX_ a,b)
+#endif
 #if defined(USE_ITHREADS)
 #define alloccopstash(a)	Perl_alloccopstash(aTHX_ a)
 #define any_dup(a,b)		Perl_any_dup(aTHX_ a,b)
@@ -1757,6 +1761,9 @@
 #  if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C)
 #define pidgone(a,b)		S_pidgone(aTHX_ a,b)
 #  endif
+#  if defined(USE_C_BACKTRACE)
+#define get_c_backtrace(a,b)	Perl_get_c_backtrace(aTHX_ a,b)
+#  endif
 #  if defined(USE_ITHREADS)
 #define mro_meta_dup(a,b)	Perl_mro_meta_dup(aTHX_ a,b)
 #define padlist_dup(a,b)	Perl_padlist_dup(aTHX_ a,b)
diff --git a/makedef.pl b/makedef.pl
index 8b972a4c67..c88bee8b0b 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -522,6 +522,11 @@ unless ($define{USE_LOCALE_NUMERIC}) {
 			 );
 }
 
+unless ($define{'USE_C_BACKTRACE'}) {
+    ++$skip{Perl_get_c_backtrace_dump};
+    ++$skip{Perl_dump_c_backtrace};
+}
+
 unless ($define{HAVE_INTERP_INTERN}) {
     ++$skip{$_} foreach qw(
 		    Perl_sys_intern_clear
diff --git a/perl.h b/perl.h
index 6ae64e46af..4181942abb 100644
--- a/perl.h
+++ b/perl.h
@@ -5895,6 +5895,16 @@ extern void moncontrol(int);
 #define PERL_PV_PRETTY_DUMP  PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
 #define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII
 
+#if defined(USE_C_BACKTRACE) && defined(I_BFD)
+#  define USE_BFD
+#  ifdef PERL_DARWIN
+#    undef USE_BFD /* BFD is useless in OS X. */
+#  endif
+#  ifdef USE_BFD
+#    include <bfd.h>
+#  endif
+#endif
+
 /*
 
    (KEEP THIS LAST IN perl.h!)
diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
index 3bb5f28428..112878aa01 100644
--- a/plan9/config_sh.sample
+++ b/plan9/config_sh.sample
@@ -121,6 +121,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='define'
 d_bcopy='define'
 d_bsd='undef'
@@ -158,6 +159,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='undef'
+d_dladdr='undef'
 d_dlerror='undef'
 d_dlopen='undef'
 d_dlsymun='undef'
@@ -635,12 +637,14 @@ i8size='1'
 i8type='char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='undef'
+i_execinfo='undef'
 i_fcntl='define'
 i_float='define'
 i_fp='undef'
diff --git a/pod/perlhacktips.pod b/pod/perlhacktips.pod
index ccc38ad89f..f41918c939 100644
--- a/pod/perlhacktips.pod
+++ b/pod/perlhacktips.pod
@@ -1397,6 +1397,82 @@ New Display -> Edit Menu
 
 Note: you can define up to 20 conversion shortcuts in the gdb section.
 
+=head2 C backtrace
+
+Starting from Perl 5.21.1, on some platforms Perl supports retrieving
+the C level backtrace (similar to what symbolic debuggers like gdb do).
+
+The backtrace returns the stack trace of the C call frames,
+with the symbol names (function names), the object names (like "perl"),
+and if it can, also the source code locations (file:line).
+
+The supported platforms are Linux and OS X (some *BSD might work at
+least partly, but they have not yet been tested).
+
+The feature needs to be enabled with C<Configure -Dusecbacktrace>.
+
+The C<-Dusecbacktrace> also enables keeping the debug information
+when compiling.  Many compilers/linkers do support having both
+optimization and keeping the debug information.  The debug information
+is needed for the symbol names and the source locations.
+
+Source code locations, even if available, can often be missing or
+misleading if the compiler has e.g. inlined code.
+
+=over 4
+
+=item Linux
+
+You B<must> need to have the BFD (-lbfd) library installed, otherwise
+C<perl> will fail to link.  The BFD is usually distributed as part of
+the binutils.
+
+Summary: C<Configure ... -Dusecbacktrace>
+and you need C<-lbfd>.
+
+=item OS X
+
+The source code locations are supported only if you have both C<-g>
+and have the Developer Tools installed.
+
+Summary: C<Configure ... -Dusecbacktrace>
+and installing the Developer Tools would be good.
+
+=back
+
+Optionally, for trying out the feature, you may want to enable
+automatic dumping of the backtrace just before a warning message
+is emitted (this includes coincidentally croaking) by adding
+C<-Accflags=-DUSE_C_BACKTRACE_ON_WARN> for Configure.
+
+Unless the above additional feature is enabled, nothing about the
+backtrace functionality is visible, except for the Perl/XS level.
+
+Furthermore, even if you have enabled this feature to be compiled,
+you need to enable it in runtime with an environment variable:
+C<PERL_C_BACKTRACE_ON_WARN=10>.  It must be an integer higher
+than zero, and it tells the desired frame count.
+
+Retrieving the backtrace from Perl level (using for example an XS
+extension) would be much less exciting than one would hope: normally
+you would see C<runops>, C<entersub>, and not much else.  This API is
+intended to be called B<from within> the Perl implementation, not from
+Perl level execution.
+
+The C API for the backtrace is as follows (see L<perlintern>) for details).
+
+=over 4
+
+=item get_c_backtrace
+
+=item free_c_backtrace
+
+=item get_c_backtrace_dump
+
+=item dump_c_backtrace
+
+=back
+
 =head2 Poison
 
 If you see in a debugger a memory area mysteriously full of 0xABABABAB
diff --git a/proto.h b/proto.h
index 078ee2ca66..3b882d813f 100644
--- a/proto.h
+++ b/proto.h
@@ -7913,6 +7913,18 @@ PERL_CALLCONV I32	Perl_unlnk(pTHX_ const char* f)
 	assert(f)
 
 #endif
+#if defined(USE_C_BACKTRACE)
+PERL_CALLCONV bool	Perl_dump_c_backtrace(pTHX_ PerlIO* fp, int max_depth, int skip)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_DUMP_C_BACKTRACE	\
+	assert(fp)
+
+/* PERL_CALLCONV void	free_c_backtrace(pTHX_ Perl_c_backtrace* bt)
+			__attribute__nonnull__(pTHX_1); */
+
+PERL_CALLCONV Perl_c_backtrace*	Perl_get_c_backtrace(pTHX_ int max_depth, int skip);
+PERL_CALLCONV SV*	Perl_get_c_backtrace_dump(pTHX_ int max_depth, int skip);
+#endif
 #if defined(USE_ITHREADS)
 PERL_CALLCONV PADOFFSET	Perl_alloccopstash(pTHX_ HV *hv)
 			__attribute__nonnull__(pTHX_1);
diff --git a/symbian/config.sh b/symbian/config.sh
index 4aae579f63..4c3c590e49 100644
--- a/symbian/config.sh
+++ b/symbian/config.sh
@@ -65,6 +65,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='undef'
@@ -102,6 +103,7 @@ d_difftime='undef'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='define'
+d_dladdr='undef'
 d_dlerror='undef'
 d_dlopen='undef'
 d_dlsymun='undef'
@@ -562,12 +564,14 @@ i8size='1'
 i8type='char'
 i_arpainet='undef'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='undef'
+i_execinfo='undef'
 i_fcntl='define'
 i_float='undef'
 i_fp='undef'
diff --git a/uconfig.h b/uconfig.h
index 35f1a0d118..37a25457fa 100644
--- a/uconfig.h
+++ b/uconfig.h
@@ -96,6 +96,12 @@
  */
 /*#define HAS_DIFFTIME		/ **/
 
+/* HAS_DLADDR:
+ *	This symbol, if defined, indicates that the dladdr routine is
+ *	available to return information about stack addresses.
+ */
+/*#define HAS_DLADDR	/ **/
+
 /* HAS_DLERROR:
  *	This symbol, if defined, indicates that the dlerror routine is
  *	available to return a string describing the last error that
@@ -103,6 +109,12 @@
  */
 /*#define HAS_DLERROR	/ **/
 
+/* HAS_BACKTRACE:
+ *	This symbol, if defined, indicates that the backtrace routine is
+ *	available to return backtrace information about the C stack.
+ */
+/*#define HAS_BACKTRACE	/ **/
+
 /* HAS_DUP2:
  *	This symbol, if defined, indicates that the dup2 routine is
  *	available to duplicate file descriptors.
@@ -654,6 +666,12 @@
  */
 /*#define I_DLFCN		/ **/
 
+/* I_EXECINFO:
+ *	This symbol, if defined, indicates that <execinfo.h> exists and should
+ *	be included.
+ */
+/*#define I_EXECINFO		/ **/
+
 /* I_FCNTL:
  *	This manifest constant tells the C program to include <fcntl.h>.
  */
@@ -4177,6 +4195,12 @@
  */
 #define	I_ASSERT		/**/
 
+/* I_BFD:
+ *	This symbol, if defined, indicates that <bfd.h> exists and
+ *	could be included by the C program to use the BFD library.
+ */
+/*#define	I_BFD		/ **/
+
 /* I_CRYPT:
  *	This symbol, if defined, indicates that <crypt.h> exists and
  *	should be included.
@@ -4723,6 +4747,6 @@
 #endif
 
 /* Generated from:
- * 06dae33599ea14bee0e39e3b22e1f685aaae36422af2c567dc1de19203950835 config_h.SH
- * 6859e7550b3ae0da512f0a8b99762af72df599ab734520206d7b3574459e948f uconfig.sh
+ * 45e2c6b42b88b07e21adb94c47d9bd7bcb8da04e2bbb38d7223eb516eb7d99de config_h.SH
+ * 6d0cc2cac48fbe8139cf8a89bdd458a93797d18e649f3ed80896bfe4d218b0a2 uconfig.sh
  * ex: set ro: */
diff --git a/uconfig.sh b/uconfig.sh
index 19e4e6e8e1..810aaec660 100644
--- a/uconfig.sh
+++ b/uconfig.sh
@@ -59,6 +59,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='undef'
@@ -96,6 +97,7 @@ d_difftime='undef'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='undef'
+d_dladdr='undef'
 d_dlerror='undef'
 d_dlopen='undef'
 d_dlsymun='undef'
@@ -548,12 +550,14 @@ i8size='1'
 i8type='signed char'
 i_arpainet='undef'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='undef'
+i_execinfo='undef'
 i_fcntl='undef'
 i_float='undef'
 i_fp='undef'
diff --git a/uconfig64.sh b/uconfig64.sh
index 71d7fad05c..8537547870 100644
--- a/uconfig64.sh
+++ b/uconfig64.sh
@@ -60,6 +60,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='undef'
@@ -97,6 +98,7 @@ d_difftime='undef'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='undef'
+d_dladdr='undef'
 d_dlerror='undef'
 d_dlopen='undef'
 d_dlsymun='undef'
@@ -549,12 +551,14 @@ i8size='1'
 i8type='signed char'
 i_arpainet='undef'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='undef'
+i_execinfo='undef'
 i_fcntl='undef'
 i_float='undef'
 i_fp='undef'
diff --git a/util.c b/util.c
index 6d4c8142df..fca71321f3 100644
--- a/util.c
+++ b/util.c
@@ -51,6 +51,16 @@ int putenv(char *);
 # endif
 #endif
 
+/* <bfd.h> will have been included, if necessary, by "perl.h" */
+#ifdef USE_C_BACKTRACE
+#  ifdef I_DLFCN
+#    include <dlfcn.h>
+#  endif
+#  ifdef I_EXECINFO
+#    include <execinfo.h>
+#  endif
+#endif
+
 #ifdef PERL_DEBUG_READONLY_COW
 # include <sys/mman.h>
 #endif
@@ -1355,6 +1365,18 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
     dVAR;
     SV *sv;
 
+#if defined(USE_C_BACKTRACE) && defined(USE_C_BACKTRACE_ON_WARN)
+    {
+        char *ws;
+        int wi;
+        /* The PERL_C_BACKTRACE_ON_WARN must be an integer of one or more. */
+        if ((ws = PerlEnv_getenv("PERL_C_BACKTRACE_ON_WARN")) &&
+            (wi = atoi(ws)) > 0) {
+            Perl_dump_c_backtrace(aTHX_ Perl_debug_log, wi, 1);
+        }
+    }
+#endif
+
     PERL_ARGS_ASSERT_MESS_SV;
 
     if (SvROK(basemsg)) {
@@ -5481,6 +5503,648 @@ Perl_drand48_r(perl_drand48_t *random_state)
 #endif
 }
 
+#ifdef USE_C_BACKTRACE
+
+/* Possibly move all this USE_C_BACKTRACE code into a new file. */
+
+#ifdef USE_BFD
+
+typedef struct {
+    bfd* abfd;
+    asymbol** bfd_syms;
+    asection* bfd_text;
+    /* Since opening the executable and scanning its symbols is quite
+     * heavy operation, we remember the filename we used the last time,
+     * and do the opening and scanning only if the filename changes.
+     * This removes most (but not all) open+scan cycles. */
+    const char* fname_prev;
+} bfd_context;
+
+/* Given a dl_info, update the BFD context if necessary. */
+static void bfd_update(bfd_context* ctx, Dl_info* dl_info)
+{
+    /* BFD open and scan only if the filename changed. */
+    if (ctx->fname_prev == NULL ||
+        strNE(dl_info->dli_fname, ctx->fname_prev)) {
+        ctx->abfd = bfd_openr(dl_info->dli_fname, 0);
+        if (ctx->abfd) {
+            if (bfd_check_format(ctx->abfd, bfd_object)) {
+                IV symbol_size = bfd_get_symtab_upper_bound(ctx->abfd);
+                if (symbol_size > 0) {
+                    Safefree(ctx->bfd_syms);
+                    Newx(ctx->bfd_syms, symbol_size, asymbol*);
+                    ctx->bfd_text =
+                        bfd_get_section_by_name(ctx->abfd, ".text");
+                }
+                else
+                    ctx->abfd = NULL;
+            }
+            else
+                ctx->abfd = NULL;
+        }
+        ctx->fname_prev = dl_info->dli_fname;
+    }
+}
+
+/* Given a raw frame, try to symbolize it and store
+ * symbol information (source file, line number) away. */
+static void bfd_symbolize(bfd_context* ctx,
+                          void* raw_frame,
+                          char** symbol_name,
+                          STRLEN* symbol_name_size,
+                          char** source_name,
+                          STRLEN* source_name_size,
+                          STRLEN* source_line)
+{
+    *symbol_name = NULL;
+    *symbol_name_size = 0;
+    if (ctx->abfd) {
+        IV offset = PTR2IV(raw_frame) - PTR2IV(ctx->bfd_text->vma);
+        if (offset > 0 &&
+            bfd_canonicalize_symtab(ctx->abfd, ctx->bfd_syms) > 0) {
+            const char *file;
+            const char *func;
+            unsigned int line = 0;
+            if (bfd_find_nearest_line(ctx->abfd, ctx->bfd_text,
+                                      ctx->bfd_syms, offset,
+                                      &file, &func, &line) &&
+                file && func && line > 0) {
+                /* Size and copy the source file, use only
+                 * the basename of the source file.
+                 *
+                 * NOTE: the basenames are fine for the
+                 * Perl source files, but may not always
+                 * be the best idea for XS files. */
+                const char *p, *b = NULL;
+                /* Look for the last slash. */
+                for (p = file; *p; p++) {
+                    if (*p == '/')
+                        b = p + 1;
+                }
+                if (b == NULL || *b == 0) {
+                    b = file;
+                }
+                *source_name_size = p - b + 1;
+                Newx(*source_name, *source_name_size + 1, char);
+                Copy(b, *source_name, *source_name_size + 1, char);
+
+                *symbol_name_size = strlen(func);
+                Newx(*symbol_name, *symbol_name_size + 1, char);
+                Copy(func, *symbol_name, *symbol_name_size + 1, char);
+
+                *source_line = line;
+            }
+        }
+    }
+}
+
+#endif /* #ifdef USE_BFD */
+
+#ifdef PERL_DARWIN
+
+/* OS X has no public API for for 'symbolicating' (Apple official term)
+ * stack addresses to {function_name, source_file, line_number}.
+ * Good news: there is command line utility atos(1) which does that.
+ * Bad news 1: it's a command line utility.
+ * Bad news 2: one needs to have the Developer Tools installed.
+ * Bad news 3: in newer releases it needs to be run as 'xcrun atos'.
+ *
+ * To recap: we need to open a pipe for reading for a utility which
+ * might not exist, or exists in different locations, and then parse
+ * the output.  And since this is all for a low-level API, we cannot
+ * use high-level stuff.  Thanks, Apple. */
+
+typedef struct {
+    const char* tool;
+    const char* format;
+    bool unavail;
+    const char* fname;
+    void* object_base_addr;
+} atos_context;
+
+/* Given |dl_info|, updates the context.  If the context has been
+ * marked unavailable, return immediately.  If not but the tool has
+ * not been set, set it to either "xcrun atos" or "atos" (also set the
+ * format to use for creating commands for piping), or if neither is
+ * unavailable (one needs the Developer Tools installed), mark the context
+ * an unavailable.  Finally, update the filename (object name),
+ * and its base address. */
+
+static void atos_update(atos_context* ctx,
+                        Dl_info* dl_info)
+{
+    if (ctx->unavail)
+        return;
+    if (ctx->tool == NULL) {
+        const char* tools[] = {
+            "/usr/bin/xcrun",
+            "/usr/bin/atos"
+        };
+        const char* formats[] = {
+            "/usr/bin/xcrun atos -o '%s' -l %08x %08x 2>&1",
+            "/usr/bin/atos -d -o '%s' -l %08x %08x 2>&1"
+        };
+        struct stat st;
+        UV i;
+        for (i = 0; i < C_ARRAY_LENGTH(tools); i++) {
+            if (stat(tools[i], &st) == 0 && S_ISREG(st.st_mode)) {
+                ctx->tool = tools[i];
+                ctx->format = formats[i];
+                break;
+            }
+        }
+        if (ctx->tool == NULL) {
+            ctx->unavail = TRUE;
+            return;
+        }
+    }
+    if (ctx->fname == NULL ||
+        strNE(dl_info->dli_fname, ctx->fname)) {
+        ctx->fname = dl_info->dli_fname;
+        ctx->object_base_addr = dl_info->dli_fbase;
+    }
+}
+
+/* Given an output buffer end |p| and its |start|, matches
+ * for the atos output, extracting the source code location
+ * if possible, returning NULL otherwise. */
+static const char* atos_parse(const char* p,
+                              const char* start,
+                              STRLEN* source_name_size,
+                              STRLEN* source_line) {
+    /* atos() outputs is something like:
+     * perl_parse (in miniperl) (perl.c:2314)\n\n".
+     * We cannot use Perl regular expressions, because we need to
+     * stay low-level.  Therefore here we have a rolled-out version
+     * of a state machine which matches _backwards_from_the_end_ and
+     * if there's a success, returns the starts of the filename,
+     * also setting the filename size and the source line number.
+     * The matched regular expression is roughly "\(.*:\d+\)\s*$" */
+    const char* source_number_start;
+    const char* source_name_end;
+    /* Skip trailing whitespace. */
+    while (p > start && isspace(*p)) p--;
+    /* Now we should be at the close paren. */
+    if (p == start || *p != ')')
+        return NULL;
+    p--;
+    /* Now we should be in the line number. */
+    if (p == start || !isdigit(*p))
+        return NULL;
+    /* Skip over the digits. */
+    while (p > start && isdigit(*p))
+        p--;
+    /* Now we should be at the colon. */
+    if (p == start || *p != ':')
+        return NULL;
+    source_number_start = p + 1;
+    source_name_end = p; /* Just beyond the end. */
+    p--;
+    /* Look for the open paren. */
+    while (p > start && *p != '(')
+        p--;
+    if (p == start)
+        return NULL;
+    p++;
+    *source_name_size = source_name_end - p;
+    *source_line = atoi(source_number_start);
+    return p;
+}
+
+/* Given a raw frame, read a pipe from the symbolicator (that's the
+ * technical term) atos, reads the result, and parses the source code
+ * location.  We must stay low-level, so we use snprintf(), pipe(),
+ * and fread(), and then also parse the output ourselves. */
+static void atos_symbolize(atos_context* ctx,
+                           void* raw_frame,
+                           char** source_name,
+                           STRLEN* source_name_size,
+                           STRLEN* source_line)
+{
+    char cmd[1024];
+    const char* p;
+    Size_t cnt;
+
+    if (ctx->unavail)
+        return;
+    /* Simple security measure: if there's any funny business with
+     * the object name (used as "-o '%s'" ), leave since at least
+     * partially the user controls it. */
+    for (p = ctx->fname; *p; p++) {
+        if (*p == '\'' || iscntrl(*p)) {
+            ctx->unavail = TRUE;
+            return;
+        }
+    }
+    cnt = snprintf(cmd, sizeof(cmd), ctx->format,
+                   ctx->fname, ctx->object_base_addr, raw_frame);
+    if (cnt < sizeof(cmd)) {
+        /* Undo nostdio.h #defines that disable stdio.
+         * This is somewhat naughty, but is used elsewhere
+         * in the core, and affects only OS X. */
+#undef FILE
+#undef popen
+#undef fread
+#undef pclose
+        FILE* fp = popen(cmd, "r");
+        /* At the moment we open a new pipe for each stack frame.
+         * This is naturally somewhat slow, but hopefully generating
+         * stack traces is never going to in a performance critical path.
+         *
+         * We could play tricks with atos by batching the stack
+         * addresses to be resolved: atos can either take multiple
+         * addresses from the command line, or read addresses from
+         *
+         * a file (though the mess of creating temporary files would
+         * probably negate much of any possible speedup).
+         *
+         * Normally there are only two objects present in the backtrace:
+         * perl itself, and the libdyld.dylib.  (Note that the object
+         * filenames contain the full pathname, so perl may not always
+         * be in the same place.)  Whenever the object in the
+         * backtrace changes, the base address also changes.
+         *
+         * The problem with batching the addresses, though, would be
+         * matching the results with the addresses: the parsing of
+         * the results is already painful enough with a single address. */
+        if (fp) {
+            char out[1024];
+            UV cnt = fread(out, 1, sizeof(out), fp);
+            if (cnt < sizeof(out)) {
+                const char* p = atos_parse(out + cnt, out,
+                                           source_name_size,
+                                           source_line);
+                if (p) {
+                    Newx(*source_name,
+                         *source_name_size + 1, char);
+                    Copy(p, *source_name,
+                         *source_name_size + 1,  char);
+                }
+            }
+            pclose(fp);
+        }
+    }
+}
+
+#endif /* #ifdef PERL_DARWIN */
+
+/*
+=for apidoc get_c_backtrace
+
+Collects the backtrace (aka "stacktrace") into a single linear
+malloced buffer, which the caller B<must> Perl_free_c_backtrace().
+
+Scans the frames back by depth + skip, then drops the skip innermost,
+returning at most depth frames.
+
+=cut
+*/
+
+Perl_c_backtrace*
+Perl_get_c_backtrace(pTHX_ int depth, int skip)
+{
+    /* Note that here we must stay as low-level as possible: Newx(),
+     * Copy(), Safefree(); since we may be called from anywhere,
+     * so we should avoid higher level constructs like SVs or AVs.
+     *
+     * Since we are using safesysmalloc() via Newx(), don't try
+     * getting backtrace() there, unless you like deep recursion. */
+
+    /* Currently only implemented with backtrace() and dladdr(),
+     * for other platforms NULL is returned. */
+
+#if defined(HAS_BACKTRACE) && defined(HAS_DLADDR)
+    /* backtrace() is available via <execinfo.h> in glibc and in most
+     * modern BSDs; dladdr() is available via <dlfcn.h>. */
+
+    /* We try fetching this many frames total, but then discard
+     * the |skip| first ones.  For the remaining ones we will try
+     * retrieving more information with dladdr(). */
+    int try_depth = skip +  depth;
+
+    /* The addresses (program counters) returned by backtrace(). */
+    void** raw_frames;
+
+    /* Retrieved with dladdr() from the addresses returned by backtrace(). */
+    Dl_info* dl_infos;
+
+    /* Sizes _including_ the terminating \0 of the object name
+     * and symbol name strings. */
+    STRLEN* object_name_sizes;
+    STRLEN* symbol_name_sizes;
+
+#ifdef USE_BFD
+    /* The symbol names comes either from dli_sname,
+     * or if using BFD, they can come from BFD. */
+    char** symbol_names;
+#endif
+
+    /* The source code location information.  Dug out with e.g. BFD. */
+    char** source_names;
+    STRLEN* source_name_sizes;
+    STRLEN* source_lines;
+
+    Perl_c_backtrace* bt = NULL;  /* This is what will be returned. */
+    int got_depth; /* How many frames were returned from backtrace(). */
+    UV frame_count = 0; /* How many frames we return. */
+    UV total_bytes = 0; /* The size of the whole returned backtrace. */
+
+#ifdef USE_BFD
+    bfd_context bfd_ctx;
+#endif
+#ifdef PERL_DARWIN
+    atos_context atos_ctx;
+#endif
+
+    /* Here are probably possibilities for optimizing.  We could for
+     * example have a struct that contains most of these and then
+     * allocate |try_depth| of them, saving a bunch of malloc calls.
+     * Note, however, that |frames| could not be part of that struct
+     * because backtrace() will want an array of just them.  Also be
+     * careful about the name strings. */
+    Newx(raw_frames, try_depth, void*);
+    Newx(dl_infos, try_depth, Dl_info);
+    Newx(object_name_sizes, try_depth, STRLEN);
+    Newx(symbol_name_sizes, try_depth, STRLEN);
+    Newx(source_names, try_depth, char*);
+    Newx(source_name_sizes, try_depth, STRLEN);
+    Newx(source_lines, try_depth, STRLEN);
+#ifdef USE_BFD
+    Newx(symbol_names, try_depth, char*);
+#endif
+
+    /* Get the raw frames. */
+    got_depth = (int)backtrace(raw_frames, try_depth);
+
+    /* We use dladdr() instead of backtrace_symbols() because we want
+     * the full details instead of opaque strings.  This is useful for
+     * two reasons: () the details are needed for further symbolic
+     * digging (2) by having the details we fully control the output,
+     * which in turn is useful when more platforms are added:
+     * we can keep out output "portable". */
+
+    /* We want a single linear allocation, which can then be freed
+     * with a single swoop.  We will do the usual trick of first
+     * walking over the structure and seeing how much we need to
+     * allocate, then allocating, and then walking over the structure
+     * the second time and populating it. */
+
+    /* First we must compute the total size of the buffer. */
+    total_bytes = sizeof(Perl_c_backtrace_header);
+    if (got_depth > skip) {
+        int i;
+#ifdef USE_BFD
+        bfd_init(); /* Is this safe to call multiple times? */
+        Zero(&bfd_ctx, 1, bfd_context);
+#endif
+#ifdef PERL_DARWIN
+        Zero(&atos_ctx, 1, atos_context);
+#endif
+        for (i = skip; i < try_depth; i++) {
+            Dl_info* dl_info = &dl_infos[i];
+
+            total_bytes += sizeof(Perl_c_backtrace_frame);
+
+            source_names[i] = NULL;
+            source_name_sizes[i] = 0;
+            source_lines[i] = 0;
+
+            /* Yes, zero from dladdr() is failure. */
+            if (dladdr(raw_frames[i], dl_info)) {
+                object_name_sizes[i] =
+                    dl_info->dli_fname ? strlen(dl_info->dli_fname) : 0;
+                symbol_name_sizes[i] =
+                    dl_info->dli_sname ? strlen(dl_info->dli_sname) : 0;
+#ifdef USE_BFD
+                bfd_update(&bfd_ctx, dl_info);
+                bfd_symbolize(&bfd_ctx, raw_frames[i],
+                              &symbol_names[i],
+                              &symbol_name_sizes[i],
+                              &source_names[i],
+                              &source_name_sizes[i],
+                              &source_lines[i]);
+#endif
+#if PERL_DARWIN
+                atos_update(&atos_ctx, dl_info);
+                atos_symbolize(&atos_ctx,
+                               raw_frames[i],
+                               &source_names[i],
+                               &source_name_sizes[i],
+                               &source_lines[i]);
+#endif
+
+                /* Plus ones for the terminating \0. */
+                total_bytes += object_name_sizes[i] + 1;
+                total_bytes += symbol_name_sizes[i] + 1;
+                total_bytes += source_name_sizes[i] + 1;
+
+                frame_count++;
+            } else {
+                break;
+            }
+        }
+#ifdef USE_BFD
+        Safefree(bfd_ctx.bfd_syms);
+#endif
+    }
+
+    /* Now we can allocate and populate the result buffer. */
+    Newxc(bt, total_bytes, char, Perl_c_backtrace);
+    Zero(bt, total_bytes, char);
+    bt->header.frame_count = frame_count;
+    bt->header.total_bytes = total_bytes;
+    if (frame_count > 0) {
+        Perl_c_backtrace_frame* frame = bt->frame_info;
+        char* name_base = (char *)(frame + frame_count);
+        char* name_curr = name_base; /* Outputting the name strings here. */
+        UV i;
+        for (i = skip; i < skip + frame_count; i++) {
+            Dl_info* dl_info = &dl_infos[i];
+
+            frame->addr = raw_frames[i];
+            frame->object_base_addr = dl_info->dli_fbase;
+            frame->symbol_addr = dl_info->dli_saddr;
+
+            /* Copies a string, including the \0, and advances the name_curr.
+             * Also copies the start and the size to the frame. */
+#define PERL_C_BACKTRACE_STRCPY(frame, doffset, src, dsize, size) \
+            if (size && src) \
+                Copy(src, name_curr, size, char); \
+            frame->doffset = name_curr - (char*)bt; \
+            frame->dsize = size; \
+            name_curr += size; \
+            *name_curr++ = 0;
+
+            PERL_C_BACKTRACE_STRCPY(frame, object_name_offset,
+                                    dl_info->dli_fname,
+                                    object_name_size, object_name_sizes[i]);
+
+#ifdef USE_BFD
+            PERL_C_BACKTRACE_STRCPY(frame, symbol_name_offset,
+                                    symbol_names[i],
+                                    symbol_name_size, symbol_name_sizes[i]);
+            Safefree(symbol_names[i]);
+#else
+            PERL_C_BACKTRACE_STRCPY(frame, symbol_name_offset,
+                                    dl_info->dli_sname,
+                                    symbol_name_size, symbol_name_sizes[i]);
+#endif
+
+            PERL_C_BACKTRACE_STRCPY(frame, source_name_offset,
+                                    source_names[i],
+                                    source_name_size, source_name_sizes[i]);
+            Safefree(source_names[i]);
+
+#undef PERL_C_BACKTRACE_STRCPY
+
+            frame->source_line_number = source_lines[i];
+
+            frame++;
+        }
+        assert(total_bytes ==
+               (UV)(sizeof(Perl_c_backtrace_header) +
+                    frame_count * sizeof(Perl_c_backtrace_frame) +
+                    name_curr - name_base));
+    }
+#ifdef USE_BFD
+    Safefree(symbol_names);
+#endif
+    Safefree(source_lines);
+    Safefree(source_name_sizes);
+    Safefree(source_names);
+    Safefree(symbol_name_sizes);
+    Safefree(object_name_sizes);
+    /* Assuming the strings returned by dladdr() are pointers
+     * to read-only static memory (the object file), so that
+     * they do not need freeing (and cannot be). */
+    Safefree(dl_infos);
+    Safefree(raw_frames);
+    return bt;
+#else
+    PERL_UNUSED_ARGV(depth);
+    PERL_UNUSED_ARGV(skip);
+    return NULL;
+#endif
+}
+
+/*
+=for apidoc free_c_backtrace
+
+Deallocates a backtrace received from get_c_bracktrace.
+
+=cut
+*/
+
+/*
+=for apidoc get_c_backtrace_dump
+
+Returns a SV a dump of |depth| frames of the call stack, skipping
+the |skip| innermost ones.  depth of 20 is usually enough.
+
+The appended output looks like:
+
+...
+1   10e004812:0082   Perl_croak   util.c:1716    /usr/bin/perl
+2   10df8d6d2:1d72   perl_parse   perl.c:3975    /usr/bin/perl
+...
+
+The fields are tab-separated.  The first column is the depth (zero
+being the innermost non-skipped frame).  In the hex:offset, the hex is
+where the program counter was in S_parse_body, and the :offset (might
+be missing) tells how much inside the S_parse_body the program counter was.
+
+The util.c:1716 is the source code file and line number.
+
+The /usr/bin/perl is obvious (hopefully).
+
+Unknowns are C<"-">.  Unknowns can happen unfortunately quite easily:
+if the platform doesn't support retrieving the information;
+if the binary is missing the debug information;
+if the optimizer has transformed the code by for example inlining.
+
+=cut
+*/
+
+SV*
+Perl_get_c_backtrace_dump(pTHX_ int depth, int skip)
+{
+    Perl_c_backtrace* bt;
+
+    bt = get_c_backtrace(depth, skip + 1 /* Hide ourselves. */);
+    if (bt) {
+        Perl_c_backtrace_frame* frame;
+        SV* dsv = newSVpvs("");
+        UV i;
+        for (i = 0, frame = bt->frame_info;
+             i < bt->header.frame_count; i++, frame++) {
+            Perl_sv_catpvf(aTHX_ dsv, "%d", (int)i);
+            Perl_sv_catpvf(aTHX_ dsv, "\t%p", frame->addr ? frame->addr : "-");
+            /* Symbol (function) names might disappear without debug info.
+             *
+             * The source code location might disappear in case of the
+             * optimizer inlining or otherwise rearranging the code. */
+            if (frame->symbol_addr) {
+                Perl_sv_catpvf(aTHX_ dsv, ":%04x",
+                               (int)
+                               ((char*)frame->addr - (char*)frame->symbol_addr));
+            }
+            Perl_sv_catpvf(aTHX_ dsv, "\t%s",
+                           frame->symbol_name_size &&
+                           frame->symbol_name_offset ?
+                           (char*)bt + frame->symbol_name_offset : "-");
+            if (frame->source_name_size &&
+                frame->source_name_offset &&
+                frame->source_line_number) {
+                Perl_sv_catpvf(aTHX_ dsv, "\t%s:%"UVuf,
+                               (char*)bt + frame->source_name_offset,
+                               (UV)frame->source_line_number);
+            } else {
+                Perl_sv_catpvf(aTHX_ dsv, "\t-");
+            }
+            Perl_sv_catpvf(aTHX_ dsv, "\t%s",
+                           frame->object_name_size &&
+                           frame->object_name_offset ?
+                           (char*)bt + frame->object_name_offset : "-");
+            /* The frame->object_base_addr is not output,
+             * but it is used for symbolizing/symbolicating. */
+            sv_catpvs(dsv, "\n");
+        }
+
+        Perl_free_c_backtrace(aTHX_ bt);
+
+        return dsv;
+    }
+
+    return NULL;
+}
+
+/*
+=for apidoc dump_c_backtrace
+
+Dumps the C backtrace to the given fp.
+
+Returns true if a backtrace could be retrieved, false if not.
+
+=cut
+*/
+
+bool
+Perl_dump_c_backtrace(pTHX_ PerlIO* fp, int depth, int skip)
+{
+    SV* sv;
+
+    PERL_ARGS_ASSERT_DUMP_C_BACKTRACE;
+
+    sv = Perl_get_c_backtrace_dump(aTHX_ depth, skip);
+    if (sv) {
+        sv_2mortal(sv);
+        PerlIO_printf(fp, "%s", SvPV_nolen(sv));
+        return TRUE;
+    }
+    return FALSE;
+}
+
+#endif /* #ifdef USE_C_BACKTRACE */
 
 /*
  * Local variables:
diff --git a/util.h b/util.h
index 34dc760269..57a3ad0b65 100644
--- a/util.h
+++ b/util.h
@@ -85,6 +85,78 @@ typedef struct PERL_DRAND48_T perl_drand48_t;
 #define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed)))
 #define Perl_drand48() (Perl_drand48_r(&PL_random_state))
 
+#ifdef USE_C_BACKTRACE
+
+typedef struct {
+    /* The number of frames returned. */
+    UV frame_count;
+    /* The total size of the Perl_c_backtrace, including this header,
+     * the frames, and the name strings. */
+    UV total_bytes;
+} Perl_c_backtrace_header;
+
+typedef struct {
+    void*  addr;  /* the program counter at this frame */
+
+    /* We could use Dl_info (as used by dladdr()) for many of these but
+     * that would be naughty towards non-dlfcn systems (hi there, Win32). */
+
+    void*  symbol_addr; /* symbol address (hint: try symbol_addr - addr) */
+    void*  object_base_addr;   /* base address of the shared object */
+
+    /* The offsets are from the beginning of the whole backtrace,
+     * which makes the backtrace relocatable. */
+    STRLEN object_name_offset; /* pathname of the shared object */
+    STRLEN object_name_size;   /* length of the pathname */
+    STRLEN symbol_name_offset; /* symbol name */
+    STRLEN symbol_name_size;   /* length of the symbol name */
+    STRLEN source_name_offset; /* source code file name */
+    STRLEN source_name_size;   /* length of the source code file name */
+    STRLEN source_line_number; /* source code line number */
+
+    /* OS X notes: atos(1) (more recently, "xcrun atos"), but the C
+     * API atos() uses is unknown (private "Symbolicator" framework,
+     * might require Objective-C even if the API would be known).
+     * Currently we open read pipe to "xcrun atos" and parse the
+     * output - quite disgusting.  And that won't work if the
+     * Developer Tools isn't installed. */
+
+    /* Win32 notes: as moral equivalents of backtrace() + dladdr(),
+     * one could possibly first use GetCurrentProcess() +
+     * SymInitialize(), and then CaptureStackBackTrace() +
+     * SymFromAddr(). */
+
+    /* Note that using the compiler optimizer easily leads into much
+     * of this information, like the symbol names (think inlining),
+     * and source code locations getting lost or confused.  In many
+     * cases keeping the debug information (-g) is necessary.
+     *
+     * Note that for example with gcc you can do both -O and -g.
+     *
+     * Note, however, that on some platforms (e.g. OSX + clang (cc))
+     * backtrace() + dladdr() works fine without -g. */
+
+    /* For example: the mere presence of <bfd.h> is no guarantee: e.g.
+     * OS X has that, but BFD does not seem to work on the OSX executables.
+     *
+     * Another niceness would be to able to see something about
+     * the function arguments, however gdb/lldb manage to do that. */
+} Perl_c_backtrace_frame;
+
+typedef struct {
+    Perl_c_backtrace_header header;
+    Perl_c_backtrace_frame  frame_info[1];
+    /* After the header come:
+     * (1) header.frame_count frames
+     * (2) frame_count times the \0-terminated strings (object_name
+     * and so forth).  The frames contain the pointers to the starts
+     * of these strings, and the lengths of these strings. */
+} Perl_c_backtrace;
+
+#define Perl_free_c_backtrace(bt) Safefree(bt)
+
+#endif /* USE_C_BACKTRACE */
+
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/win32/config.ce b/win32/config.ce
index f90b6c5aaa..dae0c606ad 100644
--- a/win32/config.ce
+++ b/win32/config.ce
@@ -106,6 +106,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='define'
@@ -143,6 +144,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='define'
+d_dladdr='undef'
 d_dlerror='define'
 d_dlopen='define'
 d_dlsymun='undef'
@@ -619,12 +621,14 @@ i8size='1'
 i8type='char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='define'
+i_execinfo='undef'
 i_fcntl='define'
 i_float='define'
 i_fp='undef'
diff --git a/win32/config.gc b/win32/config.gc
index 5cd83c036c..2f5e6d0958 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -108,6 +108,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='define'
@@ -145,6 +146,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='define'
+d_dladdr='undef'
 d_dlerror='define'
 d_dlopen='define'
 d_dlsymun='undef'
@@ -631,12 +633,14 @@ i8size='1'
 i8type='char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='define'
+i_execinfo='undef'
 i_fcntl='define'
 i_float='define'
 i_fp='undef'
diff --git a/win32/config.vc b/win32/config.vc
index cf0d316ee8..3aa1992e40 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -108,6 +108,7 @@ d_attribute_noreturn='undef'
 d_attribute_pure='undef'
 d_attribute_unused='undef'
 d_attribute_warn_unused_result='undef'
+d_backtrace='undef'
 d_bcmp='undef'
 d_bcopy='undef'
 d_bsd='define'
@@ -145,6 +146,7 @@ d_difftime='define'
 d_dir_dd_fd='undef'
 d_dirfd='undef'
 d_dirnamlen='define'
+d_dladdr='undef'
 d_dlerror='define'
 d_dlopen='define'
 d_dlsymun='undef'
@@ -630,12 +632,14 @@ i8size='1'
 i8type='char'
 i_arpainet='define'
 i_assert='define'
+i_bfd='undef'
 i_bsdioctl=''
 i_crypt='undef'
 i_db='undef'
 i_dbm='undef'
 i_dirent='define'
 i_dlfcn='define'
+i_execinfo='undef'
 i_fcntl='define'
 i_float='define'
 i_fp='undef'