package B::Debug;
-our $VERSION = '1.24';
+our $VERSION = '1.25';
+BEGIN { if ($] >= 5.027001) { require deprecate; import deprecate; } }
use strict;
require 5.006;
-use B qw(peekop class walkoptree walkoptree_exec
+use B qw(peekop walkoptree walkoptree_exec
main_start main_root cstring sv_undef SVf_NOK SVf_IOK);
use Config;
my (@optype, @specialsv_name);
my $addr = ${$op} ? $op->ppaddr : '';
$addr =~ s/^PL_ppaddr// if $addr;
if (${$op}) {
- return sprintf "0x%08x %6s %s", ${$op}, class($op), $addr;
+ return sprintf "0x%08x %6s %s", ${$op}, B::class($op), $addr;
} else {
return sprintf "0x%x %6s %s", ${$op}, '', $addr;
}
sub B::OP::debug {
my ($op) = @_;
- printf <<'EOT', class($op), $$op, _printop($op), _printop($op->next), _printop($op->sibling), $op->targ, $op->type, $op->name;
+ printf <<'EOT', B::class($op), $$op, _printop($op), _printop($op->next), _printop($op->sibling), $op->targ, $op->type, $op->name;
%s (0x%lx)
op_ppaddr %s
op_next %s
}
if ($have_B_Flags) {
printf <<'EOT', $op->flags, $op->flagspv, $op->private, $op->privatepv;
- op_flags %d %s
- op_private %d %s
+ op_flags %u %s
+ op_private %u %s
EOT
} else {
printf <<'EOT', $op->flags, $op->private;
- op_flags %d
- op_private %d
+ op_flags %u
+ op_private %u
+EOT
+ }
+ if ($op->can('rettype')) {
+ printf <<'EOT', $op->rettype;
+ op_rettype %u
EOT
}
}
cop_warnings 0x%x
EOT
if ($] > 5.008 and $] < 5.011) {
- my $cop_io = class($op->io) eq 'SPECIAL' ? '' : $op->io->as_string;
+ my $cop_io = B::class($op->io) eq 'SPECIAL' ? '' : $op->io->as_string;
printf(" cop_io %s\n", cstring($cop_io));
}
}
}
}
+sub B::UNOP_AUX::debug {
+ my ($op) = @_;
+ $op->B::OP::debug();
+ # string and perl5 aux_list needs the cv
+ # cperl has aux, Concise,-debug leaves it empty
+ if ($op->can('aux')) {
+ printf "\top_aux\t%s\n", cstring($op->aux);
+ }
+}
+
sub B::PVOP::debug {
my ($op) = @_;
$op->B::OP::debug();
sub B::SV::debug {
my ($sv) = @_;
if (!$$sv) {
- print class($sv), " = NULL\n";
+ print B::class($sv), " = NULL\n";
return;
}
- printf <<'EOT', class($sv), $$sv, $sv->REFCNT;
+ printf <<'EOT', B::class($sv), $$sv, $sv->REFCNT;
%s (0x%x)
REFCNT %d
EOT
}
sub B::CV::debug {
- my ($sv) = @_;
- $sv->B::PVNV::debug();
- my ($stash) = $sv->STASH;
- my ($start) = $sv->START;
- my ($root) = $sv->ROOT;
- my ($padlist) = $sv->PADLIST;
- my ($file) = $sv->FILE;
- my ($gv) = $sv->GV;
+ my ($cv) = @_;
+ $cv->B::PVNV::debug();
+ my $stash = $cv->STASH;
+ my $start = $cv->START;
+ my $root = $cv->ROOT;
+ my $padlist = $cv->PADLIST;
+ my $file = $cv->FILE;
+ my $gv;
printf <<'EOT', $$stash, $$start, $$root;
STASH 0x%x
START 0x%x
ROOT 0x%x
EOT
- if ( $]>5.017 && ($sv->FLAGS & 0x40000)) { #lexsub
- printf("\tNAME\t%%s\n", $sv->NAME);
+ if ($cv->can('NAME_HEK') && $cv->NAME_HEK) {
+ printf("\tNAME\t%%s\n", $cv->NAME_HEK);
+ }
+ elsif ( $]>5.017 && ($cv->FLAGS & 0x40000)) { #lexsub
+ printf("\tNAME\t%%s\n", $cv->NAME_HEK);
} else {
- printf("\tGV\t%0x%x\t%s\n", $$gv, $gv->SAFENAME);
+ $gv = $cv->GV;
+ printf("\tGV\t%0x%x\t%s\n", $$gv, $gv->SAFENAME);
}
- printf <<'EOT', $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
+ printf <<'EOT', $file, $cv->DEPTH, $padlist, ${$cv->OUTSIDE};
FILE %s
DEPTH %d
PADLIST 0x%x
OUTSIDE 0x%x
EOT
- printf("\tOUTSIDE_SEQ\t%d\n", $sv->OUTSIDE_SEQ) if $] > 5.007;
+ printf("\tOUTSIDE_SEQ\t%d\n", $cv->OUTSIDE_SEQ) if $] > 5.007;
if ($have_B_Flags) {
- my $SVt_PVCV = $] < 5.010 ? 12 : 13;
- printf("\tCvFLAGS\t0x%x\t%s\n", $sv->CvFLAGS,
- $have_B_Flags_extra ? $sv->flagspv($SVt_PVCV) : $sv->flagspv);
+ my $SVt_PVCV = $] < 5.010 ? 12 : 13;
+ printf("\tCvFLAGS\t0x%x\t%s\n", $cv->CvFLAGS,
+ $have_B_Flags_extra ? $cv->flagspv($SVt_PVCV) : $cv->flagspv);
} else {
- printf("\tCvFLAGS\t0x%x\n", $sv->CvFLAGS);
+ printf("\tCvFLAGS\t0x%x\n", $cv->CvFLAGS);
}
+ printf("\tSIGOP\t0x%x\n", $cv->SIGOP) if $cv->can('SIGOP');
$start->debug if $start;
$root->debug if $root;
$gv->debug if $gv;
my (@array) = eval { $av->ARRAY; };
print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
my $fill = eval { scalar(@array) };
- if ($Config{'useithreads'} && class($av) ne 'PADLIST') {
+ if ($Config{'useithreads'} && B::class($av) ne 'PADLIST') {
printf <<'EOT', $fill, $av->MAX, $av->OFF;
FILL %d
MAX %d
sub B::PADLIST::debug {
my ($padlist) = @_;
- printf <<'EOT', class($padlist), $$padlist, $padlist->REFCNT;
+ printf <<'EOT', B::class($padlist), $$padlist, $padlist->REFCNT;
%s (0x%x)
REFCNT %d
EOT
=head1 DESCRIPTION
-See F<ext/B/README> and the newer L<B::Concise>, L<B::Terse>.
+See F<ext/B/README> and the newer L<B::Concise>.
=head1 OPTIONS
=head1 AUTHOR
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+Malcolm Beattie, C<retired>
Reini Urban C<rurban@cpan.org>
=head1 LICENSE