Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
static MGVTBL Affix_pin_vtbl = {
Affix_get_pin, Affix_set_pin, Affix_len_pin, nullptr, Affix_free_pin, nullptr, Affix_pin_dup, nullptr};
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;
if (is_pin(aTHX_ sv)) {
*(void **)c_arg_ptr = _get_pin_from_sv(aTHX_ sv)->pointer;
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->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 &&
(strEQ(type_name, "Buffer") || strEQ(type_name, "@Buffer") || strEQ(type_name, "SockAddr") ||
strEQ(type_name, "@SockAddr") || strEQ(type_name, "StringList") || strEQ(type_name, "@StringList"))) {
sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
return;
}
const char * pointee_name = infix_type_get_name(pointee_type);
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->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);
size_t total_size = len * element_size;
char * c_array = (char *)infix_arena_alloc(affix->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->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));
}
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 NULL/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);
size_t fixed_len = type->meta.array_info.num_elements;
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
static int Affix_cv_dup(pTHX_ MAGIC * mg, CLONE_PARAMS * param) {
Affix * old_affix = (Affix *)mg->mg_ptr;
Affix * new_affix;
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; // Copied too
/* 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->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 = NULL;
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 = NULL;
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
}
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
// 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 NULL;
}
void Affix_trigger_variadic(pTHX_ CV * cv) {
dSP;
dAXMARK;
dXSTARG;
dMY_CXT;
Affix * affix = (Affix *)CvXSUBANY(cv).any_ptr;
size_t items = SP - MARK;
if (items < affix->num_fixed_args)
croak(
"Not enough arguments for variadic function. Expected at least %zu, got %zu", affix->num_fixed_args, items);
// Construct the complete signature string dynamically
SV * sig_sv = sv_2mortal(newSVpv("", 0));
// Reconstruct fixed part from the cached sig_str (which ends in '; ...' or similar)
// We need to parse the original signature string to get the fixed part cleanly,
// OR we can reconstruct it from the plan.
// Simplest: The affix->sig_str contains the fixed part and the ';'.
// We assume affix->sig_str is like "(*char; ...)->int"
char * semi_ptr = strchr(affix->sig_str, ';');
if (!semi_ptr)
croak("Internal error: Variadic function missing semicolon in signature");
// Append fixed part up to and including ';'
sv_catpvn(sig_sv, affix->sig_str, (semi_ptr - affix->sig_str) + 1);
// Iterate varargs to infer types and append to signature
for (size_t i = affix->num_fixed_args; i < items; ++i) {
SV * arg = ST(i);
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(aTHX_ arg))
// It's a pointer/struct pin. We treat it as a void pointer for the signature
// unless we can introspect the pin's type object deeply.
// For now, let's treat pins as '*void' (opaque pointer) in varargs unless coerced.
sv_catpvs(sig_sv, "*void");
else if (SvIOK(arg))
sv_catpvs(sig_sv, "sint64"); // Default integer promotion
else if (SvNOK(arg))
sv_catpvs(sig_sv, "double"); // Default float promotion
else if (SvPOK(arg))
sv_catpvs(sig_sv, "*char"); // Default string promotion
else // Fallback/Unknown
sv_catpvs(sig_sv, "sint64");
}
// Append return type part (find ')' in original sig)
char * close_paren = strrchr(affix->sig_str, ')');
if (close_paren)
sv_catpv(sig_sv, close_paren);
else
croak("Malformed signature string in affix");
const char * full_sig = SvPV_nolen(sig_sv);
// Check Cache
infix_forward_t * trampoline = NULL;
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 {
// Cache Miss: Compile new trampoline
// We use the parsing logic to get types
infix_arena_t * temp_arena = NULL;
infix_type * ret_type = NULL;
infix_function_argument * args = NULL;
size_t num_args = 0, num_fixed = 0;
infix_status status =
infix_signature_parse(full_sig, &temp_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);
if (status != INFIX_SUCCESS) {
if (temp_arena)
infix_arena_destroy(temp_arena);
croak("Failed to compile variadic signature: %s", full_sig);
}
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;
}
strcat(signature_buf, ",");
}
}
strcat(signature_buf, ") -> ");
const char * ret_sig = _get_string_from_type_obj(aTHX_ ret_sv);
if (!ret_sig)
croak("Invalid return type object");
strcat(signature_buf, ret_sig);
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;
const char * sig_to_parse = signature;
char * clean_sig = nullptr;
if (strstr(signature, "+")) {
clean_sig = savepv(signature);
const char * p = signature;
char * d = clean_sig;
while (*p) {
// Strip '+' only if it precedes a signature character: * [ { ! < ( @
if (*p == '+' &&
(p[1] == '*' || p[1] == '[' || p[1] == '{' || p[1] == '!' || p[1] == '<' || p[1] == '(' ||
p[1] == '@'))
p++;
else
*d++ = *p++;
}
*d = '\0';
sig_to_parse = clean_sig;
}
infix_status status =
infix_signature_parse(sig_to_parse, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);
if (clean_sig)
safefree(clean_sig);
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(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 = NULL;
infix_type * ret_type = NULL;
infix_function_argument * args = NULL;
size_t num_args = 0, num_fixed = 0;
const char * sig_to_parse = signature;
char * clean_sig = nullptr;
if (strstr(signature, "+")) {
clean_sig = savepv(signature);
const char * p = signature;
char * d = clean_sig;
while (*p) {
// Strip '+' only if it precedes a signature character: * [ { ! < ( @
if (*p == '+' &&
(p[1] == '*' || p[1] == '[' || p[1] == '{' || p[1] == '!' || p[1] == '<' || p[1] == '(' || p[1] == '@'))
p++;
else
*d++ = *p++;
}
*d = '\0';
sig_to_parse = clean_sig;
}
infix_status status =
infix_signature_parse(sig_to_parse, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);
if (clean_sig)
safefree(clean_sig);
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 = NULL;
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 = NULL;
// 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, ";") != NULL);
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(affix->ret_type);
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);
}
if (alignment == 0)
alignment = 1;
current_offset = (current_offset + alignment - 1) & ~(alignment - 1);
affix->plan[i].data.c_arg_offset = current_offset;
current_offset += size;
lib/Affix.c view on Meta::CPAN
PerlIO * pio = IoIFP(io);
*(FILE **)c_ptr = PerlIO_findFILE(pio);
return;
}
}
}
if (SvTYPE(rv) == SVt_PVAV) {
AV * av = (AV *)SvRV(perl_sv);
size_t len = av_len(av) + 1;
size_t element_size = infix_type_get_size(pointee_type);
size_t total_size = len * element_size;
char * c_array;
Newxz(c_array, total_size, char);
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->args_arena)
temp_ptr = infix_arena_alloc(affix->args_arena, size, align);
else
temp_ptr = safecalloc(1, size);
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->args_arena)
temp_ptr = infix_arena_alloc(affix->args_arena, size, align);
else
temp_ptr = safecalloc(1, size);
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));
}
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) {
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) {
HV * hv;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV)
hv = (HV *)SvRV(sv);
else if (SvTYPE(sv) == SVt_PVHV)
hv = (HV *)sv;
else
lib/Affix.c view on Meta::CPAN
return;
}
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
croak("Expected an ARRAY reference for array marshalling");
AV * av = (AV *)SvRV(sv);
size_t perl_array_len = av_len(av) + 1;
size_t num_to_copy = perl_array_len < c_array_len ? perl_array_len : c_array_len;
size_t element_size = infix_type_get_size(element_type);
for (size_t i = 0; i < num_to_copy; ++i) {
SV ** element_sv_ptr = av_fetch(av, i, 0);
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 {
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 = type->meta.func_ptr_info.return_type;
size_t num_args = type->meta.func_ptr_info.num_args;
size_t num_fixed_args = type->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] = type->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);
}
Affix_Pin * _get_pin_from_sv(pTHX_ SV * sv) {
if (!sv || !SvOK(sv) || !SvROK(sv) || !SvMAGICAL(SvRV(sv)))
return nullptr;
MAGIC * mg = mg_findext(SvRV(sv), PERL_MAGIC_ext, &Affix_pin_vtbl);
if (mg)
return (Affix_Pin *)mg->mg_ptr;
return nullptr;
}
static int Affix_set_pin(pTHX_ SV * sv, MAGIC * mg) {
Affix_Pin * pin = (Affix_Pin *)mg->mg_ptr;
if (!pin || !pin->pointer || !pin->type)
return 0;
if (pin->bit_width > 0) {
size_t sz = infix_type_get_size(pin->type);
uint64_t val = (uint64_t)SvUV(sv);
uint64_t mask = ((uint64_t)1 << pin->bit_width) - 1;
val &= mask;
uint64_t current = 0;
memcpy(¤t, pin->pointer, sz);
current &= ~(mask << pin->bit_offset);
current |= (val << pin->bit_offset);
memcpy(pin->pointer, ¤t, sz);
return 0;
}
const infix_type * type_to_marshal = pin->type;
if (pin->type->category == INFIX_TYPE_POINTER) {
const infix_type * pointee = pin->type->meta.pointer_info.pointee_type;
if (pointee->category == INFIX_TYPE_VOID) {
if (pin->size > 0) {
STRLEN perl_len;
const char * perl_str = SvPV(sv, perl_len);
size_t bytes_to_copy = (perl_len < pin->size) ? perl_len : pin->size;
memcpy(pin->pointer, perl_str, bytes_to_copy);
if (bytes_to_copy < pin->size)
memset((char *)pin->pointer + bytes_to_copy, 0, pin->size - bytes_to_copy);
return 0;
}
else
croak("Cannot assign a value to a dereferenced void pointer (opaque handle)");
}
}
sv2ptr(aTHX_ nullptr, sv, pin->pointer, type_to_marshal);
return 0;
}
static U32 Affix_len_pin(pTHX_ SV * sv, MAGIC * mg) {
Affix_Pin * pin = (Affix_Pin *)mg->mg_ptr;
if (!pin || !pin->pointer || !pin->type) {
if (SvTYPE(sv) == SVt_PVAV)
return av_len(MUTABLE_AV(sv));
return sv_len(sv);
}
return pin->type->size;
}
lib/Affix.c view on Meta::CPAN
infix_arena_destroy(pin->type_arena);
pin->type_arena = nullptr;
}
if (pin && pin->owner_sv) {
SvREFCNT_dec(pin->owner_sv);
pin->owner_sv = nullptr;
}
}
else {
Newxz(pin, 1, Affix_Pin);
mg = sv_magicext(sv, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
}
// Re-assign mg_ptr because sv_magicext(..., 0) likely corrupted it by treating pin as a string
mg->mg_ptr = (char *)pin;
pin->pointer = pointer;
pin->managed = managed;
pin->bit_offset = bit_offset;
pin->bit_width = bit_width;
if (owner_sv) {
pin->owner_sv = owner_sv;
SvREFCNT_inc(pin->owner_sv);
}
pin->type_arena = infix_arena_create(2048);
if (!pin->type_arena) {
safefree(pin);
mg->mg_ptr = nullptr;
croak("Failed to create memory arenas for pin's type information");
}
pin->type = _copy_type_graph_to_arena(pin->type_arena, type);
if (!pin->type) {
infix_arena_destroy(pin->type_arena);
safefree(pin);
mg->mg_ptr = nullptr;
croak("Failed to copy type information into pin");
}
}
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) {
Affix_Pin * pin;
Newxz(pin, 1, Affix_Pin);
pin->pointer = symbol;
pin->managed = false;
pin->owner_sv = ST(0);
SvREFCNT_inc(pin->owner_sv);
pin->type_arena = infix_arena_create(256);
infix_type * void_ptr_type = nullptr;
if (infix_type_create_pointer_to(pin->type_arena, &void_ptr_type, infix_type_create_void()) != INFIX_SUCCESS) {
safefree(pin);
infix_arena_destroy(pin->type_arena);
croak("Internal error: Failed to create pointer type for pin");
}
pin->type = void_ptr_type;
SV * obj_data = newSV(0);
sv_setiv(obj_data, PTR2IV(pin));
SV * rv = newRV_inc(obj_data);
// Bless into Affix::Pointer BEFORE attaching magic to avoid triggering 'set' during blessing
(void)sv_bless(rv, gv_stashpv("Affix::Pointer", GV_ADD));
MAGIC * mg = sv_magicext(obj_data, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
mg->mg_ptr = (char *)pin;
ST(0) = sv_2mortal(rv);
XSRETURN(1);
}
XSRETURN_UNDEF;
}
XS_INTERNAL(Affix_pin) {
dXSARGS;
dMY_CXT;
if (items != 4)
croak_xs_usage(cv, "var, lib, symbol, type");
SV * target_sv = ST(0);
const char * lib_path_or_name = SvPV_nolen(ST(1));
const char * symbol_name = SvPV_nolen(ST(2));
const char * signature = SvPV_nolen(ST(3));
infix_library_t * lib = infix_library_open(lib_path_or_name);
if (lib == nullptr) {
warn("Failed to load library from path '%s' for pinning: %s", lib_path_or_name, infix_get_last_error().message);
XSRETURN_UNDEF;
}
void * ptr = infix_library_get_symbol(lib, symbol_name);
infix_library_close(lib);
if (ptr == nullptr) {
warn("Failed to locate symbol '%s' in library '%s'", symbol_name, lib_path_or_name);
XSRETURN_UNDEF;
}
infix_type * type = nullptr;
infix_arena_t * arena = nullptr;
const char * sig_to_parse = signature;
char * clean_sig = nullptr;
if (strstr(signature, "+")) {
clean_sig = savepv(signature);
const char * p = signature;
char * d = clean_sig;
while (*p) {
// Strip '+' only if it precedes a signature character: * [ { ! < ( @
if (*p == '+' &&
(p[1] == '*' || p[1] == '[' || p[1] == '{' || p[1] == '!' || p[1] == '<' || p[1] == '(' || p[1] == '@'))
p++;
else
*d++ = *p++;
}
*d = '\0';
sig_to_parse = clean_sig;
}
if (infix_type_from_signature(&type, &arena, sig_to_parse, MY_CXT.registry) != INFIX_SUCCESS) {
SV * err_sv = _format_parse_error(aTHX_ "for pin", sig_to_parse, infix_get_last_error());
warn_sv(err_sv);
if (arena)
infix_arena_destroy(arena);
if (clean_sig)
safefree(clean_sig);
XSRETURN_UNDEF;
}
_pin_sv(aTHX_ target_sv, type, ptr, false, nullptr, 0, 0);
infix_arena_destroy(arena);
if (clean_sig)
safefree(clean_sig);
XSRETURN_YES;
}
XS_INTERNAL(Affix_unpin) {
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "var");
if (mg_findext(ST(0), PERL_MAGIC_ext, &Affix_pin_vtbl) && !sv_unmagicext(ST(0), PERL_MAGIC_ext, &Affix_pin_vtbl))
XSRETURN_YES;
XSRETURN_NO;
}
XS_INTERNAL(Affix_sizeof) {
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 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
}
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;
if (name[0] == '@')
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);
if (!type_str)
type_str = SvPV_nolen(type_sv);
// Live() prepends '+' to signatures. Infix doesn't support this character.
if (type_str[0] == '+')
type_str++;
sv_catpv(def_sv, type_str);
}
sv_catpv(def_sv, ";");
//~ warn("Affix: Registering types: %s", SvPV_nolen(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);
#endif
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_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)) {
if (infix_registry_iterator_get_type(&it)) {
const char * name = infix_registry_iterator_get_name(&it);
PUSHs(sv_2mortal(newSVpv(name, 0)));
}
}
XSRETURN(count);
}
void _DumpHex(pTHX_ const void * addr, size_t len, const char * file, int line) {
if (addr == nullptr) {
printf("Dumping %lu bytes from null pointer %p at %s line %d\n", (unsigned long)len, addr, file, line);
fflush(stdout);
lib/Affix.c view on Meta::CPAN
int count;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 1);
PUSHs(scalar);
PUTBACK;
count = call_pv("Data::Printer::p", G_SCALAR);
SPAGAIN;
if (count != 1) {
warn("Big trouble\n");
return;
}
STRLEN len;
const char * s = SvPVx(POPs, len);
printf("%s at %s line %d\n", s, file, line);
fflush(stdout);
PUTBACK;
FREETMPS;
LEAVE;
}
XS_INTERNAL(Affix_sv_dump) {
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "sv");
sv_dump(ST(0));
XSRETURN_EMPTY;
}
SV * _new_pointer_obj(pTHX_ Affix_Pin * pin) {
SV * data_sv = newSV(0);
sv_setiv(data_sv, PTR2IV(pin));
SvUPGRADE(data_sv, SVt_PVMG);
SV * rv = newRV_noinc(data_sv);
// Bless into Affix::Pointer
(void)sv_bless(rv, gv_stashpv("Affix::Pointer", GV_ADD));
MAGIC * mg = sv_magicext(data_sv, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
mg->mg_ptr = (char *)pin;
return rv;
}
XS_INTERNAL(Affix_malloc) {
dXSARGS;
dMY_CXT;
if (items < 1)
croak_xs_usage(cv, "size");
UV size = SvUV(ST(0));
infix_type * type = nullptr;
infix_arena_t * parse_arena = nullptr;
const char * sig = "*void";
if (infix_type_from_signature(&type, &parse_arena, sig, MY_CXT.registry) != INFIX_SUCCESS) {
SV * err_sv = _format_parse_error(aTHX_ "for malloc", sig, infix_get_last_error());
warn_sv(err_sv);
if (parse_arena)
infix_arena_destroy(parse_arena);
XSRETURN_UNDEF;
}
if (size == 0) {
infix_arena_destroy(parse_arena);
warn("Cannot malloc a zero-sized type");
XSRETURN_UNDEF;
}
void * ptr = safemalloc(size);
Affix_Pin * pin;
Newxz(pin, 1, Affix_Pin);
pin->size = size;
pin->pointer = ptr;
pin->managed = true;
pin->type_arena = infix_arena_create(1024);
// We unwrap the pointer type logic here similar to cast.
// If the user passed "Int", we want the pin to be typed as "Int" (so $$pin reads an int).
// _unwrap_pin_type handles the logic of "don't unwrap *void or *char".
pin->type = _copy_type_graph_to_arena(pin->type_arena, _unwrap_pin_type(type));
infix_arena_destroy(parse_arena);
ST(0) = sv_2mortal(_new_pointer_obj(aTHX_ pin));
XSRETURN(1);
}
XS_INTERNAL(Affix_calloc) {
dXSARGS;
dMY_CXT;
if (items != 2)
croak_xs_usage(cv, "count, type_signature");
UV count = SvUV(ST(0));
const char * signature = nullptr;
SV * type_sv = ST(1);
signature = _get_string_from_type_obj(aTHX_ type_sv);
if (!signature)
signature = SvPV_nolen(type_sv);
infix_type * elem_type = nullptr;
infix_arena_t * parse_arena = nullptr;
if (infix_type_from_signature(&elem_type, &parse_arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
SV * err_sv = _format_parse_error(aTHX_ "for calloc", signature, infix_get_last_error());
warn_sv(err_sv);
if (parse_arena)
infix_arena_destroy(parse_arena);
XSRETURN_UNDEF;
}
size_t elem_size = infix_type_get_size(elem_type);
if (elem_size == 0) {
infix_arena_destroy(parse_arena);
warn("Cannot calloc a zero-sized type");
XSRETURN_UNDEF;
}
void * ptr = safecalloc(count, elem_size);
Affix_Pin * pin;
Newxz(pin, 1, Affix_Pin);
pin->pointer = ptr;
pin->managed = true;
pin->type_arena = infix_arena_create(1024);
infix_type * array_type;
if (infix_type_create_array(pin->type_arena, &array_type, elem_type, count) != INFIX_SUCCESS) {
safefree(pin);
if (ptr)
safefree(ptr);
infix_arena_destroy(pin->type_arena);
infix_arena_destroy(parse_arena);
warn("Failed to create array type graph.");
XSRETURN_UNDEF;
}
pin->type = array_type;
pin->size = (count * elem_size);
infix_arena_destroy(parse_arena);
ST(0) = sv_2mortal(_new_pointer_obj(aTHX_ pin));
XSRETURN(1);
}
XS_INTERNAL(Affix_realloc) {
dXSARGS;
if (items != 2)
croak_xs_usage(cv, "self, new_size");
Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
if (!pin || !pin->managed) {
warn("Can only realloc a managed pointer");
XSRETURN_NO;
}
UV new_size = SvUV(ST(1));
size_t old_size = pin->size;
void * new_ptr = saferealloc(pin->pointer, new_size);
if (new_size > old_size)
memset((char *)new_ptr + old_size, 0, new_size - old_size);
pin->pointer = new_ptr;
pin->size = new_size;
XSRETURN_YES;
}
XS_INTERNAL(Affix_free) {
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "pointer_object");
Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
if (!pin) {
warn("Affix::free called on a non-pointer object");
XSRETURN_NO;
}
if (!pin->managed) {
warn("Cannot free a pointer that was not allocated by Affix (it is unmanaged)");
XSRETURN_NO;
}
if (pin->pointer) {
safefree(pin->pointer);
pin->pointer = nullptr;
}
XSRETURN_YES;
}
static const infix_type * _resolve_type(pTHX_ const infix_type * type);
XS_INTERNAL(Affix_cast) {
dXSARGS;
dMY_CXT;
if (items != 2)
croak_xs_usage(cv, "pointer_or_address, new_type_signature");
SV * arg = ST(0);
Affix_Pin * pin = _get_pin_from_sv(aTHX_ arg);
void * ptr_val = nullptr;
if (pin)
ptr_val = pin->pointer;
else if (SvIOK(arg))
ptr_val = INT2PTR(void *, SvUV(arg));
else {
warn("Argument to cast must be a Pointer Object or Integer Address");
XSRETURN_UNDEF;
}
SV * type_sv = ST(1);
const char * signature = _get_string_from_type_obj(aTHX_ type_sv);
if (!signature)
signature = SvPV_nolen(type_sv);
bool live_hint = (signature[0] == '+');
if (live_hint)
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;
}
/* Value (Copy) vs Pin (Reference) */
bool return_as_value = false;
bool is_string_type = false;
if (new_type->category == INFIX_TYPE_PRIMITIVE || new_type->category == INFIX_TYPE_ENUM ||
new_type->category == INFIX_TYPE_STRUCT || new_type->category == INFIX_TYPE_UNION) {
return_as_value = true;
}
else if (new_type->category == INFIX_TYPE_POINTER) {
const infix_type * pointee = new_type->meta.pointer_info.pointee_type;
/* Check if casting to String (*char) or WString (*wchar_t) */
if (pointee->category == INFIX_TYPE_PRIMITIVE) {
if (pointee->meta.primitive_id == INFIX_PRIMITIVE_SINT8 ||
pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT8 ||
/* Char check */
infix_type_get_size(pointee) == 1) {
return_as_value = true;
is_string_type = true;
}
#if defined(INFIX_OS_WINDOWS)
else if (infix_type_get_size(pointee) == sizeof(wchar_t)) {
return_as_value = true;
is_string_type = true;
}
#endif
}
}
if (return_as_value) {
/* Read memory -> Perl Scalar */
SV * ret_val = sv_newmortal();
const infix_type * resolved = _resolve_type(aTHX_ new_type);
if (is_string_type) {
/*
* String pull handlers expect a pointer-to-pointer (char**).
* 'ptr_val' IS the char*. So we pass '&ptr_val'.
* The handler reads *(&ptr_val) -> ptr_val, then reads the string.
*/
ptr2sv(aTHX_ nullptr, &ptr_val, ret_val, new_type);
}
else if (live_hint && (resolved->category == INFIX_TYPE_STRUCT || resolved->category == INFIX_TYPE_UNION)) {
// Live struct return from cast: bypass ptr2sv and create blessed HV
HV * hv = newHV();
SV * rv = newRV_noinc(MUTABLE_SV(hv));
sv_bless(rv, gv_stashpv("Affix::Live", GV_ADD));
_populate_hv_from_c_struct(
aTHX_ nullptr, hv, resolved, ptr_val, true, pin ? (pin->owner_sv ? pin->owner_sv : arg) : nullptr);
ret_val = sv_2mortal(rv);
}
else if (resolved->category == INFIX_TYPE_UNION) {
// Unions are always live!
pull_union(aTHX_ nullptr, ret_val, resolved, ptr_val);
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 * pin = _get_pin_from_sv(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 * dpin = _get_pin_from_sv(aTHX_ ST(1));
if (dpin)
destructor_ptr = dpin->pointer;
}
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);
}
XS_INTERNAL(Affix_dump) {
dVAR;
dXSARGS;
if (items != 2)
croak_xs_usage(cv, "scalar, length_in_bytes");
Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
if (!pin) {
warn("scalar is not a valid pointer");
XSRETURN_EMPTY;
}
if (!pin->pointer) {
warn("Cannot dump a nullptr pointer");
XSRETURN_EMPTY;
}
UV length = SvUV(ST(1));
if (length == 0) {
warn("Dump length cannot be zero");
XSRETURN_EMPTY;
}
// PL_curcop may be nullptr during thread destruction or callbacks?
const char * file = "Unknown";
int line = 0;
if (LIKELY(PL_curcop)) {
file = OutCopFILE(PL_curcop);
line = CopLINE(PL_curcop);
}
_DumpHex(aTHX_ pin->pointer, length, file, line);
ST(0) = ST(0);
XSRETURN(1);
}
static void * _resolve_writable_ptr(pTHX_ SV * sv) {
if (is_pin(aTHX_ sv)) {
Affix_Pin * p = _get_pin_from_sv(aTHX_ sv);
return p ? p->pointer : nullptr;
}
if (SvIOK(sv))
return INT2PTR(void *, SvUV(sv));
return nullptr;
}
static const void * _resolve_readable_ptr(pTHX_ SV * sv) {
if (is_pin(aTHX_ sv)) {
Affix_Pin * p = _get_pin_from_sv(aTHX_ sv);
return p ? p->pointer : nullptr;
}
if (SvIOK(sv))
return INT2PTR(void *, SvUV(sv));
if (SvPOK(sv))
return (const void *)SvPV_nolen(sv);
return nullptr;
lib/Affix.c view on Meta::CPAN
dVAR;
dXSBOOTARGSXSAPIVERCHK;
PERL_UNUSED_VAR(items);
#ifdef USE_ITHREADS
my_perl = (PerlInterpreter *)PERL_GET_CONTEXT;
#endif
MY_CXT_INIT;
MY_CXT.lib_registry = newHV();
MY_CXT.callback_registry = newHV();
MY_CXT.enum_registry = newHV();
MY_CXT.coercion_cache = newHV();
MY_CXT.stash_pointer = nullptr;
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");
// Scalar pins
XSUB_EXPORT(pin, "$$$$", "pin");
XSUB_EXPORT(unpin, "$", "pin");
// 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::_register_enum_values", Affix_register_enum_values, __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, "$", "memory");
XSUB_EXPORT(malloc, "$", "memory");
XSUB_EXPORT(calloc, "$$", "memory");
XSUB_EXPORT(realloc, "$$", "memory");
XSUB_EXPORT(free, "$", "memory");
XSUB_EXPORT(cast, "$$", "memory");
XSUB_EXPORT(dump, "$$", "memory");
XSUB_EXPORT(own, "$;$", "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");
// Pin internals (for Affix::Pointer)
(void)newXSproto_portable("Affix::_pin_type", Affix_pin_type, __FILE__, "$");
(void)newXSproto_portable("Affix::_pin_element_type", Affix_pin_element_type, __FILE__, "$");
(void)newXSproto_portable("Affix::_pin_count", Affix_pin_count, __FILE__, "$");
(void)newXSproto_portable("Affix::_pin_size", Affix_pin_size, __FILE__, "$");
(void)newXSproto_portable("Affix::_pin_get_at", Affix_pin_get_at, __FILE__, "$$");
(void)newXSproto_portable("Affix::_pin_set_at", Affix_pin_set_at, __FILE__, "$$$");
(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__, "$");
#undef XSUB_EXPORT
Perl_xs_boot_epilog(aTHX_ ax);
( run in 0.697 second using v1.01-cache-2.11-cpan-39bf76dae61 )