view release on metacpan or  search on metacpan

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

    my($obj) = @_;

    Acme::Perl::VM::apvm_die('Modification of read-only value (%s) attempted', $obj->special_name);
}

sub STASH(){ undef }

sub POK(){ 0 }
sub ROK(){ 0 }

sub special_name{
    my($obj) = @_;
    return $B::specialsv_name[$$obj] || sprintf 'SPECIAL(0x%x)', $$obj;
}

package
    B::SV;

# for sv_setsv()
sub setsv{
    my($dst, $src) = @_;

    my $dst_ref = $dst->object_2svref;
    ${$dst_ref} = ${$src->object_2svref};
    bless $dst, ref(B::svref_2object( $dst_ref ));

    return $dst;
}

# for sv_setpv()/sv_setiv()/sv_setnv() etc.
sub setval{
    my($dst, $val) = @_;

    my $dst_ref = $dst->object_2svref;
    ${$dst_ref} = $val;
    bless $dst, ref(B::svref_2object( $dst_ref ));

    return $dst;
}

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

    ${$sv->object_2svref} = undef;
    return;
}

sub toCV{
    my($sv) = @_;
    Carp::croak(sprintf 'Cannot convert %s to a CV', B::class($sv));
}

sub STASH(){ undef }

package
    B::PVMG;

sub ROK{
    my($obj) = @_;
    my $dummy = ${ $obj->object_2svref }; # invoke mg_get()
    return $obj->SUPER::ROK;
}

package
    B::CV;

sub toCV{ $_[0] }

sub clear{
    Carp::croak('Cannot clear a CV');
}

sub ROK(){ 0 }

package
    B::GV;


sub toCV{ $_[0]->CV }

sub clear{
    Carp::croak('Cannot clear a CV');
}

sub ROK(){ 0 }

package
    B::AV;

sub setsv{
    my($sv) = @_;
    Carp::croak('Cannot call setsv() for ' . B::class($sv));
}

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

    @{$sv->object_2svref} = ();
    return;
}

unless(__PACKAGE__->can('OFF')){
    # some versions of B::Debug requires this
    constant->import(OFF => 0);
}

sub ROK(){ 0 }

package
    B::HV;

sub ROK(){ 0 }

*setsv = \&B::AV::setsv;

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

    %{$sv->object_2svref} = ();
    return;
}