view release on metacpan or  search on metacpan

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

    return $PL_op->next;
}

sub pp_concat{
    my $targ = GET_ATARGET;
    my $right= POP;
    my $left = TOP;

    SET( $targ->setval(SvPV($left) . SvPV($right)) );
    return $PL_op->next;
}

sub pp_readline{
    $PL_last_in_gv = POP;
    if($PL_last_in_gv->class ne 'GV'){
        PUSH($PL_last_in_gv);
        &pp_rv2gv;
        $PL_last_in_gv = POP;
    }

    # do_readline
    my $targ    = GET_TARGETSTACKED;
    my $istream = $PL_last_in_gv->object_2svref;

    my $gimme = GIMME_V;
    if($gimme == G_ARRAY){
        mPUSH(map{ svref_2object(\$_) } readline $istream);
    }
    else{
        $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{
    my $pkg;
    if(MAXARG == 1){
        $pkg = $PL_curcop->stashpv;
    }
    else{
        my $sv = POP;
        if($sv->ROK){
            apvm_die 'Attempt to bless into a reference';
        }
        $pkg = SvPV($sv);
        if($pkg eq ''){
            apvm_warn q{Explicit blessing to '' (assuming package main)};
        }
    }
    bless ${TOP->object_2svref}, $pkg;
    return $PL_op->next;
}

sub pp_push{
    my $mark = POPMARK;
    my $av   = $PL_stack[++$mark];
    my $n    = push @{$av->object_2svref}, mark_list($mark);
    SETval($n);
    return $PL_op->next;
}

sub pp_pop{
    my $av  = POP;
    my $val = pop @{$av->object_2svref};
    mPUSH(svref_2object(\$val));
    return $PL_op->next;
}

sub pp_shift{
    my $av  = POP;
    my $val = shift @{$av->object_2svref};
    mPUSH(svref_2object(\$val));
    return $PL_op->next;
}

sub pp_unshift{
    my $mark = POPMARK;
    my $av   = $PL_stack[++$mark];
    my $n    = unshift @{$av->object_2svref}, mark_list($mark);
    SETval($n);
    return $PL_op->next;
}

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;