view release on metacpan or  search on metacpan

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

    if(!defined ${$ref}){
        apvm_warn 'Use of uninitialized value';
        return 0;
    }

    return ${$ref} + 0;
}

sub SvIV{
    my($sv) = @_;
    my $ref = $sv->object_2svref;

    if(!defined ${$ref}){
        apvm_warn 'Use of uninitialized value';
        return 0;
    }

    return int(${$ref});
}

sub av_assign{
    my $av   = shift;
    my $ref  = $av->object_2svref;
    $#{$ref} = $#_;
    for(my $i = 0; $i < @_; $i++){
        tie $ref->[$i], 'Acme::Perl::VM::Alias', $_[$i]->object_2svref;
    }
    return;
}

sub av_store{
    my($av, $ix, $sv) = @_;
    tie $av->object_2svref->[$ix],
        'Acme::Perl::VM::Alias', $sv->object_2svref;
    return;
}

sub hv_store{
    my($hv, $key, $sv) = @_;
    tie $hv->object_2svref->{$key},
        'Acme::Perl::VM::Alias', $sv->object_2svref;
    return;
}

sub hv_store_ent{
    my($hv, $key, $sv) = @_;
    tie $hv->object_2svref->{ ${$key->object_2svref} },
        'Acme::Perl::VM::Alias', $sv->object_2svref;
    return;
}

sub hv_scalar{
    my($hv) = @_;
    my $sv = sv_newmortal();
    $sv->setval(scalar %{ $hv->object_2svref });
    return $sv;
}

sub defoutgv{
    no strict 'refs';
    return \*{ select() };
}

sub gv_fullname{
    my($gv, $prefix) = @_;
    $prefix = '' unless defined $prefix;

    my $stashname = $gv->STASH->NAME;
    if($stashname eq 'main'){
        $prefix .= $gv->SAFENAME;
    }
    else{
        $prefix .= join q{::}, $stashname, $gv->SAFENAME;
    }
    return $prefix;
}

# Utilities

sub sv_defined{
    my($sv) = @_;

    return $sv && ${$sv} && defined(${ $sv->object_2svref });
}

sub is_not_null{
    my($sv) = @_;
    return ${$sv};
}
sub is_null{
    my($sv) = @_;
    return !${$sv};
}

my %not_a_scalar;
@not_a_scalar{qw(AV HV CV IO)} = ();
sub is_scalar{
    my($sv) = @_;
    return !exists $not_a_scalar{ $sv->class };
}

sub mark_list{
    my($mark) = @_;
    return map{ ${ $_->object_2svref } } splice @PL_stack, $mark+1;
}


our %external;

sub apvm_extern{
    foreach my $arg(@_){
        if(ref $arg){
            if(ref($arg) ne 'CODE'){
                Carp::croak('Not a CODE reference for apvm_extern()');
            }
            $external{refaddr $arg} = 1;
        }
        else{
            my $stash = do{ no strict 'refs'; \%{$arg .'::'} };
            while(my $name = each %{$stash}){
                my $code_ref = do{ no strict 'refs'; *{$arg . '::' . $name}{CODE} };