Teach B::Concise about OPpFT_STACKING

[perl5.git] / ext / B / B / Concise.pm

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index b2179a7..8ab7e00 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
 
 use Exporter (); # use #5
 

-our $VERSION   = "0.68";
+our $VERSION   = "0.86";

 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main


@@ -28,7 +28,7 @@ our %EXPORT_TAGS =
 # use #6
 use B qw(class ppname main_start main_root main_cv cstring svref_2object
         SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
 # use #6
 use B qw(class ppname main_start main_root main_cv cstring svref_2object
         SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL

-        CVf_ANON);
+        CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);

 
 my %style =
   ("terse" =>
 
 my %style =
   ("terse" =>


@@ -37,8 +37,8 @@ my %style =
     "(*(    )*)goto #class (#addr)\n",
     "#class pp_#name"],
    "concise" =>
     "(*(    )*)goto #class (#addr)\n",
     "#class pp_#name"],
    "concise" =>

-   ["#hyphseq2 (*(   (x( ;)x))*)<#classsym> "
-    . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n"
+   ["#hyphseq2 (*(   (x( ;)x))*)<#classsym> #exname#arg(?([#targarglife])?)"
+    . "~#flags(?(/#private)?)(?(:#hints)?)(x(;~->#next)x)\n"

     , "  (*(    )*)     goto #seq\n",
     "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
    "linenoise" =>
     , "  (*(    )*)     goto #seq\n",
     "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"],
    "linenoise" =>


@@ -49,7 +49,7 @@ my %style =
    ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
     . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" .
     ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n")
    ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
     . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" .
     ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n")

-    . "\top_flags\t#flagval\n\top_private\t#privval\n"
+    . "\top_flags\t#flagval\n\top_private\t#privval\t#hintsval\n"

     . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
     . "(?(\top_sv\t\t#svaddr\n)?)",
     "    GOTO #addr\n",
     . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
     . "(?(\top_sv\t\t#svaddr\n)?)",
     "    GOTO #addr\n",


@@ -74,6 +74,7 @@ my $big_endian = 1;   # more <sequence#> display
 my $tree_style = 0;    # tree-order details
 my $banner = 1;                # print banner before optree is traversed
 my $do_main = 0;       # force printing of main routine
 my $tree_style = 0;    # tree-order details
 my $banner = 1;                # print banner before optree is traversed
 my $do_main = 0;       # force printing of main routine

+my $show_src;          # show source code

 
 # another factor: can affect all styles!
 our @callbacks;                # allow external management
 
 # another factor: can affect all styles!
 our @callbacks;                # allow external management


@@ -142,15 +143,17 @@ sub concise_subref {
 
 sub concise_stashref {
     my($order, $h) = @_;
 
 sub concise_stashref {
     my($order, $h) = @_;

+    local *s;

     foreach my $k (sort keys %$h) {
     foreach my $k (sort keys %$h) {

-       local *s = $h->{$k};
+       next unless defined $h->{$k};
+       *s = $h->{$k};

        my $coderef = *s{CODE} or next;
        reset_sequence();
        print "FUNC: ", *s, "\n";
        my $codeobj = svref_2object($coderef);
        next unless ref $codeobj eq 'B::CV';
        my $coderef = *s{CODE} or next;
        reset_sequence();
        print "FUNC: ", *s, "\n";
        my $codeobj = svref_2object($coderef);
        next unless ref $codeobj eq 'B::CV';

-       eval { concise_cv_obj($order, $codeobj) }
-       or warn "err $@ on $codeobj";
+       eval { concise_cv_obj($order, $codeobj, $k) };
+       warn "err $@ on $codeobj" if $@;

     }
 }
 
     }
 }
 


@@ -244,6 +247,7 @@ my @tree_decorations =
    [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
   );
 
    [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0],
   );
 

+my @render_packs; # collect -stash=<packages>

 
 sub compileOpts {
     # set rendering state from options and args
 
 sub compileOpts {
     # set rendering state from options and args


@@ -279,6 +283,7 @@ sub compileOpts {
        } elsif ($o eq "-littleendian") {
            $big_endian = 0;
        }
        } elsif ($o eq "-littleendian") {
            $big_endian = 0;
        }

+       # miscellaneous, presentation

        elsif ($o eq "-nobanner") {
            $banner = 0;
        } elsif ($o eq "-banner") {
        elsif ($o eq "-nobanner") {
            $banner = 0;
        } elsif ($o eq "-banner") {


@@ -288,6 +293,25 @@ sub compileOpts {
            $do_main = 1;
        } elsif ($o eq "-nomain") {
            $do_main = 0;
            $do_main = 1;
        } elsif ($o eq "-nomain") {
            $do_main = 0;

+       } elsif ($o eq "-src") {
+           $show_src = 1;
+       }
+       elsif ($o =~ /^-stash=(.*)/) {
+           my $pkg = $1;
+           no strict 'refs';
+           if (! %{$pkg.'::'}) {
+               eval "require $pkg";
+           } else {
+               require Config;
+               if (!$Config::Config{usedl}
+                   && keys %{$pkg.'::'} == 1
+                   && $pkg->can('bootstrap')) {
+                   # It is something that we're statically linked to, but hasn't
+                   # yet been used.
+                   eval "require $pkg";
+               }
+           }
+           push @render_packs, $pkg;

        }
        # line-style options
        elsif (exists $style{substr($o, 1)}) {
        }
        # line-style options
        elsif (exists $style{substr($o, 1)}) {


@@ -321,6 +345,10 @@ sub compile {
                concise_specials("CHECK", $order,
                                 B::check_av->isa("B::AV") ?
                                 B::check_av->ARRAY : ());
                concise_specials("CHECK", $order,
                                 B::check_av->isa("B::AV") ?
                                 B::check_av->ARRAY : ());

+           } elsif ($objname eq "UNITCHECK") {
+               concise_specials("UNITCHECK", $order,
+                                B::unitcheck_av->isa("B::AV") ?
+                                B::unitcheck_av->ARRAY : ());

            } elsif ($objname eq "END") {
                concise_specials("END", $order,
                                 B::end_av->isa("B::AV") ?
            } elsif ($objname eq "END") {
                concise_specials("END", $order,
                                 B::end_av->isa("B::AV") ?


@@ -346,7 +374,12 @@ sub compile {
                concise_subref($order, $objref, $objname);
            }
        }
                concise_subref($order, $objref, $objname);
            }
        }

-       if (!@args or $do_main) {
+       for my $pkg (@render_packs) {
+           no strict 'refs';
+           concise_stashref($order, \%{$pkg.'::'});
+       }
+
+       if (!@args or $do_main or @render_packs) {

            print $walkHandle "main program:\n" if $do_main;
            concise_main($order);
        }
            print $walkHandle "main program:\n" if $do_main;
            concise_main($order);
        }


@@ -429,7 +462,7 @@ sub walk_topdown {
            walk_topdown($kid, $sub, $level + 1);
        }
     }
            walk_topdown($kid, $sub, $level + 1);
        }
     }

-    elsif (class($op) eq "PMOP") {
+    if (class($op) eq "PMOP") {

        my $maybe_root = $op->pmreplroot;
        if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
            # It really is the root of the replacement, not something
        my $maybe_root = $op->pmreplroot;
        if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
            # It really is the root of the replacement, not something


@@ -549,8 +582,11 @@ sub fmt_line {    # generate text-line for op.
 
     $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg;     # populate #var's
     $text =~ s/[ \t]*~+[ \t]*/ /g;             # squeeze tildes
 
     $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg;     # populate #var's
     $text =~ s/[ \t]*~+[ \t]*/ /g;             # squeeze tildes

+
+    $text = "# $hr->{src}\n$text" if $show_src and $hr->{src};
+

     chomp $text;
     chomp $text;

-    return "$text\n" if $text ne "";
+    return "$text\n" if $text ne "" and $order ne "tree";

     return $text; # suppress empty lines
 }
 
     return $text; # suppress empty lines
 }
 


@@ -559,26 +595,32 @@ our %priv; # used to display each opcode's BASEOP.op_private values
 $priv{$_}{128} = "LVINTRO"
   for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
        "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
 $priv{$_}{128} = "LVINTRO"
   for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
        "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",

-       "padav", "padhv", "enteriter");
+       "padav", "padhv", "enteriter", "entersub");

 $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
 $priv{"aassign"}{64} = "COMMON";
 $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
 $priv{"aassign"}{64} = "COMMON";

-$priv{"aassign"}{32} = "PHASH" if $] < 5.009;
+$priv{"aassign"}{32} = $] < 5.009 ? "PHASH" : "STATE";

 $priv{"sassign"}{32} = "STATE";
 $priv{"sassign"}{64} = "BKWARD";
 $priv{"sassign"}{32} = "STATE";
 $priv{"sassign"}{64} = "BKWARD";

+$priv{"sassign"}{128}= "CV2GV";

 $priv{$_}{64} = "RTIME" for ("match", "subst", "substcont", "qr");
 @{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
                                    "COMPL", "GROWS");
 $priv{$_}{64} = "RTIME" for ("match", "subst", "substcont", "qr");
 @{$priv{"trans"}}{1,2,4,8,16,64} = ("<UTF", ">UTF", "IDENT", "SQUASH", "DEL",
                                    "COMPL", "GROWS");

+$priv{transr} = $priv{trans};

 $priv{"repeat"}{64} = "DOLIST";
 $priv{"leaveloop"}{64} = "CONT";
 $priv{"repeat"}{64} = "DOLIST";
 $priv{"leaveloop"}{64} = "CONT";

+$priv{$_}{4} = "DREFed" for (qw(rv2sv rv2av rv2hv));

 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
   for (qw(rv2gv rv2sv padsv aelem helem));
 $priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");
 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
   for (qw(rv2gv rv2sv padsv aelem helem));
 $priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");

-@{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD");
-@{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
+$priv{rv2gv}{4} = "NOINIT";
+@{$priv{"entersub"}}{1,4,16,32,64} = qw( INARGS TARG DBG DEREF );
+@{$priv{rv2cv}}{1,8,128} = ("CONST","AMPER","NO()");

 $priv{"gv"}{32} = "EARLYCV";
 $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
 $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
        "enteriter");
 $priv{"gv"}{32} = "EARLYCV";
 $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER";
 $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv",
        "enteriter");

+$priv{$_}{8} = 'LVSUB' for qw(rv2av rv2gv rv2hv padav padhv aelem helem
+                        aslice hslice av2arylen keys rkeys substr pos vec);

 $priv{$_}{16} = "TARGMY"
   for (map(($_,"s$_"),"chop", "chomp"),
        map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
 $priv{$_}{16} = "TARGMY"
   for (map(($_,"s$_"),"chop", "chomp"),
        map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",


@@ -592,12 +634,13 @@ $priv{$_}{16} = "TARGMY"
        "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
        "setpriority", "time", "sleep");
 $priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
        "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
        "setpriority", "time", "sleep");
 $priv{$_}{4} = "REVERSED" for ("enteriter", "iter");

-@{$priv{"const"}}{4,8,16,32,64,128} = ("SHORT","STRICT","ENTERED",'$[',"BARE","WARN");
+@{$priv{"const"}}{4,8,16,64,128} = ("SHORT","STRICT","ENTERED","BARE","WARN");

 $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
 $priv{"list"}{64} = "GUESSED";
 $priv{"delete"}{64} = "SLICE";
 $priv{"exists"}{64} = "SUB";
 @{$priv{"sort"}}{1,2,4,8,16,32,64} = ("NUM", "INT", "REV", "INPLACE","DESC","QSORT","STABLE");
 $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
 $priv{"list"}{64} = "GUESSED";
 $priv{"delete"}{64} = "SLICE";
 $priv{"exists"}{64} = "SUB";
 @{$priv{"sort"}}{1,2,4,8,16,32,64} = ("NUM", "INT", "REV", "INPLACE","DESC","QSORT","STABLE");

+$priv{"reverse"}{8} = "INPLACE";

 $priv{"threadsv"}{64} = "SVREFd";
 @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
   for ("open", "backtick");
 $priv{"threadsv"}{64} = "SVREFd";
 @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR")
   for ("open", "backtick");


@@ -607,7 +650,7 @@ $priv{$_}{2} = "FTACCESS"
 $priv{"entereval"}{2} = "HAS_HH";
 if ($] >= 5.009) {
   # Stacked filetests are post 5.8.x
 $priv{"entereval"}{2} = "HAS_HH";
 if ($] >= 5.009) {
   # Stacked filetests are post 5.8.x

-  $priv{$_}{4} = "FTSTACKED"
+  @{$priv{$_}}{4,8} = ("FTSTACKED","FTSTACKING")

     for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
          "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
         "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",
     for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec",
          "ftis", "fteowned", "ftrowned", "ftzero", "ftsize", "ftmtime",
         "ftatime", "ftctime", "ftsock", "ftchr", "ftblk", "ftfile", "ftdir",


@@ -617,20 +660,47 @@ if ($] >= 5.009) {
   $priv{$_}{2} = "GREPLEX"
     for ("mapwhile", "mapstart", "grepwhile", "grepstart");
 }
   $priv{$_}{2} = "GREPLEX"
     for ("mapwhile", "mapstart", "grepwhile", "grepstart");
 }

-
-sub private_flags {
-    my($name, $x) = @_;
+$priv{$_}{128} = '+1' for qw "caller wantarray";
+@{$priv{coreargs}}{1,2,64,128} = ('DREF1','DREF2','$MOD','MARK');
+
+our %hints; # used to display each COP's op_hints values
+
+# strict refs, subs, vars
+@hints{2,512,1024} = ('$', '&', '*');
+# integers, locale, bytes
+@hints{1,4,8,16} = ('i', 'l', 'b');
+# block scope, localise %^H, $^OPEN (in), $^OPEN (out)
+@hints{256,131072,262144,524288} = ('{','%','<','>');
+# overload new integer, float, binary, string, re
+@hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
+# taint and eval
+@hints{1048576,2097152} = ('T', 'E');
+# filetest access, UTF-8
+@hints{4194304,8388608} = ('X', 'U');
+
+sub _flags {
+    my($hash, $x) = @_;

     my @s;
     my @s;

-    for my $flag (128, 96, 64, 32, 16, 8, 4, 2, 1) {
-       if ($priv{$name}{$flag} and $x & $flag and $x >= $flag) {
+    for my $flag (sort {$b <=> $a} keys %$hash) {
+       if ($hash->{$flag} and $x & $flag and $x >= $flag) {

            $x -= $flag;
            $x -= $flag;

-           push @s, $priv{$name}{$flag};
+           push @s, $hash->{$flag};

        }
     }
     push @s, $x if $x;
     return join(",", @s);
 }
 
        }
     }
     push @s, $x if $x;
     return join(",", @s);
 }
 

+sub private_flags {
+    my($name, $x) = @_;
+    _flags($priv{$name}, $x);
+}
+
+sub hints_flags {
+    my($x) = @_;
+    _flags(\%hints, $x);
+}
+

 sub concise_sv {
     my($sv, $hr, $preferpv) = @_;
     $hr->{svclass} = class($sv);
 sub concise_sv {
     my($sv, $hr, $preferpv) = @_;
     $hr->{svclass} = class($sv);


@@ -638,10 +708,9 @@ sub concise_sv {
       if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
     Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv;
     $hr->{svaddr} = sprintf("%#x", $$sv);
       if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV;
     Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv;
     $hr->{svaddr} = sprintf("%#x", $$sv);

-    if ($hr->{svclass} eq "GV") {
+    if ($hr->{svclass} eq "GV" && $sv->isGV_with_GP()) {

        my $gv = $sv;
        my $gv = $sv;

-       my $stash = $gv->STASH->NAME;
-       if ($stash eq "main") {
+       my $stash = $gv->STASH->NAME; if ($stash eq "main") {

            $stash = "";
        } else {
            $stash = $stash . "::";
            $stash = "";
        } else {
            $stash = $stash . "::";


@@ -649,9 +718,16 @@ sub concise_sv {
        $hr->{svval} = "*$stash" . $gv->SAFENAME;
        return "*$stash" . $gv->SAFENAME;
     } else {
        $hr->{svval} = "*$stash" . $gv->SAFENAME;
        return "*$stash" . $gv->SAFENAME;
     } else {

-       while (class($sv) eq "RV") {
-           $hr->{svval} .= "\\";
-           $sv = $sv->RV;
+       if ($] >= 5.011) {
+           while (class($sv) eq "IV" && $sv->FLAGS & SVf_ROK) {
+               $hr->{svval} .= "\\";
+               $sv = $sv->RV;
+           }
+       } else {
+           while (class($sv) eq "RV") {
+               $hr->{svval} .= "\\";
+               $sv = $sv->RV;
+           }

        }
        if (class($sv) eq "SPECIAL") {
            $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
        }
        if (class($sv) eq "SPECIAL") {
            $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];


@@ -673,6 +749,23 @@ sub concise_sv {
     }
 }
 
     }
 }
 

+my %srclines;
+
+sub fill_srclines {
+    my $fullnm = shift;
+    if ($fullnm eq '-e') {
+       $srclines{$fullnm} = [ $fullnm, "-src not supported for -e" ];
+       return;
+    }
+    open (my $fh, '<', $fullnm)
+       or warn "# $fullnm: $!, (chdirs not supported by this feature yet)\n"
+       and return;
+    my @l = <$fh>;
+    chomp @l;
+    unshift @l, $fullnm; # like @{_<$fullnm} in debug, array starts at 1
+    $srclines{$fullnm} = \@l;
+}
+

 sub concise_op {
     my ($op, $level, $format) = @_;
     my %h;
 sub concise_op {
     my ($op, $level, $format) = @_;
     my %h;


@@ -702,15 +795,18 @@ sub concise_op {
                    # These changes relate to the jumbo closure fix.
                    # See changes 19939 and 20005
                    my $fake = '';
                    # These changes relate to the jumbo closure fix.
                    # See changes 19939 and 20005
                    my $fake = '';

-                   $fake .= 'a' if $padname->IVX & 1; # PAD_FAKELEX_ANON
-                   $fake .= 'm' if $padname->IVX & 2; # PAD_FAKELEX_MULTI
-                   $fake .= ':' . $padname->NVX if $curcv->CvFLAGS & CVf_ANON;
+                   $fake .= 'a'
+                       if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
+                   $fake .= 'm'
+                       if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
+                   $fake .= ':' . $padname->PARENT_PAD_INDEX
+                       if $curcv->CvFLAGS & CVf_ANON;

                    $h{targarglife} = "$h{targarg}:FAKE:$fake";
                }
            }
            else {
                    $h{targarglife} = "$h{targarg}:FAKE:$fake";
                }
            }
            else {

-               my $intro = $padname->NVX - $cop_seq_base;
-               my $finish = int($padname->IVX) - $cop_seq_base;
+               my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
+               my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;

                $finish = "end" if $finish == 999999999 - $cop_seq_base;
                $h{targarglife} = "$h{targarg}:$intro,$finish";
            }
                $finish = "end" if $finish == 999999999 - $cop_seq_base;
                $h{targarglife} = "$h{targarg}:$intro,$finish";
            }


@@ -747,7 +843,7 @@ sub concise_op {
        } else {
            $h{arg} = "($precomp)";
        }
        } else {
            $h{arg} = "($precomp)";
        }

-    } elsif ($h{class} eq "PVOP" and $h{name} ne "trans") {
+    } elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') {

        $h{arg} = '("' . $op->pv . '")';
        $h{svval} = '"' . $op->pv . '"';
     } elsif ($h{class} eq "COP") {
        $h{arg} = '("' . $op->pv . '")';
        $h{svval} = '"' . $op->pv . '"';
     } elsif ($h{class} eq "COP") {


@@ -755,12 +851,20 @@ sub concise_op {
        $h{coplabel} = $label;
        $label = $label ? "$label: " : "";
        my $loc = $op->file;
        $h{coplabel} = $label;
        $label = $label ? "$label: " : "";
        my $loc = $op->file;

+       my $pathnm = $loc;

        $loc =~ s[.*/][];
        $loc =~ s[.*/][];

-       $loc .= ":" . $op->line;
+       my $ln = $op->line;
+       $loc .= ":$ln";

        my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);
        my($stash, $cseq) = ($op->stash->NAME, $op->cop_seq - $cop_seq_base);

-       my $arybase = $op->arybase;
-       $arybase = $arybase ? ' $[=' . $arybase : "";
-       $h{arg} = "($label$stash $cseq $loc$arybase)";
+       $h{arg} = "($label$stash $cseq $loc)";
+       if ($show_src) {
+           fill_srclines($pathnm) unless exists $srclines{$pathnm};
+           # Would love to retain Jim's use of // but this code needs to be
+           # portable to 5.8.x
+           my $line = $srclines{$pathnm}[$ln];
+           $line = "-src unavailable under -e" unless defined $line;
+           $h{src} = "$ln: $line";
+       }

     } elsif ($h{class} eq "LOOP") {
        $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
          . " redo->" . seq($op->redoop) . ")";
     } elsif ($h{class} eq "LOOP") {
        $h{arg} = "(next->" . seq($op->nextop) . " last->" . seq($op->lastop)
          . " redo->" . seq($op->redoop) . ")";


@@ -785,7 +889,6 @@ sub concise_op {
     $h{seq} = "" if $h{seq} eq "-";
     if ($] > 5.009) {
        $h{opt} = $op->opt;
     $h{seq} = "" if $h{seq} eq "-";
     if ($] > 5.009) {
        $h{opt} = $op->opt;

-       $h{static} = $op->static;

        $h{label} = $labels{$$op};
     } else {
        $h{seqnum} = $op->seq;
        $h{label} = $labels{$$op};
     } else {
        $h{seqnum} = $op->seq;


@@ -803,6 +906,12 @@ sub concise_op {
     $h{flags} = op_flags($op->flags);
     $h{privval} = $op->private;
     $h{private} = private_flags($h{name}, $op->private);
     $h{flags} = op_flags($op->flags);
     $h{privval} = $op->private;
     $h{private} = private_flags($h{name}, $op->private);

+    if ($op->can("hints")) {
+      $h{hintsval} = $op->hints;
+      $h{hints} = hints_flags($h{hintsval});
+    } else {
+      $h{hintsval} = $h{hints} = '';
+    }

     $h{addr} = sprintf("%#x", $$op);
     $h{typenum} = $op->type;
     $h{noise} = $linenoise[$op->type];
     $h{addr} = sprintf("%#x", $$op);
     $h{typenum} = $op->type;
     $h{noise} = $linenoise[$op->type];


@@ -1017,11 +1126,11 @@ on threaded and un-threaded perls.
 =head1 OPTIONS
 
 Arguments that don't start with a hyphen are taken to be the names of
 =head1 OPTIONS
 
 Arguments that don't start with a hyphen are taken to be the names of

-subroutines to print the OPs of; if no such functions are specified,
-the main body of the program (outside any subroutines, and not
-including use'd or require'd files) is rendered.  Passing C<BEGIN>,
+subroutines to render; if no such functions are specified, the main
+body of the program (outside any subroutines, and not including use'd
+or require'd files) is rendered.  Passing C<BEGIN>, C<UNITCHECK>,

 C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding
 C<CHECK>, C<INIT>, or C<END> will cause all of the corresponding

-special blocks to be printed.
+special blocks to be printed.  Arguments must follow options.

 
 Options affect how things are rendered (ie printed).  They're presented
 here by their visual effect, 1st being strongest.  They're grouped
 
 Options affect how things are rendered (ie printed).  They're presented
 here by their visual effect, 1st being strongest.  They're grouped


@@ -1150,14 +1259,49 @@ usual convention for Arabic numerals, and the default.
 
 =item B<-littleendian>
 
 
 =item B<-littleendian>
 

-Print seqence numbers with the least significant digit first.  This is
+Print sequence numbers with the least significant digit first.  This is

 obviously mutually exclusive with bigendian.
 
 =back
 
 =head2 Other options
 
 obviously mutually exclusive with bigendian.
 
 =back
 
 =head2 Other options
 

-These are pairwise exclusive.
+=over 4
+
+=item B<-src>
+
+With this option, the rendering of each statement (starting with the
+nextstate OP) will be preceded by the 1st line of source code that
+generates it.  For example:
+
+    1  <0> enter
+    # 1: my $i;
+    2  <;> nextstate(main 1 junk.pl:1) v:{
+    3  <0> padsv[$i:1,10] vM/LVINTRO
+    # 3: for $i (0..9) {
+    4  <;> nextstate(main 3 junk.pl:3) v:{
+    5  <0> pushmark s
+    6  <$> const[IV 0] s
+    7  <$> const[IV 9] s
+    8  <{> enteriter(next->j last->m redo->9)[$i:1,10] lKS
+    k  <0> iter s
+    l  <|> and(other->9) vK/1
+    # 4:     print "line ";
+    9      <;> nextstate(main 2 junk.pl:4) v
+    a      <0> pushmark s
+    b      <$> const[PV "line "] s
+    c      <@> print vK
+    # 5:     print "$i\n";
+    ...
+
+=item B<-stash="somepackage">
+
+With this, "somepackage" will be required, then the stash is
+inspected, and each function is rendered.
+
+=back
+
+The following options are pairwise exclusive.

 
 =over 4
 
 
 =over 4
 


@@ -1393,6 +1537,36 @@ The OP's flags, abbreviated as a series of symbols.
 
 The numeric value of the OP's flags.
 
 
 The numeric value of the OP's flags.
 

+=item B<#hints>
+
+The COP's hint flags, rendered with abbreviated names if possible. An empty
+string if this is not a COP. Here are the symbols used:
+
+    $ strict refs
+    & strict subs
+    * strict vars
+    i integers
+    l locale
+    b bytes
+    { block scope
+    % localise %^H
+    < open in
+    > open out
+    I overload int
+    F overload float
+    B overload binary
+    S overload string
+    R overload re
+    T taint
+    E eval
+    X filetest access
+    U utf-8
+
+=item B<#hintsval>
+
+The numeric value of the COP's hint flags, or an empty string if this is not
+a COP.
+

 =item B<#hyphseq>
 
 The sequence number of the OP, or a hyphen if it doesn't have one.
 =item B<#hyphseq>
 
 The sequence number of the OP, or a hyphen if it doesn't have one.


@@ -1454,13 +1628,6 @@ Whether or not the op has been optimised by the peephole optimiser.
 
 Only available in 5.9 and later.
 
 
 Only available in 5.9 and later.
 

-=item B<#static>
-
-Whether or not the op is statically defined.  This flag is used by the
-B::C compiler backend and indicates that the op should not be freed.
-
-Only available in 5.9 and later.
-

 =item B<#sibaddr>
 
 The address of the OP's next youngest sibling, in hexadecimal.
 =item B<#sibaddr>
 
 The address of the OP's next youngest sibling, in hexadecimal.


@@ -1530,7 +1697,14 @@ This is B<very> similar to previous, only the first two ops differ.  This
 subroutine rendering is more representative, insofar as a single main
 program will have many subs.
 
 subroutine rendering is more representative, insofar as a single main
 program will have many subs.
 

+=item perl -MB::Concise -e 'B::Concise::compile("-exec","-src", \%B::Concise::)->()'

 
 

+This renders all functions in the B::Concise package with the source
+lines.  It eschews the O framework so that the stashref can be passed
+directly to B::Concise::compile().  See -stash option for a more
+convenient way to render a package.
+
+=back

 
 =head1 Using B::Concise outside of the O framework
 
 
 =head1 Using B::Concise outside of the O framework
 


@@ -1573,14 +1747,14 @@ This restores one of the standard line-styles: C<terse>, C<concise>,
 C<linenoise>, C<debug>, C<env>, into effect.  It also accepts style
 names previously defined with add_style().
 
 C<linenoise>, C<debug>, C<env>, into effect.  It also accepts style
 names previously defined with add_style().
 

-=head2 add_style()
+=head2 add_style ()

 
 This subroutine accepts a new style name and three style arguments as
 above, and creates, registers, and selects the newly named style.  It is
 an error to re-add a style; call set_style_standard() to switch between
 several styles.
 
 
 This subroutine accepts a new style name and three style arguments as
 above, and creates, registers, and selects the newly named style.  It is
 an error to re-add a style; call set_style_standard() to switch between
 several styles.
 

-=head2 add_callback()
+=head2 add_callback ()

 
 If your newly minted styles refer to any new #variables, you'll need
 to define a callback subroutine that will populate (or modify) those
 
 If your newly minted styles refer to any new #variables, you'll need
 to define a callback subroutine that will populate (or modify) those