summaryrefslogtreecommitdiff
path: root/lib/B/Terse.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/B/Terse.pm')
-rw-r--r--lib/B/Terse.pm132
1 files changed, 0 insertions, 132 deletions
diff --git a/lib/B/Terse.pm b/lib/B/Terse.pm
deleted file mode 100644
index 6489dc0afe..0000000000
--- a/lib/B/Terse.pm
+++ /dev/null
@@ -1,132 +0,0 @@
-package B::Terse;
-use strict;
-use B qw(peekop class walkoptree_slow walkoptree_exec
- main_start main_root cstring svref_2object);
-use B::Asmdata qw(@specialsv_name);
-
-sub terse {
- my ($order, $cvref) = @_;
- my $cv = svref_2object($cvref);
- if ($order eq "exec") {
- walkoptree_exec($cv->START, "terse");
- } else {
- walkoptree_slow($cv->ROOT, "terse");
- }
-}
-
-sub compile {
- my $order = shift;
- my @options = @_;
- if (@options) {
- return sub {
- my $objname;
- foreach $objname (@options) {
- $objname = "main::$objname" unless $objname =~ /::/;
- eval "terse(\$order, \\&$objname)";
- die "terse($order, \\&$objname) failed: $@" if $@;
- }
- }
- } else {
- if ($order eq "exec") {
- return sub { walkoptree_exec(main_start, "terse") }
- } else {
- return sub { walkoptree_slow(main_root, "terse") }
- }
- }
-}
-
-sub indent {
- my $level = shift;
- return " " x $level;
-}
-
-sub B::OP::terse {
- my ($op, $level) = @_;
- my $targ = $op->targ;
- $targ = ($targ > 0) ? " [$targ]" : "";
- print indent($level), peekop($op), $targ, "\n";
-}
-
-sub B::SVOP::terse {
- my ($op, $level) = @_;
- print indent($level), peekop($op), " ";
- $op->sv->terse(0);
-}
-
-sub B::GVOP::terse {
- my ($op, $level) = @_;
- print indent($level), peekop($op), " ";
- $op->gv->terse(0);
-}
-
-sub B::PMOP::terse {
- my ($op, $level) = @_;
- my $precomp = $op->precomp;
- print indent($level), peekop($op),
- defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
-
-}
-
-sub B::PVOP::terse {
- my ($op, $level) = @_;
- print indent($level), peekop($op), " ", cstring($op->pv), "\n";
-}
-
-sub B::COP::terse {
- my ($op, $level) = @_;
- my $label = $op->label;
- if ($label) {
- $label = " label ".cstring($label);
- }
- print indent($level), peekop($op), $label, "\n";
-}
-
-sub B::PV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
-}
-
-sub B::AV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
-}
-
-sub B::GV::terse {
- my ($gv, $level) = @_;
- my $stash = $gv->STASH->NAME;
- if ($stash eq "main") {
- $stash = "";
- } else {
- $stash = $stash . "::";
- }
- print indent($level);
- printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
-}
-
-sub B::IV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
-}
-
-sub B::NV::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
-}
-
-sub B::NULL::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s (0x%lx)\n", class($sv), $$sv;
-}
-
-sub B::SPECIAL::terse {
- my ($sv, $level) = @_;
- print indent($level);
- printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
-}
-
-1;