view release on metacpan or  search on metacpan

lib/Affix/marshal.c  view on Meta::CPAN

                safefree((void *)raw_ptr);
            }
        }
    }
    /* Case 2: alloc_owned() stores ptr directly in a UV scalar */
    else if (SvOK(sv)) {
        UV raw_ptr = SvUV(sv);
        if (raw_ptr) {
            sv_setuv(sv, 0);
            safefree((void *)raw_ptr);
        }
    }
}

IV alloc_raw(pTHX_ IV sz) { return PTR2IV(safecalloc(1, sz)); }

void set_mem_u128(IV addr, IV l, IV h) {
    unsigned __int128 * p = (unsigned __int128 *)addr;
    *p = ((unsigned __int128)h << 64) | (unsigned __int128)l;
}

IV get_string_ptr() {
    static char * m = "Hello from C Pointer";
    return PTR2IV(m);
}

int test_invoke_callback(IV addr, int a, double b) {
    int (*f)(int, double) = (int (*)(int, double))addr;
    return f(a, b);
}

/**
 * @brief Verifies native callback invocation for 128-bit function pointers.
 */
SV * test_invoke_callback_128(pTHX_ IV addr, SV * arg_sv) {
    unsigned __int128 (*f)(__int128) = (unsigned __int128 (*)(__int128))addr;
    __int128 arg = (__int128)_alt_sv_to_int128(aTHX_ arg_sv);
    unsigned __int128 res = f(arg);
    SV * ret = newSV(0);
    alt_int128_to_sv(aTHX_ ret, res, false); /* Callback return value is uint128 */
    return ret;
}

IV get_file_ptr(pTHX_ SV * fh_ref) {
    IO * io = sv_2io(fh_ref);
    if (!io)
        return 0;
    return PTR2IV(PerlIO_exportFILE(IoIFP(io), nullptr));
}

typedef struct {
    unsigned __int128 val;
    int id;
} BigData;

void mutate_big_data_native(BigData * d) {
    d->val += 1; /* Add 1 to the 128-bit int natively */
    d->id = 777;
}

void verify_marshalling_128(pTHX_ SV * input) {
    dMY_CXT;
    const infix_type * type = infix_registry_lookup_type(MY_CXT.registry, "BigData");
    BigData stack_struct = {0, 0};
    if (SvROK(input)) {
        SV * proxy = newSV(0);
        sv_setsv(proxy, input);
        bind_placeholder(aTHX_ proxy, &stack_struct, type, 0, 0, false, nullptr, nullptr, false, false);
        MAGIC * mg = mg_find(proxy, PERL_MAGIC_ext);
        if (mg && mg->mg_virtual->svt_set)
            mg->mg_virtual->svt_set(aTHX_ proxy, mg);
        SvREFCNT_dec(proxy);
    }
    mutate_big_data_native(&stack_struct);
    if (SvROK(input)) {
        SV * proxy_rv = bind_aggregate(aTHX_ & stack_struct, type, nullptr, false);
        HV * target_hv = (HV *)SvRV(input);
        HV * source_hv = (HV *)SvRV(proxy_rv);
        hv_iterinit(source_hv);
        HE * entry;
        while ((entry = hv_iternext(source_hv))) {
            I32 klen;
            char * kstr = hv_iterkey(entry, &klen);
            SV * val = hv_iterval(source_hv, entry);
            hv_store(target_hv, kstr, klen, newSVsv(val), 0);
        }
        SvREFCNT_dec(proxy_rv);
    }
}

/*   Mock C++ Object For Custom Destructor Test   */
typedef struct {
    int value;
} MockCxxObj;

static int mock_cxx_dtor_calls = 0;

IV mock_cxx_new(int v) {
    MockCxxObj * obj = safemalloc(sizeof(MockCxxObj));
    obj->value = v;
    return PTR2IV(obj);
}

void mock_cxx_delete(void * ptr) {
    mock_cxx_dtor_calls++;
    safefree(ptr);
}

IV get_mock_cxx_dtor() { return PTR2IV(mock_cxx_delete); }
int get_mock_cxx_dtor_calls() { return mock_cxx_dtor_calls; }

XS_INTERNAL(XS_main_define_types) {
    dVAR;
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "defs");
    define_types(aTHX_ SvPV_nolen(ST(0)));
    XSRETURN_EMPTY;
}

XS_INTERNAL(XS_main_sizeof_type) {

lib/Affix/marshal.c  view on Meta::CPAN

    if (items != 0)
        croak_xs_usage(cv, "");
    {
        IV RETVAL;
        dXSTARG;
        RETVAL = get_string_ptr();
        TARGi((IV)RETVAL, 1);
        ST(0) = TARG;
    }
    XSRETURN(1);
}
XS_INTERNAL(XS_main_test_invoke_callback) {
    dVAR;
    dXSARGS;
    if (items != 3)
        croak_xs_usage(cv, "addr, a, b");
    {
        IV addr = (IV)SvIV(ST(0));
        int a = (int)SvIV(ST(1));
        double b = (double)SvNV(ST(2));
        int RETVAL;
        dXSTARG;
        RETVAL = test_invoke_callback(addr, a, b);
        TARGi((IV)RETVAL, 1);
        ST(0) = TARG;
    }
    XSRETURN(1);
}

XS_INTERNAL(XS_main_test_invoke_callback_128) {
    dVAR;
    dXSARGS;
    if (items != 2)
        croak_xs_usage(cv, "addr, arg_sv");
    {
        IV addr = (IV)SvIV(ST(0));
        SV * arg_sv = ST(1);
        SV * RETVAL;
        RETVAL = test_invoke_callback_128(aTHX_ addr, arg_sv);
        RETVAL = sv_2mortal(RETVAL);
        ST(0) = RETVAL;
    }
    XSRETURN(1);
}

XS_INTERNAL(XS_main_get_file_ptr) {
    dVAR;
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "fh_ref");
    {
        SV * fh_ref = ST(0);
        IV RETVAL;
        dXSTARG;
        RETVAL = get_file_ptr(aTHX_ fh_ref);
        TARGi((IV)RETVAL, 1);
        ST(0) = TARG;
    }
    XSRETURN(1);
}
XS_INTERNAL(XS_main_verify_marshalling_128) {
    dVAR;
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "input");
    verify_marshalling_128(aTHX_ ST(0));
    XSRETURN_EMPTY;
}

XS_INTERNAL(XS_main_mock_cxx_new) {
    dVAR;
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "v");
    {
        int v = (int)SvIV(ST(0));
        IV RETVAL;
        dXSTARG;
        RETVAL = mock_cxx_new(v);
        TARGi((IV)RETVAL, 1);
        ST(0) = TARG;
    }
    XSRETURN(1);
}

XS_INTERNAL(XS_main_get_mock_cxx_dtor) {
    dVAR;
    dXSARGS;
    if (items != 0)
        croak_xs_usage(cv, "");
    {
        IV RETVAL;
        dXSTARG;
        RETVAL = get_mock_cxx_dtor();
        TARGi((IV)RETVAL, 1);
        ST(0) = TARG;
    }
    XSRETURN(1);
}

XS_INTERNAL(XS_main_mock_cxx_delete) {
    dVAR;
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "ptr");
    mock_cxx_delete(INT2PTR(void *, SvIV(ST(0))));
    XSRETURN_EMPTY;
}

XS_INTERNAL(XS_main_get_mock_cxx_dtor_calls) {
    dVAR;
    dXSARGS;
    if (items != 0)
        croak_xs_usage(cv, "");
    {
        int RETVAL;
        dXSTARG;
        RETVAL = get_mock_cxx_dtor_calls();
        TARGi((IV)RETVAL, 1);
        ST(0) = TARG;
    }
    XSRETURN(1);
}

/**
 * @brief Helper to verify if a VTable belongs to the Affix system (v1 or v2).
 */
int is_v2_vtable(MGVTBL * v) {
    if (!v)
        return 0;
    return (v == &vtbl_sint8 || v == &vtbl_uint8 || v == &vtbl_sint16 || v == &vtbl_uint16 || v == &vtbl_sint32 ||
            v == &vtbl_uint32 || v == &vtbl_sint64 || v == &vtbl_uint64 || v == &vtbl_sint128 || v == &vtbl_uint128 ||
            v == &vtbl_float || v == &vtbl_double || v == &vtbl_float16 || v == &vtbl_bool || v == &vtbl_void ||
            v == &vtbl_bitfield || v == &vtbl_pointer || v == &vtbl_array || v == &string_vtable ||
            v == &wstring_vtable || v == &vtbl_lazy_aggregate || v == &vtbl_enum || v == &vtbl_buffer);
}

/**
 * @brief Internal helper to safely extract a pointer address from a Perl scalar.
 * @details This function handles Affix::Memory objects, v2.0 magical Pins, and
 * raw integers. It includes logic to handle Pointer[Void] correctly by
 * suppressing the dereference that is normally required for typed pointers.
 *
 * @param sv The Perl Scalar to inspect.
 * @param ignore_mg A specific magic pointer to skip (prevents self-extraction during assignment).
 * @return The raw C pointer address, or NULL if extraction fails.
 */
void * _extract_pointer_value(pTHX_ SV * sv, MAGIC * ignore_mg) {
    if (!sv)
        return nullptr;

    // Use a secondary pointer for unwrapping to preserve the original SV (the potential object)
    SV * target = sv;
    if (SvROK(sv))
        target = SvRV(sv);

    /* Handle Magic Pins (even inside blessed objects) */
    if (SvMAGICAL(target)) {
        MAGIC * mg = mg_find(target, PERL_MAGIC_ext);
        while (mg) {
            if (is_v2_vtable(mg->mg_virtual) && mg != ignore_mg) {
                Affix_Pin_2_Point_Oh * im = (Affix_Pin_2_Point_Oh *)mg->mg_ptr;
                if (mg->mg_virtual == &vtbl_pointer)
                    return im->absolute ? im->ptr : (im->ptr ? *(void **)im->ptr : nullptr);
                return im->ptr;
            }
            mg = mg->mg_moremagic;
        }
    }

    /* Handle Affix::Memory Handles */
    if (sv_isobject(sv) && sv_derived_from(sv, "Affix::Memory")) {
        SV * rv = SvRV(sv);
        if (SvTYPE(rv) == SVt_PVAV) {
            SV ** p = av_fetch((AV *)rv, 0, 0);
            return (p && *p) ? INT2PTR(void *, SvUV(*p)) : nullptr;
        }
        return INT2PTR(void *, SvUV(rv));
    }

    /* Fallback: Raw Integers */
    if (SvIOK(sv))
        return INT2PTR(void *, SvUV(sv));

    return nullptr;
}