view release on metacpan or  search on metacpan

lib/Acme/Perl/VM.pm  view on Meta::CPAN

    );
    return;
}
sub SAVECLEARSV{
    my($sv) = @_;
    push @PL_savestack, Acme::Perl::VM::Scope::Clearsv->new(
        sv  => $sv,
    );
    return;
}
sub SAVEPADSV{
    my($off) = @_;
    push @PL_savestack, Acme::Perl::VM::Scope::Padsv->new(
        off     => $off,
        value   => ${$PL_curpad[$off]->object_2svref},
        comppad => $PL_comppad,
    );
    return;
}
sub save_scalar{
    my($gv) = @_;
    push @PL_savestack, Acme::Perl::VM::Scope::Scalar->new(gv => $gv);
    return $PL_savestack[-1]->sv;
}
sub save_ary{
    my($gv) = @_;
    push @PL_savestack, Acme::Perl::VM::Scope::Array->new(gv => $gv);
    return $PL_savestack[-1]->sv;
}
sub save_hash{
    my($gv) = @_;
    push @PL_savestack, Acme::Perl::VM::Scope::Hash->new(gv => $gv);
    return $PL_savestack[-1]->sv;
}

sub PAD_SET_CUR_NOSAVE{
    my($padlist, $nth) = @_;

    $PL_comppad_name = $padlist->ARRAYelt(0);
    $PL_comppad      = $padlist->ARRAYelt($nth);
    @PL_curpad       = ($PL_comppad->ARRAY);

    return;
}
sub PAD_SET_CUR{
    my($padlist, $nth) = @_;

    SAVECOMPPAD();
    PAD_SET_CUR_NOSAVE($padlist, $nth);

    return;
}

sub PAD_SV{
    #my($targ) = @_;

    return $PL_curpad[ $_[0] ];
}

sub dopoptosub{
    my($startingblock) = @_;

    for(my $i = $startingblock; $i >= 0; $i--){
        my $type = $PL_cxstack[$i]->type;

        if($type eq 'EVAL' or $type eq 'SUB'){
            return $i;
        }
    }
    return -1;
}

my %loop;
@loop{qw(SUBST SUB EVAL NULL)} = ();
$loop{LOOP}    = TRUE;

sub dopoptoloop{
    my($startingblock) = @_;

    for(my $i = $startingblock; $i >= 0; --$i){
        my $cx   = $PL_cxstack[$i];
        my $type = $cx->type;

        if(exists $loop{$type}){
            if(!$loop{$type}){
                apvm_warn 'Exsiting %s via %s', $type, $PL_op->name;
                $i = -1 if $type eq 'NULL';
            }
            return $i;
        }
    }
    return -1;
}
sub dopoptolabel{
    my($label) = @_;

    for(my $i = $#PL_cxstack; $i >= 0; --$i){
        my $cx   = $PL_cxstack[$i];
        my $type = $cx->type;

        if(exists $loop{$type}){
            if(!$loop{$type}){
                apvm_warn 'Exsiting %s via %s', $type, $PL_op->name;
                return $type eq 'NULL' ? -1 : $i;
            }
            elsif($cx->label && $cx->label eq $label){
                return $i;
            }
        }
    }
    return -1;
}

sub OP_GIMME{ # op.h
    my($op, $default) = @_;
    my $op_gimme = $op->flags & OPf_WANT;
    return $op_gimme == OPf_WANT_VOID   ? G_VOID
        :  $op_gimme == OPf_WANT_SCALAR ? G_SCALAR
        :  $op_gimme == OPf_WANT_LIST   ? G_ARRAY
        :                                 $default;
}

sub OP_GIMME_REVERSE{ # op.h
    my($flags) = @_;
    $flags &= G_WANT;
    return $flags == G_VOID   ? OPf_WANT_VOID
        :  $flags == G_SCALAR ? OPf_WANT_SCALAR
        :                       OPf_WANT_LIST;
}

sub gimme2want{
    my($gimme) = @_;
    $gimme &= G_WANT;
    return $gimme == G_VOID   ? undef
        :  $gimme == G_SCALAR ? 0
        :                       1;
}
sub want2gimme{
    my($wantarray) = @_;

lib/Acme/Perl/VM.pm  view on Meta::CPAN

1;
__END__

=head1 NAME

Acme::Perl::VM - A Perl5 Virtual Machine in Pure Perl (APVM)

=head1 VERSION

This document describes Acme::Perl::VM version 0.006.

=head1 SYNOPSIS

    use Acme::Perl::VM;

    run_block{
        print "Hello, APVM world!\n",
    };

=head1 DESCRIPTION

C<Acme::Perl::VM> is an implementation of Perl5 virtual machine in pure Perl.

Perl provides a feature to access compiled syntax trees (B<opcodes>) by
C<B> module. C<B::*> modules walk into opcodes and do various things;
C<B::Deparse> retrieves Perl source code from subroutine references,
C<B::Concise> reports formatted syntax trees, and so on.

This module also walks into the opcodes, and executes them with its
own B<ppcodes>.

You can run any Perl code:

    use Acme::Perl::VM;

    run_block {
        print "Hello, APVM world!\n";
    };

This code says B<Hello, APVM world> to C<stdout> as you expect.

Here is a more interesting example:

    BEGIN{ $ENV{APVM} = 'trace' }
    use Acme::Perl::VM;

    run_block {
        print "Hello, APVM world!\n";
    };

And you'll get a list of opcodes as the code runs:

    .entersub(&__ANON__) VOID
    .nextstate(main -:4) VOID
    .pushmark SCALAR
    .const("Hello, APVM world!\n") SCALAR
    .print SCALAR KIDS
    Hello, APVM world!
    .leavesub KIDS

The first C<entersub> is the start of the block. The next C<nextstate>
indicates the statement that says hello. C<pushmark>, C<const>, and
C<print> are opcodes which runs on the statement. The last C<leavesub> is
the end of the block. This is a future of the module.

In short, the module has no purpose :)

=head1 DEPENDENCIES

Perl 5.8.1 or later.

=head1 BUGS

No bugs have been reported.

Please report any bugs or feature requests to the author.

=head1 AUTHOR

Goro Fuji (gfx) E<lt>gfuji(at)cpan.orgE<gt>.

=head1 SEE ALSO

L<perlapi>.

L<perlhack>.

F<pp.h> for PUSH/POP macros.

F<pp.c>, F<pp_ctl.c>, and F<pp_hot.c> for ppcodes.

F<op.h> for opcodes.

F<cop.h> for COP and context blocks.

F<scope.h> and F<scope.c> for scope stacks.

F<pad.h> and F<pad.c> for pad variables.

F<run.c> for runops.

L<B>.

L<B::Concise>.

L<Devel::Optrace>.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2009, Goro Fuji (gfx). Some rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut