view release on metacpan or  search on metacpan

xs/slot/slot.c  view on Meta::CPAN

                IV idx = SvIV(*svp);
                OP *newop = newOP(OP_CUSTOM, 0);
                newop->op_ppaddr = pp_slot_clear;
                newop->op_targ = idx;
                op_free(entersubop);
                return newop;
            }
        }
    }
    return entersubop;
}

/* ============================================
   XS Accessor - fallback for dynamic calls
   ============================================ */

static XS(xs_slot_accessor) {
    dXSARGS;
    IV idx = CvXSUBANY(cv).any_iv;
    SV **slot = &g_slots[idx];

    if (items) {
        SV *old = *slot;
        SV *new_val = ST(0);
        *slot = SvREFCNT_inc_simple_NN(new_val);
        SvREFCNT_dec_NN(old);
        if (g_has_watchers[idx]) fire_watchers(aTHX_ idx, new_val);
        ST(0) = new_val;
        XSRETURN(1);
    }
    ST(0) = *slot;
    XSRETURN(1);
}

/* ============================================
   Watchers
   ============================================ */

static void fire_watchers(pTHX_ IV idx, SV *new_val) {
    char key[32];
    int klen = snprintf(key, sizeof(key), "%ld", (long)idx);
    SV **name_sv = hv_fetch(g_slot_names, key, klen, 0);

    if (!name_sv || !SvOK(*name_sv)) return;

    STRLEN name_len;
    const char *name = SvPV(*name_sv, name_len);
    SV **svp = hv_fetch(g_watchers, name, name_len, 0);

    if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) {
        AV *callbacks = (AV*)SvRV(*svp);
        SSize_t i, len = av_len(callbacks);
        for (i = 0; i <= len; i++) {
            SV **cb = av_fetch(callbacks, i, 0);
            if (cb && SvROK(*cb)) {
                dSP;
                ENTER; SAVETMPS;
                PUSHMARK(SP);
                mXPUSHs(newSVpvn(name, name_len));
                XPUSHs(new_val);
                PUTBACK;
                call_sv(*cb, G_DISCARD);
                FREETMPS; LEAVE;
            }
        }
    }
}

/* ============================================
   Slot management
   ============================================ */

static void ensure_slot_capacity(IV needed) {
    if (needed >= g_slots_size) {
        IV new_size = g_slots_size ? g_slots_size * 2 : 16;
        IV i;
        while (new_size <= needed) new_size *= 2;
        Renew(g_slots, new_size, SV*);
        Renew(g_has_watchers, new_size, char);
        for (i = g_slots_size; i < new_size; i++) {
            g_slots[i] = &PL_sv_undef;
            g_has_watchers[i] = 0;
        }
        g_slots_size = new_size;
    }
}

static IV create_slot(pTHX_ const char *name, STRLEN name_len) {
    IV idx = g_slots_count++;
    char key[32];
    int klen;

    ensure_slot_capacity(idx);
    hv_store(g_slot_index, name, name_len, newSViv(idx), 0);
    klen = snprintf(key, sizeof(key), "%ld", (long)idx);
    hv_store(g_slot_names, key, klen, newSVpvn(name, name_len), 0);

    return idx;
}

static char* get_caller(pTHX) {
    return HvNAME((HV*)CopSTASH(PL_curcop));
}

static void install_accessor(pTHX_ const char *pkg, const char *name, IV idx) {
    char full[512];
    CV *cv;

    snprintf(full, sizeof(full), "%s::%s", pkg, name);
    cv = newXS(full, xs_slot_accessor, __FILE__);
    CvXSUBANY(cv).any_iv = idx;

    /* Install call checker for custom op optimization */
    cv_set_call_checker(cv, slot_call_checker, (SV*)cv);
}

static XS(xs_import) {
    dXSARGS;
    char *pkg = get_caller(aTHX);
    int i;

xs/slot/slot.c  view on Meta::CPAN

        ST(0) = g_slots[idx];
        XSRETURN(1);
    }
    XSRETURN_EMPTY;
}

static XS(xs_get) {
    dXSARGS;
    if (items < 1) XSRETURN_UNDEF;
    STRLEN name_len;
    const char *name = SvPV(ST(0), name_len);
    SV **svp = hv_fetch(g_slot_index, name, name_len, 0);
    if (svp) {
        ST(0) = g_slots[SvIV(*svp)];
        XSRETURN(1);
    }
    XSRETURN_UNDEF;
}

static XS(xs_set) {
    dXSARGS;
    if (items < 2) XSRETURN_EMPTY;
    STRLEN name_len;
    const char *name = SvPV(ST(0), name_len);
    SV **svp = hv_fetch(g_slot_index, name, name_len, 0);
    if (svp) {
        IV idx = SvIV(*svp);
        SV *old = g_slots[idx];
        g_slots[idx] = SvREFCNT_inc(ST(1));
        SvREFCNT_dec(old);
        ST(0) = g_slots[idx];
        XSRETURN(1);
    }
    XSRETURN_EMPTY;
}

/* slot::add - create slot(s) without installing accessors (fastest path) */
static XS(xs_add) {
    dXSARGS;
    int i;
    for (i = 0; i < items; i++) {
        STRLEN name_len;
        const char *name = SvPV(ST(i), name_len);
        /* Only create if doesn't exist */
        if (!hv_fetch(g_slot_index, name, name_len, 0)) {
            create_slot(aTHX_ name, name_len);
        }
    }
    XSRETURN_EMPTY;
}

static XS(xs_slots) {
    dXSARGS;
    HE *entry;
    PERL_UNUSED_VAR(items);
    SP -= items;
    hv_iterinit(g_slot_index);
    while ((entry = hv_iternext(g_slot_index))) {
        XPUSHs(hv_iterkeysv(entry));
    }
    PUTBACK;
    return;
}

/* slot::exists - check if slot is defined */
static XS(xs_exists) {
    dXSARGS;
    STRLEN name_len;
    const char *name;
    if (items != 1) croak("Usage: slot::exists($name)");
    name = SvPV(ST(0), name_len);
    if (hv_exists(g_slot_index, name, name_len)) {
        XSRETURN_YES;
    }
    XSRETURN_NO;
}

/* slot::clear - reset slot value to undef and clear watchers */
static XS(xs_clear) {
    dXSARGS;
    int i;
    for (i = 0; i < items; i++) {
        STRLEN name_len;
        const char *name = SvPV(ST(i), name_len);
        SV **svp = hv_fetch(g_slot_index, name, name_len, 0);
        if (svp) {
            IV idx = SvIV(*svp);
            SV *old = g_slots[idx];
            /* Reset to undef */
            g_slots[idx] = &PL_sv_undef;
            SvREFCNT_dec(old);
            /* Clear watchers */
            hv_delete(g_watchers, name, name_len, G_DISCARD);
            g_has_watchers[idx] = 0;
        }
    }
    XSRETURN_EMPTY;
}

/* slot::clear_by_idx - reset slot value to undef and clear watchers by index */
static XS(xs_clear_by_idx) {
    dXSARGS;
    int i;
    for (i = 0; i < items; i++) {
        IV idx = SvIV(ST(i));
        if (idx >= 0 && idx < g_slots_count) {
            SV *old = g_slots[idx];
            char key[32];
            int klen;
            SV **name_sv;

            /* Reset to undef */
            g_slots[idx] = &PL_sv_undef;
            SvREFCNT_dec(old);

            /* Clear watchers - need to look up name from idx */
            klen = snprintf(key, sizeof(key), "%ld", (long)idx);
            name_sv = hv_fetch(g_slot_names, key, klen, 0);
            if (name_sv && SvOK(*name_sv)) {
                STRLEN name_len;
                const char *name = SvPV(*name_sv, name_len);