3

在一个正在运行的 Perl 程序中,如果我有一个 Op 地址(通过B::ConciseDevel::Callsite或通过神秘的其他方式),是否有一种简单的方法可以将其转换为正确的 B::OP,无需步行操作码树?

为了使这一点更清楚,这里有一些代码:

use Devel::Callsite;
use B::Concise qw(set_style);
use B;

sub testing
{
    sub foo { callsite() };
    my $op_addr =  foo;
    printf "Op address is 0x%x\n", $op_addr;


    # I can get OPs by walking and looking for $op_addr,
    # but I don't want to do that.
    my $walker = B::Concise::compile('-terse', '-src', \&testing);
    B::Concise::walk_output(\my $buf);
    $walker->();   # walks and renders into $buf;
    print $buf;
}

testing();

运行此程序时,您会看到如下内容:

$ perl /tmp/foo.pl
Op address is 0x2026940
B::Concise::compile(CODE(0x1f32b18))
UNOP (0x1f40fd0) leavesub [1] 
    LISTOP (0x20aa870) lineseq 
# 8:     my $op_addr =  foo;
         COP (0x1f7cd80) nextstate 
         BINOP (0x20aba80) sassign 
            UNOP (0x20ad200) entersub [2] 
                UNOP (0x1f39b80) null [148] 
                    OP (0x1fd14f0) pushmark 
                    UNOP (0x1f397c0) null [17] 
                        SVOP (0x1f39890) gv  GV (0x1fa0968) *foo 
            OP (0x2026940) padsv [1]
                ^^^^^^^^^^ 
....

a and0x2026940的地址也是如此,根据this有, ,方法。如果说地址,那将是另外一个方法的地址。B::OPnext()sibling()name()0x20aa870LISTOPchildren()

我添加了 B::Concise 只是为了显示发生了什么。实际上,我不想遍历 optree,因为我假设/希望地址实际上是该列表所在的位置。

所以也许有两个部分,首先是B::Op我认为是父类的地址,但之后我想知道我们在谈论哪种操作(UNOP,BINOP,LISTOP)。

如果我能完成铸件,第二部分可能很容易: allB::OP都有一个name()方法,所以我可以从中找出我拥有的 OP 子类。

编辑: ikegami 的解决方案现在是 Devel::Callsite 版本 1.0.1 的一部分,尽管它不太正确。

4

1 回答 1

4

这复制了 B 的 internal make_op_object

use B qw( );

use Inline C => <<'__EOS__';

    static const char * const opclassnames[] = {
        "B::NULL",
        "B::OP",
        "B::UNOP",
        "B::BINOP",
        "B::LOGOP",
        "B::LISTOP",
        "B::PMOP",
        "B::SVOP",
        "B::PADOP",
        "B::PVOP",
        "B::LOOP",
        "B::COP",
        "B::METHOP",
        "B::UNOP_AUX"
    };

    SV *make_op_object(IV o_addr) {
        const OP *o = INT2PTR(OP*, o_addr);
        SV *opsv = newSV(0);
        sv_setiv(newSVrv(opsv, opclassnames[op_class(o)]), o_addr);
        return opsv;
    }

__EOS__

示例使用:

use Devel::Callsite qw( callsite );

my $site = sub { return callsite() };
my $addr = $site->();
my $op = make_op_object($addr);
say $op->name;
于 2018-07-17T17:04:45.277 回答