view release on metacpan or  search on metacpan

lib/Affix.c  view on Meta::CPAN

    warn("Affix::free called on an unmanaged pointer");
    XSRETURN_NO;
}

XS_INTERNAL(Affix_cast) {
    dXSARGS;
    dMY_CXT;
    if (items != 2)
        croak_xs_usage(cv, "pointer_or_address, new_type_signature");

    /* Extract the raw address from input (Handle, Pin, or Integer) */
    SV * arg = ST(0);
    void * ptr_val = get_address_v2(aTHX_ arg);
    if (!ptr_val)
        XSRETURN_UNDEF;

    /* Resolve the signature string */
    SV * type_sv = ST(1);
    const char * signature = _get_string_from_type_obj(aTHX_ type_sv);
    if (!signature)
        signature = SvPV_nolen(type_sv);

    /* Determine Return Strategy: Value (Copy) vs Reference (Pin) */
    bool return_as_value = false;
    bool is_string_type = false;

    // Check if the type object is a Const wrapper
    bool readonly = _is_const_obj(aTHX_ type_sv);

    /* Resolve the type object and create an arena if it's a dynamic signature */
    infix_type * new_type = nullptr;
    infix_arena_t * parse_arena = nullptr;

    if (infix_type_from_signature(&new_type, &parse_arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
        SV * err_sv = _format_parse_error(aTHX_ "for cast", signature, infix_get_last_error());
        warn_sv(err_sv);
        if (parse_arena)
            infix_arena_destroy(parse_arena);
        XSRETURN_UNDEF;
    }

    const infix_type * resolved = resolve_type(aTHX_ new_type);

    if (resolved->category == INFIX_TYPE_PRIMITIVE || resolved->category == INFIX_TYPE_ENUM) {
        return_as_value = true;
    }
    else if (resolved->category == INFIX_TYPE_POINTER) {
        const infix_type * pointee = resolve_type(aTHX_ resolved->meta.pointer_info.pointee_type);

        /* char* or uchar* are returned as Perl strings immediately */
        if (pointee->category == INFIX_TYPE_PRIMITIVE &&
            (pointee->meta.primitive_id == INFIX_PRIMITIVE_SINT8 ||
             pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT8)) {
            return_as_value = true;
            is_string_type = true;
        }
    }

    /* Determine the owner lifeline */
    /* This ensures that if we cast memory inside an Affix::Memory block,
       the block stays alive as long as this casted variable exists. */
    SV * owner = _borrow_lifeline(aTHX_ arg);

    /* Execution */
    if (return_as_value) {
        SV * ret_val = sv_newmortal();
        if (is_string_type)  // String pullers expect char**, so we pass the address of our pointer
            ptr2sv(aTHX_ nullptr, &ptr_val, ret_val, new_type, readonly);
        else  // Primitives expect the address of the data
            ptr2sv(aTHX_ nullptr, ptr_val, ret_val, new_type, readonly);

        /* If we parsed an anonymous signature, we can destroy the arena now
           since we copied the data out into a standard Perl scalar. */
        if (parse_arena)
            infix_arena_destroy(parse_arena);

        ST(0) = ret_val;
    }
    else {
        /* Reference path: Create a magic-bound variable pointing to the memory */
        SV * ret_val;
        infix_type_category cat = resolved->category;

        if (cat == INFIX_TYPE_STRUCT || cat == INFIX_TYPE_UNION || cat == INFIX_TYPE_ARRAY ||
            cat == INFIX_TYPE_VECTOR || cat == INFIX_TYPE_COMPLEX) {
            /* Aggregate binder handles the arena lifecycle automatically.
               If parse_arena is provided, it is freed when the Perl SV is destroyed. */
            ret_val = bind_aggregate_anon(aTHX_ ptr_val, new_type, owner, parse_arena, readonly);
            ST(0) = sv_2mortal(ret_val);
        }
        else {
            /* Fallback for generic pointers */
            ret_val = newSV(0);
            const infix_type * bind_type = new_type;

            /* If it's a pointer, we typically want to bind to the pointee
               so that $$var works correctly. */
            if (new_type->category == INFIX_TYPE_POINTER)
                bind_type = _unwrap_pin_type(new_type);

            bind_placeholder(aTHX_ ret_val, ptr_val, bind_type, 0, 0, true, owner, parse_arena, readonly, true);
            ST(0) = sv_2mortal(newRV_noinc(ret_val));
        }
    }

    XSRETURN(1);
}


XS_INTERNAL(Affix_attach_destructor) {
    dXSARGS;
    if (items < 2)
        croak_xs_usage(cv, "pin, destructor_ptr, [lib_obj]");

    Affix_Pin_2_Point_Oh * pin = get_pin_v2(aTHX_ ST(0));
    if (!pin) {
        warn("First argument to attach_destructor must be a pinned pointer");
        XSRETURN_UNDEF;
    }

    void * destructor_ptr = nullptr;