X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FDebug.pm;h=8b34a1d8af022e2c7e2abde8772f7f8fd6ad4736;hb=bb7c595be2e30a806b95ad83e9d3613aeb95c384;hp=d88cef378015b5e20ed799ebec5c006f3a51cedf;hpb=a798dbf2f5009fe67f7460a594ffd57a76c0fa98;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm index d88cef3..8b34a1d 100644 --- a/ext/B/B/Debug.pm +++ b/ext/B/B/Debug.pm @@ -1,4 +1,7 @@ package B::Debug; + +our $VERSION = '1.02'; + use strict; use B qw(peekop class walkoptree walkoptree_exec main_start main_root cstring sv_undef); @@ -8,14 +11,25 @@ my %done_gv; sub B::OP::debug { my ($op) = @_; - printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private; + printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type; %s (0x%lx) op_next 0x%x op_sibling 0x%x op_ppaddr %s op_targ %d op_type %d +EOT + if ($] > 5.009) { + printf <<'EOT', $op->opt, $op->static; + op_opt %d + op_static %d +EOT + } else { + printf <<'EOT', $op->seq; op_seq %d +EOT + } + printf <<'EOT', $op->flags, $op->private; op_flags %d op_private %d EOT @@ -33,17 +47,20 @@ sub B::BINOP::debug { printf "\top_last\t\t0x%x\n", ${$op->last}; } -sub B::LOGOP::debug { +sub B::LOOP::debug { my ($op) = @_; - $op->B::UNOP::debug(); - printf "\top_other\t0x%x\n", ${$op->other}; + $op->B::BINOP::debug(); + printf <<'EOT', ${$op->redoop}, ${$op->nextop}, ${$op->lastop}; + op_redoop 0x%x + op_nextop 0x%x + op_lastop 0x%x +EOT } -sub B::CONDOP::debug { +sub B::LOGOP::debug { my ($op) = @_; $op->B::UNOP::debug(); - printf "\top_true\t0x%x\n", ${$op->true}; - printf "\top_false\t0x%x\n", ${$op->false}; + printf "\top_other\t0x%x\n", ${$op->other}; } sub B::LISTOP::debug { @@ -60,23 +77,23 @@ sub B::PMOP::debug { printf "\top_pmnext\t0x%x\n", ${$op->pmnext}; printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp); printf "\top_pmflags\t0x%x\n", $op->pmflags; - $op->pmshort->debug; $op->pmreplroot->debug; } sub B::COP::debug { my ($op) = @_; $op->B::OP::debug(); - my ($filegv) = $op->filegv; - printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line; + my $cop_io = class($op->io) eq 'SPECIAL' ? '' : $op->io->as_string; + printf <<'EOT', $op->label, $op->stashpv, $op->file, $op->cop_seq, $op->arybase, $op->line, ${$op->warnings}, cstring($cop_io); cop_label %s - cop_stash 0x%x - cop_filegv 0x%x + cop_stashpv %s + cop_file %s cop_seq %d cop_arybase %d cop_line %d + cop_warnings 0x%x + cop_io %s EOT - $filegv->debug; } sub B::SVOP::debug { @@ -89,20 +106,13 @@ sub B::SVOP::debug { sub B::PVOP::debug { my ($op) = @_; $op->B::OP::debug(); - printf "\top_pv\t\t0x%x\n", $op->pv; + printf "\top_pv\t\t%s\n", cstring($op->pv); } -sub B::GVOP::debug { +sub B::PADOP::debug { my ($op) = @_; $op->B::OP::debug(); - printf "\top_gv\t\t0x%x\n", ${$op->gv}; - $op->gv->debug; -} - -sub B::CVOP::debug { - my ($op) = @_; - $op->B::OP::debug(); - printf "\top_cv\t\t0x%x\n", ${$op->cv}; + printf "\top_padix\t\t%ld\n", $op->padix; } sub B::NULL::debug { @@ -127,6 +137,15 @@ sub B::SV::debug { EOT } +sub B::RV::debug { + my ($rv) = @_; + B::SV::debug($rv); + printf <<'EOT', ${$rv->RV}; + RV 0x%x +EOT + $rv->RV->debug; +} + sub B::PV::debug { my ($sv) = @_; $sv->B::SV::debug(); @@ -184,22 +203,22 @@ sub B::CV::debug { my ($start) = $sv->START; my ($root) = $sv->ROOT; my ($padlist) = $sv->PADLIST; + my ($file) = $sv->FILE; my ($gv) = $sv->GV; - my ($filegv) = $sv->FILEGV; - printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE}; + printf <<'EOT', $$stash, $$start, $$root, $$gv, $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE}, $sv->OUTSIDE_SEQ; STASH 0x%x START 0x%x ROOT 0x%x GV 0x%x - FILEGV 0x%x + FILE %s DEPTH %d - PADLIST 0x%x + PADLIST 0x%x OUTSIDE 0x%x + OUTSIDE_SEQ %d EOT $start->debug if $start; $root->debug if $root; $gv->debug if $gv; - $filegv->debug if $filegv; $padlist->debug if $padlist; } @@ -208,25 +227,27 @@ sub B::AV::debug { $av->B::SV::debug; my(@array) = $av->ARRAY; print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n"; - printf <<'EOT', scalar(@array), $av->MAX, $av->OFF, $av->AvFLAGS; - FILL %d + printf <<'EOT', scalar(@array), $av->MAX, $av->OFF; + FILL %d MAX %d OFF %d +EOT + printf <<'EOT', $av->AvFLAGS if $] < 5.009; AvFLAGS %d EOT } - + sub B::GV::debug { my ($gv) = @_; if ($done_gv{$$gv}++) { - printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME; + printf "GV %s::%s\n", $gv->STASH->NAME, $gv->SAFENAME; return; } my ($sv) = $gv->SV; my ($av) = $gv->AV; my ($cv) = $gv->CV; $gv->B::SV::debug; - printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS; + printf <<'EOT', $gv->SAFENAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS; NAME %s STASH %s (0x%x) SV 0x%x @@ -238,7 +259,7 @@ sub B::GV::debug { CV 0x%x CVGEN %d LINE %d - FILEGV 0x%x + FILE %s GvFLAGS 0x%x EOT $sv->debug if $sv; @@ -253,7 +274,8 @@ sub B::SPECIAL::debug { sub compile { my $order = shift; - if ($order eq "exec") { + B::clearsym(); + if ($order && $order eq "exec") { return sub { walkoptree_exec(main_start, "debug") } } else { return sub { walkoptree(main_root, "debug") } @@ -261,3 +283,23 @@ sub compile { } 1; + +__END__ + +=head1 NAME + +B::Debug - Walk Perl syntax tree, printing debug info about ops + +=head1 SYNOPSIS + + perl -MO=Debug[,OPTIONS] foo.pl + +=head1 DESCRIPTION + +See F. + +=head1 AUTHOR + +Malcolm Beattie, C + +=cut