File Coverage

blib/lib/Text/Xslate/PP/Opcode.pm

Criterion	Covered	Total	%
statement	43	319	13.4
branch	1	42	2.3
condition	0	2	0.0
subroutine	15	86	17.4
pod	0	75	0.0
total	59	524	11.2

package Text::Xslate::PP::Opcode;
use Mouse;
extends qw(Text::Xslate::PP::State);

our $VERSION = '3.4.0';

use Carp ();
use Scalar::Util ();

use Text::Xslate::PP;
use Text::Xslate::PP::Const;
use Text::Xslate::PP::Method;
use Text::Xslate::Util qw(
    p neat
    mark_raw unmark_raw html_escape uri_escape
    $DEBUG
);

use constant _DUMP_PP => scalar($DEBUG =~ /\b dump=pp \b/xms);

no warnings 'recursion';

if(!Text::Xslate::PP::_PP_ERROR_VERBOSE()) {
    our @CARP_NOT = qw(
        Text::Xslate
    );
}
our $_current_frame;


#
#
#

sub op_noop {
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_move_to_sb {
    $_[0]->{sb} = $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_move_from_sb {
    $_[0]->{sa} = $_[0]->{sb};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_save_to_lvar {
    tx_access_lvar( $_[0], $_[0]->op_arg, $_[0]->{sa} );
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_load_lvar {
    $_[0]->{sa} = tx_access_lvar( $_[0], $_[0]->op_arg );
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_load_lvar_to_sb {
    $_[0]->{sb} = tx_access_lvar( $_[0], $_[0]->op_arg );
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_localize_s {
    my($st) = @_;
    my $key    = $st->op_arg;
    my $newval = $st->{sa};
    $st->localize($key, $newval);

    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub op_localize_vars {
    my($st) = @_;
    my $new_vars = $st->{sa};
    my $old_vars = $st->vars;

    if(ref($new_vars) ne 'HASH') {
        $st->warn(undef, "Variable map must be a HASH reference");
    }

    push @{ $st->{local_stack} }, bless sub {
            $st->vars($old_vars);
            return;
        }, 'Text::Xslate::PP::Guard';

    $st->vars($new_vars);

    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub op_push {
    push @{ $_[0]->{ SP }->[ -1 ] }, $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_pushmark {
    push @{ $_[0]->{ SP } }, [];
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_nil {
    $_[0]->{sa} = undef;
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_vars {
    $_[0]->{sa} = $_[0]->{vars};

    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_literal {
    $_[0]->{sa} = $_[0]->op_arg;
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_literal_i {
    $_[0]->{sa} = $_[0]->op_arg;
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_fetch_s {
    $_[0]->{sa} = $_[0]->{vars}->{ $_[0]->op_arg };
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_fetch_field {
    my($st) = @_;
    my $var = $st->{sb};
    my $key = $st->{sa};
    $st->{sa} = $st->fetch($var, $key);
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}


sub op_fetch_field_s {
    my($st) = @_;
    my $var = $st->{sa};
    my $key = $st->op_arg;
    $st->{sa} = $st->fetch($var, $key);
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}


sub op_print {
    my($st) = @_;
    $st->print($st->{sa});
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}


sub op_print_raw {
    my($st) = @_;
    if(defined $st->{sa}) {
        $st->{ output } .= $st->{sa};
    }
    else {
        $st->warn( undef, "Use of nil to print" );
    }
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}


sub op_print_raw_s {
    $_[0]->{ output } .= $_[0]->op_arg;
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_include {
    my($st) = @_;
    my $child = Text::Xslate::PP::tx_load_template( $st->engine, $st->{sa}, 1 );
    $st->push_frame('include', undef);
    my $output = Text::Xslate::PP::tx_execute( $child, $st->{vars} );
    $st->pop_frame(0);
    $st->{output} .= $output;
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub op_find_file {
    $_[0]->{sa} = eval { $_[0]->engine->find_file($_[0]->{sa}); 1 };
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_suffix {
    $_[0]->{sa} = $_[0]->engine->{suffix};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_for_start {
    my($st) = @_;
    my $id = $st->op_arg;
    my $ar = Text::Xslate::PP::tx_check_itr_ar($st, $st->{sa});

    #tx_access_lvar( $st, $id + TXfor_ITEM, undef );
    tx_access_lvar( $st, $id + TXfor_ITER, -1 );
    tx_access_lvar( $st, $id + TXfor_ARRAY, $ar );

    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}


sub op_for_iter {
    my($st) = @_;
    my $id = $st->{sa};
    my $av = tx_access_lvar( $st, $id + TXfor_ARRAY );

    if(defined $av) {
        my $i = tx_access_lvar( $st, $id + TXfor_ITER );
        $av = [ $av ] unless ref $av;
        if ( ++$i < scalar(@{ $av })  ) {
            tx_access_lvar( $st, $id + TXfor_ITEM, $av->[ $i ] );
            tx_access_lvar( $st, $id + TXfor_ITER, $i );
            goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
        }
        else {
            # finish the loop
            $st->{sa} = ( $i > 0 ); # for 'for-else' block
            tx_access_lvar( $st, $id + TXfor_ITEM,  undef );
            tx_access_lvar( $st, $id + TXfor_ITER,  undef );
            tx_access_lvar( $st, $id + TXfor_ARRAY, undef );
        }
    }

    # finish
    $st->{ pc } = $st->op_arg;
    goto $st->{ code }->[ $st->{ pc } ]->{ exec_code };
}


sub op_add {
    $_[0]->{sa} = $_[0]->{sb} + $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_sub {
    $_[0]->{sa} = $_[0]->{sb} - $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_mul {
    $_[0]->{sa} = $_[0]->{sb} * $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_div {
    $_[0]->{sa} = $_[0]->{sb} / $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_mod {
    my($st) = @_;
    my $lhs = int $st->{sb};
    my $rhs = int $st->{sa};
    if($rhs == 0) {
        $st->error(undef, "Illegal modulus zero");
        $st->{sa} = 'NaN';
    }
    else {
        $st->{sa} = $lhs % $rhs;
    }
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}


sub op_concat {
    my($st) = @_;
    $st->{sa} = Text::Xslate::PP::tx_concat($st->{sb}, $st->{sa});
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub op_repeat {
    my($st) = @_;
    $st->{sa} = Text::Xslate::PP::tx_repeat($st->{sb}, $st->{sa});
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub op_bitor {
    $_[0]->{sa} = int($_[0]->{sb}) | int($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_bitand {
    $_[0]->{sa} = int($_[0]->{sb}) & int($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_bitxor {
    $_[0]->{sa} = int($_[0]->{sb}) ^ int($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_bitneg {
    $_[0]->{sa} = ~int($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}



sub op_and {
    if ( $_[0]->{sa} ) {
        goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
    }
    else {
        $_[0]->{ pc } = $_[0]->op_arg;
        goto $_[0]->{ code }->[ $_[0]->{ pc } ]->{ exec_code };
    }
}


sub op_dand {
    if ( defined $_[0]->{sa} ) {
        goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
    }
    else {
        $_[0]->{ pc } = $_[0]->op_arg;
        goto $_[0]->{ code }->[ $_[0]->{ pc } ]->{ exec_code };
    }
}


sub op_or {
    if ( ! $_[0]->{sa} ) {
        goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
    }
    else {
        $_[0]->{ pc } = $_[0]->op_arg;
        goto $_[0]->{ code }->[ $_[0]->{ pc } ]->{ exec_code };
    }
}


sub op_dor {
    my $sv = $_[0]->{sa};
    if ( defined $sv ) {
        $_[0]->{ pc } = $_[0]->op_arg;
        goto $_[0]->{ code }->[ $_[0]->{ pc } ]->{ exec_code };
    }
    else {
        goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
    }

}

sub op_not {
    $_[0]->{sa} = ! $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_minus {
    $_[0]->{sa} = -$_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_max_index {
    $_[0]->{sa} = scalar(@{ $_[0]->{sa} }) - 1;
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_builtin_mark_raw {
    $_[0]->{sa} = mark_raw($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_builtin_unmark_raw {
    $_[0]->{sa} = unmark_raw($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_builtin_html_escape {
    $_[0]->{sa} = html_escape($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_builtin_uri_escape {
    $_[0]->{sa} = uri_escape($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_builtin_is_array_ref {
    $_[0]->{sa} = Text::Xslate::Util::is_array_ref($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_builtin_is_hash_ref {
    $_[0]->{sa} = Text::Xslate::Util::is_hash_ref($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_is_code_ref {
    $_[0]->{sa} = Text::Xslate::Util::is_code_ref($_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_match {
    $_[0]->{sa} = Text::Xslate::PP::tx_match($_[0]->{sb}, $_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_eq {
    $_[0]->{sa} = Text::Xslate::PP::tx_sv_eq($_[0]->{sb}, $_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_ne {
    $_[0]->{sa} = !Text::Xslate::PP::tx_sv_eq($_[0]->{sb}, $_[0]->{sa});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_lt {
    $_[0]->{sa} = $_[0]->{sb} < $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_le {
    $_[0]->{sa} = $_[0]->{sb} <= $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_gt {
    $_[0]->{sa} = $_[0]->{sb} > $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_ge {
    $_[0]->{sa} = $_[0]->{sb} >= $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_ncmp {
    $_[0]->{sa} = $_[0]->{sb} <=> $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}
sub op_scmp {
    $_[0]->{sa} = $_[0]->{sb} cmp $_[0]->{sa};
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_range {
    my($self) = @_;
    push @{ $self->{ SP }->[ -1 ] }, ($self->{sb} .. $self->{sa});
    goto $self->{ code }->[ ++$self->{ pc } ]->{ exec_code };
}

sub op_fetch_symbol {
    my($st) = @_;
    my $name = $st->op_arg;
    $st->{sa} = $st->fetch_symbol($name);

    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub tx_macro_enter {
    my($st, $macro, $retaddr) = @_;
    my $name   = $macro->name;
    my $addr   = $macro->addr;
    my $nargs  = $macro->nargs;
    my $outer  = $macro->outer;
    my $args   = pop @{ $st->{SP} };

    print STDERR " " x $st->current_frame, "tx_macro_enter($name) to $retaddr\n" if _DUMP_PP;

    if(@{$args} != $nargs) {
        $st->error(undef, "Wrong number of arguments for %s (%d %s %d)",
            $name, scalar(@{$args}), scalar(@{$args}) > $nargs ? '>' : '<', $nargs);
        $st->{ sa } = undef;
        $st->{ pc }++;
        return;
    }

    my $cframe = $st->push_frame($name, $retaddr);

    $cframe->[ TXframe_OUTPUT ]  = $st->{ output };

    $st->{ output } = '';

    my $i = 0;
    if($outer > 0) {
        # copies lexical variables from the old frame to the new one
        my $oframe = $st->frame->[ $st->current_frame - 1 ];
        for(; $i < $outer; $i++) {
            my $real_ix = $i + TXframe_START_LVAR;
            $cframe->[$real_ix] = $oframe->[$real_ix];
        }
    }

    for my $val (@{$args}) {
        tx_access_lvar( $st, $i++, $val );
    }

    $st->{ pc } = $addr;
    if($st->{code}->[$addr]->{opname} ne 'macro_begin') {
        Carp::croak("Oops: entering non-macros: ", p($st->{code}->[$addr]));
    }
    return;
}

sub op_macro_end {
    my($st) = @_;

    my $top = $st->frame->[ $st->current_frame ];
    printf STDERR "%stx_macro_end(%s)]\n", ' ' x $st->current_frame - 1, $top->[ TXframe_NAME ] if _DUMP_PP;

    $st->{sa} = mark_raw( $st->{ output } );
    $st->pop_frame(1);

    $st->{ pc } = $top->[ TXframe_RETADDR ];
    goto $st->{ code }->[ $st->{ pc } ]->{ exec_code };
}

sub op_funcall {
    my($st) = @_;
    my $func = $st->{sa};
    if(ref $func eq TXt_MACRO) {
        tx_macro_enter($st, $func, $st->{ pc } + 1);
        goto $st->{ code }->[ $st->{ pc } ]->{ exec_code };
    }
    else {
        $st->{sa} = tx_funcall( $st, $func );
        goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
    }
}

sub op_methodcall_s {
    my($st) = @_;
    $st->{sa} = Text::Xslate::PP::Method::tx_methodcall(
        $st, undef, $st->op_arg, @{ pop @{ $st->{SP} } });
    goto $st->{ code }->[ ++$st->{ pc } ]->{ exec_code };
}

sub op_make_array {
    my $args = pop @{ $_[0]->{SP} };
    $_[0]->{sa} = $args;
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_make_hash {
    my $args = pop @{ $_[0]->{SP} };
    $_[0]->{sa} = { @{$args} };
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_merge_hash {
    $_[0]->{sa} = Text::Xslate::Util::merge_hash($_[0]->{sa}, $_[0]->{sb});
    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}


sub op_enter {
    push @{$_[0]->{save_local_stack} ||= []}, delete $_[0]->{local_stack};

    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_leave {
    $_[0]->{local_stack} = pop @{$_[0]->{save_local_stack}};

    goto $_[0]->{ code }->[ ++$_[0]->{ pc } ]->{ exec_code };
}

sub op_goto {
    $_[0]->{ pc } = $_[0]->op_arg;
    goto $_[0]->{ code }->[ $_[0]->{ pc } ]->{ exec_code };
}

sub op_end {
    my($st) = @_;
    printf STDERR "op_end at %d\n", $st->{pc} if _DUMP_PP;
    $st->{ pc } = $st->code_len;

    if($st->current_frame != 0) {
        #Carp::croak("Oops: broken stack frame:" .  p($st->frame));
    }
    return;
}

sub op_depend;      *op_depend      = \&op_noop;
sub op_macro_begin; *op_macro_begin = \&op_noop;
sub op_macro_nargs; *op_macro_nargs = \&op_noop;
sub op_macro_outer; *op_macro_outer = \&op_noop;
sub op_set_opinfo;  *op_set_opinfo  = \&op_noop;
sub op_super;       *op_super       = \&op_noop;

#
# INTERNAL COMMON FUNCTIONS
#

sub tx_access_lvar {
    return $_[0]->pad->[ $_[1] + TXframe_START_LVAR ] if @_ == 2;
    $_[0]->pad->[ $_[1] + TXframe_START_LVAR ] = $_[2];
}


sub tx_funcall {
    my ( $st, $proc ) = @_;
    my ( @args ) = @{ pop @{ $st->{ SP } } };
    my $ret;

    if(!defined $proc) {
        my $c = $st->{code}->[ $st->{pc} - 1 ];
        $st->error( undef, "Undefined function%s is called",
            $c->{ opname } eq 'fetch_s' ? " $c->{arg}()" : ""
        );
    }
    else {
        $ret = eval { $proc->( @args ) };
        $st->error( undef, "%s", $@) if $@;
    }

    return $ret;
}

sub proccall {
    my($st, $proc) = @_;
    if(ref $proc eq TXt_MACRO) {
        local $st->{pc} = $st->{pc};
        tx_macro_enter($st, $proc, $st->{code_len});
        $st->{code}->[ $st->{pc} ]->{ exec_code }->( $st );
        return $st->{sa};
    }
    else {
        return tx_funcall($st, $proc);
    }
}

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