view release on metacpan or  search on metacpan

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

/*
 * doubly.c - Thread-safe doubly linked list with SV registry
 *
 * Architecture following slot.c pattern:
 * - Dynamic SV-based node storage (no serialization)
 * - Index-based linking for thread safety (indices clone safely)
 * - Full API compatibility with Doubly module
 */

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

/* ============================================
   Data Structures
   ============================================ */

/* Node storage - index-based linking for thread safety */
typedef struct DoublyNodeSlot {
    SV* data;           /* Direct SV* - no serialization needed */
    IV prev_idx;        /* Index of prev node (-1 = none) */
    IV next_idx;        /* Index of next node (-1 = none) */
    IV list_idx;        /* Which list this node belongs to */
    IV node_id;         /* Stable ID for Perl object references */
#ifdef USE_ITHREADS
    void* data_interp;  /* Interpreter that owns data SV */
#endif
} DoublyNodeSlot;

/* List metadata */
typedef struct DoublyListMeta {
    IV head_idx;        /* Index of first node (-1 = empty placeholder) */
    IV tail_idx;        /* Index of last node */
    IV length;          /* Number of nodes with data */
    IV refcount;        /* Reference count for GC */
    int destroyed;      /* Flag to mark as destroyed */
} DoublyListMeta;

/* Global registries */
static DoublyListMeta* g_lists = NULL;
static IV g_lists_size = 0;
static IV g_lists_count = 0;

static DoublyNodeSlot* g_nodes = NULL;
static IV g_nodes_size = 0;
static IV g_nodes_count = 0;
static IV g_next_node_id = 1;

/* Free list for node reuse */
static IV* g_free_nodes = NULL;
static IV g_free_nodes_size = 0;
static IV g_free_nodes_count = 0;

/* Free list for list reuse */
static IV* g_free_lists = NULL;
static IV g_free_lists_size = 0;
static IV g_free_lists_count = 0;

/* Thread safety */
#ifdef USE_ITHREADS
static perl_mutex doubly_mutex;
static int doubly_mutex_initialized = 0;
#define DOUBLY_LOCK()   MUTEX_LOCK(&doubly_mutex)
#define DOUBLY_UNLOCK() MUTEX_UNLOCK(&doubly_mutex)
#else
#define DOUBLY_LOCK()
#define DOUBLY_UNLOCK()
#endif

static int doubly_initialized = 0;

/* ============================================
   Custom OPs for hot paths
   ============================================ */

static XOP doubly_data_get_xop;
static XOP doubly_data_set_xop;
static XOP doubly_length_xop;

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

    XSRETURN(1);
}

static XS(xs_destroy) {
    dXSARGS;
    HV* hash;
    SV** id_sv;
    IV list_idx;

    if (items < 1) croak("Usage: doubly::destroy(self)");

    hash = (HV*)SvRV(ST(0));
    id_sv = hv_fetch(hash, "_id", 3, 0);
    list_idx = id_sv ? SvIV(*id_sv) : -1;

    list_destroy(aTHX_ list_idx);
    XSRETURN_EMPTY;
}

static XS(xs_DESTROY) {
    dXSARGS;
    HV* hash;
    SV** id_sv;
    IV list_idx;
#ifdef USE_ITHREADS
    SV** owner_tid_sv;
    UV owner_tid;
    UV my_tid;
#endif

    PERL_UNUSED_VAR(items);

    /* Skip cleanup during global destruction */
    if (PL_dirty) {
        XSRETURN_EMPTY;
    }

    hash = (HV*)SvRV(ST(0));
    id_sv = hv_fetch(hash, "_id", 3, 0);
    list_idx = id_sv ? SvIV(*id_sv) : -1;

#ifdef USE_ITHREADS
    owner_tid_sv = hv_fetch(hash, "_owner_tid", 10, 0);
    owner_tid = owner_tid_sv ? SvUV(*owner_tid_sv) : 0;
    my_tid = PTR2UV(PERL_GET_THX);

    /* Always decrement refcount - list_decref handles SV ownership internally.
     * This prevents memory leaks from cloned objects that never get cleaned up. */
    list_decref(aTHX_ list_idx);
    (void)owner_tid; /* Suppress unused variable warning */
    (void)my_tid;
#else
    list_decref(aTHX_ list_idx);
#endif
    XSRETURN_EMPTY;
}

static XS(xs_CLONE_SKIP) {
    dXSARGS;
    PERL_UNUSED_VAR(items);
    /* Return 1 - do NOT clone doubly objects to new threads.
     * Each thread must create its own lists. Sharing lists across
     * threads is not supported. */
    XSRETURN_IV(1);
}

/* ============================================
   Boot
   ============================================ */

XS_EXTERNAL(boot_doubly) {
    dXSBOOTARGSXSAPIVERCHK;
    CV *method_cv;
    SV *ckobj;
    PERL_UNUSED_VAR(items);

    doubly_init(aTHX);

    /* Register custom OPs */
    XopENTRY_set(&doubly_data_get_xop, xop_name, "doubly_data_get");
    XopENTRY_set(&doubly_data_get_xop, xop_desc, "doubly data getter");
    Perl_custom_op_register(aTHX_ pp_doubly_data_get, &doubly_data_get_xop);

    XopENTRY_set(&doubly_data_set_xop, xop_name, "doubly_data_set");
    XopENTRY_set(&doubly_data_set_xop, xop_desc, "doubly data setter");
    Perl_custom_op_register(aTHX_ pp_doubly_data_set, &doubly_data_set_xop);

    XopENTRY_set(&doubly_length_xop, xop_name, "doubly_length");
    XopENTRY_set(&doubly_length_xop, xop_desc, "doubly length");
    Perl_custom_op_register(aTHX_ pp_doubly_length, &doubly_length_xop);

    XopENTRY_set(&doubly_next_xop, xop_name, "doubly_next");
    XopENTRY_set(&doubly_next_xop, xop_desc, "doubly next");
    Perl_custom_op_register(aTHX_ pp_doubly_next, &doubly_next_xop);

    XopENTRY_set(&doubly_prev_xop, xop_name, "doubly_prev");
    XopENTRY_set(&doubly_prev_xop, xop_desc, "doubly prev");
    Perl_custom_op_register(aTHX_ pp_doubly_prev, &doubly_prev_xop);

    XopENTRY_set(&doubly_start_xop, xop_name, "doubly_start");
    XopENTRY_set(&doubly_start_xop, xop_desc, "doubly start");
    Perl_custom_op_register(aTHX_ pp_doubly_start, &doubly_start_xop);

    XopENTRY_set(&doubly_end_xop, xop_name, "doubly_end");
    XopENTRY_set(&doubly_end_xop, xop_desc, "doubly end");
    Perl_custom_op_register(aTHX_ pp_doubly_end, &doubly_end_xop);

    XopENTRY_set(&doubly_is_start_xop, xop_name, "doubly_is_start");
    XopENTRY_set(&doubly_is_start_xop, xop_desc, "doubly is_start");
    Perl_custom_op_register(aTHX_ pp_doubly_is_start, &doubly_is_start_xop);

    XopENTRY_set(&doubly_is_end_xop, xop_name, "doubly_is_end");
    XopENTRY_set(&doubly_is_end_xop, xop_desc, "doubly is_end");
    Perl_custom_op_register(aTHX_ pp_doubly_is_end, &doubly_is_end_xop);

    /* Register XS functions */
    newXS("doubly::new", xs_new, __FILE__);
    newXS("doubly::add", xs_add, __FILE__);
    newXS("doubly::bulk_add", xs_bulk_add, __FILE__);
    newXS("doubly::remove_from_start", xs_remove_from_start, __FILE__);
    newXS("doubly::remove_from_end", xs_remove_from_end, __FILE__);
    newXS("doubly::remove", xs_remove, __FILE__);
    newXS("doubly::remove_from_pos", xs_remove_from_pos, __FILE__);