flag results from the CPAN

flag

Acme-Perl-VM

view release on metacpan or search on metacpan

        $i++;
    }
}

sub runops_standard{ # run.c
    1 while(${ $PL_op = &{$PL_ppaddr[ $PL_op->type ]} });
    return;
}

sub _op_trace{
    my $flags = $PL_op->flags;
    my $name  = $PL_op->name;

    deb '.%s', $name;
    if(ref($PL_op) eq 'B::COP'){
        deb '(%s%s %s:%d)', 
            ($PL_op->label ? $PL_op->label.': ' : ''),
            $PL_op->stashpv,
            $PL_op->file, $PL_op->line,
        ;
    }
    elsif($name eq 'entersub'){
        my $gv = TOP;
        if(!$gv->isa('B::GV')){
            $gv = $gv->GV;
        }
        deb '(%s)', gv_fullname($gv, '&');
    }
    elsif($name eq 'aelemfast'){
        my $name;
        if($flags & OPf_SPECIAL){
            my $padname = $PL_comppad_name->ARRAYelt($PL_op->targ);
            $name = $padname->POK ? '@'.$padname->PVX : '[...]';
        }
        else{
            $name = gv_fullname(GVOP_gv($PL_op), '@');
        }
        deb '[%s[%s]]', $name, $PL_op->private;
    }
    elsif($PL_op->targ && $name !~ /leave/){
        if($name eq 'const' || $name eq 'method_named'){

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

        if($sv->class eq 'GV'){
            my $prefix = $name eq 'gvsv' ? '$' : '*';
            deb '(%s)', gv_fullname($sv, $prefix);
            deb ' INTRO' if $PL_op->private & OPpLVAL_INTRO;
        }
        else{
            deb '(%s)', B::perlstring(SvPV(SVOP_sv($PL_op)));
        }
    }

    deb ' VOID'    if( ($flags & OPf_WANT) == OPf_WANT_VOID   );
    deb ' SCALAR'  if( ($flags & OPf_WANT) == OPf_WANT_SCALAR );
    deb ' LIST'    if( ($flags & OPf_WANT) == OPf_WANT_LIST   );

    deb ' KIDS'    if $flags & OPf_KIDS;
    deb ' PARENS'  if $flags & OPf_PARENS;
    deb ' REF'     if $flags & OPf_REF;
    deb ' MOD'     if $flags & OPf_MOD;
    deb ' STACKED' if $flags & OPf_STACKED;
    deb ' SPECIAL' if $flags & OPf_SPECIAL;

    deb "\n";
}

sub runops_debug{
    _op_trace();
    while(${ $PL_op = &{$PL_ppaddr[$PL_op->type]} }){
        if(APVM_STACK){
            dump_stack();
        }

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

sub SETval{
    my($val) = @_;
    $PL_stack[-1] = PAD_SV( $PL_op->targ )->setval($val);
    return;
}

sub GET_TARGET{
    return PAD_SV($PL_op->targ);
}
sub GET_TARGETSTACKED{
    return $PL_op->flags & OPf_STACKED ? POP : PAD_SV($PL_op->targ);
}
sub GET_ATARGET{
    return $PL_op->flags & OPf_STACKED ? $PL_stack[$#PL_stack-1] : PAD_SV($PL_op->targ);
}

sub MAXARG{
    return $PL_op->private & 0x0F;
}

sub PUSHBLOCK{
    my($type, %args) = @_;

    $args{oldcop}     = $PL_curcop;

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

            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;
}

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


    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

            @_ = (caller 0)[3];
        }
    }

    push @_, ' is not implemented';
    goto &Carp::confess;
}


sub call_sv{ # perl.h
    my($sv, $flags) = @_;

    if($flags & G_DISCARD){
        ENTER;
        SAVETMPS;
    }

    my $cv = $sv->toCV();

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

    $PL_op = Acme::Perl::VM::OP_CallSV->new(
        cv    => $cv,
        next  => NULL,
        flags => OP_GIMME_REVERSE($flags),
    );
    $PL_curcop = $PL_op;

    PUSH($cv);
    my $oldmark  = TOPMARK;

    $PL_runops->();

    my $retval = $#PL_stack - $oldmark;

    if($flags & G_DISCARD){
        $#PL_stack = $oldmark;
        $retval = 0;
        FREETMPS;
        LEAVE;
    }

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

    return $retval;

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

    required => 1,
);

has next => (
    is  => 'ro',
    isa => 'B::OBJECT',

    required => 1,
);

has flags => (
    is  => 'ro',
    isa => 'Int',

    required => 1,
);

use constant {
    class => 'OP',
    type  => B::opnumber('entersub'),
    name  => 'entersub',

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

        apvm_die 'panic: do_kv';
    }

    my $gimme = GIMME_V;

    if($gimme == G_VOID){
        return $PL_op->next;
    }
    elsif($gimme == G_SCALAR){

        if($PL_op->flags & OPf_MOD || LVRET){
            not_implemented $PL_op->name . ' for lvalue';
        }

        my $num = keys %{ $hv->object_2svref };
        mPUSH( svref_2object(\$num) );
        return $PL_op->next;
    }


    my($dokeys, $dovalues);

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

            apvm_die 'Not a SCALAR reference';
        }
    }
    else{
        if($sv->class ne 'GV'){
            not_implemented 'rv2xv for soft references';
        }
        $gv = $sv;
    }

    if($PL_op->flags & OPf_MOD){
        if($PL_op->private & OPpLVAL_INTRO){
            if($PL_op->first->name eq 'null'){
                $sv = save_scalar(TOP);
            }
            else{
                $sv = save_scalar($gv);
            }
        }
        elsif($PL_op->private & OPpDEREF){
            vivify_ref($sv, $PL_op->private & OPpDEREF);

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

        $save  = \&save_hash;
    }
    my $gimme = GIMME_V;

    if($sv->ROK){
        $sv = $sv->RV;

        if($sv->class ne $class){
            apvm_die "Not $name reference";
        }
        if($PL_op->flags & OPf_REF){
            SET($sv);
            return $PL_op->next;
        }
        elsif(LVRET){
            not_implemented 'rv2av for lvalue';
        }
        elsif($PL_op->flags & OPf_MOD
                && $PL_op->private & OPpLVAL_INTRO){
            apvm_die q{Can't localize through a reference};
        }
    }
    else{
        if($sv->class eq $class){
            if($PL_op->flags & OPf_REF){
                SET($sv);
                return $PL_op->next;
            }
            elsif(LVRET){
                not_implemented 'rv2av for lvalue';
            }
        }
        else{
            if($sv->class ne 'GV'){
                not_implemented 'rv2av for symbolic reference';
            }

            if($PL_op->private & OPpLVAL_INTRO){
                $sv = $save->($sv);
            }
            else{
                $sv = $sv->$class();
            }

            if($PL_op->flags & OPf_REF){
                SET($sv);
                return $PL_op->next;
            }
            elsif(LVRET){
                not_implemented 'rv2av for lvalue';
            }
        }
    }

    if($class eq 'AV'){ # rv2av

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

    return $PL_op->next;
}
sub pp_rv2hv{
    goto &pp_rv2av;
}

sub pp_padsv{
    my $targ = GET_TARGET;
    PUSH($targ);

    if($PL_op->flags & OPf_MOD){
        if(($PL_op->private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO){
            SAVECLEARSV($targ);
        }
    }
    return $PL_op->next;
}

sub pp_padav{
    my $targ = GET_TARGET;

    if(($PL_op->private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO){
            SAVECLEARSV($targ);
    }
    if($PL_op->flags & OPf_REF){
        PUSH($targ);
        return $PL_op->next;;
    }
    elsif(LVRET){
        not_implemented 'padav for lvalue';
    }

    my $gimme = GIMME_V;
    if($gimme == G_ARRAY){
        PUSH( $targ->ARRAY );

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


sub pp_padhv{
    my $targ = GET_TARGET;

    if(($PL_op->private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO){
        SAVECLEARSV($targ);
    }

    PUSH($targ);

    if($PL_op->flags & OPf_REF){
        return $PL_op->next;
    }
    elsif(LVRET){
        not_implemented 'padhv for lvalue';
    }

    my $gimme = GIMME_V;
    if($gimme == G_ARRAY){
        return &_do_kv;
    }

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

        SET( hv_scalar($targ) );
    }

    return $PL_op->next;;
}

sub pp_anonlist{
    my $mark = POPMARK;
    my @ary  = mark_list($mark);

    if($PL_op->flags & OPf_SPECIAL){
        my $ref = \@ary;
        mPUSH(svref_2object(\$ref));
    }
    else{
        mPUSH(svref_2object(\@ary));
    }
    return $PL_op->next;
}
sub pp_anonhash{
    my $mark     = POPMARK;

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

        my $val;
        if($mark < $#PL_stack){
            $val = ${ $PL_stack[++$mark]->object_2svref };
        }
        else{
            apvm_warn 'Odd number of elements';
        }
        $hash{ ${ $key->object_2svref } } = $val;
    }
    $#PL_stack = $origmark;
    if($PL_op->flags & OPf_SPECIAL){
        my $ref = \%hash;
        mPUSH(svref_2object(\$ref));
    }
    else{
        mPUSH(svref_2object(\%hash));
    }
    return $PL_op->next;
}

sub _refto{

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

    return $PL_op->next;
}

sub pp_entersub{
    my $sv = POP;
    my $cv = $sv->toCV();

    if(is_null($cv)){
        apvm_die 'Undefined subroutine %s called', gv_fullname($sv, '&');
    }
    my $hasargs = ($PL_op->flags & OPf_STACKED) != 0;

    ENTER;
    SAVETMPS;

    my $mark  = POPMARK;
    my $gimme = GIMME_V;

    if(!cv_external($cv)){
        my $cx = PUSHBLOCK(SUB =>
            oldsp => $mark,

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

    my $cx = PUSHBLOCK(FOREACH => 
        oldsp => $#PL_stack,
        gimme => GIMME_V,

        resetsp  => $mark,
        iterdata => $iterdata,
        padvar   => $padvar,
        for_def  => $for_def,
    );

    if($PL_op->flags & OPf_STACKED){
        my $iterary = POP;
        if($iterary->class ne 'AV'){
            my $sv    = POP;
            my $right = $iterary;
            if(_range_is_numeric($sv, $right)){
                $cx->iterix(SvIV($sv));
                $cx->itermax(SvIV($right));
            }
            else{
                $cx->iterlval(SvPV($sv));

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

sub pp_stub{
    if(GIMME_V == G_SCALAR){
        PUSH(sv_undef);
    }
    return $PL_op->next;
}


sub _dopoptoloop{
    my $cxix;
    if($PL_op->flags & OPf_SPECIAL){
        $cxix = dopoptoloop($#PL_cxstack);
        if($cxix < 0){
            apvm_die q{Can't "%s" outside a loop block}, $PL_op->name
        }
    }
    else{
        $cxix = dopoptolabel($PL_op->pv);
        if($cxix < 0){
            apvm_die q{Label not found for "%s %s"}, $PL_op->name, $PL_op->pv;
        }

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

        $targ->setval(scalar readline $istream);
        PUSH($targ);
    }

    return $PL_op->next;
}

sub pp_print{
    my $mark     = POPMARK;
    my $origmark = $mark;
    my $gv   = ($PL_op->flags & OPf_STACKED) ? $PL_stack[++$mark]->object_2svref : defoutgv;

    my $ret  = print {$gv} mark_list($mark);

    $#PL_stack = $origmark;
    PUSH( $ret ? sv_yes : sv_no );
    return $PL_op->next;
}
sub pp_say{
    my $mark     = POPMARK;
    my $origmark = $mark;
    my $gv   = ($PL_op->flags & OPf_STACKED) ? $PL_stack[++$mark]->object_2svref : defoutgv;

    local $\ = "\n";
    my $ret  = print {$gv} mark_list($mark);

    $#PL_stack = $origmark;
    PUSH( $ret ? sv_yes : sv_no );
    return $PL_op->next;
}

sub pp_bless{

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


sub pp_join{
    my $mark = POPMARK;

    my $delim = $PL_stack[++$mark];
    SETval(join SvPV($delim), mark_list($mark));
    return $PL_op->next;
}

sub pp_aelemfast{
    my $av   = $PL_op->flags & OPf_SPECIAL ? PAD_SV($PL_op->targ) : GVOP_gv($PL_op)->AV;
    my $lval = $PL_op->flags & OPf_MOD || LVRET;

    PUSH( svref_2object(\$av->object_2svref->[$PL_op->private]) );
    return $PL_op->next;
}

sub pp_aelem{
    my $elemsv = POP;
    my $av     = TOP;
    my $lval   = $PL_op->flags & OPf_MOD || LVRET;

    if($elemsv->ROK){
        apvm_warn q{Use of reference %s as array index}, $elemsv->object_2svref;
    }

    SET( svref_2object(\$av->object_2svref->[SvIV($elemsv)]) );
    return $PL_op->next;
}

sub pp_helem{
    my $keysv = POP;
    my $hv    = TOP;
    my $lval  = $PL_op->flags & OPf_MOD || LVRET;

    SET( svref_2object(\$hv->object_2svref->{SvPV($keysv)}) );
    return $PL_op->next;
}
sub pp_keys{
    return &_do_kv;
}
sub pp_values{
    return &_do_kv;
}

( run in 4.325 seconds using v1.01-cache-2.11-cpan-94b05bcf43c )