view release on metacpan or  search on metacpan

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

    APVM_SCOPE => scalar(APVM_DEBUG =~ /\b scope \b/xmsi),
    APVM_CX    => scalar(APVM_DEBUG =~ /\b (?: cx | context ) \b/xmsi),
    APVM_STACK => scalar(APVM_DEBUG =~ /\b stack \b/xmsi),

    APVM_DUMMY => scalar(APVM_DEBUG =~ /\b dummy \b/xmsi),
};

use Exporter qw(import);

BEGIN{
    our @EXPORT      = qw(run_block call_sv);
    our @EXPORT_OK   = qw(
        $PL_op $PL_curcop
        @PL_stack @PL_markstack @PL_cxstack @PL_scopestack @PL_savestack @PL_tmps
        $PL_tmps_floor
        $PL_comppad $PL_comppad_name @PL_curpad
        $PL_last_in_gv
        $PL_runops
        @PL_ppaddr

        PUSHMARK POPMARK TOPMARK
        PUSH POP TOP SET SETval
        mPUSH
        GET_TARGET
        GET_TARGETSTACKED
        GET_ATARGET
        MAXARG

        PUSHBLOCK POPBLOCK TOPBLOCK
        PUSHSUB POPSUB
        PUSHLOOP POPLOOP

        dounwind

        ENTER LEAVE LEAVE_SCOPE
        SAVETMPS FREETMPS
        SAVE SAVECOMPPAD SAVECLEARSV
        SAVEPADSV
        save_scalar save_ary save_hash

        OP_GIMME GIMME_V LVRET

        PAD_SV PAD_SET_CUR_NOSAVE PAD_SET_CUR
        CX_CURPAD_SAVE CX_CURPAD_SV

        dopoptosub dopoptoloop dopoptolabel

        deb apvm_warn apvm_die croak ddx

        GVOP_gv

        vivify_ref
        sv_newmortal sv_mortalcopy sv_2mortal
        SvPV SvNV SvIV SvTRUE
        av_assign av_store
        hv_store hv_store_ent hv_scalar

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