Acme-Perl-VM

 view release on metacpan or  search on metacpan

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

    # not yet implemented completely
    # cf.
    # die_where() in pp_ctl.c
    # vdie()      in util.c
    die  APVM_DEBUG ? longmess(@_) : mess(@_);
}
sub croak{
    die  APVM_DEBUG ? longmess(@_) : mess(@_);
}

sub PUSHMARK(){
    push @PL_markstack, $#PL_stack;
    return;
}
sub POPMARK(){
    return pop @PL_markstack;
}
sub TOPMARK(){
    return $PL_markstack[-1];
}

sub PUSH{
    push @PL_stack, @_;
    return;
}
sub mPUSH{
    PUSH(map{ sv_2mortal($_) } @_);
    return;
}
sub POP(){
    return pop @PL_stack;
}
sub TOP(){
    return $PL_stack[-1];
}
sub SET{
    my($sv) = @_;
    $PL_stack[-1] = $sv;
    return;
}
sub SETval{
    my($val) = @_;
    $PL_stack[-1] = PAD_SV( $PL_op->targ )->setval($val);

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

sub block_gimme{
    my $cxix = dopoptosub($#PL_cxstack);

    if($cxix < 0){
        return G_VOID;
    }

    return $PL_cxstack[$cxix]->gimme;
}

sub GIMME_V(){ # op.h
    my $gimme = OP_GIMME($PL_op, -1);
    return $gimme != -1 ? $gimme : block_gimme();
}

sub LVRET(){ # cf. is_lvalue_sub() in pp_ctl.h
    if($PL_op->flags & OPpMAYBE_LVSUB){
        my $cxix = dopoptosub($#PL_cxstack);

        if($PL_cxstack[$cxix]->lval && $PL_cxstack[$cxix]->cv->CvFLAGS & CVf_LVALUE){
            not_implemented 'lvalue';
            return TRUE;
        }
    }
    return FALSE;
}

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

        FREETMPS;
        LEAVE;
    }

    $PL_op     = $old_op;
    $PL_curcop = $old_cop;

    return $retval;
}

sub run_block(&@){
    my($code, @args) = @_;

    if(APVM_DUMMY){
        return $code->(@args);
    }
    local $SIG{__DIE__}  = \&Carp::confess if APVM_DEBUG;
    local $SIG{__WARN__} = \&Carp::cluck   if APVM_DEBUG;

    ENTER;
    SAVETMPS;

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

        Carp::confess($obj->special_name, ' is not a normal SV object');
    };
}

sub setval{
    my($obj) = @_;

    Acme::Perl::VM::apvm_die('Modification of read-only value (%s) attempted', $obj->special_name);
}

sub STASH(){ undef }

sub POK(){ 0 }
sub ROK(){ 0 }

sub special_name{
    my($obj) = @_;
    return $B::specialsv_name[$$obj] || sprintf 'SPECIAL(0x%x)', $$obj;
}

package
    B::SV;

# for sv_setsv()

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

    ${$sv->object_2svref} = undef;
    return;
}

sub toCV{
    my($sv) = @_;
    Carp::croak(sprintf 'Cannot convert %s to a CV', B::class($sv));
}

sub STASH(){ undef }

package
    B::PVMG;

sub ROK{
    my($obj) = @_;
    my $dummy = ${ $obj->object_2svref }; # invoke mg_get()
    return $obj->SUPER::ROK;
}

package
    B::CV;

sub toCV{ $_[0] }

sub clear{
    Carp::croak('Cannot clear a CV');
}

sub ROK(){ 0 }

package
    B::GV;


sub toCV{ $_[0]->CV }

sub clear{
    Carp::croak('Cannot clear a CV');
}

sub ROK(){ 0 }

package
    B::AV;

sub setsv{
    my($sv) = @_;
    Carp::croak('Cannot call setsv() for ' . B::class($sv));
}

sub clear{

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

    @{$sv->object_2svref} = ();
    return;
}

unless(__PACKAGE__->can('OFF')){
    # some versions of B::Debug requires this
    constant->import(OFF => 0);
}

sub ROK(){ 0 }

package
    B::HV;

sub ROK(){ 0 }

*setsv = \&B::AV::setsv;

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

    %{$sv->object_2svref} = ();
    return;
}

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

sub BUILD{
    my($cx) = @_;

    $cx->label($PL_curcop->label);
    $cx->myop($PL_op);
    $cx->nextop($PL_op->nextop);

    return;
}

sub ITERVAR(){ undef }

no Mouse;
__PACKAGE__->meta->make_immutable();

package Acme::Perl::VM::Context::FOREACH;
use Mouse;
use Acme::Perl::VM::B qw(USE_ITHREADS);
extends 'Acme::Perl::VM::Context::LOOP';

has padvar => (

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

);
has iterix => (
    is  => 'rw',
    isa => 'Int',
);
has itermax => (
    is  => 'rw',
    isa => 'Int',
);

sub type(){ 'LOOP' } # this is a LOOP

sub BUILD{
    my($cx) = @_;
    $cx->ITERDATA_SET($cx->iterdata);
    return;
}


sub ITERVAR{
    my($cx) = @_;

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

package Acme::Perl::VM::Scope::Scalar;
use Mouse;
extends 'Acme::Perl::VM::Scope::Localizer';

sub _save{
    my($self) = @_;
    return Acme::Perl::VM::gv_fullname($self->gv, '$');
}

sub save_type(){ 'SCALAR' }
sub create_ref{
    my($self) = @_;

    if($self->gv->SV->MAGICAL){
        bless $self, 'Acme::Perl::VM::Scope::Scalar::Magical';
        $self->old_value(${$self->old_ref});
        return \local(${*{ $self->gv->object_2svref }}); # to copy MAGIC
    }
    else{
        return \my $scalar;

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

package Acme::Perl::VM::Scope::Array;
use Mouse;
extends 'Acme::Perl::VM::Scope::Localizer';

sub _save{
    my($self) = @_;
    return Acme::Perl::VM::gv_fullname($self->gv, '@');
}

sub save_type(){ 'ARRAY' }
sub create_ref{
    my($self) = @_;
    return \local @{*{ $self->gv->object_2svref }};
}
sub sv{
    my($self) = @_;
    return $self->gv->AV;
}

no Mouse;

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

package Acme::Perl::VM::Scope::Hash;
use Mouse;
extends 'Acme::Perl::VM::Scope::Localizer';

sub _save{
    my($self) = @_;
    return Acme::Perl::VM::gv_fullname($self->gv, '%');
}

sub save_type(){ 'HASH' }
sub create_ref{
    my($self) = @_;
    return \local %{*{ $self->gv->object_2svref }};
}
sub sv{
    my($self) = @_;
    return $self->gv->HV;
}

no Mouse;