准确的Perl位置,例如使用B::Deparse



Perl中一个长期存在的问题是如何用比行号更精细的粒度来识别位置。(点击链接了解更多信息。)这个问题是关于如何获得它的。

最有前途的方法是使用正在考虑的Perl操作码地址,并围绕该地址展开语句。在子例程级别,B::Deparse将在给定代码引用的情况下重新创建Perl。因此,理想的做法是修改B::Deparse,允许您提供一个开始离职的操作。如果做不到这一点,它可能会离开封闭的子例程,显示遇到的每个语句的操作代码地址。有关此示例,请参阅下面的代码。

B: :Concise可以显示子例程的操作代码反汇编。在它的反汇编输出中,它给出地址,并且它给出的地址与Devel::Callsite返回的地址相匹配。

问题是,按照以下步骤检测B::Deparse后,它给出的OP地址与B::ConciseDevel::Callsite给出的地址不匹配。下面给出的输出显示了这一点。

我可以规范化地址,以便它们引用相对偏移而不是绝对地址。然而,这是一项艰巨的工作,很粗糙,我甚至不完全确定这是否可行,因为Deparse可能会通过"令人讨厌"或取消优化来更改代码。

具体来说,下面是一些显示不匹配的代码。请注意,depase给出的地址都没有显示在反汇编中。

use B::Deparse;
use B::Concise qw(set_style);
sub foo() {
    my $x=1; $x+=1;
}
my $deparse = B::Deparse->new("-p", "-l", "-sC");
$body = $deparse->coderef2text(&foo);
print($body, "n");
my $walker = B::Concise::compile('-basic', 'foo', &foo);
B::Concise::set_style_standard('debug');
B::Concise::walk_output(my $buf);
$walker->();            # walks and renders into $buf;
print($buf);
package B::Deparse;
# Modified to show OP addresses
sub lineseq {
    my($self, $root, $cx, @ops) = @_;
    my($expr, @exprs);
    my $out_cop = $self->{'curcop'};
    my $out_seq = defined($out_cop) ? $out_cop->cop_seq : undef;
    my $limit_seq;
    if (defined $root) {
    $limit_seq = $out_seq;
    my $nseq;
    $nseq = $self->find_scope_st($root->sibling) if ${$root->sibling};
    $limit_seq = $nseq if !defined($limit_seq)
               or defined($nseq) && $nseq < $limit_seq;
    }
    $limit_seq = $self->{'limit_seq'}
    if defined($self->{'limit_seq'})
    && (!defined($limit_seq) || $self->{'limit_seq'} < $limit_seq);
    local $self->{'limit_seq'} = $limit_seq;
    my $fn = sub {
        my ($text, $i) = @_;
        my $op = $ops[$i];
        push @exprs, sprintf("# op: 0x%xn%s ", $op, $text);
    };
    $self->walk_lineseq($root, @ops, $fn);
    # $self->walk_lineseq($root, @ops,
    #              sub { push @exprs, $_[0]} );
    my $sep = $cx ? '; ' : ";n";
    my $body = join($sep, grep {length} @exprs);
    my $subs = "";
    if (defined $root && defined $limit_seq && !$self->{'in_format'}) {
    $subs = join "n", $self->seq_subs($limit_seq);
    }
    return join($sep, grep {length} $body, $subs);
}

我从运行中得到的输出是:

() {
    # op: 0x14a4b30
#line 4 "deparse-so.pl"
    (my $x = 1) ;
    # op: 0x14a4aa0
#line 4 "deparse-so.pl"
    ($x += 1) ;
}
main::foo:
UNOP (0xeb9978)
    op_next     0
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_LEAVESUB]
    op_type     175
    op_flags    4
    op_private  65  
    op_first    0xeab7a0
LISTOP (0xeab7a0)
    op_next     0xeb9978
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_LINESEQ]
    op_type     181
    op_flags    12
    op_private  0   
    op_first    0xeab7e8
    op_last     0xeb9a20
COP (0xeab7e8)
    op_next     0xeab890
    op_sibling  0xeab848
    op_ppaddr   PL_ppaddr[OP_NEXTSTATE]
    op_type     182
    op_flags    1
    op_private  0   0
BINOP (0xeab848)
    op_next     0xeb99c0
    op_sibling  0xeb99c0
    op_ppaddr   PL_ppaddr[OP_SASSIGN]
    op_type     37
    op_flags    69
    op_private  2   
    op_first    0xeab890
    op_last     0xeab8d0
SVOP (0xeab890)
    op_next     0xeab8d0
    op_sibling  0xeab8d0
    op_ppaddr   PL_ppaddr[OP_CONST]
    op_type     5
    op_flags    2
    op_private  0   
    op_sv       0xea3c40
OP (0xeab8d0)
    op_next     0xeab848
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_PADSV]
    op_type     9
    op_flags    178
    op_private  128 
COP (0xeb99c0)
    op_next     0xeab768
    op_sibling  0xeb9a20
    op_ppaddr   PL_ppaddr[OP_NEXTSTATE]
    op_type     182
    op_flags    1
    op_private  0   0
BINOP (0xeb9a20)
    op_next     0xeb9978
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_ADD]
    op_type     63
    op_flags    70
    op_private  2   
    op_first    0xeab768
    op_last     0xeb9a68
OP (0xeab768)
    op_next     0xeb9a68
    op_sibling  0xeb9a68
    op_ppaddr   PL_ppaddr[OP_PADSV]
    op_type     9
    op_flags    50
    op_private  0   
SVOP (0xeb9a68)
    op_next     0xeb9a20
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_CONST]
    op_type     5
    op_flags    2
    op_private  0   
    op_sv       0xea3c10
B::Concise::compile(CODE(0xea3c70))
UNOP (0xeb9978)
    op_next     0
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_LEAVESUB]
    op_type     175
    op_flags    4
    op_private  65  
    op_first    0xeab7a0
LISTOP (0xeab7a0)
    op_next     0xeb9978
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_LINESEQ]
    op_type     181
    op_flags    12
    op_private  0   
    op_first    0xeab7e8
    op_last     0xeb9a20
COP (0xeab7e8)
    op_next     0xeab890
    op_sibling  0xeab848
    op_ppaddr   PL_ppaddr[OP_NEXTSTATE]
    op_type     182
    op_flags    1
    op_private  0   0
BINOP (0xeab848)
    op_next     0xeb99c0
    op_sibling  0xeb99c0
    op_ppaddr   PL_ppaddr[OP_SASSIGN]
    op_type     37
    op_flags    69
    op_private  2   
    op_first    0xeab890
    op_last     0xeab8d0
SVOP (0xeab890)
    op_next     0xeab8d0
    op_sibling  0xeab8d0
    op_ppaddr   PL_ppaddr[OP_CONST]
    op_type     5
    op_flags    2
    op_private  0   
    op_sv       0xea3c40
OP (0xeab8d0)
    op_next     0xeab848
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_PADSV]
    op_type     9
    op_flags    178
    op_private  128 
COP (0xeb99c0)
    op_next     0xeab768
    op_sibling  0xeb9a20
    op_ppaddr   PL_ppaddr[OP_NEXTSTATE]
    op_type     182
    op_flags    1
    op_private  0   0
BINOP (0xeb9a20)
    op_next     0xeb9978
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_ADD]
    op_type     63
    op_flags    70
    op_private  2   
    op_first    0xeab768
    op_last     0xeb9a68
OP (0xeab768)
    op_next     0xeb9a68
    op_sibling  0xeb9a68
    op_ppaddr   PL_ppaddr[OP_PADSV]
    op_type     9
    op_flags    50
    op_private  0   
SVOP (0xeb9a68)
    op_next     0xeb9a20
    op_sibling  0
    op_ppaddr   PL_ppaddr[OP_CONST]
    op_type     5
    op_flags    2
    op_private  0   
    op_sv       0xea3c10

最后,作为鼓励人们在这里提供帮助的一种方式,如果解决了这个问题,Perl调试器Devel::Trepan可能会出现该解决方案,并允许您可靠地知道在调试器内停止时的确切位置。

注意:经过编辑以使问题更加清晰

svref_2object返回一个对象,该对象允许您从传递给svref_2object的参数引用的结构中提取信息。

您正在打印该对象的地址(一个标量被祝福到类B::CV中)。

use B qw( );
sub foo { }
my $cv = B::svref_2object(&foo);
printf "%xn", &foo;                 # Numification of 1st ref to &foo.
printf "%xn", &foo;                 # Numification of 2nd ref to &foo.
printf "%xn", $cv;                   # Numification of ref to B::CV object.
printf "%xn", $cv->object_2svref();  # Numification of 3rd ref to &foo.
printf "%xn", $$cv;  # Address of struct referenced by svref_2object's arg (Undocumented)

引用将其引用的地址数字化,因此我们得到:

3c5eaf8
3c5eaf8
3c5e1b0
3c5eaf8
3c5eaf8

ikegami隐藏在评论中的回答建议让我发现了我在第一个提出的解决方案中提出的概念缺陷:在B::Deparse内部,一个词法数组变量存储OP,这些OP是指向实际代码OP结构的隐式指针。使用未记录的$$来获取标量隐式指向的底层地址,可以得到正确的地址。所以在我的猴子补丁代码B::Deparse::lineeq,更改:

push @exprs, sprintf("# op: 0x%xn%s ", $op, $text);

至:

push @exprs, sprintf("# op: 0x%xn%s ", $$op, $text);
                                        ^^

给我一个地址,我可以用它来匹配结果。

尽管如此,仍有一些工作要做,所以如果有其他方法或建议,我很乐意听到。

Devel::Trepan 0.70版本现在在其deparse命令中使用了适当修改的上述代码,以便能够显示多个语句中的哪一个将要运行。

最新更新