view release on metacpan or  search on metacpan

Shared.xs  view on Meta::CPAN

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
#include "pool.h"

/* slot_sv lifetime magic: returned scalar pins the pool object alive by
 * holding an incremented refcount, released when the scalar is freed. */
static int pool_scalar_magic_free(pTHX_ SV *sv, MAGIC *mg) {
    PERL_UNUSED_ARG(sv);
    if (mg->mg_obj) SvREFCNT_dec(mg->mg_obj);
    return 0;
}

static const MGVTBL pool_scalar_magic_vtbl = {
    NULL, NULL, NULL, NULL, pool_scalar_magic_free, NULL, NULL, NULL
};

#define EXTRACT_POOL(sv) \
    if (!sv_isobject(sv) || !sv_derived_from(sv, "Data::Pool::Shared")) \
        croak("Expected a Data::Pool::Shared object"); \
    PoolHandle *h = INT2PTR(PoolHandle*, SvIV(SvRV(sv))); \
    if (!h) croak("Attempted to use a destroyed Data::Pool::Shared object")

#define MAKE_OBJ(class, handle) \
    SV *obj = newSViv(PTR2IV(handle)); \
    SV *ref = newRV_noinc(obj); \
    sv_bless(ref, gv_stashpv(class, GV_ADD)); \
    RETVAL = ref

#define CHECK_SLOT(h, slot) \
    if ((UV)(slot) >= (h)->hdr->capacity) \
        croak("slot %" UVuf " out of range (capacity %" UVuf ")", \
              (UV)(slot), (UV)(h)->hdr->capacity)

#define CHECK_ALLOCATED(h, slot) \
    if (!pool_is_allocated(h, slot)) \
        croak("slot %" UVuf " is not allocated", (UV)(slot))


MODULE = Data::Pool::Shared  PACKAGE = Data::Pool::Shared

PROTOTYPES: DISABLE

SV *
new(class, path, capacity, elem_size)
    const char *class
    SV *path
    UV capacity
    UV elem_size
  PREINIT:
    char errbuf[POOL_ERR_BUFLEN];
  CODE:
    const char *p = SvOK(path) ? SvPV_nolen(path) : NULL;
    PoolHandle *h = pool_create(p, capacity, (uint32_t)elem_size, POOL_VAR_RAW, errbuf);
    if (!h) croak("Data::Pool::Shared->new: %s", errbuf);
    MAKE_OBJ(class, h);
  OUTPUT:
    RETVAL

SV *
new_memfd(class, name, capacity, elem_size)
    const char *class
    const char *name
    UV capacity
    UV elem_size
  PREINIT:

Shared.xs  view on Meta::CPAN

allocated_slots(self)
    SV *self
  PREINIT:
    EXTRACT_POOL(self);
  CODE:
    AV *av = newAV();
    uint64_t cap = h->hdr->capacity;
    uint32_t nwords = h->bitmap_words;
    for (uint32_t widx = 0; widx < nwords; widx++) {
        uint64_t word = __atomic_load_n(&h->bitmap[widx], __ATOMIC_RELAXED);
        while (word) {
            int bit = __builtin_ctzll(word);
            uint64_t slot = (uint64_t)widx * 64 + bit;
            if (slot < cap)
                av_push(av, newSViv((IV)slot));
            word &= word - 1;
        }
    }
    RETVAL = newRV_noinc((SV *)av);
  OUTPUT:
    RETVAL

UV
ptr(self, slot)
    SV *self
    UV slot
  PREINIT:
    EXTRACT_POOL(self);
  CODE:
    CHECK_SLOT(h, slot);
    CHECK_ALLOCATED(h, slot);
    RETVAL = PTR2UV(pool_slot_ptr(h, slot));
  OUTPUT:
    RETVAL

UV
data_ptr(self)
    SV *self
  PREINIT:
    EXTRACT_POOL(self);
  CODE:
    RETVAL = PTR2UV(h->data);
  OUTPUT:
    RETVAL

SV *
slot_sv(self, slot)
    SV *self
    UV slot
  PREINIT:
    EXTRACT_POOL(self);
  CODE:
    CHECK_SLOT(h, slot);
    CHECK_ALLOCATED(h, slot);
    RETVAL = newSV(0);
    sv_upgrade(RETVAL, SVt_PV);
    SvPV_set(RETVAL, (char *)pool_slot_ptr(h, slot));
    SvLEN_set(RETVAL, 0);
    SvCUR_set(RETVAL, h->hdr->elem_size);
    SvPOK_on(RETVAL);
    /* Pin pool alive while this SV is referenced — magic before READONLY */
    MAGIC *mg = sv_magicext(RETVAL, NULL, PERL_MAGIC_ext, &pool_scalar_magic_vtbl, NULL, 0);
    mg->mg_obj = SvREFCNT_inc_simple_NN(self);
    SvREADONLY_on(RETVAL);
  OUTPUT:
    RETVAL


MODULE = Data::Pool::Shared  PACKAGE = Data::Pool::Shared::I64

PROTOTYPES: DISABLE

SV *
new(class, path, capacity)
    const char *class
    SV *path
    UV capacity
  PREINIT:
    char errbuf[POOL_ERR_BUFLEN];
  CODE:
    const char *p = SvOK(path) ? SvPV_nolen(path) : NULL;
    PoolHandle *h = pool_create(p, capacity, sizeof(int64_t), POOL_VAR_I64, errbuf);
    if (!h) croak("Data::Pool::Shared::I64->new: %s", errbuf);
    MAKE_OBJ(class, h);
  OUTPUT:
    RETVAL

SV *
new_memfd(class, name, capacity)
    const char *class
    const char *name
    UV capacity
  PREINIT:
    char errbuf[POOL_ERR_BUFLEN];
  CODE:
    PoolHandle *h = pool_create_memfd(name, capacity, sizeof(int64_t), POOL_VAR_I64, errbuf);
    if (!h) croak("Data::Pool::Shared::I64->new_memfd: %s", errbuf);
    MAKE_OBJ(class, h);
  OUTPUT:
    RETVAL

SV *
new_from_fd(class, fd)
    const char *class
    int fd
  PREINIT:
    char errbuf[POOL_ERR_BUFLEN];
  CODE:
    PoolHandle *h = pool_open_fd(fd, POOL_VAR_I64, errbuf);
    if (!h) croak("Data::Pool::Shared::I64->new_from_fd: %s", errbuf);
    MAKE_OBJ(class, h);
  OUTPUT:
    RETVAL

IV
get(self, slot)
    SV *self
    UV slot
  PREINIT:
    EXTRACT_POOL(self);
  CODE: