view release on metacpan or  search on metacpan

lib/Data/NDArray/Shared.pm  view on Meta::CPAN

use Carp ();
our $VERSION = '0.02';
require XSLoader;
XSLoader::load('Data::NDArray::Shared', $VERSION);

sub CLONE_SKIP { 1 }  # blessed C-pointer handle: never clone into ithreads (double-free)

*numel = \&size;
*flat  = \&to_list;

# ---------------------------------------------------------------------------
# PDL interop.  PDL is an optional, load-on-demand dependency (no build or
# runtime prereq).  Each dtype maps to a PDL type of the SAME byte width, so the
# data copies/aliases with no element conversion.  NOTE the axis order: this
# array is row-major C-order while PDL's dim(0) is the fastest-varying axis, so
# shapes are reversed across the boundary -- an (r, c) array <-> PDL dims (c, r).
# ---------------------------------------------------------------------------
my %PDL_TYPE = (   # dtype => PDL type-constructor name
    f64 => 'double',    f32 => 'float',
    i64 => 'longlong',  i32 => 'long',   i16 => 'short',  i8 => 'sbyte',
    u64 => 'ulonglong', u32 => 'ulong',  u16 => 'ushort', u8 => 'byte',
);
my %DTYPE_OF = reverse %PDL_TYPE;   # PDL type name => dtype

sub _require_pdl {
    eval { require PDL; 1 }
        or Carp::croak("Data::NDArray::Shared: PDL interop needs PDL installed (cpanm PDL)");
}
sub _pdl_ctor {
    my ($dtype) = @_;
    my $name = $PDL_TYPE{$dtype} or Carp::croak("no PDL type for dtype '$dtype'");
    exists &{"PDL::$name"}
        or Carp::croak("this PDL has no '$name' type (needed for dtype '$dtype'); upgrade PDL");
    \&{"PDL::$name"};
}

# NDArray -> a NEW (copied) PDL piddle; dims = reverse(shape).
sub to_pdl {
    my ($self) = @_;
    _require_pdl();
    my $p = PDL->new_from_specification(_pdl_ctor($self->dtype)->(), reverse $self->shape);
    ${ $p->get_dataref } = $self->buffer;   # read-locked snapshot
    $p->upd_data;
    return $p;
}

# A NEW shared NDArray copied from a piddle; $path undef => anonymous mapping.
sub from_pdl {
    my ($class, $p, $path) = @_;
    _require_pdl();
    my $tname = "" . $p->type;
    my $dt = $DTYPE_OF{$tname}
        or Carp::croak("Data::NDArray::Shared->from_pdl: unsupported PDL type '$tname'");
    $p = $p->copy;                          # force a contiguous, physical piddle
    my $self = $class->new($path, $dt, reverse $p->dims);
    $self->update_from_bytes(${ $p->get_dataref });
    return $self;
}

# Copy a piddle into THIS array in place (same dtype + shape); returns self.
sub update_from_pdl {
    my ($self, $p) = @_;
    _require_pdl();
    my $tname = "" . $p->type;
    my $dt = $DTYPE_OF{$tname}
        or Carp::croak("Data::NDArray::Shared->update_from_pdl: unsupported PDL type '$tname'");
    $dt eq $self->dtype
        or Carp::croak("update_from_pdl: dtype mismatch (piddle $dt vs array " . $self->dtype . ")");
    my @want = reverse $self->shape;
    my @got  = $p->dims;
    "@want" eq "@got"
        or Carp::croak("update_from_pdl: shape mismatch (array (@{[ $self->shape ]}) vs piddle dims (@got))");
    $p = $p->copy;
    $self->update_from_bytes(${ $p->get_dataref });
    return $self;
}

# Zero-copy: a PDL ndarray ALIASING this array's shared mmap, built via PDL's C
# API (PDL_DONTTOUCHDATA, so PDL never frees/reallocates our mapping).  In-place
# PDL ops write straight through (visible to every sharing process); reads see
# live data.  NO locking -- coordinate access yourself.  The array is kept alive
# while the piddle lives.  Needs PDL at BUILD time (the C path); croaks otherwise.
sub as_pdl_alias {
    my ($self) = @_;
    _require_pdl();
    my $typenum = _pdl_ctor($self->dtype)->()->enum;        # PDL type number for our dtype
    # _alias_pdl_create croaks if the module was built without PDL (no C path).
    my $p = $self->_alias_pdl_create($typenum, [ reverse $self->shape ]);   # dims in PDL order
    $p->hdr->{_nda_shared} = $self;   # keep the mapping alive while the piddle lives
    return $p;
}

1;
__END__

=encoding utf-8

=head1 NAME

Data::NDArray::Shared - shared-memory typed N-dimensional numeric array for Linux

=head1 SYNOPSIS

    use Data::NDArray::Shared;

    # a 2x3 array of doubles in an anonymous shared mapping
    # ($path = undef for an anonymous array)
    my $a = Data::NDArray::Shared->new(undef, "f64", 2, 3);

    $a->ndim;        # 2
    $a->size;        # 6   (== 2 * 3, also ->numel)
    $a->shape;       # (2, 3)
    $a->strides;     # (3, 1)   row-major, in elements
    $a->dtype;       # "f64"
    $a->itemsize;    # 8

    $a->set(0, 0, 1.5);          # element [0][0] = 1.5  (multi-index)
    $a->get(0, 0);               # 1.5
    $a->set_flat(5, 9);          # last element by flat index
    $a->get_flat(5);             # 9