view release on metacpan or  search on metacpan

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

        gv_fullname

        looks_like_number
        sv_defined is_null is_not_null
        mark_list
        not_implemented
        dump_object dump_value dump_stack dump_si

        apvm_extern
        cv_external

        APVM_DEBUG APVM_DUMMY
        APVM_SCOPE APVM_TRACE
    );
    our %EXPORT_TAGS = (
        perl_h => \@EXPORT_OK,
    );

    if(APVM_DEBUG && -t *STDERR){
        require Term::ANSIColor;

        *deb = \&_deb_colored;
    }
    else{
        *deb = \&_deb;
    }
}

use Scalar::Util qw(looks_like_number refaddr);
use Carp ();

use Acme::Perl::VM::Context;
use Acme::Perl::VM::Scope;
use Acme::Perl::VM::PP;
use Acme::Perl::VM::B;

our $PL_runops = (APVM_TRACE || APVM_STACK)
    ? \&runops_debug
    : \&runops_standard;

our $PL_op;
our $PL_curcop;

our @PL_stack;
our @PL_markstack;
our @PL_cxstack;
our @PL_scopestack;
our @PL_savestack;
our @PL_tmps;

our $PL_tmps_floor;

our $PL_comppad;
our $PL_comppad_name;
our @PL_curpad;

our $PL_last_in_gv;

our @PL_ppaddr;

our $color = 'GREEN BOLD'; # for debugging log

sub not_implemented;

{
    my $i = 0;
    while(my $ppname = B::ppname($i)){
        my $ppaddr = \$Acme::Perl::VM::PP::{$ppname};

        if(ref($ppaddr) eq 'GLOB'){
            $PL_ppaddr[$i] = *{$ppaddr}{CODE};
        }

        $PL_ppaddr[$i] ||= sub{ not_implemented($ppname) };

        $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'){
            my $sv = PAD_SV($PL_op->targ);

            if(is_scalar($sv)){
                deb '(%s)', $sv->POK ? B::perlstring($sv->PVX) : $sv->as_string;
            }