my $sum = 0;
while ( my $_ = <> ) {
$sum += $_;
}
say $sum;
bin/sum
(OP*)PL_main_rootstrict.pm
importwarnings.pm
importfeature.pm
importperl -MO=Concise bin/sumperl -MO=Concise,exec bin/sum$ perl -MO=Concise bin/sum
m <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
2 <;> nextstate(main 44 sum:5) v:%,*,&,{,$ ->3
5 <2> sassign vKS/2 ->6
3 <$> const(IV 0) s ->4
4 <0> padsv[$sum:44,48] sRM*/LVINTRO ->5
6 <;> nextstate(main 47 sum:6) v:%,*,&,$ ->7
h <2> leaveloop vK/2 ->i
7 <{> enterloop(next->b last->h redo->8) v ->c
- <1> null vK/1 ->h
g <|> and(other->8) vK/1 ->h
f <1> defined sK/1 ->g
- <1> null sKS/2 ->f
c <0> padsv[$_:45,47] sRM*/LVINTRO ->d
e <1> readline[t3] sKS/1 ->f
d <$> gv(*ARGV) s ->e
- <@> lineseq vK ->-
perl -MO=Concise,-exec bin/sum
1 <0> enter
2 <;> nextstate(main 44 sum:5) v:%,*,&,{,$
3 <$> const(IV 0) s
4 <0> padsv[$sum:44,48] sRM*/LVINTRO
5 <2> sassign vKS/2
6 <;> nextstate(main 47 sum:6) v:%,*,&,$
7 <{> enterloop(next->b last->h redo->8) v
c <0> padsv[$_:45,47] sRM*/LVINTRO
d <$> gv(*ARGV) s
e <1> readline[t3] sKS/1
f <1> defined sK/1
g <|> and(other->8) vK/1
8 <0> padsv[$sum:44,48] sRM
9 <0> padsv[$_:45,47] s
a <2> add[t4] vKS/2
b <0> unstack v
goto c
perl -MO=Concise bin/sum | bin/idealized-optree
leave
enter
nextstate(main sum:5)
sassign
const 0
padsv $sum
nextstate(main sum:6)
perl -MO=Concise,exec bin/sum | bin/hand-waving
enter
nextstate(main sum:5)
const 0
padsv $sum
sassign
nextstate(main sum:6)
leave
|
![]() |
|
|
|
|
|
perl -MO=Debug bin/sum
BINOP (0x81facc8)
next 0x…
sibling 0x…
ppaddr PL_ppaddr[OP_SASSIGN]
type 36
opt 1
flags 69
private 2
first 0x…
0$sum
o = …->start
while ( o ) {
o = o->ppaddr();
}
From Gisle Aas' PerlGuts Illustrated
PADLIST[0][ op->TARG ]
NULL"$_""$sum"PADLIST[1..][ op->TARG ]
$_$sum
package eldritch;
use pragma -base;
$H^{eldritch} = 1
nextstate->cop_hints_hash = \ %^H
my $padsv = main_root()
->first
->sibling
->first
->sibling;walkoptree(
main_root,
'my_method'
);
sub B::OP::my_method {
…
walkallops_filtered(
…,
sub {
opgrep( {
name => 'sassign',
first => {
name => 'const',
iv => 0,
sibling => {
name => 'padsv'
},
},
} );
}
);
//sassign/const[@iv=0]/sibling::padsv
MAGIC_DIAMOND: {
next
if not(
$check{magic_diamond}
and parents->[0]->name eq 'readline'
and $op->gv_harder->NAME eq 'ARGV'
);
warning 'Use of <>';
}
Add your own warnings
B::Lint->register_plugin( __PACKAGE__ => [ 'good_taste' ];
sub match {
my ( $op, $checks_href ) = @_;
if ( $checks_href->{good_taste} ) {
…
}
}
|
PL_ppaddr[OP_EVAL]
|
|
|
Wraps PL_ppaddr[OP_EVAL] |
|
use overload::eval 'hook';
eval 'milk?';
sub hook { say "Got @_" }
eval rot13( 'fnl "Hryyb!"' )
perl -Moverload::eval=-p obfu.pl
Edits the past too
Good for proxies and lying liar objects
fix( $_ ) for B::Utils::all_roots
sub fix ($o) {
…
$o->ppaddr( NEW ) if $o->type == OP_REF;
fix $o->first
fix $o->sibling
}
|
|
|
my $pushmark = B::OP->new( pushmark => 2 );
my $die = B::LISTOP->new(
die => 5,
$pushmark,
$gvsv );
$die->targ( 1 );
$die->private( 1 );
my $or_root = B::LOGOP->new(
or => 2,
$op,
$die )
optree_diff( \&foo, \&bar )
- /leavesub/lineseq/nextstate*print
+ /leavesub/lineseq/nextstate*null
+ .op_flags = 4
+ .op_private = 1
+ .op_targ = 0
+ /leavesub/lineseq/nextstate*null/or
+ .op_flags = 4
+ .op_other = 0
+ .op_private = 1
+ .op_targ = 0
+ /leavesub/lineseq/nextstate*null/or/print