view release on metacpan or  search on metacpan

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

        return 0;
    const infix_type * type = resolve_type(aTHX_ im->type);
    SvGMAGICAL_off(sv);
    uint64_t val = 0;
    size_t sz = type->size;
    if (sz == 1)
        memcpy(&val, im->ptr, 1);
    else if (sz == 2)
        memcpy(&val, im->ptr, 2);
    else if (sz == 4)
        memcpy(&val, im->ptr, 4);
    else if (sz == 8)
        memcpy(&val, im->ptr, 8);
    /* Calculate bitmask and apply overflow protection */
    uint64_t wmask = (im->bit_width == 64) ? ~0ULL : ((1ULL << im->bit_width) - 1);
    uint64_t mask = wmask << im->bit_offset;
    uint64_t new_bits = (SvUV(sv) & wmask) << im->bit_offset;
    val = (val & ~mask) | new_bits;
    if (sz == 1)
        memcpy(im->ptr, &val, 1);
    else if (sz == 2)
        memcpy(im->ptr, &val, 2);
    else if (sz == 4)
        memcpy(im->ptr, &val, 4);
    else if (sz == 8)
        memcpy(im->ptr, &val, 8);
    SvGMAGICAL_on(sv);
    return 0;
}

MGVTBL vtbl_bitfield = {get_bitfield, set_bitfield, nullptr, nullptr, free_v2_pin};

/**
 * @brief Universal closure trampoline for FFI Perl callbacks attached to Structs.
 * @details This function is invoked from native C space when a callback fires. It converts
 * the raw C arguments back into Perl variables using VTable magic, executes
 * the Perl subroutine, and marshals the result back into the expected C return type.
 */
void perl_universal_closure(infix_context_t * ctx, void * ret, void ** args) {
    dTHX;
    dSP;
    CV * perl_sub = (CV *)infix_reverse_get_user_data(ctx);
    size_t n = infix_reverse_get_num_args(ctx);

    ENTER;
    SAVETMPS;
    PUSHMARK(SP);

    /* Push C arguments onto the Perl Stack using Affix 2.0 pull handlers */
    for (size_t i = 0; i < n; i++) {
        const infix_type * type = infix_reverse_get_arg_type(ctx, i);
        Affix_Pull puller = get_pull_handler(aTHX_ type);

        if (!puller)
            croak("Unsupported struct callback argument type");

        SV * arg_sv = newSV(0);
        puller(aTHX_ nullptr, arg_sv, type, args[i], false);
        mXPUSHs(arg_sv);
    }
    PUTBACK;

    const infix_type * ret_type = infix_reverse_get_return_type(ctx);
    U32 call_flags = G_KEEPERR | ((ret_type->category == INFIX_TYPE_VOID) ? G_VOID : G_SCALAR);

    size_t count = call_sv((SV *)perl_sub, call_flags);
    SPAGAIN;

    /* Retrieve Perl return value and pass it back to C using Affix 2.0 push handlers */
    if (SvTRUE(ERRSV)) {
        Perl_warn(aTHX_ "Perl struct callback died: %" SVf, ERRSV);
        sv_setsv(ERRSV, &PL_sv_undef);
        if (ret && !(call_flags & G_VOID))
            memset(ret, 0, infix_type_get_size(ret_type));
    }
    else if (call_flags & G_SCALAR) {
        SV * return_sv = (count == 1) ? POPs : &PL_sv_undef;
        sv2ptr(aTHX_ nullptr, return_sv, ret, ret_type);
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
}

void pull_pointer_as_callable(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
    void * c_ptr = *(void **)p;
    if (c_ptr == nullptr) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

    const infix_type * pointee = type;
    if (type->category == INFIX_TYPE_POINTER)
        pointee = resolve_type(aTHX_ type->meta.pointer_info.pointee_type);

    SV * wrapper = wrap_callable_pointer(aTHX_ c_ptr, pointee);
    sv_setsv(sv, wrapper);
    SvREFCNT_dec(wrapper);
}

/**
 * @brief Dynamically wraps a C function pointer into a callable Perl Subroutine.
 */
SV * wrap_callable_pointer(pTHX_ void * addr, const infix_type * type) {
    if (!addr)
        return newSV(0);

    char sig[512];
    /* Serialize the AST back into a string signature */
    if (infix_type_print(sig, sizeof(sig), type, INFIX_DIALECT_SIGNATURE) != INFIX_SUCCESS) {
        warn("Affix: failed to serialize callback type signature, wrapping as raw pointer");
        return newSVuv(PTR2UV(addr));
    }

    /* Strip the callback indicator '!' so Affix::wrap treats it as a standard function */
    char * sig_ptr = sig;
    if (sig_ptr[0] == '!')
        sig_ptr++;

    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    EXTEND(SP, 2);
    /* Push arguments for Affix::wrap($address, $signature_string) */
    PUSHs(sv_2mortal(newSVuv(PTR2UV(addr))));
    PUSHs(sv_2mortal(newSVpv(sig_ptr, 0)));
    PUTBACK;

    int count = call_pv("Affix::wrap", G_SCALAR);
    SPAGAIN;

    SV * ret = newSV(0);
    if (count == 1) {
        SV * wrapped = POPs;
        if (SvOK(wrapped))
            sv_setsv(ret, wrapped);
        else
            sv_setuv(ret, PTR2UV(addr));
    }
    else {
        sv_setuv(ret, PTR2UV(addr));
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return ret;
}

int get_ptr(pTHX_ SV * sv, MAGIC * mg) {
    Affix_Pin_2_Point_Oh * im = (Affix_Pin_2_Point_Oh *)mg->mg_ptr;
    SvSMAGICAL_off(sv);

    /* If it's absolute (malloc/cast/pin), im->ptr is the memory address of the data.
       If it's relative (struct member), im->ptr is the address of a pointer variable. */
    void * addr = im->absolute ? im->ptr : (im->ptr ? *(void **)im->ptr : nullptr);

    if (!addr) {
        sv_setsv(sv, &PL_sv_undef);
    }
    else {
        const infix_type * res = resolve_type(aTHX_ im->type);

        /* Detect terminal pointers (String, StringList, Callback, etc.) */
        Affix_Pull puller = get_pull_handler(aTHX_ res);
        if (puller && puller != pull_pointer_as_pin) {
            puller(aTHX_ nullptr, sv, res, &addr, im->readonly);
        }
        else {
            /* If the type is a pointer, step down one level. */
            const infix_type * pointee =
                (res->category == INFIX_TYPE_POINTER) ? res->meta.pointer_info.pointee_type : res;

            /* WString (wchar_t*): convert the wide string to a Perl UTF-8 string.
               Only uint16/uint32 pointers whose width matches wchar_t are treated
               as WString, mirroring the marshaling in get_opcode_for_type. */
            if (pointee->category == INFIX_TYPE_PRIMITIVE && pointee->size == sizeof(wchar_t) &&
                (pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT16 ||
                 pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT32)) {
                size_t el_sz = pointee->size;
                wchar_t * ws = (wchar_t *)addr;
                size_t act = 0;
                while (el_sz == 2 ? ((uint16_t *)ws)[act] : ((uint32_t *)ws)[act])
                    act++;
                U8 * buf = (U8 *)safemalloc(act * UTF8_MAXBYTES + 1);
                U8 * d = buf;
                for (size_t i = 0; i < act; i++) {
                    UV cp = (el_sz == 2) ? ((uint16_t *)ws)[i] : ((uint32_t *)ws)[i];
                    if (el_sz == 2 && cp >= 0xD800 && cp <= 0xDBFF && i + 1 < act) {
                        uint16_t low = ((uint16_t *)ws)[i + 1];
                        if (low >= 0xDC00 && low <= 0xDFFF) {
                            cp = 0x10000 + (((cp - 0xD800) << 10) | (low - 0xDC00));
                            i++;
                        }
                    }
                    d = uvchr_to_utf8(d, cp);
                }
                *d = '\0';
                sv_setpvn(sv, (char *)buf, d - buf);
                SvUTF8_on(sv);
                safefree(buf);
            }
            else {