view release on metacpan or  search on metacpan

Shared.xs  view on Meta::CPAN

            croak("Data::Reservoir::Shared: weight must be a finite number > 0");
    }
    s = SvPVbyte(item, n);                 /* may croak (wide char) -- BEFORE the lock, AFTER weight magic */
    /* SvNV(weight) above and SvPVbyte(item) just now both run magic = arbitrary
     * Perl that can have destroyed self -- re-check before the first use of h. */
    REEXTRACT(self);
    rsv_rwlock_wrlock(h);
    RETVAL = (h->mode == RSV_MODE_WEIGHTED)
        ? rsv_add_weighted_locked(h, s, (uint64_t)n, w)
        : rsv_add_locked(h, s, (uint64_t)n);
    __atomic_fetch_add(&h->hdr->stat_ops, 1, __ATOMIC_RELAXED);
    rsv_rwlock_wrunlock(h);
  OUTPUT:
    RETVAL

UV
add_many(self, items)
    SV *self
    SV *items
  PREINIT:
    EXTRACT(self);
    AV *av;
    IV  top;
    UV  stored = 0;
  CODE:
    SvGETMAGIC(items);
    if (!SvROK(items) || SvTYPE(SvRV(items)) != SVt_PVAV)
        croak("Data::Reservoir::Shared->add_many: expected an array reference");
    av = (AV *)SvRV(items);
    /* Pin the array for the whole loop: an element's magic can drop the caller's
     * last reference (undef $aref), freeing av and dangling later av_fetch calls. */
    SvREFCNT_inc((SV *)av); sv_2mortal((SV *)av);
    top = av_len(av);
    /* SvGETMAGIC(items) above, and av_len on a tied array, both run Perl that
     * can have destroyed self -- re-check before the first use of h below. */
    REEXTRACT(self);
    {
        STRLEN cnt = (top >= 0) ? (STRLEN)(top + 1) : 0, i;
        const char **ps = NULL; STRLEN *ls = NULL; double *ws = NULL;
        int weighted = (h->mode == RSV_MODE_WEIGHTED);
        if (cnt) {
            Newx(ps, cnt, const char *); SAVEFREEPV(ps);
            Newx(ls, cnt, STRLEN);       SAVEFREEPV(ls);
            if (weighted) { Newx(ws, cnt, double); SAVEFREEPV(ws); }
            for (i = 0; i < cnt; i++) {
                SV **el = av_fetch(av, (SSize_t)i, 0);
                if (weighted) {
                    /* weighted mode: each element is a [item, weight] pair,
                     * validated here (before the lock; no croak while locked) */
                    if (el && *el) SvGETMAGIC(*el);   /* a tied-array element is a deferred-magic PVLV */
                    if (!el || !*el || !SvROK(*el) || SvTYPE(SvRV(*el)) != SVt_PVAV)
                        croak("Data::Reservoir::Shared->add_many: weighted reservoir expects [item, weight] pairs");
                    AV *pair = (AV *)SvRV(*el);
                    SV **iv = av_fetch(pair, 0, 0);
                    SV **wv = av_fetch(pair, 1, 0);
                    if (!iv || !*iv || !wv || !*wv)
                        croak("Data::Reservoir::Shared->add_many: each element must be [item, weight]");
                    /* Pin both element SVs by value BEFORE any magic runs: the item's
                     * SvPVbyte (or the weight's get-magic) can free or reassign the
                     * pair AV, dangling the other's raw SV** slot. The mortal INC
                     * keeps both alive for this branch even if the pair AV is freed. */
                    SV *isv = *iv, *wsv = *wv;
                    SvREFCNT_inc(isv); sv_2mortal(isv);
                    SvREFCNT_inc(wsv); sv_2mortal(wsv);
                    {
                        STRLEN len;
                        const char *src = SvPVbyte(isv, len); /* may run overload/tie/get-magic = arbitrary Perl */
                        /* Copy bytes into a private mortal SV NOW: a LATER element SvPVbyte can
                         * grow/free THIS element PV, dangling src before the locked loop uses it. */
                        SV *copy = sv_2mortal(newSVpvn(src, len));
                        ps[i] = SvPVX_const(copy);
                        ls[i] = len;
                    }
                    SvGETMAGIC(wsv);
                    { double w = SvOK(wsv) ? SvNV(wsv) : 0.0;  /* undef -> 0 -> clean croak below, no warning */
                      if (!(w > 0.0) || !isfinite(w))
                          croak("Data::Reservoir::Shared->add_many: weight must be a finite number > 0");
                      ws[i] = w; }
                } else if (el && *el) {
                    STRLEN len;
                    const char *src = SvPVbyte(*el, len); /* may run overload/tie/get-magic = arbitrary Perl */
                    /* Copy bytes into a private mortal SV NOW: a LATER element SvPVbyte can
                     * grow/free THIS element PV, dangling src before the locked loop uses it. */
                    SV *copy = sv_2mortal(newSVpvn(src, len));
                    ps[i] = SvPVX_const(copy);
                    ls[i] = len;
                } else { ps[i] = ""; ls[i] = 0; }
            }
        }
        /* Element get-magic in the resolve loop above (SvPVbyte / SvGETMAGIC on
         * the weight) can also have destroyed self. Outside the `if (cnt)`
         * block: an empty or tied size-0 array skips the loop but still
         * reaches this lock. */
        REEXTRACT(self);
        rsv_rwlock_wrlock(h);
        if (weighted)
            for (i = 0; i < cnt; i++) stored += (UV)rsv_add_weighted_locked(h, ps[i], (uint64_t)ls[i], ws[i]);
        else
            for (i = 0; i < cnt; i++) stored += (UV)rsv_add_locked(h, ps[i], (uint64_t)ls[i]);
        __atomic_fetch_add(&h->hdr->stat_ops, 1, __ATOMIC_RELAXED);
        rsv_rwlock_wrunlock(h);
    }
    RETVAL = stored;
  OUTPUT:
    RETVAL

# ---- reading the sample ----

SV *
get(self, i)
    SV *self
    UV i
  PREINIT:
    EXTRACT(self);
    const uint8_t *ptr; uint64_t len; int ok;
    uint8_t *tmp = NULL;
  CODE:
    /* copy the item out under the read lock, then build the SV (no croak-capable
     * Perl allocation while the lock is held) */
    Newx(tmp, (size_t)h->item_size, uint8_t); SAVEFREEPV(tmp);   /* cached: matches rsv_get_locked's clamp */
    rsv_rwlock_rdlock(h);