Pure PerlによるPerl5 Virtual Machineの実装

Perl VMの気持ちを知るには、PurePerlで実装してみるとよい。

コード例（PerlVM.pmのコードは記事の末尾にある）：

#!perl -w
use strict;
use PerlVM;
my $x = shift || 42;

PerlVM::call_sv(sub{
	print "Hello,", " world!", "\n";
	if($x){
		print $x, " is true\n";
	}
	else{
		print $x, " is false\n";
	}
});
__END__

実行結果：

$ perl hello.pl
Hello, world!
42 is true

むろん、PerlVM::call_sv()の中で引数を呼び出したりはしていない。

Hello, world!くらいならPerlVMの中身も比較的単純だ。そのメカニズムはBモジュールに依存している。Bを使えばコードリファレンスの実体であるCV構造体にアクセスできるのだが、BはさらにOPコード構造体へのインターフェイスを提供しているため、このようなことが可能となっている。
OPコードの処理自体は、Perlがコードを実行するのと同じやり方となっている。pp.h/pp.c/pp_hot.cあたりの対応するコードと比較すると、かなり単純化しているものの、メカニズム自体はほとんど同じであることがわかるだろう。何しろ、OPコード実行ループはたったのこれだけである：

    while(is_not_null( $op = &{$code{ $op->ppaddr } || _not_implemented($op)} )){
        print $op->ppaddr, "\n" if VERBOSE;
    }

そしてperlソースコードの対応する関数は以下の通り(run.c)：

int
Perl_runops_standard(pTHX)
{
    dVAR;
    while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
        PERL_ASYNC_CHECK();
    }
    TAINT_NOT;
    return 0;
}

実行ループの形は同じである。あとは，pp_xxx()が実際の処理を行う。

もっとも、このPerlVM.pmで用意しているスタックは引数と戻り値のための@stackしか用意していないのだが、必要な内部スタックはそれだけではない。たとえば、スコープを扱おうとすると実装はずっと複雑になるし、ループやサブルーチン呼び出し、例外などの実装も難しい。

それでもやはり、コア部分は非常に単純である。これでVMの実行のイメージは掴めるのではないだろうか。

PerlVM.pm:

package PerlVM;

use 5.008_001;
use strict;
use warnings;

use B qw(svref_2object);
use Class::Inspector;
use Carp;

use constant VERBOSE  => $ENV{PERLVM_VERBOSE} ? 1 : 0;
use constant sv_undef => svref_2object(\do{ my $empty });


our @stack;
our $stack_ix = 0;
our $mark_ix  = 0;

our $op;
our $curcop;

our $padlist;
our $curpad;

sub PL_op() :lvalue{
    return $op;
}
sub PL_curcop() :lvalue{
    return $curcop;
}

sub PAD_SV($){
    my($targ) = @_;
    return $curpad->ARRAYelt($targ);
}

sub MARK(){
    return $stack[$mark_ix];
}
sub PUSHMARK(){
    $mark_ix = $stack_ix;
    return;
}

sub PUSH($){
    my($sv) = @_;

    $stack[$stack_ix++] = $sv;
    return;
}
sub POP(){
    $stack_ix--;
    return pop @stack;
}

sub mark_ix() :lvalue { $mark_ix  }
sub stack_ix():lvalue { $stack_ix }

sub is_not_null($){
    my($sv) = @_;

    return $$sv;
}
sub _not_implemented($){
    my($op) = @_;

    croak $op->ppaddr, ' is not yet implemented';
}

our %code;
initialize_name2code(\%code);

sub call_sv{
    my $cv       = svref_2object(shift);
    $op      = $cv->START;

    # pp_entersub
    $padlist = $cv->PADLIST;
    $curpad  = $padlist->ARRAYelt(1);

    printf "call_sv(\&%s)\n", $cv->GV->NAME if VERBOSE;

    PUSHMARK;

    # runops
    while(is_not_null( $op = &{$code{ $op->ppaddr } || _not_implemented($op)} )){
        print $op->ppaddr, "\n" if VERBOSE;
    }
}

sub initialize_name2code{
    my($ref) = @_;

    my $methods = Class::Inspector->methods(__PACKAGE__, 'public');

    foreach my $method(@{$methods}){
        if($method =~ /^pp_/){
            my $opname = $method;
            $opname =~ s/pp_/OP_/;

            no strict 'refs';
            $ref->{sprintf 'PL_ppaddr[%s]', uc $opname} = \&{__PACKAGE__ . '::' . $method};
        }
    }
    return;
}


sub pp_nextstate{
    PL_curcop = PL_op;

    return PL_op->next;
}

sub pp_pushmark{
    PUSHMARK;

    return PL_op->next;
}

sub pp_const{
    my $sv = is_not_null(PL_op->sv) ? PL_op->sv : PAD_SV(PL_op->targ);
    PUSH($sv);

    return PL_op->next;
}

sub pp_print{
    while(mark_ix < stack_ix){
        print ${ MARK->object_2svref };

        mark_ix++;
    }

    return PL_op->next;
}

sub pp_leavesub{
    return PL_op->next;
}

sub pp_cond_expr{
    my $sv = POP->object_2svref;

    if(${$sv}){
        return PL_op->other;
    }
    else{
        return PL_op->next;
    }
}

sub pp_padsv{
    PUSH( PAD_SV(PL_op->targ) );
    return PL_op->next;
}

sub pp_enter{
    # stub
    return PL_op->next;
}
sub pp_leave{
    # stub
    return PL_op->next;
}
1;
__END__

一通り実装したらAcme::Perl::VMなどとして公開するかもしれない。

(追記)
Acme::Perl::VMとして公開した。