App-Stacktrace
view release on metacpan or search on metacpan
Stacktrace.xs
bin/perl-stacktrace
dist.ini
lib/App/Stacktrace.pm
lib/App/Stacktrace/perl_backtrace_raw.txt
lib/App/Stacktrace/perl_backtrace_symbols.txt
ppport.h
t/basic.t
t/release-pod-coverage.t
t/release-pod-syntax.t
t/unthreaded.t
threads.h
NAME
App::Stacktrace - Stack trace
SYNOPSIS
perl-stacktrace [option] pid
-m Prints a gdb script
--help Show this help
DESCRIPTION
perl-stacktrace prints Perl stack traces of Perl threads for a given
Perl process. For each Perl frame, the full file name and line number
are printed.
API
new
run
Stacktrace.xs view on Meta::CPAN
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <string.h>
#include "thread.h"
#include "ppport.h"
#define V(h,k,v) hv_store(h, k, strlen(k), newSViv(v), 0);
#include "threads.h"
SV*
_perl_offsets() {
HV *hv = newHV();;
V(hv, "$CXTYPEMASK", (IV)CXTYPEMASK);
V(hv, "$CXt_SUB", (IV)CXt_SUB);
V(hv, "$CXt_EVAL", (IV)CXt_EVAL);
V(hv, "$CXt_FORMAT", (IV)CXt_FORMAT);
#ifdef USE_ITHREADS
# if PERL_VERSION >= 10
V(hv, "$POOLP_main_thread", (IV)&((my_pool_t*)0)->main_thread);
V(hv, "$THREAD_next", (IV)&((ithread*)0)->next);
V(hv, "$THREAD_interpreter", (IV)&((ithread*)0)->interp);
V(hv, "$THREAD_tid", (IV)&((ithread*)0)->tid);
V(hv, "$THREAD_state", (IV)&((ithread*)0)->state);
V(hv, "$INTERPRETER_modglobal", (IV)&((PerlInterpreter*)0)->Imodglobal);
V(hv, "$INTERPRETER_curstackinfo", (IV)&((PerlInterpreter*)0)->Icurstackinfo);
V(hv, "$COP_file", (IV)&((COP*)0)->cop_file);
# elif PERL_VERSION == 8 && PERL_SUBVERSION >= 9
V(hv, "$POOLP_main_thread", (IV)&((my_pool_t*)0)->main_thread);
V(hv, "$THREAD_next", (IV)&((ithread*)0)->next);
V(hv, "$THREAD_interpreter", (IV)&((ithread*)0)->interp);
V(hv, "$THREAD_tid", (IV)&((ithread*)0)->tid);
V(hv, "$THREAD_state", (IV)&((ithread*)0)->state);
V(hv, "$INTERPRETER_modglobal", (IV)&((PerlInterpreter*)0)->Imodglobal);
V(hv, "$INTERPRETER_curstackinfo", (IV)&((PerlInterpreter*)0)->Tcurstackinfo);
V(hv, "$COP_file", (IV)&((COP*)0)->cop_file);
# else
V(hv, "$THREAD_next", (IV)&((ithread*)0)->next);
V(hv, "$THREAD_interp", (IV)&((ithread*)0)->interp);
V(hv, "$THREAD_tid", (IV)&((ithread*)0)->tid);
V(hv, "$THREAD_state", (IV)&((ithread*)0)->state);
V(hv, "$INTERPRETER_curstackinfo", (IV)&((PerlInterpreter*)0)->Tcurstackinfo);
V(hv, "$COP_file", (IV)&((COP*)0)->cop_file);
# endif
#else
V(hv, "$COP_gv", (IV)&((COP*)0)->cop_filegv);
#endif
V(hv, "$SV_any", (IV)&((SV*)0)->sv_any);
V(hv, "$STACKINFO_cxstack", (IV)&((PERL_SI*)0)->si_cxstack);
V(hv, "$STACKINFO_cxix", (IV)&((PERL_SI*)0)->si_cxix);
bin/perl-stacktrace view on Meta::CPAN
-m Prints a gdb script
-v Verbose debugging
-c Additionally, prints C stacktrace
--help Show this help
--exec exec() into gdb
=head1 DESCRIPTION
perl-stacktrace prints Perl stack traces of Perl threads for a given
Perl process. For each Perl frame, the full file name and line number
are printed.
For example, a stack dump of a running perl program:
$ ps x | grep cpan
24077 pts/12 T 0:01 /usr/local/bin/perl /usr/local/bin/cpan
24093 pts/12 S+ 0:00 grep cpan
$ perl-stacktrace 24077
lib/App/Stacktrace.pm view on Meta::CPAN
-m Prints a gdb script
-v Verbose debugging
-c Additionally, prints C stacktrace
--help Show this help
--exec exec() into gdb
=head1 DESCRIPTION
perl-stacktrace prints Perl stack traces of Perl threads for a given
Perl process. For each Perl frame, the full file name and line number
are printed.
For example, a stack dump of a running perl program:
$ ps x | grep cpan
24077 pts/12 T 0:01 /usr/local/bin/perl /usr/local/bin/cpan
24093 pts/12 S+ 0:00 grep cpan
$ perl-stacktrace 24077
lib/App/Stacktrace.pm view on Meta::CPAN
$src .= <<QUIET;
set \$DEBUG = 0
QUIET
}
my $offsets = App::Stacktrace::_perl_offsets();
for my $name (sort keys %$offsets) {
$src .= "set $name = $offsets->{$name}\n";
}
if ($Config::Config{usethreads}) {
require threads;
my $key = "threads::_pool$threads::VERSION";
my $len = length $key;
$src .= <<"THREADS";
set \$POOL_KEY = "$key"
set \$POOL_KEY_LEN = $len
THREADS
}
open my $template_fh, '<', $template_script
or die "Can't open $template_script: $!";
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
# Provides the commands:
#
# perl_backtrace_5_10_x
# perl_backtrace_5_12_x
# perl_backtrace_5_14_x
#
# perl_backtrace_5_14_x_x86_64
# perl_backtrace_5_14_x_thread_x86_64
# perl_backtrace_5_12_x_thread_x86_64
# perl_backtrace_5_10_1_thread_x86_64
#
# perl_backtrace_5_14_x_thread_i686
#
# Example usage:
#
# gdb -p 7107
# (gdb) source gdbinit.txt
# ... set lots of constants
# (gdb) perl_backtrace_5_14_x
# (gdb) detach
# (gdb) quit
#perl_backtrace_5_14_x -> perl_backtrace_5_12_threads
#perl_backtrace_5_14_x -> perl_backtrace_nothreads
#perl_backtrace_5_12_x -> perl_backtrace_5_12_threads
#perl_backtrace_5_12_x -> perl_backtrace_nothreads
#perl_backtrace_5_12_threads -> perl_backtrace_a_thread
#perl_backtrace_5_12_threads -> perl_backtrace_an_interp
#perl_backtrace_5_10_x -> perl_backtrace_5_10_threads
#perl_backtrace_5_10_x -> perl_backtrace_nothreads
#perl_backtrace_5_10_threads -> perl_backtrace_a_thread
#perl_backtrace_5_10_threads -> perl_backtrace_an_interp
#perl_backtrace_5_8_9 -> perl_backtrace_5_8_9_threads
#perl_backtrace_5_8_9 -> perl_backtrace_5_8_nothreads
#perl_backtrace_5_8_9_threads -> perl_backtrace_5_8_9_a_thread
#perl_backtrace_5_8_9_a_thread -> perl_backtrace_5_8_9_an_interp
#perl_backtrace_5_8_9_an_interp
#perl_backtrace_5_8_x -> perl_backtrace_5_8_threads
#perl_backtrace_5_8_x -> perl_backtrace_5_8_nothreads
#perl_backtrace_5_8_threads -> perl_backtrace_5_8_a_thread
#perl_backtrace_5_8_a_thread -> perl_backtrace_5_8_an_interp
#perl_backtrace_5_8_an_interp
#perl_backtrace_5_8_nothreads
#perl_backtrace_an_interp
#perl_backtrace_a_thread
#perl_backtrace_nothreads
set $PERL_ITHR_JOINABLE = 0
set $PERL_ITHR_DETACHED = 1
set $PERL_ITHR_JOINED = 2
set $PERL_ITHR_FINISHED = 4
set $PERL_ITHR_THREAD_EXIT_ONLY = 8
set $PERL_ITHR_NONVIABLE = 16
set $PERL_ITHR_DIED = 32
set $PERL_ITHR_UNCALLABLE = $PERL_ITHR_DETACHED | $PERL_ITHR_JOINED
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
end
else
if $stackinfo
set $stackinfo = (int) *((int*) ($STACKINFO_prev + (int) $stackinfo))
else
set $stackinfo = 0
end
end
end
end
define perl_backtrace_a_thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
else
print $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
end
else
if $thread
set $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
else
set $tid = 0
end
end
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $statei = (int) *((int*) ($THREAD_state + (int) $thread))
else
print $statei = (int) *((int*) ($THREAD_state + (int) $thread))
end
else
if $thread
set $statei = (int) *((int*) ($THREAD_state + (int) $thread))
else
set $statei = 0
end
end
if $statei == $PERL_ITHR_DETACHED
set $state = "detached"
else
if $statei == $PERL_ITHR_JOINED
set $state = "joined"
else
if $statei = $PERL_ITHR_FINISHED
set $state = "finished"
else
if $statei == $PERL_ITHR_THREAD_EXIT_ONLY
set $state = "exit()"
else
if $statei == $PERL_ITHR_NONVIABLE
set $state = "thread creation failed"
else
if $statei == $PERL_ITHR_DIED
set $state = "died"
else
if $statei == $PERL_ITHR_UNCALLABLE
set $state = "uncallable"
else
set $state = "???"
end
end
end
end
end
end
end
printf "thread %d %s:\n", $tid, $state
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
else
print $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
end
else
if $thread
set $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
else
set $interpreter = 0
end
end
perl_backtrace_an_interp
end
define perl_backtrace_nothreads
set $stackinfo = (int) PL_curstackinfo
while $stackinfo
if $DEBUG
printf "stackinfo=%#x\n", $stackinfo
if $stackinfo
x/128xw $stackinfo
print $cxstack = (int) *((int*) ($STACKINFO_cxstack + (int) $stackinfo))
else
print $cxstack = (int) *((int*) ($STACKINFO_cxstack + (int) $stackinfo))
end
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
end
else
if $stackinfo
set $stackinfo = (int) *((int*) ($STACKINFO_prev + (int) $stackinfo))
else
set $stackinfo = 0
end
end
end
end
define perl_backtrace_5_8_nothreads
set $stackinfo = (int) PL_curstackinfo
while $stackinfo
if $DEBUG
printf "stackinfo=%#x\n", $stackinfo
if $stackinfo
x/128xw $stackinfo
print $cxstack = (int) *((int*) ($STACKINFO_cxstack + (int) $stackinfo))
else
print $cxstack = (int) *((int*) ($STACKINFO_cxstack + (int) $stackinfo))
end
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
end
else
if $stackinfo
set $stackinfo = (int) *((int*) ($STACKINFO_prev + (int) $stackinfo))
else
set $stackinfo = 0
end
end
end
end
define perl_backtrace_5_8_a_thread
if $thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
else
print $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
end
else
if $thread
set $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
else
set $tid = 0
end
end
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $statei = (int) *((int*) ($THREAD_state + (int) $thread))
else
print $statei = (int) *((int*) ($THREAD_state + (int) $thread))
end
else
if $thread
set $statei = (int) *((int*) ($THREAD_state + (int) $thread))
else
set $statei = 0
end
end
if $statei == $PERL_ITHR_DETACHED
set $state = "detached"
else
if $statei == $PERL_ITHR_JOINED
set $state = "joined"
else
if $statei = $PERL_ITHR_FINISHED
set $state = "finished"
else
if $statei == $PERL_ITHR_THREAD_EXIT_ONLY
set $state = "exit()"
else
if $statei == $PERL_ITHR_NONVIABLE
set $state = "thread creation failed"
else
if $statei == $PERL_ITHR_DIED
set $state = "died"
else
if $statei == $PERL_ITHR_UNCALLABLE
set $state = "uncallable"
else
set $state = "???"
end
end
end
end
end
end
end
printf "thread %d %s:\n", $tid, $state
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
else
print $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
end
else
if $thread
set $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
else
set $interpreter = 0
end
end
end
perl_backtrace_5_8_an_interp
end
define perl_backtrace_5_8_threads
set $main_thread = (int) threads
if $DEBUG
printf "main_thread=%#x\n", $main_thread
if $main_thread
x/128xw $main_thread
print $thread = $main_thread
else
print $thread = $main_thread
end
else
if $main_thread
set $thread = $main_thread
else
set $thread = 0
end
end
perl_backtrace_5_8_a_thread
if $thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
end
else
if $thread
set $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
set $thread = 0
end
end
while $thread && $thread != $main_thread
perl_backtrace_5_8_a_thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
end
else
if $thread
set $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
set $thread = 0
end
end
end
end
end
define perl_backtrace_5_8_x
set $interpreter = (int) Perl_get_context()
if $interpreter
perl_backtrace_5_8_threads
else
perl_backtrace_5_8_nothreads
end
end
define perl_backtrace_5_8_9_an_interp
if $DEBUG
printf "interpreter=%#x\n", $interpreter
if $interpreter
x/128xw $interpreter
print $stackinfo = (int) *((int*) ($INTERPRETER_curstackinfo + (int) $interpreter))
else
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
end
else
if $stackinfo
set $stackinfo = (int) *((int*) ($STACKINFO_prev + (int) $stackinfo))
else
set $stackinfo = 0
end
end
end
end
define perl_backtrace_5_8_9_a_thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
else
print $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
end
else
if $thread
set $tid = (int) *((int*) ($THREAD_tid + (int) $thread))
else
set $tid = 0
end
end
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $statei = (int) *((int*) ($THREAD_state + (int) $thread))
else
print $statei = (int) *((int*) ($THREAD_state + (int) $thread))
end
else
if $thread
set $statei = (int) *((int*) ($THREAD_state + (int) $thread))
else
set $statei = 0
end
end
if $statei == $PERL_ITHR_DETACHED
set $state = "detached"
else
if $statei == $PERL_ITHR_JOINED
set $state = "joined"
else
if $statei = $PERL_ITHR_FINISHED
set $state = "finished"
else
if $statei == $PERL_ITHR_THREAD_EXIT_ONLY
set $state = "exit()"
else
if $statei == $PERL_ITHR_NONVIABLE
set $state = "thread creation failed"
else
if $statei == $PERL_ITHR_DIED
set $state = "died"
else
if $statei == $PERL_ITHR_UNCALLABLE
set $state = "uncallable"
else
set $state = "???"
end
end
end
end
end
end
end
printf "thread %d %s:\n", $tid, $state
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
else
print $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
end
else
if $thread
set $interpreter = (int) *((int*) ($THREAD_interpreter + (int) $thread))
else
set $interpreter = 0
end
end
perl_backtrace_5_8_9_an_interp
end
define perl_backtrace_5_8_9_threads
set $main_thread = (int) threads
if $DEBUG
printf "main_thread=%#x\n", $main_thread
if $main_thread
x/128xw $main_thread
print $thread = $main_thread
else
print $thread = $main_thread
end
else
if $main_thread
set $thread = $main_thread
else
set $thread = 0
end
end
perl_backtrace_5_8_9_a_thread
if $thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
end
else
if $thread
set $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
set $thread = 0
end
end
while $thread && $thread != $main_thread
perl_backtrace_5_8_9_a_thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
end
else
if $thread
set $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
set $thread = 0
end
end
end
end
end
define perl_backtrace_5_8_9
set $interpreter = (int) Perl_get_context()
if $interpreter
perl_backtrace_5_8_9_threads
else
perl_backtrace_5_8_nothreads
end
end
define perl_backtrace_5_10_threads
if $DEBUG
printf "interpreter=%#x\n", $interpreter
if $interpreter
x/128xw $interpreter
print $modglobal = (int) *((int*) ($INTERPRETER_modglobal + (int) $interpreter))
else
print $modglobal = (int) *((int*) ($INTERPRETER_modglobal + (int) $interpreter))
end
else
if $interpreter
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
if $my_pool_svval
set $my_poolp = (int) *((int*) ($SV_iv + (int) $my_pool_svval))
else
set $my_poolp = 0
end
end
if $DEBUG
printf "my_poolp=%#x\n", $my_poolp
if $my_poolp
x/128xw $my_poolp
print $main_thread = $POOLP_main_thread + (int) $my_poolp
else
print $main_thread = $POOLP_main_thread + (int) $my_poolp
end
else
if $my_poolp
set $main_thread = $POOLP_main_thread + (int) $my_poolp
else
set $main_thread = 0
end
end
if $DEBUG
printf "main_thread=%#x\n", $main_thread
if $main_thread
x/128xw $main_thread
print $thread = $main_thread
else
print $thread = $main_thread
end
else
if $main_thread
set $thread = $main_thread
else
set $thread = 0
end
end
perl_backtrace_a_thread
if $DEBUG
printf "main_thread=%#x\n", $main_thread
if $main_thread
x/128xw $main_thread
print $thread = (int) *((int*) ($THREAD_next + (int) $main_thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $main_thread))
end
else
if $main_thread
set $thread = (int) *((int*) ($THREAD_next + (int) $main_thread))
else
set $thread = 0
end
end
while $thread != $main_thread
perl_backtrace_a_thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
end
else
if $thread
set $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
set $thread = 0
end
end
end
else
perl_backtrace_an_interp
end
end
define perl_backtrace_5_10_x
set $interpreter = (int) Perl_get_context()
if $interpreter
perl_backtrace_5_10_threads
else
perl_backtrace_nothreads
end
end
define perl_backtrace_5_12_threads
if $DEBUG
printf "interpreter=%#x\n", $interpreter
if $interpreter
x/128xw $interpreter
print $modglobal = (int) *((int*) ($INTERPRETER_modglobal + (int) $interpreter))
else
print $modglobal = (int) *((int*) ($INTERPRETER_modglobal + (int) $interpreter))
end
else
if $interpreter
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
if $my_pool_svval
set $my_poolp = (int) *((int*) ($SV_uv + (int) $my_pool_svval))
else
set $my_poolp = 0
end
end
if $DEBUG
printf "my_poolp=%#x\n", $my_poolp
if $my_poolp
x/128xw $my_poolp
print $main_thread = $POOLP_main_thread + (int) $my_poolp
else
print $main_thread = $POOLP_main_thread + (int) $my_poolp
end
else
if $my_poolp
set $main_thread = $POOLP_main_thread + (int) $my_poolp
else
set $main_thread = 0
end
end
if $DEBUG
printf "main_thread=%#x\n", $main_thread
if $main_thread
x/128xw $main_thread
print $thread = $main_thread
else
print $thread = $main_thread
end
else
if $main_thread
set $thread = $main_thread
else
set $thread = 0
end
end
perl_backtrace_a_thread
if $DEBUG
printf "main_thread=%#x\n", $main_thread
if $main_thread
x/128xw $main_thread
print $thread = (int) *((int*) ($THREAD_next + (int) $main_thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $main_thread))
end
else
if $main_thread
set $thread = (int) *((int*) ($THREAD_next + (int) $main_thread))
else
set $thread = 0
end
end
while $thread != $main_thread
perl_backtrace_a_thread
if $DEBUG
printf "thread=%#x\n", $thread
if $thread
x/128xw $thread
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
print $thread = (int) *((int*) ($THREAD_next + (int) $thread))
end
else
if $thread
set $thread = (int) *((int*) ($THREAD_next + (int) $thread))
else
set $thread = 0
end
end
end
else
perl_backtrace_an_interp
end
end
define perl_backtrace_5_12_x
set $interpreter = (int) Perl_get_context()
if $interpreter
perl_backtrace_5_12_threads
else
perl_backtrace_nothreads
end
end
define perl_backtrace_5_14_x
perl_backtrace_5_12_x
end
define perl_backtrace_5_14_x_x86_64
# 5.14.0-linux-x86_64-linux: 3
# 5.13.11-linux-x86_64-linux: 3
# 5.13.3-linux-x86_64-linux: 3
# 5.13.2-linux-x86_64-linux: 3
lib/App/Stacktrace/perl_backtrace_raw.txt view on Meta::CPAN
set $GP_sv = 0
set $GV_gp = 16
set $STACKINFO_cxix = 32
set $STACKINFO_cxstack = 8
set $STACKINFO_prev = 16
set $SV_any = 0
set $SV_iv = 32
set $SV_pv = 16
perl_backtrace_5_14_x
end
define perl_backtrace_5_14_x_thread_x86_64
# 5.14.0-linux-x86_64-linux-thread-multi: 8
# 5.13.11-linux-x86_64-linux-thread-multi: 4
# 5.15.0-linux-x86_64-linux-thread-multi: 4
# 5.13.8-linux-x86_64-linux-thread-multi: 3
# 5.13.10-linux-x86_64-linux-thread-multi: 3
# 5.14.1 RC1-linux-x86_64-linux-thread-multi: 2
# 5.13.7-linux-x86_64-linux-thread-multi: 2
# 5.13.9-linux-x86_64-linux-thread-multi: 2
# 5.14.0-linux-x86_64-linux-thread-multi-ld: 1
set $CONTEXT_cop = 8
set $CONTEXT_sizeof = 80
set $CONTEXT_type = 0
set $COP_file = 48
set $COP_line = 36
set $CXTYPEMASK = 15
set $CXt_EVAL = 10
set $CXt_FORMAT = 9
set $CXt_SUB = 8
set $GP_sv = 0
set $GV_gp = 16
set $INTERPRETER_curstackinfo = 608
set $INTERPRETER_modglobal = 1768
set $POOLP_main_thread = 0
set $STACKINFO_cxix = 32
set $STACKINFO_cxstack = 8
set $STACKINFO_prev = 16
set $SV_any = 0
set $SV_iv = 32
set $SV_pv = 16
set $THREAD_interpreter = 16
set $THREAD_next = 0
set $THREAD_state = 76
set $THREAD_tid = 24
perl_backtrace_5_14_x
end
define perl_backtrace_5_12_x_thread_x86_64
# 5.12.3-linux-x86_64-linux-thread-multi: 4
# 5.13.0-linux-x86_64-linux-thread-multi: 2
# 5.12.4 RC1-linux-x86_64-linux-thread-multi: 2
set $CONTEXT_cop = 8
set $CONTEXT_sizeof = 80
set $CONTEXT_type = 0
set $COP_file = 48
set $COP_line = 36
set $CXTYPEMASK = 15
set $CXt_EVAL = 10
set $CXt_FORMAT = 9
set $CXt_SUB = 8
set $GP_sv = 0
set $GV_gp = 16
set $INTERPRETER_curstackinfo = 600
set $INTERPRETER_modglobal = 1736
set $POOLP_main_thread = 0
set $STACKINFO_cxix = 32
set $STACKINFO_cxstack = 8
set $STACKINFO_prev = 16
set $SV_any = 0
set $SV_iv = 24
set $SV_pv = 16
set $THREAD_interpreter = 16
set $THREAD_next = 0
set $THREAD_state = 76
set $THREAD_tid = 24
perl_backtrace_5_12_x
end
define perl_backtrace_5_10_1_thread_x86_64
# 5.10.1-linux-x86_64-linux-thread-multi: 4
set $CONTEXT_cop = 8
set $CONTEXT_sizeof = 112
set $CONTEXT_type = 0
set $COP_file = 56
set $COP_line = 36
set $CXTYPEMASK = 255
set $CXt_EVAL = 2
set $CXt_FORMAT = 6
set $CXt_SUB = 1
set $GP_sv = 0
set $GV_gp = 16
set $INTERPRETER_curstackinfo = 592
set $INTERPRETER_modglobal = 1720
set $POOLP_main_thread = 0
set $STACKINFO_cxix = 32
set $STACKINFO_cxstack = 8
set $STACKINFO_prev = 16
set $SV_any = 0
set $SV_pv = 16
set $SV_uv = 24
set $THREAD_interpreter = 16
set $THREAD_next = 0
set $THREAD_state = 76
set $THREAD_tid = 24
perl_backtrace_5_10_x
end
define perl_backtrace_5_14_x_i686
# 5.14.1 RC1-linux-i686-linux-thread-multi: 1
set $CONTEXT_cop = 8
set $CONTEXT_sizeof = 48
set $CONTEXT_type = 0
set $COP_file = 28
set $COP_line = 20
set $CXTYPEMASK = 15
set $CXt_EVAL = 10
set $CXt_FORMAT = 9
set $CXt_SUB = 8
set $GP_sv = 0
set $GV_gp = 12
set $INTERPRETER_curstackinfo = 368
set $INTERPRETER_modglobal = 1080
set $POOLP_main_thread = 0
set $STACKINFO_cxix = 16
set $STACKINFO_cxstack = 4
set $STACKINFO_prev = 8
set $SV_any = 0
set $SV_iv = 16
set $SV_pv = 12
set $THREAD_interpreter = 8
set $THREAD_next = 0
set $THREAD_state = 44
set $THREAD_tid = 12
lib/App/Stacktrace/perl_backtrace_symbols.txt view on Meta::CPAN
else
if $DEBUG
printf "%d\t... # (context*){cx_type=%d}\n", $i, $type
end
end
set $i = $i + 1
end
set $stackinfo = $stackinfo->si_prev
end
end
define perl_backtrace_a_thread
set $tid = $thread->tid
set $statei = $thread->state
if $statei == $PERL_ITHR_DETACHED
set $state = "detached"
else
if $statei == $PERL_ITHR_JOINED
set $state = "joined"
else
if $statei = $PERL_ITHR_FINISHED
set $state = "finished"
else
if $statei == $PERL_ITHR_THREAD_EXIT_ONLY
set $state = "exit()"
else
if $statei == $PERL_ITHR_NONVIABLE
set $state = "thread creation failed"
else
if $statei == $PERL_ITHR_DIED
set $state = "died"
else
if $statei == $PERL_ITHR_UNCALLABLE
set $state = "uncallable"
else
set $state = "???"
end
end
end
end
end
end
end
printf "thread %d %s:\n", $tid, $state
set $interpreter = $thread->interp
perl_backtrace_an_interp
end
define perl_backtrace_nothreads
set $stackinfo = PL_curstackinfo
while $stackinfo
set $cxstack = $stackinfo->si_cxstack
set $cxix = $stackinfo->si_cxix
set $i = 0
while $i <= $cxix
set $context = $cxstack[$i]
set $type = $context->cx_u.cx_subst.sbu_type & $CXTYPEMASK
if $type == $CXt_SUB || $type == $CXt_EVAL || $type == $CXt_FORMAT
set $file = 0
lib/App/Stacktrace/perl_backtrace_symbols.txt view on Meta::CPAN
else
if $DEBUG
printf "%d\t... # (context*){cx_type=%d}\n", $i, $type
end
end
set $i = $i + 1
end
set $stackinfo = $stackinfo->si_prev
end
end
define perl_backtrace_5_8_nothreads
set $stackinfo = PL_curstackinfo
while $stackinfo
set $cxstack = $stackinfo->si_cxstack
set $cxix = $stackinfo->si_cxix
set $i = 0
while $i <= $cxix
set $context = $cxstack[$i]
set $type = $context->cx_type & $CXTYPEMASK
if $type == $CXt_SUB || $type == $CXt_EVAL || $type == $CXt_FORMAT
set $cop = $context->cx_u.cx_blk.blku_oldcop
lib/App/Stacktrace/perl_backtrace_symbols.txt view on Meta::CPAN
set $file = "undef"
end
set $line = $cop->cop_line
printf "%s:%d\n", $file, $line
end
set $i = $i + 1
end
set $stackinfo = $stackinfo->si_prev
end
end
define perl_backtrace_5_8_a_thread
if $thread
set $tid = $thread->tid
set $statei = $thread->state
if $statei == $PERL_ITHR_DETACHED
set $state = "detached"
else
if $statei == $PERL_ITHR_JOINED
set $state = "joined"
else
if $statei = $PERL_ITHR_FINISHED
set $state = "finished"
else
if $statei == $PERL_ITHR_THREAD_EXIT_ONLY
set $state = "exit()"
else
if $statei == $PERL_ITHR_NONVIABLE
set $state = "thread creation failed"
else
if $statei == $PERL_ITHR_DIED
set $state = "died"
else
if $statei == $PERL_ITHR_UNCALLABLE
set $state = "uncallable"
else
set $state = "???"
end
end
end
end
end
end
end
printf "thread %d %s:\n", $tid, $state
set $interpreter = $thread->interp
else
set $interpreter = my_perl
end
perl_backtrace_5_8_an_interp
end
define perl_backtrace_5_8_threads
set $main_thread = threads
set $thread = $main_thread
perl_backtrace_5_8_a_thread
if $thread
set $thread = $thread->next
while $thread && $thread != $main_thread
perl_backtrace_5_8_a_thread
set $thread = $thread->next
end
end
end
define perl_backtrace_5_8
set $CXt_SUB = 1
set $CXt_EVAL = 2
set $CXt_FORMAT = 6
set $interpreter = (PerlInterpreter*)Perl_get_context()
if $interpreter
perl_backtrace_5_8_threads
else
perl_backtrace_5_8_nothreads
end
end
define perl_backtrace_5_8_9_an_interp
set $stackinfo = (PERL_SI*)$interpreter->Icurstackinfo
while $stackinfo
set $cxstack = $stackinfo->si_cxstack
set $cxix = $stackinfo->si_cxix
set $i = 0
while $i <= $cxix
lib/App/Stacktrace/perl_backtrace_symbols.txt view on Meta::CPAN
else
if $DEBUG
printf "%d\t... # (context*){cx_type=%d}\n", $i, $type
end
end
set $i = $i + 1
end
set $stackinfo = $stackinfo->si_prev
end
end
define perl_backtrace_5_8_9_nothreads
perl_backtrace_5_8_nothreads
end
define perl_backtrace_5_8_9_a_thread
set $tid = $thread->tid
set $statei = $thread->state
if $statei == $PERL_ITHR_DETACHED
set $state = "detached"
else
if $statei == $PERL_ITHR_JOINED
set $state = "joined"
else
if $statei = $PERL_ITHR_FINISHED
set $state = "finished"
else
if $statei == $PERL_ITHR_THREAD_EXIT_ONLY
set $state = "exit()"
else
if $statei == $PERL_ITHR_NONVIABLE
set $state = "thread creation failed"
else
if $statei == $PERL_ITHR_DIED
set $state = "died"
else
if $statei == $PERL_ITHR_UNCALLABLE
set $state = "uncallable"
else
set $state = "???"
end
end
end
end
end
end
end
printf "thread %d %s:\n", $tid, $state
set $interpreter = $thread->interp
perl_backtrace_5_8_9_an_interp
end
define perl_backtrace_5_8_9_threads
set $main_thread = threads
set $thread = $main_thread
perl_backtrace_5_8_9_a_thread
if $thread
set $thread = $thread->next
while $thread && $thread != $main_thread
perl_backtrace_5_8_9_a_thread
set $thread = $thread->next
end
end
end
define perl_backtrace_5_8_9
set $CXt_SUB = 1
set $CXt_EVAL = 2
set $CXt_FORMAT = 6
set $interpreter = (PerlInterpreter*)Perl_get_context()
if $interpreter
set $POOL_KEY = "threads::_pool1.71"
set $POOL_KEY_LEN = 18
perl_backtrace_5_8_9_threads
else
perl_backtrace_5_8_nothreads
end
end
define perl_backtrace_5_10_threads
set $modglobal = $interpreter->Imodglobal
set $my_pool_svp = Perl_hv_fetch($interpreter, $modglobal, $POOL_KEY, $POOL_KEY_LEN, 0)
if $my_pool_svp
set $my_pool_sv = *$my_pool_svp
set $my_pool_svval = (struct xpvuv*)($my_pool_sv->sv_any)
set $my_poolp = (my_pool_t*)($my_pool_svval->xuv_u.xuvu_uv)
set $main_thread = &($my_poolp->main_thread)
set $thread = $main_thread
perl_backtrace_a_thread
set $thread = $main_thread->next
while $thread != $main_thread
perl_backtrace_a_thread
set $thread = $thread->next
end
else
set $interpreter = my_perl
perl_backtrace_an_interp
end
end
define perl_backtrace_5_10_0
set $CXt_SUB = 1
set $CXt_EVAL = 2
set $CXt_FORMAT = 6
set $interpreter = (PerlInterpreter*)Perl_get_context()
if $interpreter
set $POOL_KEY = "threads::_pool1.67"
set $POOL_KEY_LEN = 18
perl_backtrace_5_10_threads
else
perl_backtrace_nothreads
end
end
define perl_backtrace_5_10_1
set $CXt_SUB = 1
set $CXt_EVAL = 2
set $CXt_FORMAT = 6
set $interpreter = (PerlInterpreter*)Perl_get_context()
if $interpreter
set $POOL_KEY = "threads::_pool1.72"
set $POOL_KEY_LEN = 18
perl_backtrace_5_10_threads
else
perl_backtrace_nothreads
end
end
define perl_backtrace_5_12_threads
set $modglobal = $interpreter->Imodglobal
set $my_pool_svp = Perl_hv_fetch($interpreter, $modglobal, $POOL_KEY, $POOL_KEY_LEN, 0)
if $my_pool_svp
set $my_pool_sv = *$my_pool_svp
set $my_pool_svval = (struct xpvuv*)($my_pool_sv->sv_any)
set $my_poolp = (my_pool_t*)($my_pool_svval->xuv_u.xivu_uv)
set $main_thread = &($my_poolp->main_thread)
set $thread = $main_thread
perl_backtrace_a_thread
set $thread = $main_thread->next
while $thread != $main_thread
perl_backtrace_a_thread
set $thread = $thread->next
end
else
set $interpreter = my_perl
perl_backtrace_an_interp
end
end
define perl_backtrace_5_12_x
set $CXt_SUB = 8
set $CXt_FORMAT = 9
set $CXt_EVAL = 10
set $interpreter = (PerlInterpreter*)Perl_get_context()
if $interpreter
set $POOL_KEY = "threads::_pool1.75"
set $POOL_KEY_LEN = 18
perl_backtrace_5_12_threads
else
perl_backtrace_nothreads
end
end
define perl_backtrace_5_14_x
set $CXt_SUB = 8
set $CXt_FORMAT = 9
set $CXt_EVAL = 10
set $interpreter = (PerlInterpreter*)Perl_get_context()
if $interpreter
set $POOL_KEY = "threads::_pool1.83"
set $POOL_KEY_LEN = 18
perl_backtrace_5_12_threads
else
perl_backtrace_nothreads
end
end
new_version||5.009000|
new_warnings_bitfield|||
next_symbol|||
nextargv|||
nextchar|||
ninstr|||
no_bareword_allowed|||
no_fh_allowed|||
no_op|||
not_a_number|||
nothreadhook||5.008000|
nuke_stacks|||
num_overflow|||n
offer_nice_chunk|||
oopsAV|||
oopsHV|||
op_clear|||
op_const_sv|||
op_dump||5.006000|
op_free|||
op_getmad_weak|||
U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
#else
extern U32 DPPP_(my_PL_signals);
#endif
#define PL_signals DPPP_(my_PL_signals)
#endif
/* Hint: PL_ppaddr
* Calling an op via PL_ppaddr requires passing a context argument
* for threaded builds. Since the context argument is different for
* 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
* automatically be defined as the correct argument.
*/
#if (PERL_BCDVERSION <= 0x5005005)
/* Replace: 1 */
# define PL_ppaddr ppaddr
# define PL_no_modify no_modify
/* Replace: 0 */
#endif
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
}
#endif
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
#ifndef START_MY_CXT
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define START_MY_CXT
#if (PERL_BCDVERSION < 0x5004068)
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#else
/* older perls don't have PL_numeric_radix_sv so the radix
* must manually be requested from locale.h
*/
#include <locale.h>
dTHR; /* needed for older threaded perls */
struct lconv *lc = localeconv();
char *radix = lc->decimal_point;
if (radix && IN_LOCALE) {
STRLEN len = strlen(radix);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#endif
t/unthreaded.t view on Meta::CPAN
SKIP: {
Test::More::diag( $trace );
if ( $trace && $trace =~ /ptrace: Operation not permitted/ ) {
Test::More::skip("ptrace permissions", 1);
}
Test::More::like(
$trace,
qr{
(?:
^t/unthreaded\.t:\d+\n
){10}
}xm
);
}
Test::More::is( $WAITED_PID, $pstack_pid, "Reaped pstack" );
Test::More::is( $WAITED_RC >> 8, 0, "exit(0)" );
Test::More::is( $WAITED_RC & 127, 0, "No signals" );
Test::More::is( $WAITED_RC & 128, 0, "No core dump" );
#ifdef USE_ITHREADS
typedef struct _ithread {
struct _ithread *next; /* Next thread in the list */
struct _ithread *prev; /* Prev thread in the list */
PerlInterpreter *interp; /* The threads interpreter */
UV tid; /* Threads module's thread id */
perl_mutex mutex; /* Mutex for updating things in this struct */
int count; /* Reference count. See S_ithread_create. */
int state; /* Detached, joined, finished, etc. */
int gimme; /* Context of create */
SV *init_function; /* Code to run */
AV *params; /* Args to pass function */
#ifdef WIN32
DWORD thr; /* OS's idea if thread id */
HANDLE handle; /* OS's waitable handle */
#else
pthread_t thr; /* OS's handle for the thread */
#endif
IV stack_size;
SV *err; /* Error from abnormally terminated thread */
char *err_class; /* Error object's classname if applicable */
#ifndef WIN32
sigset_t initial_sigmask; /* Thread wakes up with signals blocked */
#endif
} ithread;
typedef struct {
/* Structure for 'main' thread
* Also forms the 'base' for the doubly-linked list of threads */
ithread main_thread;
/* Protects the creation and destruction of threads*/
perl_mutex create_destruct_mutex;
UV tid_counter;
IV joinable_threads;
IV running_threads;
IV detached_threads;
IV total_threads;
IV default_stack_size;
IV page_size;
} my_pool_t;
#endif
( run in 0.699 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )