package B::Terse;
+
+our $VERSION = '1.00';
+
use strict;
-use B qw(peekop class walkoptree_slow walkoptree_exec
- main_start main_root cstring svref_2object);
+use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
+ main_start main_root cstring svref_2object SVf_IVisUV);
use B::Asmdata qw(@specialsv_name);
sub terse {
}
sub compile {
- my $order = shift;
+ my $order = @_ ? shift : "";
my @options = @_;
B::clearsym();
if (@options) {
}
sub indent {
- my $level = shift;
+ my $level = @_ ? shift : 0;
return " " x $level;
}
$op->sv->terse(0);
}
-sub B::GVOP::terse {
+sub B::PADOP::terse {
my ($op, $level) = @_;
- print indent($level), peekop($op), " ";
- $op->gv->terse(0);
+ print indent($level), peekop($op), " ", $op->padix, "\n";
}
sub B::PMOP::terse {
$stash = $stash . "::";
}
print indent($level);
- printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
+ printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
}
sub B::IV::terse {
my ($sv, $level) = @_;
print indent($level);
- printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
+ my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
+ printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
}
sub B::NV::terse {
printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
}
+sub B::RV::terse {
+ my ($rv, $level) = @_;
+ print indent($level);
+ printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv);
+}
+
+sub printref {
+ my $rv = shift;
+ my $rcl = class($rv->RV);
+ if ($rcl eq 'PV') {
+ return "\\" . cstring($rv->RV->$rcl);
+ } elsif ($rcl eq 'NV') {
+ return "\\" . $rv->RV->$rcl;
+ } elsif ($rcl eq 'IV') {
+ return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"),
+ $rv->RV->int_value;
+ } elsif ($rcl eq 'RV') {
+ return "\\" . printref($rv->RV);
+ }
+}
+
sub B::NULL::terse {
my ($sv, $level) = @_;
print indent($level);