Точное местоположение Perl, например, с помощью B::Deparse

Давняя проблема в Perl заключается в том, как определить местоположение с более высокой степенью детализации, чем номер строки. (Перейдите по ссылке для получения дополнительной информации.) Этот вопрос о том, как получить это.

Самый многообещающий способ сделать это - использовать адрес кода операции Perl, который находится на рассмотрении, и отменить операторы вокруг этого. А на уровне подпрограммы B:: Deparse будет воссоздавать Perl с учетом ссылки на код. Поэтому идеальным вариантом было бы изменить B:: Deparse, чтобы дать вам возможность предоставить поставляемую опцию для начала разбора. В противном случае он может вместо этого отменить подпрограмму, в которой отображаются адреса кода операции для каждого встреченного оператора. Посмотрите код ниже для примера этого.

B::Concise может показать разбор кода операции для подпрограммы. В своем выводе дизассемблирования он дает адреса, и те адреса, которые он дает, совпадают с адресами, возвращенными, скажем, Devel:: Callsite.

Проблема состоит в том, что после инструментирования B:: Deparse, как это сделано ниже, адреса OP, которые он дает, не совпадают с адресами B::Concise или Devel:: Callsite. Вывод, приведенный ниже, показывает это.

Я могу нормализовать адреса так, чтобы они ссылались на относительные смещения, а не на абсолютные адреса. Однако это большая работа, грубая, и я даже не совсем уверен, что это сработает, поскольку Deparse может изменить код путем "пессимизации" или, я думаю, отмены оптимизации.

Для конкретности ниже приведен код, который показывает несоответствие. Обратите внимание, что ни один из адресов, заданных deparse, не показан в разборке.

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%x\n%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 и позволит вам точно знать, где вы находитесь, когда остановились внутри отладчика.

Примечание: отредактировано для уточнения вопроса.

2 ответа

Решение

Предложение ответа ikegami, скрытое в комментариях, привело меня к обнаружению концептуальной ошибки, которую я допустил в своем первом предложенном решении: внутри B::Deparse переменная лексического массива хранит OP, и они являются неявными указателями на действительные структуры OP кода. Использование недокументированного $$ чтобы получить базовый адрес, на который неявно указывает скаляр, дает правильный адрес. Так что в моем обезьяно-пропатченном коде B::Deparse:: lineseq изменилось:

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

чтобы:

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

дает мне адрес, который я могу использовать, чтобы сопоставить результаты.

Тем не менее, предстоит еще немного поработать над этим, так что если есть какие-то другие способы или предложения, я бы хотел их услышать.

Devel:: Trepan выпуск 0.70 теперь используется в его deparse Команду вышеуказанного кода соответствующим образом модифицировали, чтобы можно было показать, какой из нескольких операторов должен быть запущен.

svref_2object возвращает объект, который позволяет извлекать информацию из структуры, на которую ссылается аргумент, переданный svref_2object,

Вы печатаете адрес этого объекта (скаляр благословил в классе B::CV).

use B qw( );

sub foo { }

my $cv = B::svref_2object(\&foo);

printf "%x\n", \&foo;                 # Numification of 1st ref to &foo.
printf "%x\n", \&foo;                 # Numification of 2nd ref to &foo.
printf "%x\n", $cv;                   # Numification of ref to B::CV object.
printf "%x\n", $cv->object_2svref();  # Numification of 3rd ref to &foo.
printf "%x\n", $$cv;  # Address of struct referenced by svref_2object's arg (Undocumented)

Ссылки нумеруются по адресу, на который они ссылаются, поэтому мы получаем:

3c5eaf8
3c5eaf8
3c5e1b0
3c5eaf8
3c5eaf8
Другие вопросы по тегам