Affix

 view release on metacpan or  search on metacpan

lib/Affix.c  view on Meta::CPAN

static const Affix_Step_Executor primitive_executors[] = {
    [INFIX_PRIMITIVE_BOOL] = plan_step_push_bool,
    [INFIX_PRIMITIVE_SINT8] = plan_step_push_sint8,
    [INFIX_PRIMITIVE_UINT8] = plan_step_push_uint8,
    [INFIX_PRIMITIVE_SINT16] = plan_step_push_sint16,
    [INFIX_PRIMITIVE_UINT16] = plan_step_push_uint16,
    [INFIX_PRIMITIVE_SINT32] = plan_step_push_sint32,
    [INFIX_PRIMITIVE_UINT32] = plan_step_push_uint32,
    [INFIX_PRIMITIVE_SINT64] = plan_step_push_sint64,
    [INFIX_PRIMITIVE_UINT64] = plan_step_push_uint64,
    [INFIX_PRIMITIVE_FLOAT16] = plan_step_push_float16,
    [INFIX_PRIMITIVE_FLOAT] = plan_step_push_float,
    [INFIX_PRIMITIVE_DOUBLE] = plan_step_push_double,
    [INFIX_PRIMITIVE_LONG_DOUBLE] = plan_step_push_long_double,
#if !defined(INFIX_COMPILER_MSVC)
    [INFIX_PRIMITIVE_SINT128] = plan_step_push_sint128,
    [INFIX_PRIMITIVE_UINT128] = plan_step_push_uint128,
#endif
};

static const Affix_Push_Handler primitive_push_handlers[] = {
    [INFIX_PRIMITIVE_BOOL] = push_handler_bool,
    [INFIX_PRIMITIVE_SINT8] = push_handler_sint8,
    [INFIX_PRIMITIVE_UINT8] = push_handler_uint8,
    [INFIX_PRIMITIVE_SINT16] = push_handler_sint16,
    [INFIX_PRIMITIVE_UINT16] = push_handler_uint16,
    [INFIX_PRIMITIVE_SINT32] = push_handler_sint32,
    [INFIX_PRIMITIVE_UINT32] = push_handler_uint32,
    [INFIX_PRIMITIVE_SINT64] = push_handler_sint64,
    [INFIX_PRIMITIVE_UINT64] = push_handler_uint64,
    [INFIX_PRIMITIVE_FLOAT16] = push_handler_float16,
    [INFIX_PRIMITIVE_FLOAT] = push_handler_float,
    [INFIX_PRIMITIVE_DOUBLE] = push_handler_double,
    [INFIX_PRIMITIVE_LONG_DOUBLE] = push_handler_long_double,
#ifdef __SIZEOF_INT128__
    [INFIX_PRIMITIVE_SINT128] = push_handler_sint128,
    [INFIX_PRIMITIVE_UINT128] = push_handler_uint128,
#endif
};
static void plan_step_push_pointer(pTHX_ Affix * affix,
                                   Affix_Plan_Step * step,
                                   SV ** perl_stack_frame,
                                   void * args_buffer,
                                   void ** c_args,
                                   void * ret_buffer) {

    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;

    void * addr = get_address_v2(aTHX_ sv);
    if (addr) {
        *(void **)c_arg_ptr = addr;
        return;
    }

    const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
    if (pointee_type == nullptr)
        croak("Internal error in push_pointer: pointee_type is nullptr");

    if (!SvOK(sv)) {
        if (!SvREADONLY(sv)) {
            size_t size = infix_type_get_size(pointee_type);
            size_t align = infix_type_get_alignment(pointee_type);

            if (size == 0) {
                size = sizeof(void *);
                align = _Alignof(void *);
            }

            void * temp_slot = infix_arena_alloc(affix->call_args_arena, size, align > 0 ? align : 1);
            memset(temp_slot, 0, size);
            *(void **)c_arg_ptr = temp_slot;
            return;
        }

        *(void **)c_arg_ptr = nullptr;
        return;
    }

    if (SvIOK(sv)) {  // Treat integer value as a raw memory address
        *(void **)c_arg_ptr = INT2PTR(void *, SvUV(sv));
        return;
    }

    const char * type_name = infix_type_get_name(type);
    if (!type_name && type->category == INFIX_TYPE_NAMED_REFERENCE)
        type_name = type->meta.named_reference.name;
    if ((type_name &&
         (strEQ(type_name, "Buffer") || strEQ(type_name, "@Buffer") || strEQ(type_name, "SockAddr") ||
          strEQ(type_name, "@SockAddr") || strEQ(type_name, "StringList") || strEQ(type_name, "@StringList"))) ||
        (is_string_list_type(aTHX_ type) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)) {
        sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
        return;
    }

    const char * pointee_name = infix_type_get_name(pointee_type);
    if (!pointee_name && pointee_type->category == INFIX_TYPE_NAMED_REFERENCE)
        pointee_name = pointee_type->meta.named_reference.name;
    if (pointee_name &&
        (strEQ(pointee_name, "File") || strEQ(pointee_name, "@File") || strEQ(pointee_name, "PerlIO") ||
         strEQ(pointee_name, "@PerlIO"))) {
        sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
        return;
    }

    if (pointee_type->category == INFIX_TYPE_REVERSE_TRAMPOLINE &&
        (SvTYPE(sv) == SVt_PVCV || (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV))) {
        push_reverse_trampoline(aTHX_ affix, pointee_type, sv, c_arg_ptr);
        return;
    }
    if (SvROK(sv)) {
        SV * const rv = SvRV(sv);
        if (pointee_type->category == INFIX_TYPE_POINTER) {
            const infix_type * inner_pointee_type = pointee_type->meta.pointer_info.pointee_type;
            if (inner_pointee_type->category == INFIX_TYPE_PRIMITIVE &&
                (inner_pointee_type->meta.primitive_id == INFIX_PRIMITIVE_SINT8 ||
                 inner_pointee_type->meta.primitive_id == INFIX_PRIMITIVE_UINT8)) {
                if (SvPOK(rv)) {
                    char ** ptr_slot =
                        (char **)infix_arena_alloc(affix->call_args_arena, sizeof(char *), _Alignof(char *));
                    *ptr_slot = SvPV_nolen(rv);
                    *(void **)c_arg_ptr = ptr_slot;
                    return;
                }
            }
        }
        if (SvTYPE(rv) == SVt_PVAV) {
            AV * av = (AV *)rv;
            size_t len = av_len(av) + 1;
            size_t element_size = infix_type_get_size(pointee_type);
            if (element_size > 0 && len > SIZE_MAX / element_size)
                croak("Array size overflow: %zu elements * %zu bytes", len, element_size);
            size_t total_size = len * element_size;
            char * c_array = (char *)infix_arena_alloc(affix->call_args_arena, total_size, _Alignof(void *));
            if (!c_array)
                croak("Failed to allocate from arena for array marshalling");
            memset(c_array, 0, total_size);
            for (size_t i = 0; i < len; ++i) {
                SV ** elem_sv_ptr = av_fetch(av, i, 0);
                if (elem_sv_ptr)
                    sv2ptr(aTHX_ affix, *elem_sv_ptr, c_array + (i * element_size), pointee_type);
            }
            *(void **)c_arg_ptr = c_array;
            return;
        }
        const infix_type * copy_type = (pointee_type->category == INFIX_TYPE_VOID)
            ? (SvIOK(rv)       ? infix_type_create_primitive(INFIX_PRIMITIVE_SINT64)
                   : SvNOK(rv) ? infix_type_create_primitive(INFIX_PRIMITIVE_DOUBLE)
                   : SvPOK(rv) ? (*(void **)c_arg_ptr = SvPV_nolen(rv), (infix_type *)nullptr)
                               : (croak("Cannot pass reference to this type of scalar for a 'void*' parameter"),
                                  (infix_type *)nullptr))
            : pointee_type;
        if (!copy_type)
            return;
        void * dest_c_ptr = infix_arena_alloc(
            affix->call_args_arena, infix_type_get_size(copy_type), infix_type_get_alignment(copy_type));
        SV * sv_to_marshal = (SvTYPE(rv) == SVt_PVHV) ? sv : rv;
        sv2ptr(aTHX_ affix, sv_to_marshal, dest_c_ptr, copy_type);
        *(void **)c_arg_ptr = dest_c_ptr;
        return;
    }
    if (SvPOK(sv)) {
        bool is_char_ptr = (pointee_type->category == INFIX_TYPE_PRIMITIVE &&
                            (pointee_type->meta.primitive_id == INFIX_PRIMITIVE_SINT8 ||
                             pointee_type->meta.primitive_id == INFIX_PRIMITIVE_UINT8));
        bool is_void_ptr = (pointee_type->category == INFIX_TYPE_VOID);
        if (is_char_ptr || is_void_ptr) {
            *(const char **)c_arg_ptr = SvPV_nolen(sv);
            return;
        }
    }
    sv_dump(sv);
    char signature_buf[256];
    if (infix_type_print(signature_buf, sizeof(signature_buf), (infix_type *)type, INFIX_DIALECT_SIGNATURE) !=
        INFIX_SUCCESS) {
        strncpy(signature_buf, "[error printing type]", sizeof(signature_buf) - 1);
        signature_buf[sizeof(signature_buf) - 1] = '\0';
    }
    croak("Don't know how to handle this type of scalar as a pointer argument yet: %s", signature_buf);
}

static void plan_step_push_struct(pTHX_ Affix * affix,
                                  Affix_Plan_Step * step,
                                  SV ** perl_stack_frame,
                                  void * args_buffer,
                                  void ** c_args,
                                  void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;
    push_struct(aTHX_ affix, type, sv, c_arg_ptr);
}

static void plan_step_push_union(pTHX_ Affix * affix,
                                 Affix_Plan_Step * step,
                                 SV ** perl_stack_frame,
                                 void * args_buffer,
                                 void ** c_args,
                                 void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;
    push_union(aTHX_ affix, type, sv, c_arg_ptr);
}

static void plan_step_push_array(pTHX_ Affix * affix,
                                 Affix_Plan_Step * step,
                                 SV ** perl_stack_frame,
                                 void * args_buffer,
                                 void ** c_args,
                                 void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];

    // args_buffer slot is sizeof(void*) because we substituted Pointer for Array in the JIT
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;

    // Handle nullptr/Undef
    if (!SvOK(sv)) {
        *(void **)c_arg_ptr = nullptr;
        return;
    }

    const infix_type * element_type = type->meta.array_info.element_type;
    size_t element_size = infix_type_get_size(element_type);

    if (SvPOK(sv) && element_type->category == INFIX_TYPE_PRIMITIVE && element_size == 1) {
        STRLEN len;
        const char * s = SvPV(sv, len);

lib/Affix.c  view on Meta::CPAN

                                SV ** perl_stack_frame,
                                void * args_buffer,
                                void ** c_args,
                                void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;
    sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
}

static void plan_step_push_complex(pTHX_ Affix * affix,
                                   Affix_Plan_Step * step,
                                   SV ** perl_stack_frame,
                                   void * args_buffer,
                                   void ** c_args,
                                   void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;
    if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
        croak("Expected an ARRAY reference with two numbers for complex type marshalling");
    AV * av = (AV *)SvRV(sv);
    if (av_len(av) != 1)
        croak("Expected exactly two elements (real, imaginary) for complex type");
    const infix_type * base_type = type->meta.complex_info.base_type;
    size_t base_size = infix_type_get_size(base_type);
    SV ** real_sv_ptr = av_fetch(av, 0, 0);
    SV ** imag_sv_ptr = av_fetch(av, 1, 0);
    if (!real_sv_ptr || !imag_sv_ptr)
        croak("Failed to fetch real or imaginary part from array for complex type");
    sv2ptr(aTHX_ affix, *real_sv_ptr, c_arg_ptr, base_type);
    sv2ptr(aTHX_ affix, *imag_sv_ptr, (char *)c_arg_ptr + base_size, base_type);
}

static void plan_step_push_vector(pTHX_ Affix * affix,
                                  Affix_Plan_Step * step,
                                  SV ** perl_stack_frame,
                                  void * args_buffer,
                                  void ** c_args,
                                  void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;

    // If it's a string, assume it's a packed buffer (e.g. pack 'f4')
    // and copy it directly. This is much faster than iterating an AV.
    if (SvPOK(sv)) {
        STRLEN len;
        const char * buf = SvPV(sv, len);
        size_t expected_size = infix_type_get_size(type);
        if (len >= expected_size) {
            memcpy(c_arg_ptr, buf, expected_size);
            return;
        }
        // If string is too short, fall through to AV check or error
    }

    if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
        croak("Expected an ARRAY reference or Packed String for vector marshalling");
    AV * av = (AV *)SvRV(sv);
    size_t num_elements = av_len(av) + 1;
    size_t c_vector_len = type->meta.vector_info.num_elements;
    if (num_elements != c_vector_len)
        croak("Perl array has %lu elements, but C vector type requires %lu.",
              (unsigned long)num_elements,
              (unsigned long)c_vector_len);
    const infix_type * element_type = type->meta.vector_info.element_type;
    size_t element_size = infix_type_get_size(element_type);
    for (size_t i = 0; i < num_elements; ++i) {
        SV ** element_sv_ptr = av_fetch(av, i, 0);
        if (element_sv_ptr) {
            void * element_ptr = (char *)c_arg_ptr + (i * element_size);
            sv2ptr(aTHX_ affix, *element_sv_ptr, element_ptr, element_type);
        }
    }
}

static void plan_step_push_sv(pTHX_ Affix * affix,
                              Affix_Plan_Step * step,
                              SV ** perl_stack_frame,
                              void * args_buffer,
                              void ** c_args,
                              void * ret_buffer) {
    PERL_UNUSED_VAR(affix);
    PERL_UNUSED_VAR(ret_buffer);
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;
    *(void **)c_arg_ptr = sv;
}

static void plan_step_push_callback(pTHX_ Affix * affix,
                                    Affix_Plan_Step * step,
                                    SV ** perl_stack_frame,
                                    void * args_buffer,
                                    void ** c_args,
                                    void * ret_buffer) {
    PERL_UNUSED_VAR(ret_buffer);
    const infix_type * type = step->data.type;
    SV * sv = perl_stack_frame[step->data.index];
    void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
    c_args[step->data.index] = c_arg_ptr;
    push_reverse_trampoline(aTHX_ affix, type, sv, c_arg_ptr);
}

static void plan_step_call_c_function(pTHX_ Affix * affix,
                                      Affix_Plan_Step * step,
                                      SV ** perl_stack_frame,
                                      void * args_buffer,
                                      void ** c_args,
                                      void * ret_buffer) {
    PERL_UNUSED_VAR(step);
    PERL_UNUSED_VAR(perl_stack_frame);
    PERL_UNUSED_VAR(args_buffer);
    affix->cif(ret_buffer, c_args);

lib/Affix.c  view on Meta::CPAN

    Newxz(new_affix, 1, Affix);

    //~ warn("Affix_cv_dup: old=%p -> new=%p", old_affix, new_affix);

    /* Basic copy of metadata */
    new_affix->num_args = old_affix->num_args;
    new_affix->plan_length = old_affix->plan_length;
    new_affix->total_args_size = old_affix->total_args_size;
    new_affix->ret_opcode = old_affix->ret_opcode;
    new_affix->num_out_params = old_affix->num_out_params;
    new_affix->num_fixed_args = old_affix->num_fixed_args;
    new_affix->ret_readonly = old_affix->ret_readonly;

    /* Reconstruct strings */
    if (old_affix->sig_str)
        new_affix->sig_str = savepv(old_affix->sig_str);
    if (old_affix->sym_name)
        new_affix->sym_name = savepv(old_affix->sym_name);
    new_affix->target_addr = old_affix->target_addr;

    new_affix->infix = nullptr;
    new_affix->args_arena = nullptr;
    new_affix->ret_arena = nullptr;
    new_affix->call_args_arena = nullptr;
    new_affix->call_ret_arena = nullptr;
    new_affix->c_args = nullptr;
    new_affix->plan = nullptr;
    new_affix->out_param_info = nullptr;
    new_affix->return_sv = nullptr;
    new_affix->variadic_cache = nullptr;  // Don't copy cache, let it rebuild

    mg->mg_ptr = (char *)new_affix;

#ifdef MULTIPLICITY
    new_affix->owner_perl = aTHX;
#endif

    // Update the new CV's fast access pointer
    CV * new_cv = (CV *)mg->mg_obj;
    CvXSUBANY(new_cv).any_ptr = (void *)new_affix;

    return 1;
}

// Helper to rebuild Affix data in the new thread
static void rebuild_affix_data(pTHX_ Affix * affix) {
    //~ warn("rebuild_affix_data: %p", affix);
    dMY_CXT;
    infix_arena_t * parse_arena = nullptr;
    infix_type * ret_type = nullptr;
    infix_function_argument * args = nullptr;
    size_t num_args = 0, num_fixed = 0;

    // Re-parse signature using THIS thread's registry
    infix_status status =
        infix_signature_parse(affix->sig_str, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);

    if (status != INFIX_SUCCESS) {
        if (parse_arena)
            infix_arena_destroy(parse_arena);
        croak("Affix failed to rebuild in new thread: signature parse error");
    }

    // Prepare JIT types (handle array decay)
    infix_type ** jit_arg_types = nullptr;
    if (num_args > 0) {
        jit_arg_types = safemalloc(sizeof(infix_type *) * num_args);
        for (size_t i = 0; i < num_args; ++i) {
            infix_type * t = args[i].type;
            if (t->category == INFIX_TYPE_ARRAY) {
                infix_type * ptr_type = nullptr;
                status = infix_type_create_pointer_to(parse_arena, &ptr_type, t->meta.array_info.element_type);
                if (status != INFIX_SUCCESS) {
                    if (parse_arena)
                        infix_arena_destroy(parse_arena);
                    croak("Affix failed to rebuild in new thread: type clone error");
                }
                jit_arg_types[i] = ptr_type;
            }
            else
                jit_arg_types[i] = t;
        }
    }

    // Create trampoline
    status =
        infix_forward_create_manual(&affix->infix, ret_type, jit_arg_types, num_args, num_fixed, affix->target_addr);

    if (jit_arg_types)
        safefree(jit_arg_types);

    if (status != INFIX_SUCCESS) {
        infix_arena_destroy(parse_arena);
        croak("Affix failed to rebuild trampoline in new thread");
    }

    affix->cif = infix_forward_get_code(affix->infix);
    affix->ret_type = infix_forward_get_return_type(affix->infix);
    affix->unwrapped_ret_type = _unwrap_pin_type(affix->ret_type);
    affix->ret_pull_handler = get_pull_handler(aTHX_ affix->ret_type);
    // affix->ret_opcode is already set from parent, but safe to assume it matches

    // Allocate arenas & SV
    affix->args_arena = infix_arena_create(4096);
    affix->ret_arena = infix_arena_create(1024);
    affix->return_sv = newSV(0);
    if (affix->num_args > 0)
        Newx(affix->c_args, affix->num_args, void *);

    affix->variadic_cache = newHV();

    // Rebuild plan
    Newxz(affix->plan, affix->plan_length + 1, Affix_Plan_Step);

    size_t out_param_count = 0;
    OutParamInfo * temp_out_info = safemalloc(sizeof(OutParamInfo) * (affix->num_args > 0 ? affix->num_args : 1));
    size_t current_offset = 0;

    for (size_t i = 0; i < affix->num_args; ++i) {
        // Deep copy types from parse_arena to persistent args_arena
        const infix_type * original_type = _copy_type_graph_to_arena(affix->args_arena, args[i].type);

        // Recalculate offsets (logic duplication from Affix_affix, but necessary)
        size_t alignment, size;
        if (original_type->category == INFIX_TYPE_ARRAY) {
            alignment = _Alignof(void *);
            size = sizeof(void *);
        }
        else {
            alignment = infix_type_get_alignment(original_type);
            size = infix_type_get_size(original_type);
        }
        if (alignment == 0)
            alignment = 1;

        current_offset = (current_offset + alignment - 1) & ~(alignment - 1);

lib/Affix.c  view on Meta::CPAN

            bool is_sv_pointer = pointee_name && (strEQ(pointee_name, "SV") || strEQ(pointee_name, "@SV"));

            if (!is_sv_pointer && pointee->category != INFIX_TYPE_REVERSE_TRAMPOLINE &&
                pointee->category != INFIX_TYPE_VOID) {
                temp_out_info[out_param_count].perl_stack_index = i;
                temp_out_info[out_param_count].pointee_type = pointee;
                temp_out_info[out_param_count].writer = get_out_param_writer(pointee);
                out_param_count++;
            }
        }
        else if (original_type->category == INFIX_TYPE_ARRAY) {
            temp_out_info[out_param_count].perl_stack_index = i;
            temp_out_info[out_param_count].pointee_type = original_type;
            temp_out_info[out_param_count].writer = affix_array_writeback;
            out_param_count++;
        }
    }
    affix->plan[affix->num_args].opcode = OP_DONE;

    // Setup OUT params
    if (out_param_count > 0) {
        affix->out_param_info = safemalloc(sizeof(OutParamInfo) * out_param_count);
        memcpy(affix->out_param_info, temp_out_info, sizeof(OutParamInfo) * out_param_count);
    }
    safefree(temp_out_info);

    // Done. parse_arena can go.
    infix_arena_destroy(parse_arena);
}


static MGVTBL Affix_cv_vtbl = {0, 0, 0, 0, Affix_cv_free, 0, Affix_cv_dup, 0};

static MGVTBL Affix_coercion_vtbl = {0};  // Marker vtable for coerced values

// Centralized helper to check if an SV is a Const type object
static bool _is_const_obj(pTHX_ SV * sv) {
    if (!sv || !SvOK(sv))
        return false;
    if (sv_isobject(sv) && sv_derived_from(sv, "Affix::Type::Const"))
        return true;
    return false;
}

// Helper to extract the signature string from a coerced SV
static const char * _get_coerced_sig(pTHX_ SV * sv) {
    if (SvMAGICAL(sv)) {
        MAGIC * mg = mg_findext(sv, PERL_MAGIC_ext, &Affix_coercion_vtbl);
        if (mg && mg->mg_ptr)
            return mg->mg_ptr;
    }
    return nullptr;
}
void Affix_trigger_variadic(pTHX_ CV * cv) {
    dSP;
    dAXMARK;
    dXSTARG;
    Affix * affix = (Affix *)CvXSUBANY(cv).any_ptr;
    I32 items_raw = SP - MARK;
    if (items_raw < 0)
        croak("Affix: internal error, negative argument count");
    size_t items = (size_t)items_raw;

    /* Fiber-safe arena setup (see GENERATE_TRIGGER_XSUB for rationale) */
    affix->call_args_arena = infix_arena_create(4096);
    affix->call_ret_arena = infix_arena_create(1024);
    SAVEDESTRUCTOR_X(_cleanup_arena, affix->call_args_arena);
    SAVEDESTRUCTOR_X(_cleanup_arena, affix->call_ret_arena);

    // Build the dynamic signature string
    SV * sig_sv = sv_2mortal(newSVpv("", 0));
    char * semi_ptr = strchr(affix->sig_str, ';');

    // Copy the fixed portion of the signature exactly as defined
    sv_catpvn(sig_sv, affix->sig_str, (semi_ptr - affix->sig_str));
    sv_catpvs(sig_sv, ";");

    infix_arena_mark_t args_mark = infix_arena_get_mark(affix->call_args_arena);
    infix_arena_mark_t ret_mark = infix_arena_get_mark(affix->call_ret_arena);

    // Coerce variadic arguments into types
    for (size_t i = affix->num_fixed_args; i < items; ++i) {
        SV * arg = ST(i);
        SvGETMAGIC(arg);
        const char * coerced_sig = _get_coerced_sig(aTHX_ arg);

        if (i > affix->num_fixed_args)
            sv_catpvs(sig_sv, ",");

        if (coerced_sig) {
            sv_catpv(sig_sv, coerced_sig);
        }
        else if (is_pin_v2(aTHX_ arg)) {
            // Intelligent Pin Coercion: use the underlying C type
            const infix_type * res = resolve_type(aTHX_ get_pin_v2(aTHX_ arg)->type);
            char type_buf[64];
            if (infix_type_print(type_buf, sizeof(type_buf), res, INFIX_DIALECT_SIGNATURE) == INFIX_SUCCESS)
                sv_catpv(sig_sv, type_buf);
            else
                sv_catpvs(sig_sv, "*void");
        }
        else {
            // Default scalar coercion (C promotion rules)
            if (SvIOK(arg))
                sv_catpvs(sig_sv, "sint32");
            else if (SvNOK(arg))
                sv_catpvs(sig_sv, "double");
            else if (SvPOK(arg))
                sv_catpvs(sig_sv, "*char");
            else
                sv_catpvs(sig_sv, "sint32");
        }
    }

    // Finalize signature (append return type)
    sv_catpv(sig_sv, strrchr(affix->sig_str, ')'));
    const char * full_sig = SvPV_nolen(sig_sv);

    // JIT or Fetch from Cache
    // We check the variadic_cache so we don't re-compile for identical calls
    infix_forward_t * trampoline = nullptr;
    SV ** cache_entry = hv_fetch(affix->variadic_cache, full_sig, strlen(full_sig), 0);
    if (cache_entry) {
        trampoline = INT2PTR(infix_forward_t *, SvIV(*cache_entry));
    }
    else {
        // Compile a new specialized trampoline via infix
        infix_arena_t * temp_arena = nullptr;
        infix_type * ret_type;
        infix_function_argument * args;
        size_t n_args, n_fixed;
        dMY_CXT;

        if (infix_signature_parse(full_sig, &temp_arena, &ret_type, &args, &n_args, &n_fixed, MY_CXT.registry) !=
            INFIX_SUCCESS)
            croak("Internal error: Variadic JIT failed to parse signature");

        infix_type ** arg_types = safemalloc(sizeof(infix_type *) * n_args);
        for (size_t i = 0; i < n_args; ++i)
            arg_types[i] = args[i].type;

        // Note: passing n_fixed is CRITICAL for ARM64 stack placement
        if (infix_forward_create_manual(&trampoline, ret_type, arg_types, n_args, n_fixed, affix->target_addr) !=
            INFIX_SUCCESS)
            croak("Internal error: Variadic JIT failed to create trampoline");

        safefree(arg_types);
        infix_arena_destroy(temp_arena);
        hv_store(affix->variadic_cache, full_sig, strlen(full_sig), newSViv(PTR2IV(trampoline)), 0);
    }

    // Execution
    size_t c_args_size = sizeof(void *) * items;
    void ** c_args;
    if (c_args_size <= 2048)
        c_args = alloca(c_args_size);
    else {
        Newx(c_args, items, void *);
        SAVEFREEPV(c_args);
    }
    const infix_type * variadic_ret_type = infix_forward_get_return_type(trampoline);
    size_t ret_size = infix_type_get_size(variadic_ret_type);
    if (ret_size < sizeof(void *))
        ret_size = sizeof(void *);
    void * ret_buffer = infix_arena_alloc(affix->call_ret_arena, ret_size, 8);

    for (size_t i = 0; i < items; ++i) {
        const infix_type * arg_type = infix_forward_get_arg_type(trampoline, i);
        void * data = infix_arena_alloc(affix->call_args_arena, infix_type_get_size(arg_type), 8);
        sv2ptr(aTHX_ affix, ST(i), data, arg_type);
        c_args[i] = data;
    }

    infix_forward_get_code(trampoline)(ret_buffer, c_args);
    ptr2sv(aTHX_ affix, ret_buffer, TARG, infix_forward_get_return_type(trampoline), affix->ret_readonly);

    infix_arena_rewind(affix->call_args_arena, args_mark);
    infix_arena_rewind(affix->call_ret_arena, ret_mark);

    ST(0) = TARG;
    XSRETURN(1);
}

XS_INTERNAL(Affix_coerce) {
    dXSARGS;
    if (items != 2)
        croak_xs_usage(cv, "type, value_sv");

    SV * type_sv = ST(0);
    SV * target_sv = ST(1);

    if (SvREADONLY(target_sv))
        croak("Cannot coerce a read-only value");

    const char * sig = _get_string_from_type_obj(aTHX_ type_sv);
    if (!sig)
        croak("Invalid type object passed to coerce");

    // Attach magic to the SV containing the signature string
    sv_magicext(target_sv, nullptr, PERL_MAGIC_ext, &Affix_coercion_vtbl, sig, strlen(sig));

    // Return the modified SV
    ST(0) = target_sv;
    XSRETURN(1);
}

lib/Affix.c  view on Meta::CPAN

                if (next_sv_ptr) {
                    const char * next_sig = _get_string_from_type_obj(aTHX_ * next_sv_ptr);
                    if (next_sig && strEQ(next_sig, ";"))
                        continue;
                }
                if (sig_remaining < 2)
                    croak("Signature too long (buffer overflow)");
                signature_buf[sig_pos++] = ',';
                sig_remaining--;
            }
        }
        {
            const char * close_arrow = ") -> ";
            size_t ca_len = strlen(close_arrow);
            if (ca_len >= sig_remaining)
                croak("Signature too long (buffer overflow)");
            memcpy(signature_buf + sig_pos, close_arrow, ca_len);
            sig_pos += ca_len;
            sig_remaining -= ca_len;
        }
        const char * ret_sig = _get_string_from_type_obj(aTHX_ ret_sv);
        if (!ret_sig)
            croak("Invalid return type object");
        size_t ret_len = strlen(ret_sig);
        if (ret_len >= sig_remaining)
            croak("Signature too long (buffer overflow)");
        memcpy(signature_buf + sig_pos, ret_sig, ret_len);
        sig_pos += ret_len;
        signature_buf[sig_pos] = '\0';
        signature = signature_buf;
    }
    else {
        signature = _get_string_from_type_obj(aTHX_ sig_sv);
        if (!signature)
            signature = SvPV_nolen(sig_sv);
    }

    // Direct marshalling path
    if (ix == 2) {
        Affix_Backend * backend;
        Newxz(backend, 1, Affix_Backend);

        infix_arena_t * parse_arena = nullptr;
        infix_type * ret_type = nullptr;
        infix_function_argument * args = nullptr;
        size_t num_args = 0, num_fixed = 0;

        backend->ret_readonly = false;
        if (ret_sv && _is_const_obj(aTHX_ ret_sv))
            backend->ret_readonly = true;
        else if (sig_sv && _is_const_obj(aTHX_ sig_sv))
            backend->ret_readonly = true;

        infix_status status =
            infix_signature_parse(signature, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);

        if (status != INFIX_SUCCESS) {
            safefree(backend);
            if (parse_arena)
                infix_arena_destroy(parse_arena);
            infix_error_details_t err = infix_get_last_error();
            if (err.message[0] != '\0')
                warn("Failed to parse signature for affix_bundle: %s", err.message);
            else
                warn("Failed to parse signature for affix_bundle (Error Code: %d)", status);
            XSRETURN_UNDEF;
        }

        infix_direct_arg_handler_t * handlers =
            (infix_direct_arg_handler_t *)safecalloc(num_args, sizeof(infix_direct_arg_handler_t));

        for (size_t i = 0; i < num_args; ++i)
            handlers[i] = get_direct_handler_for_type(args[i].type);

        status = infix_forward_create_direct(&backend->infix, signature, symbol, handlers, MY_CXT.registry);

        safefree(handlers);
        infix_arena_destroy(parse_arena);

        if (status != INFIX_SUCCESS) {
            safefree(backend);
            infix_error_details_t err = infix_get_last_error();
            warn("Failed to create direct trampoline: %s", err.message[0] ? err.message : "Unknown Error");
            XSRETURN_UNDEF;
        }

        backend->cif = infix_forward_get_direct_code(backend->infix);
        backend->num_args = num_args;
        backend->ret_type = infix_forward_get_return_type(backend->infix);

        backend->pull_handler = get_pull_handler(aTHX_ backend->ret_type);
        backend->ret_opcode = get_ret_opcode_for_type(aTHX_ backend->ret_type);

        if (!backend->pull_handler) {
            infix_forward_destroy(backend->infix);
            safefree(backend);
            warn("Unsupported return type for affix_bundle");
            XSRETURN_UNDEF;
        }

        backend->lib_handle = created_implicit_handle ? lib_handle_for_symbol : nullptr;

        CV * cv_new =
            newXSproto_portable((ix == 0 || ix == 2) ? rename_str : nullptr, Affix_trigger_backend, __FILE__, nullptr);

        CvXSUBANY(cv_new).any_ptr = (void *)backend;

        SV * obj = (ix == 1 || ix == 3) ? newRV_noinc(MUTABLE_SV(cv_new)) : newRV_inc(MUTABLE_SV(cv_new));
        sv_bless(obj, gv_stashpv("Affix::Bundled", GV_ADD));
        ST(0) = sv_2mortal(obj);
        XSRETURN(1);
    }

    // Standard path (parse & prepare types)
    infix_arena_t * parse_arena = nullptr;
    infix_type * ret_type = nullptr;
    infix_function_argument * args = nullptr;
    size_t num_args = 0, num_fixed = 0;

    infix_status status =
        infix_signature_parse(signature, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);

    if (status != INFIX_SUCCESS) {
        infix_error_details_t err = infix_get_last_error();
        warn("Failed to parse signature: %s", err.message);
        if (parse_arena)
            infix_arena_destroy(parse_arena);
        XSRETURN_UNDEF;
    }

    // JIT Type substitution (array decay)
    // We create a separate list of types for JIT compilation where Arrays are replaced by Pointers.
    // The original Array types are kept for the marshalling plan.
    infix_type ** jit_arg_types = nullptr;
    if (num_args > 0) {
        jit_arg_types = safemalloc(sizeof(infix_type *) * num_args);
        for (size_t i = 0; i < num_args; ++i) {
            infix_type * t = args[i].type;
            if (t->category == INFIX_TYPE_ARRAY) {
                // Arrays passed as arguments decay to pointers.
                // We create a Pointer[Element] type in the temp arena for JIT creation.
                infix_type * ptr_type = nullptr;
                // FIX: Check return value to satisfy nodiscard warning
                if (infix_type_create_pointer_to(parse_arena, &ptr_type, t->meta.array_info.element_type) !=
                    INFIX_SUCCESS) {
                    safefree(jit_arg_types);
                    infix_arena_destroy(parse_arena);
                    croak("Failed to create pointer type for array decay");
                }
                jit_arg_types[i] = ptr_type;
            }
            else
                jit_arg_types[i] = t;
        }
    }

    // Object init & trampoline generation
    Affix * affix;
    Newxz(affix, 1, Affix);
    affix->return_sv = newSV(0);
    affix->variadic_cache = newHV();

    bool is_variadic = (strstr(signature, ";") != nullptr);
    affix->sig_str = savepv(signature);
    if (rename_str)
        affix->sym_name = savepv(rename_str);
    affix->target_addr = symbol;
    if (lib_handle_for_symbol)
        affix->lib_handle = lib_handle_for_symbol;

    // Create Trampoline using the JIT-optimized types
    status = infix_forward_create_manual(&affix->infix, ret_type, jit_arg_types, num_args, num_fixed, symbol);

    if (jit_arg_types)
        safefree(jit_arg_types);

    if (status != INFIX_SUCCESS) {
        infix_error_details_t err = infix_get_last_error();
        warn("Failed to create trampoline: %s", err.message);
        _affix_destroy(aTHX_ affix);
        infix_arena_destroy(parse_arena);
        XSRETURN_UNDEF;
    }

    affix->cif = infix_forward_get_code(affix->infix);
    affix->num_args = num_args;
    affix->num_fixed_args = num_fixed;

    affix->ret_type = infix_forward_get_return_type(affix->infix);
    affix->unwrapped_ret_type = _unwrap_pin_type(affix->ret_type);
    affix->ret_pull_handler = get_pull_handler(aTHX_ affix->ret_type);
    affix->ret_opcode = get_ret_opcode_for_type(aTHX_ affix->ret_type);

    // Extract outer constness if specified for the return type via objects
    affix->ret_readonly = false;
    if (ret_sv && _is_const_obj(aTHX_ ret_sv))
        affix->ret_readonly = true;
    else if (sig_sv && _is_const_obj(aTHX_ sig_sv))
        affix->ret_readonly = true;

    if (affix->ret_pull_handler == nullptr) {
        _affix_destroy(aTHX_ affix);
        warn("Unsupported return type");
        infix_arena_destroy(parse_arena);
        XSRETURN_UNDEF;
    }

    if (affix->num_args > 0)
        Newx(affix->c_args, affix->num_args, void *);
    else
        affix->c_args = nullptr;

    affix->args_arena = infix_arena_create(4096);
    affix->ret_arena = infix_arena_create(1024);

    // Build execution plan
    affix->plan_length = affix->num_args;
    Newxz(affix->plan, affix->plan_length + 1, Affix_Plan_Step);

    size_t current_offset = 0;
    size_t out_param_count = 0;
    OutParamInfo * temp_out_info = safemalloc(sizeof(OutParamInfo) * (affix->num_args > 0 ? affix->num_args : 1));

    for (size_t i = 0; i < affix->num_args; ++i) {
        // Deep copy from temporary parse_arena to persistent args_arena.
        // We use the ORIGINAL types (args[i].type) so marshalling knows it's an Array.
        const infix_type * original_type = _copy_type_graph_to_arena(affix->args_arena, args[i].type);

        // Calculate offset based on JIT expectation (Array Decay -> Pointer size)
        size_t alignment, size;
        if (original_type->category == INFIX_TYPE_ARRAY) {
            alignment = _Alignof(void *);
            size = sizeof(void *);
        }
        else {
            alignment = infix_type_get_alignment(original_type);
            size = infix_type_get_size(original_type);
        }

lib/Affix.c  view on Meta::CPAN

                    char * c_array;
                    if (affix && affix->call_args_arena) {
                        c_array = (char *)infix_arena_alloc(affix->call_args_arena, total_size, _Alignof(void *));
                    }
                    else {
                        Newxz(c_array, total_size, char);
                        SAVEFREEPV(c_array);
                    }
                    memset(c_array, 0, total_size);

                    for (size_t i = 0; i < len; ++i) {
                        SV ** elem_sv_ptr = av_fetch(av, i, 0);
                        if (elem_sv_ptr)
                            sv2ptr(aTHX_ affix, *elem_sv_ptr, c_array + (i * element_size), pointee_type);
                    }
                    *(void **)c_ptr = c_array;
                    return;
                }
                else if (SvTYPE(rv) == SVt_PVHV) {
                    size_t size = infix_type_get_size(pointee_type);
                    size_t align = infix_type_get_alignment(pointee_type);
                    if (align < 1)
                        align = 1;
                    void * temp_ptr;
                    if (affix && affix->call_args_arena)
                        temp_ptr = infix_arena_alloc(affix->call_args_arena, size, align);
                    else {
                        temp_ptr = safecalloc(1, size);
                        SAVEFREEPV(temp_ptr);
                    }
                    memset(temp_ptr, 0, size);
                    sv2ptr(aTHX_ affix, rv, temp_ptr, pointee_type);
                    *(void **)c_ptr = temp_ptr;
                    return;
                }

                size_t size = infix_type_get_size(pointee_type);
                size_t align = infix_type_get_alignment(pointee_type);
                if (align < 1)
                    align = 1;
                void * temp_ptr;
                if (affix && affix->call_args_arena)
                    temp_ptr = infix_arena_alloc(affix->call_args_arena, size, align);
                else {
                    temp_ptr = safecalloc(1, size);
                    SAVEFREEPV(temp_ptr);
                }
                memset(temp_ptr, 0, size);

                if (pointee_type->category == INFIX_TYPE_PRIMITIVE || pointee_type->category == INFIX_TYPE_ENUM)
                    sv2ptr(aTHX_ affix, rv, temp_ptr, pointee_type);
                else
                    sv2ptr(aTHX_ affix, perl_sv, temp_ptr, pointee_type);
                *(void **)c_ptr = temp_ptr;
            }
            else {
                char signature_buf[256];
                if (infix_type_print(
                        signature_buf, sizeof(signature_buf), (infix_type *)type, INFIX_DIALECT_SIGNATURE) !=
                    INFIX_SUCCESS) {
                    strncpy(signature_buf, "[error printing type]", sizeof(signature_buf) - 1);
                    signature_buf[sizeof(signature_buf) - 1] = '\0';
                }
                croak("sv2ptr cannot handle this kind of pointer conversion yet: %s", signature_buf);
            }
        }
        break;
    case INFIX_TYPE_STRUCT:
        {
            if (is_perl_sv_type(type)) {
                *(SV **)c_ptr = perl_sv;
                SvREFCNT_inc(perl_sv);
                return;
            }
            push_struct(aTHX_ affix, type, perl_sv, c_ptr);
        }
        break;
    case INFIX_TYPE_UNION:
        push_union(aTHX_ affix, type, perl_sv, c_ptr);
        break;
    case INFIX_TYPE_ARRAY:
        push_array(aTHX_ affix, type, perl_sv, c_ptr);
        break;
    case INFIX_TYPE_REVERSE_TRAMPOLINE:
        push_reverse_trampoline(aTHX_ affix, type, perl_sv, c_ptr);
        break;
    case INFIX_TYPE_ENUM:
        if (SvPOK(perl_sv)) {
            dMY_CXT;
            const char * type_name = infix_type_get_name(type);
            if (!type_name && type->category == INFIX_TYPE_NAMED_REFERENCE)
                type_name = type->meta.named_reference.name;
            if (type_name) {
                SV ** enum_info_ptr = hv_fetch(MY_CXT.enum_registry, type_name, strlen(type_name), 0);
                if (enum_info_ptr) {
                    HV * enum_info = (HV *)SvRV(*enum_info_ptr);
                    SV ** enum_map_ptr = hv_fetch(enum_info, "consts", 6, 0);
                    if (enum_map_ptr) {
                        HV * enum_map = (HV *)SvRV(*enum_map_ptr);
                        STRLEN len;
                        const char * str = SvPV(perl_sv, len);
                        SV ** val_sv = hv_fetch(enum_map, str, len, 0);
                        if (val_sv) {
                            sv2ptr(aTHX_ affix, *val_sv, c_ptr, type->meta.enum_info.underlying_type);
                            return;
                        }
                    }
                }
            }
        }
        sv2ptr(aTHX_ affix, perl_sv, c_ptr, type->meta.enum_info.underlying_type);
        break;
    default:
        croak("sv2ptr cannot convert this complex type");
        break;
    }
}
void push_struct(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p) {
    void * addr = get_address_v2(aTHX_ sv);
    if (addr) {
        memcpy(p, addr, infix_type_get_size(type));

lib/Affix.c  view on Meta::CPAN

        if (element_sv_ptr) {
            void * element_ptr = (char *)p + (i * element_size);
            sv2ptr(aTHX_ affix, *element_sv_ptr, element_ptr, element_type);
        }
    }
}
void push_reverse_trampoline(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p) {
    PERL_UNUSED_VAR(affix);
    dMY_CXT;
    SV * coderef_cv = nullptr;
    if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)
        coderef_cv = SvRV(sv);
    else if (SvTYPE(sv) == SVt_PVCV)
        coderef_cv = sv;
    if (coderef_cv) {
        char key[32];
        snprintf(key, sizeof(key), "%p", (void *)coderef_cv);
        SV ** entry_sv_ptr = hv_fetch(MY_CXT.callback_registry, key, strlen(key), 0);
        if (entry_sv_ptr) {
            Implicit_Callback_Magic * magic_data = INT2PTR(Implicit_Callback_Magic *, SvIV(*entry_sv_ptr));
            *(void **)p = infix_reverse_get_code(magic_data->reverse_ctx);
        }
        else {
            // Dereference through any Pointer wrappers to reach the REVERSE_TRAMPOLINE type with func_ptr_info.
            // Callback signature already includes the pointer (*((args)->ret)), so Pointer[Callback[...]] is
            // Pointer[Pointer[Function]].
            const infix_type * ft = resolve_type(aTHX_ type);
            while (ft && ft->category == INFIX_TYPE_POINTER)
                ft = resolve_type(aTHX_ ft->meta.pointer_info.pointee_type);

            if (!ft || ft->category != INFIX_TYPE_REVERSE_TRAMPOLINE)
                croak("Expected a callback type for struct member");

            Affix_Callback_Data * cb_data;
            Newxz(cb_data, 1, Affix_Callback_Data);
            cb_data->coderef_rv = newRV_inc(coderef_cv);
            storeTHX(cb_data->perl);
            infix_type * ret_type = ft->meta.func_ptr_info.return_type;
            size_t num_args = ft->meta.func_ptr_info.num_args;
            size_t num_fixed_args = ft->meta.func_ptr_info.num_fixed_args;
            infix_type ** arg_types = nullptr;
            if (num_args > 0) {
                Newx(arg_types, num_args, infix_type *);
                for (size_t i = 0; i < num_args; ++i)
                    arg_types[i] = ft->meta.func_ptr_info.args[i].type;
            }
            infix_reverse_t * reverse_ctx = nullptr;

            infix_status status = infix_reverse_create_closure_manual(&reverse_ctx,
                                                                      ret_type,
                                                                      arg_types,
                                                                      num_args,
                                                                      num_fixed_args,
                                                                      (void *)_affix_callback_handler_entry,
                                                                      (void *)cb_data);
            if (arg_types)
                Safefree(arg_types);
            if (status != INFIX_SUCCESS) {
                SvREFCNT_dec(cb_data->coderef_rv);
                safefree(cb_data);
                croak("Failed to create callback: %s", infix_get_last_error().message);
            }
            Implicit_Callback_Magic * magic_data;
            Newxz(magic_data, 1, Implicit_Callback_Magic);
            magic_data->reverse_ctx = reverse_ctx;
            hv_store(MY_CXT.callback_registry, key, strlen(key), newSViv(PTR2IV(magic_data)), 0);
            *(void **)p = infix_reverse_get_code(reverse_ctx);
        }
    }
    else if (!SvOK(sv))
        *(void **)p = nullptr;
    else
        croak("Argument for a callback must be a code reference or undef.");
}
static SV * _format_parse_error(pTHX_ const char * context_msg, const char * signature, infix_error_details_t err) {
    STRLEN sig_len = strlen(signature);
    int radius = 20;
    size_t start = (err.position > radius) ? (err.position - radius) : 0;
    size_t end = (err.position + radius < sig_len) ? (err.position + radius) : sig_len;
    const char * start_indicator = (start > 0) ? "... " : "";
    const char * end_indicator = (end < sig_len) ? " ..." : "";
    int start_indicator_len = (start > 0) ? 4 : 0;
    char snippet[128];
    snprintf(
        snippet, sizeof(snippet), "%s%.*s%s", start_indicator, (int)(end - start), signature + start, end_indicator);
    char pointer[128];
    int caret_pos = err.position - start + start_indicator_len;
    snprintf(pointer, sizeof(pointer), "%*s^", caret_pos, "");
    return sv_2mortal(newSVpvf("Failed to parse signature %s:\n\n  %s\n  %s\n\nError: %s (at position %zu)",
                               context_msg,
                               snippet,
                               pointer,
                               err.message,
                               err.position));
}
XS_INTERNAL(Affix_Lib_as_string) {
    dVAR;
    dXSARGS;
    if (items < 1)
        croak_xs_usage(cv, "$lib");
    IV RETVAL;
    {
        infix_library_t * lib;
        IV tmp = SvIV((SV *)SvRV(ST(0)));
        lib = INT2PTR(infix_library_t *, tmp);
        RETVAL = PTR2IV(lib->handle);
    }
    XSRETURN_IV(RETVAL);
};
XS_INTERNAL(Affix_Lib_DESTROY) {
    dXSARGS;
    dMY_CXT;
    if (items != 1)
        croak_xs_usage(cv, "$lib");
    IV tmp = SvIV((SV *)SvRV(ST(0)));
    infix_library_t * lib = INT2PTR(infix_library_t *, tmp);
    if (MY_CXT.lib_registry) {
        hv_iterinit(MY_CXT.lib_registry);
        HE * he;
        SV * key_to_delete = nullptr;
        while ((he = hv_iternext(MY_CXT.lib_registry))) {
            SV * entry_sv = HeVAL(he);
            LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(entry_sv));
            if (entry->lib == lib) {
                entry->ref_count--;
                if (entry->ref_count == 0) {
                    key_to_delete = sv_2mortal(newSVsv(HeKEY_sv(he)));
                    infix_library_close(entry->lib);
                    safefree(entry);
                }
                break;
            }
        }
        if (key_to_delete)
            hv_delete_ent(MY_CXT.lib_registry, key_to_delete, G_DISCARD, 0);
    }
    XSRETURN_EMPTY;
}
XS_INTERNAL(Affix_load_library) {
    dXSARGS;
    dMY_CXT;
    if (items != 1)
        croak_xs_usage(cv, "library_path");
    const char * path = SvPV_nolen(ST(0));
    SV ** entry_sv_ptr = hv_fetch(MY_CXT.lib_registry, path, strlen(path), 0);
    if (entry_sv_ptr) {
        LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(*entry_sv_ptr));
        entry->ref_count++;
        SV * obj_data = newSV(0);
        sv_setiv(obj_data, PTR2IV(entry->lib));
        ST(0) = sv_2mortal(sv_bless(newRV_inc(obj_data), gv_stashpv("Affix::Lib", GV_ADD)));
        XSRETURN(1);
    }
    infix_library_t * lib = infix_library_open(path);
    if (lib) {
        LibRegistryEntry * new_entry;
        Newxz(new_entry, 1, LibRegistryEntry);
        new_entry->lib = lib;
        new_entry->ref_count = 1;
        hv_store(MY_CXT.lib_registry, path, strlen(path), newSViv(PTR2IV(new_entry)), 0);
        SV * obj_data = newSV(0);
        sv_setiv(obj_data, PTR2IV(lib));
        ST(0) = sv_2mortal(sv_bless(newRV_inc(obj_data), gv_stashpv("Affix::Lib", GV_ADD)));
        XSRETURN(1);
    }
    XSRETURN_UNDEF;
}
XS_INTERNAL(Affix_get_last_error_message) {
    dXSARGS;
    PERL_UNUSED_VAR(items);
    infix_error_details_t err = infix_get_last_error();
    if (err.message[0] != '\0')
        ST(0) = sv_2mortal(newSVpv(err.message, 0));
#if defined(INFIX_OS_WINDOWS)
    else if (err.system_error_code != 0) {
        char buf[256];
        FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
                       nullptr,
                       err.system_error_code,
                       0,
                       buf,
                       sizeof(buf),
                       nullptr);
        ST(0) = sv_2mortal(newSVpvf("System error: %s (code %ld)", buf, err.system_error_code));
    }
#endif
    else
        ST(0) = sv_2mortal(newSVpvf("Infix error code %d at position %zu", (int)err.code, err.position));
    XSRETURN(1);
}


XS_INTERNAL(Affix_find_symbol) {
    dXSARGS;
    dMY_CXT;  // Require the thread-local context
    if (items != 2 || !sv_isobject(ST(0)) || !sv_derived_from(ST(0), "Affix::Lib"))
        croak_xs_usage(cv, "Affix_Lib_object, symbol_name");
    IV tmp = SvIV((SV *)SvRV(ST(0)));
    infix_library_t * lib = INT2PTR(infix_library_t *, tmp);
    const char * name = SvPV_nolen(ST(1));
    void * symbol = infix_library_get_symbol(lib, name);
    if (symbol) {
        SV * sv = newSV(0);
        /* Symbols are addresses. Use 'void' type so address() returns the symbol value itself. */
        bind_placeholder(aTHX_ sv, symbol, infix_type_create_void(), 0, 0, false, ST(0), nullptr, false, true);
        ST(0) = sv_2mortal(newRV_noinc(sv));
        XSRETURN(1);
    }
    XSRETURN_UNDEF;
}

XS_INTERNAL(Affix_sizeof) {
    dXSARGS;
    dMY_CXT;
    if (items != 1)
        croak_xs_usage(cv, "type_signature");
    SV * type_sv = ST(0);

    if (SvIOK(type_sv) && !sv_isobject(type_sv)) {
        ST(0) = sv_2mortal(newSVuv(SvUV(type_sv)));
        XSRETURN(1);
    }

    const char * signature = _get_string_from_type_obj(aTHX_ type_sv);

    infix_type * type = nullptr;
    infix_arena_t * arena = nullptr;
    if (infix_type_from_signature(&type, &arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
        SV * err_sv = _format_parse_error(aTHX_ "for sizeof", signature, infix_get_last_error());
        warn_sv(err_sv);
        if (arena)
            infix_arena_destroy(arena);
        XSRETURN_UNDEF;
    }
    size_t type_size = infix_type_get_size(type);
    infix_arena_destroy(arena);
    ST(0) = sv_2mortal(newSVuv(type_size));
    XSRETURN(1);
}

XS_INTERNAL(Affix_alignof) {
    dXSARGS;
    dMY_CXT;
    if (items != 1)
        croak_xs_usage(cv, "type_signature");
    SV * type_sv = ST(0);
    const char * signature = _get_string_from_type_obj(aTHX_ type_sv);
    infix_type * type = nullptr;
    infix_arena_t * arena = nullptr;
    if (infix_type_from_signature(&type, &arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
        SV * err_sv = _format_parse_error(aTHX_ "for alignof", signature, infix_get_last_error());
        warn_sv(err_sv);
        if (arena)
            infix_arena_destroy(arena);
        XSRETURN_UNDEF;
    }
    size_t align = (type->category == INFIX_TYPE_ARRAY) ? type->alignment : infix_type_get_alignment(type);
    if (align == 0)
        align = 1;
    infix_arena_destroy(arena);
    ST(0) = sv_2mortal(newSVuv(align));
    XSRETURN(1);
}

XS_INTERNAL(Affix_offsetof) {
    dXSARGS;
    dMY_CXT;
    if (items != 2)
        croak_xs_usage(cv, "type_signature, member_name");
    SV * type_sv = ST(0);
    const char * signature = _get_string_from_type_obj(aTHX_ type_sv);
    const char * member_name = SvPV_nolen(ST(1));
    infix_type * type = nullptr;
    infix_arena_t * arena = nullptr;
    if (infix_type_from_signature(&type, &arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
        SV * err_sv = _format_parse_error(aTHX_ "for offsetof", signature, infix_get_last_error());
        warn_sv(err_sv);
        if (arena)
            infix_arena_destroy(arena);
        XSRETURN_UNDEF;
    }

    if (type->category != INFIX_TYPE_STRUCT && type->category != INFIX_TYPE_UNION) {
        infix_arena_destroy(arena);
        warn("offsetof expects a Struct or Union type");
        XSRETURN_UNDEF;
    }

    size_t offset = 0;
    bool found = false;
    for (size_t i = 0; i < type->meta.aggregate_info.num_members; ++i) {
        const infix_struct_member * m = &type->meta.aggregate_info.members[i];
        if (m->name && strEQ(m->name, member_name)) {
            offset = m->offset;
            found = true;
            break;
        }
    }
    infix_arena_destroy(arena);
    if (!found) {
        warn("Member '%s' not found in type '%s'", member_name, signature);
        XSRETURN_UNDEF;
    }
    ST(0) = sv_2mortal(newSVuv(offset));
    XSRETURN(1);
}

void _export_function(pTHX_ HV * _export, const char * what, const char * _tag) {
    SV ** tag = hv_fetch(_export, _tag, strlen(_tag), TRUE);
    if (tag && SvOK(*tag) && SvROK(*tag) && (SvTYPE(SvRV(*tag))) == SVt_PVAV)
        av_push((AV *)SvRV(*tag), newSVpv(what, 0));
    else {
        AV * av = newAV();
        av_push(av, newSVpv(what, 0));
        (void)hv_store(_export, _tag, strlen(_tag), newRV_noinc(MUTABLE_SV(av)), 0);
    }
}

void _affix_callback_handler_entry(infix_context_t * ctx, void * retval, void ** args) {
    Affix_Callback_Data * cb_data = (Affix_Callback_Data *)infix_reverse_get_user_data(ctx);
    if (!cb_data)
        return;

#ifdef MULTIPLICITY
#ifdef PERL_SET_CONTEXT
    PERL_SET_CONTEXT(cb_data->perl);
#endif
#endif

    dTHXa(cb_data->perl);
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    size_t num_args = infix_reverse_get_num_args(ctx);

lib/Affix.c  view on Meta::CPAN

    }
    _infix_cache_clear();
    if (MY_CXT.enum_registry) {
        // Values are HVs, we need to dec ref them?
        // hv_undef decreases refcounts of values automatically.
        hv_undef(MY_CXT.enum_registry);
        MY_CXT.enum_registry = nullptr;
    }
    if (MY_CXT.coercion_cache) {
        hv_undef(MY_CXT.coercion_cache);
        MY_CXT.coercion_cache = nullptr;
    }
    MY_CXT.stash_pointer = nullptr;
    XSRETURN_EMPTY;
}

XS_INTERNAL(Affix_register_enum_values) {
    dXSARGS;
    dMY_CXT;
    if (items != 3)
        croak_xs_usage(cv, "name, values_hashref, consts_hashref");

    const char * name = SvPV_nolen(ST(0));
    SV * values_rv = ST(1);
    SV * consts_rv = ST(2);

    if (!SvROK(values_rv) || SvTYPE(SvRV(values_rv)) != SVt_PVHV)
        croak("Enum values must be a Hash Reference { Int => String }");
    if (!SvROK(consts_rv) || SvTYPE(SvRV(consts_rv)) != SVt_PVHV)
        croak("Enum constants must be a Hash Reference { String => Int }");

    HV * enum_info = newHV();
    (void)hv_store(enum_info, "vals", 4, newRV_inc(SvRV(values_rv)), 0);
    (void)hv_store(enum_info, "consts", 6, newRV_inc(SvRV(consts_rv)), 0);

    SV * hv_ref = newRV_noinc(MUTABLE_SV(enum_info));
    if (!hv_store(MY_CXT.enum_registry, name, strlen(name), hv_ref, 0))
        SvREFCNT_dec(hv_ref);
    XSRETURN_EMPTY;
}

XS_INTERNAL(Affix_typedef) {
    dXSARGS;
    dMY_CXT;
    if (items < 1 || items > 2)
        croak_xs_usage(cv, "$name, [$type]");

    SV * name_sv = ST(0);
    const char * raw_name = SvPV_nolen(name_sv);
    const char * name = (raw_name[0] == '@') ? raw_name + 1 : raw_name;

    SV * def_sv = sv_2mortal(newSVpvf("@%s", name));
    if (items == 2) {
        sv_catpv(def_sv, " = ");
        SV * type_sv = ST(1);
        const char * type_str = _get_string_from_type_obj(aTHX_ type_sv);
        sv_catpv(def_sv, type_str ? type_str : SvPV_nolen(type_sv));
    }
    //~ else
    // If no type is provided, define it as an empty (opaque) struct
    // This prevents "Unexpected token" errors in infix.
    //~ sv_catpv(def_sv, ";");

    sv_catpv(def_sv, ";");

    if (infix_register_types(MY_CXT.registry, SvPV_nolen(def_sv)) != INFIX_SUCCESS) {
        SV * err_sv = _format_parse_error(aTHX_ "in typedef", SvPV_nolen(def_sv), infix_get_last_error());
        warn_sv(err_sv);
        XSRETURN_UNDEF;
    }

#if DEBUG
    char * blah;
    Newxz(blah, 1024 * 5, char);
    infix_registry_print(blah, 1024 * 5, MY_CXT.registry);
    warn("registry: %s", blah);
    safefree(blah);
#endif

    // Export the constant sub so users can use the type name in Perl
    HV * stash = CopSTASH(PL_curcop);
    bool sub_exists = false;
    if (stash) {
        SV ** entry = hv_fetch(stash, name, strlen(name), 0);
        if (entry && *entry && isGV(*entry)) {
            if (GvCV((GV *)*entry))
                sub_exists = true;
        }
    }
    if (!sub_exists) {
        SV * type_name_sv = newSVpvf("@%s", name);
        newCONSTSUB(stash, (char *)name, type_name_sv);
    }
    XSRETURN_YES;
}
XS_INTERNAL(Affix_register_types_raw) {
    dXSARGS;
    dMY_CXT;
    if (items != 1)
        croak_xs_usage(cv, "definitions_string");

    const char * defs = SvPV_nolen(ST(0));
    if (infix_register_types(MY_CXT.registry, defs) != INFIX_SUCCESS) {
        infix_error_details_t err = infix_get_last_error();
        STRLEN sig_len = strlen(defs);
        int radius = 20;
        size_t start = (err.position > radius) ? (err.position - radius) : 0;
        size_t end = (err.position + radius < sig_len) ? (err.position + radius) : sig_len;
        const char * start_indicator = (start > 0) ? "... " : "";
        const char * end_indicator = (end < sig_len) ? " ..." : "";
        int start_indicator_len = (start > 0) ? 4 : 0;
        char snippet[256];
        snprintf(
            snippet, sizeof(snippet), "%s%.*s%s", start_indicator, (int)(end - start), defs + start, end_indicator);
        char pointer[256];
        int caret_pos = err.position - start + start_indicator_len;
        snprintf(pointer, sizeof(pointer), "%*s^", caret_pos, "");

        warn("Failed to parse batch signature:\n\n  %s\n  %s\n\nError: %s (at position %zu)",
             snippet,
             pointer,
             err.message,
             err.position);
    }
    XSRETURN_YES;
}
XS_INTERNAL(Affix_dump_registry) {
    dXSARGS;
    dMY_CXT;
    char * buffer;
    size_t size = 1024 * 128;  // 128KB
    Newxz(buffer, size, char);

    if (infix_registry_print(buffer, size, MY_CXT.registry) == INFIX_SUCCESS)
        ST(0) = sv_2mortal(newSVpv(buffer, 0));
    else
        ST(0) = sv_2mortal(newSVpvs("[Registry too large or print failed]"));

    safefree(buffer);
    XSRETURN(1);
}

XS_INTERNAL(Affix_defined_types) {
    dXSARGS;
    dMY_CXT;
    PERL_UNUSED_VAR(cv);

    size_t count = 0;
    infix_registry_iterator_t it_counter = infix_registry_iterator_begin(MY_CXT.registry);
    while (infix_registry_iterator_next(&it_counter))
        if (infix_registry_iterator_get_type(&it_counter))
            count++;

    if (GIMME_V == G_SCALAR) {
        ST(0) = sv_2mortal(newSVuv(count));
        XSRETURN(1);
    }
    if (count == 0)
        XSRETURN(0);

    EXTEND(SP, count);

    infix_registry_iterator_t it = infix_registry_iterator_begin(MY_CXT.registry);
    while (infix_registry_iterator_next(&it)) {

lib/Affix.c  view on Meta::CPAN

    XSRETURN_YES;
}

XS_INTERNAL(Affix_own) {
    dXSARGS;
    if (items < 1)
        croak_xs_usage(cv, "pin, [should_own]");

    /* V2 memory is managed via Affix::Memory objects.
       Check if the object is an Affix::Memory handle. */
    if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "Affix::Memory"))
        XSRETURN_YES;

    XSRETURN_NO;
}
XS_INTERNAL(Affix_free) {
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "pointer_object");

    SV * arg = ST(0);
    SV * owner = _borrow_lifeline(aTHX_ arg);
    if (owner && sv_isobject(owner) && sv_derived_from(owner, "Affix::Memory")) {
        free_owned(aTHX_ owner);
        XSRETURN_YES;
    }
    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;

lib/Affix.c  view on Meta::CPAN

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;
    if (SvIOK(ST(1)))
        destructor_ptr = INT2PTR(void *, SvUV(ST(1)));
    else {
        Affix_Pin_2_Point_Oh * dpin = get_pin_v2(aTHX_ ST(1));
        if (dpin)
            destructor_ptr = dpin->ptr;
    }

    if (!destructor_ptr) {
        warn("Destructor pointer cannot be null");
        XSRETURN_UNDEF;
    }

    pin->destructor = (void (*)(void *))destructor_ptr;

    if (items > 2 && sv_isobject(ST(2)) && sv_derived_from(ST(2), "Affix::Lib"))
        pin->destructor_lib_sv = newSVsv(ST(2));

    XSRETURN_YES;
}

XS_INTERNAL(Affix_errno) {
    dXSARGS;
    PERL_UNUSED_VAR(items);

    SV * dual = newSV(1);

#ifdef _WIN32
    DWORD err_code = GetLastError();
    sv_setuv(dual, (UV)err_code);

    char * buf = nullptr;
    DWORD len =
        FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
                       nullptr,
                       err_code,
                       MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
                       (LPSTR)&buf,
                       0,
                       nullptr);

    if (buf) {
        while (len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r'))
            buf[--len] = '\0';
        sv_setpvn(dual, buf, len);
        LocalFree(buf);
    }
    else
        sv_setpvn(dual, "Unknown system error", 20);

    SvIOK_on(dual);
    SvIsUV_on(dual);  // Mark as unsigned for DWORD
#else
    int err_code = errno;
    sv_setiv(dual, err_code);

    const char * msg = strerror(err_code);
    if (msg)
        sv_setpv(dual, msg);
    else
        sv_setpv(dual, "Unknown system error");

    SvIV_set(dual, (IV)err_code);
    SvIOK_on(dual);
#endif

    ST(0) = sv_2mortal(dual);
    XSRETURN(1);
}


static void * _resolve_writable_ptr(pTHX_ SV * sv) { return get_address_v2(aTHX_ sv); }
static const void * _resolve_readable_ptr(pTHX_ SV * sv) {
    void * ptr = get_address_v2(aTHX_ sv);
    if (ptr)
        return ptr;
    if (SvPOK(sv) && !SvROK(sv))
        return (const void *)SvPV_nolen(sv);
    return nullptr;
}

XS_INTERNAL(Affix_dump) {
    dVAR;
    dXSARGS;
    if (items != 2)
        croak_xs_usage(cv, "scalar, length_in_bytes");

    const void * ptr = _resolve_readable_ptr(aTHX_ ST(0));

    if (!ptr) {
        warn("scalar is not a valid pointer, memory address, or string");
        XSRETURN_EMPTY;
    }

    UV length = SvUV(ST(1));
    if (length == 0) {
        warn("Dump length cannot be zero");
        XSRETURN_EMPTY;
    }

    /* Extract Perl-level file and line info for the dump header */
    const char * file = "Unknown";
    int line = 0;
    if (LIKELY(PL_curcop)) {
        file = OutCopFILE(PL_curcop);
        line = CopLINE(PL_curcop);
    }

    /* Call the internal hex-dump utility */
    _DumpHex(aTHX_ ptr, (size_t)length, file, line);

    /* Return the original scalar as a pass-through */
    ST(0) = ST(0);
    XSRETURN(1);
}

XS_INTERNAL(Affix_raw) {
    dVAR;
    dXSARGS;
    if (items != 2)
        croak_xs_usage(cv, "scalar, length_in_bytes");

lib/Affix.c  view on Meta::CPAN

    // any infix call below. infix_set_allocator() copies the table, and the
    // affix_infix_* callbacks above forward to Perl_safesys*, so Perl tracks
    // infix memory and pool validation (PERL_TRACK_MEMPOOL) never fires.
    // infix_allocator is process-global and single-threaded here (module load),
    // and cloned interpreters inherit the installed table.
    infix_set_allocator(&(infix_allocator_t){
        .malloc = affix_infix_malloc,
        .calloc = affix_infix_calloc,
        .realloc = affix_infix_realloc,
        .free = affix_infix_free,
    });

    MY_CXT.registry = infix_registry_create();
    if (!MY_CXT.registry)
        croak("Failed to initialize the global type registry");

    _register_core_types(MY_CXT.registry);

    // Helper macro to define and export an XSUB in one line.
    // Assumes C function is Affix_name and Perl sub is Affix::name.
#define XSUB_EXPORT(name, proto, tag)                                          \
    (void)newXSproto_portable("Affix::" #name, Affix_##name, __FILE__, proto); \
    export_function("Affix", #name, tag)

    {
        // Core affix/wrap construction (Manual due to aliasing via XSANY)
        cv = newXSproto_portable("Affix::affix", Affix_affix, __FILE__, "$$$;$");
        XSANY.any_i32 = 0;
        export_function("Affix", "affix", "core");

        cv = newXSproto_portable("Affix::wrap", Affix_affix, __FILE__, "$$$;$");
        XSANY.any_i32 = 1;
        export_function("Affix", "wrap", "core");

        cv = newXSproto_portable("Affix::direct_affix", Affix_affix, __FILE__, "$$$;$");
        XSANY.any_i32 = 2;
        export_function("Affix", "direct_affix", "core");

        cv = newXSproto_portable("Affix::direct_wrap", Affix_affix, __FILE__, "$$$;$");
        XSANY.any_i32 = 3;
        export_function("Affix", "direct_wrap", "core");

        // Destructors
        newXS("Affix::Bundled::DESTROY", Affix_Bundled_DESTROY, __FILE__);
        // newXS("Affix::DESTROY", Affix_DESTROY, __FILE__);
        newXS("Affix::END", Affix_END, __FILE__);
        newXS("Affix::Lib::DESTROY", Affix_Lib_DESTROY, __FILE__);
        newXS("Affix::CLONE", Affix_CLONE, __FILE__);

        // Overloads
        sv_setsv(get_sv("Affix::()", TRUE), &PL_sv_yes);
        (void)newXSproto_portable("Affix::()", Affix_as_string, __FILE__, "$;@");

        sv_setsv(get_sv("Affix::Lib::()", TRUE), &PL_sv_yes);
        (void)newXSproto_portable("Affix::Lib::(0+", Affix_Lib_as_string, __FILE__, "$;@");
        (void)newXSproto_portable("Affix::Lib::()", Affix_as_string, __FILE__, "$;@");

        // Library & core utils
        XSUB_EXPORT(load_library, "$", "lib");
        XSUB_EXPORT(find_symbol, "$$", "lib");
        XSUB_EXPORT(get_last_error_message, "", "core");

        // Introspection
        XSUB_EXPORT(sizeof, "$", "core");
        XSUB_EXPORT(alignof, "$", "core");
        XSUB_EXPORT(offsetof, "$$", "core");

        // Type registry
        (void)newXSproto_portable("Affix::_typedef", Affix_typedef, __FILE__, "$;$");
        (void)newXSproto_portable("Affix::dump_registry", Affix_dump_registry, __FILE__, "");
        (void)newXSproto_portable("Affix::_register_enum_values", Affix_register_enum_values, __FILE__, "$$$");
        (void)newXSproto_portable("Affix::_register_types_raw", Affix_register_types_raw, __FILE__, "$");
        (void)newXSproto_portable("Affix::types", Affix_defined_types, __FILE__, "");

        // Debugging
        (void)newXSproto_portable("Affix::sv_dump", Affix_sv_dump, __FILE__, "$");

        // Memory management & pointers
        XSUB_EXPORT(address, nullptr, "memory");
        XSUB_EXPORT(malloc, "$", "memory");
        XSUB_EXPORT(calloc, "$$", "memory");
        XSUB_EXPORT(realloc, "$$", "memory");
        XSUB_EXPORT(free, "$", "memory");
        XSUB_EXPORT(dump, "$$", "memory");
        XSUB_EXPORT(raw, "$$", "memory");
        XSUB_EXPORT(snapshot, "$", "memory");
        XSUB_EXPORT(own, nullptr, "memory");
        XSUB_EXPORT(readonly, nullptr, "memory");
        XSUB_EXPORT(cast, "$$", "memory");
        XSUB_EXPORT(pin, "$$;$$", "memory");
        XSUB_EXPORT(unpin, "$", "memory");

        // Raw memory operations
        XSUB_EXPORT(memcpy, "$$$", "memory");
        XSUB_EXPORT(memmove, "$$$", "memory");
        XSUB_EXPORT(memset, "$$$", "memory");
        XSUB_EXPORT(memcmp, "$$$", "memory");
        XSUB_EXPORT(memchr, "$$$", "memory");

        // Pointer utils
        XSUB_EXPORT(ptr_add, "$$", "memory");
        XSUB_EXPORT(ptr_diff, "$$", "memory");
        XSUB_EXPORT(strdup, "$", "memory");
        XSUB_EXPORT(strnlen, "$$", "memory");
        XSUB_EXPORT(is_null, "$", "memory");
        XSUB_EXPORT(is_pin, "$", "memory");

        // Pin internals (for Affix::Pointer)
        (void)newXSproto_portable("Affix::_pin_type", Affix_pin_type, __FILE__, nullptr);
        (void)newXSproto_portable("Affix::_pin_element_type", Affix_pin_element_type, __FILE__, nullptr);
        (void)newXSproto_portable("Affix::_pin_count", Affix_pin_count, __FILE__, nullptr);
        (void)newXSproto_portable("Affix::_pin_size", Affix_pin_size, __FILE__, nullptr);
        (void)newXSproto_portable("Affix::_attach_destructor", Affix_attach_destructor, __FILE__, "$$;$");
    }

    XSUB_EXPORT(coerce, "$$", "core");

    XSUB_EXPORT(errno, "", "core");
    (void)newXSproto_portable("Affix::set_destruct_level", Affix_set_destruct_level, __FILE__, "$");




( run in 3.150 seconds using v1.01-cache-2.11-cpan-0fb53d1c279 )