| … | |
… | |
| 2435 | |
2435 | |
| 2436 | die $$res unless "ARRAY" eq ref $res; |
2436 | die $$res unless "ARRAY" eq ref $res; |
| 2437 | |
2437 | |
| 2438 | return wantarray ? @$res : $res->[-1]; |
2438 | return wantarray ? @$res : $res->[-1]; |
| 2439 | } else { |
2439 | } else { |
|
|
2440 | reset_signals; |
| 2440 | local $SIG{__WARN__}; |
2441 | local $SIG{__WARN__}; |
|
|
2442 | local $SIG{__DIE__}; |
| 2441 | eval { |
2443 | eval { |
| 2442 | local $SIG{__DIE__}; |
|
|
| 2443 | close $fh1; |
2444 | close $fh1; |
| 2444 | |
2445 | |
| 2445 | my @res = eval { $cb->(@args) }; |
2446 | my @res = eval { $cb->(@args) }; |
| 2446 | syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res); |
2447 | syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res); |
| 2447 | }; |
2448 | }; |
| … | |
… | |
| 2923 | prio => 6, |
2924 | prio => 6, |
| 2924 | cb => \&IO::AIO::poll_cb, |
2925 | cb => \&IO::AIO::poll_cb, |
| 2925 | ); |
2926 | ); |
| 2926 | } |
2927 | } |
| 2927 | |
2928 | |
|
|
2929 | my $_log_backtrace; |
|
|
2930 | |
| 2928 | sub _log_backtrace { |
2931 | sub _log_backtrace { |
| 2929 | my ($msg, @addr) = @_; |
2932 | my ($msg, @addr) = @_; |
| 2930 | |
2933 | |
|
|
2934 | $msg =~ s/\n//; |
|
|
2935 | |
|
|
2936 | # limit the # of concurrent backtraces |
|
|
2937 | if ($_log_backtrace < 2) { |
|
|
2938 | ++$_log_backtrace; |
| 2931 | async { |
2939 | async { |
| 2932 | my @bt = fork_call { |
2940 | my @bt = fork_call { |
| 2933 | @addr = map { sprintf "%x", $_ } @addr; |
2941 | @addr = map { sprintf "%x", $_ } @addr; |
| 2934 | my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X; |
2942 | my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X; |
| 2935 | open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |" |
2943 | open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |" |
| 2936 | or die "addr2line: $!"; |
2944 | or die "addr2line: $!"; |
| 2937 | |
2945 | |
| 2938 | my @funcs; |
2946 | my @funcs; |
| 2939 | my @res = <$fh>; |
2947 | my @res = <$fh>; |
| 2940 | chomp for @res; |
2948 | chomp for @res; |
| 2941 | while (@res) { |
2949 | while (@res) { |
| 2942 | my ($func, $line) = splice @res, 0, 2, (); |
2950 | my ($func, $line) = splice @res, 0, 2, (); |
| 2943 | push @funcs, "[$func] $line"; |
2951 | push @funcs, "[$func] $line"; |
|
|
2952 | } |
|
|
2953 | |
|
|
2954 | @funcs |
| 2944 | } |
2955 | }; |
| 2945 | |
2956 | |
| 2946 | @funcs |
2957 | LOG llevInfo, "[ABT] $msg\n"; |
|
|
2958 | LOG llevInfo, "[ABT] $_\n" for @bt; |
|
|
2959 | --$_log_backtrace; |
| 2947 | }; |
2960 | }; |
| 2948 | |
2961 | } else { |
| 2949 | $msg =~ s/\n//; |
|
|
| 2950 | |
|
|
| 2951 | LOG llevInfo, "[ABT] $msg\n"; |
2962 | LOG llevInfo, "[ABT] $msg\n"; |
| 2952 | LOG llevInfo, "[ABT] $_\n" for @bt; |
2963 | LOG llevInfo, "[ABT] [suppressed]\n"; |
| 2953 | }; |
2964 | } |
| 2954 | } |
2965 | } |
| 2955 | |
2966 | |
| 2956 | # load additional modules |
2967 | # load additional modules |
| 2957 | use cf::pod; |
2968 | use cf::pod; |
| 2958 | |
2969 | |
