Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
addr = infix_library_get_symbol(lib_handle, sym_name);
owner = lib_sv;
}
}
if (!addr)
croak("Could not resolve memory address for pin");
if (!type_sig)
croak("Type signature required for pin");
infix_type * type = nullptr;
infix_arena_t * arena = nullptr;
if (infix_type_from_signature(&type, &arena, type_sig, MY_CXT.registry) != INFIX_SUCCESS) {
if (arena)
infix_arena_destroy(arena);
croak("Invalid type signature: %s", type_sig);
}
// Bind to the target scalar
bind_placeholder(aTHX_ target_sv, addr, type, 0, 0, true, owner, arena, false, true);
// Clean up temporary type_sig if we generated it from infix_type_print
if (items == 2 && type_sig)
safefree((void *)type_sig);
ST(0) = target_sv;
XSRETURN(1);
}
XS_INTERNAL(Affix_unpin) {
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "var");
SV * sv = ST(0);
// Pins are often references to magical scalars; unwrap if necessary
if (SvROK(sv) && !sv_isobject(sv))
sv = SvRV(sv);
if (SvMAGICAL(sv)) {
MAGIC * mg = mg_find(sv, PERL_MAGIC_ext);
while (mg) {
// Check if this magic belongs to the Affix 2.0 memory system
if (is_v2_vtable(mg->mg_virtual)) {
// sv_unmagicext returns 0 on success
if (sv_unmagicext(sv, PERL_MAGIC_ext, mg->mg_virtual) == 0)
XSRETURN_YES;
}
mg = mg->mg_moremagic;
}
}
XSRETURN_NO;
}
// Handles UTF-16LE (Windows) and UTF-32 (Linux/Mac) conversion to UTF-8 SV
static void pull_pointer_as_wstring(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
PERL_UNUSED_VAR(affix);
PERL_UNUSED_VAR(type);
wchar_t * wstr = *(wchar_t **)p;
if (wstr == nullptr) {
sv_setsv(sv, &PL_sv_undef);
return;
}
// Calculate length (like wcslen)
size_t wlen = 0;
while (wstr[wlen])
wlen++;
// Pre-allocate SV buffer.
// Worst case UTF-8 expansion: 1 wchar (4 bytes) -> 4 UTF-8 bytes.
// +1 for null terminator.
SvPVCLEAR(sv);
char * d = SvGROW(sv, (wlen * sizeof(wchar_t)) + 1);
wchar_t * s = wstr;
while (*s) {
UV uv = (UV)*s++;
// Handle Windows Surrogate Pairs (UTF-16LE)
if (sizeof(wchar_t) == 2 && uv >= 0xD800 && uv <= 0xDBFF) {
if (*s >= 0xDC00 && *s <= 0xDFFF) {
UV low = (UV)*s++;
uv = ((uv - 0xD800) << 10) + (low - 0xDC00) + 0x10000;
}
}
d = (char *)uvchr_to_utf8((U8 *)d, uv);
}
*d = 0;
// Set Perl SV properties
SvCUR_set(sv, d - SvPVX(sv));
SvPOK_on(sv);
SvUTF8_on(sv);
}
// Direct marshalling experiment
void Affix_trigger_backend(pTHX_ CV * cv) {
// Backend optimization is not yet thread-clone friendly in this patch.
// For now, assume it works or isn't used in the threading test.
dSP;
dAXMARK;
dXSTARG;
Affix_Backend * backend = (Affix_Backend *)CvXSUBANY(cv).any_ptr;
if (UNLIKELY((SP - MARK) != backend->num_args))
croak("Wrong number of arguments to affixed function. Expected %" UVuf ", got %" UVuf,
(UV)backend->num_args,
(UV)(SP - MARK));
size_t ret_size = infix_type_get_size(backend->ret_type);
void * ret_buffer;
if (ret_size <= 2048)
ret_buffer = alloca(ret_size);
else {
Newxz(ret_buffer, ret_size, char);
SAVEFREEPV(ret_buffer);
}
SV ** perl_stack_frame = &ST(0);
backend->cif(ret_buffer, (void **)perl_stack_frame);
switch (backend->ret_opcode) {
case OP_RET_VOID:
sv_setsv(TARG, &PL_sv_undef);
break;
case OP_RET_BOOL:
sv_setbool(TARG, *(bool *)ret_buffer);
break;
case OP_RET_SINT8:
sv_setiv(TARG, *(int8_t *)ret_buffer);
break;
case OP_RET_UINT8:
sv_setuv(TARG, *(uint8_t *)ret_buffer);
break;
case OP_RET_SINT16:
sv_setiv(TARG, *(int16_t *)ret_buffer);
break;
case OP_RET_UINT16:
sv_setuv(TARG, *(uint16_t *)ret_buffer);
break;
case OP_RET_SINT32:
sv_setiv(TARG, *(int32_t *)ret_buffer);
break;
case OP_RET_UINT32:
sv_setuv(TARG, *(uint32_t *)ret_buffer);
break;
case OP_RET_SINT64:
sv_setiv(TARG, *(int64_t *)ret_buffer);
break;
case OP_RET_UINT64:
sv_setuv(TARG, *(uint64_t *)ret_buffer);
break;
case OP_RET_FLOAT:
sv_setnv(TARG, (double)*(float *)ret_buffer);
break;
case OP_RET_DOUBLE:
sv_setnv(TARG, *(double *)ret_buffer);
break;
case OP_RET_PTR_CHAR:
{
char * p = *(char **)ret_buffer;
if (p)
sv_setpv(TARG, p);
else
sv_setsv(TARG, &PL_sv_undef);
break;
}
case OP_RET_PTR_WCHAR:
pull_pointer_as_pin(aTHX_ nullptr, TARG, backend->ret_type, ret_buffer, backend->ret_readonly);
break;
case OP_RET_SV:
{
SV * s = *(SV **)ret_buffer;
if (s)
sv_setsv(TARG, s);
else
sv_setsv(TARG, &PL_sv_undef);
break;
}
case OP_RET_CUSTOM:
default:
backend->pull_handler(aTHX_ nullptr, TARG, backend->ret_type, ret_buffer, backend->ret_readonly);
break;
}
ST(0) = TARG;
PL_stack_sp = PL_stack_base + ax;
}
static infix_direct_value_t affix_marshaller_sint(void * sv_raw) {
dTHX;
infix_direct_value_t val;
val.i64 = SvIV((SV *)sv_raw);
return val;
}
static infix_direct_value_t affix_marshaller_uint(void * sv_raw) {
dTHX;
infix_direct_value_t val;
val.u64 = SvUV((SV *)sv_raw);
return val;
}
static infix_direct_value_t affix_marshaller_double(void * sv_raw) {
infix_direct_value_t val;
SV * sv = (SV *)sv_raw;
U32 flags = SvFLAGS(sv);
if (LIKELY(flags & SVf_NOK)) {
val.f64 = SvNVX(sv);
}
else if (flags & SVf_IOK) {
if (flags & SVf_IVisUV)
val.f64 = (double)SvUVX(sv);
else
val.f64 = (double)SvIVX(sv);
}
else {
dTHX;
val.f64 = (double)SvNV(sv);
}
return val;
}
static infix_direct_value_t affix_marshaller_pointer(void * sv_raw) {
dTHX;
infix_direct_value_t val;
SV * sv = (SV *)sv_raw;
void * v2_addr = get_address_v2(aTHX_ sv);
if (v2_addr)
val.ptr = v2_addr;
else if (SvPOK(sv))
val.ptr = (void *)SvPV_nolen(sv);
else if (!SvOK(sv))
val.ptr = nullptr;
else
val.ptr = INT2PTR(void *, SvIV(SvRV(sv)));
lib/Affix.c view on Meta::CPAN
void * struct_ptr = *(void **)c_arg_ptr;
if (!struct_ptr)
return;
// Direct AV check
if (SvTYPE(perl_sv) == SVt_PVAV) {
AV * av = (AV *)perl_sv;
size_t count = av_len(av) + 1;
size_t elem_size = infix_type_get_size(info->pointee_type);
for (size_t i = 0; i < count; ++i) {
SV ** item_ptr = av_fetch(av, i, 0);
if (item_ptr && SvROK(*item_ptr) && SvTYPE(SvRV(*item_ptr)) == SVt_PVHV) {
_populate_hv_from_c_struct(aTHX_ affix,
(HV *)SvRV(*item_ptr),
info->pointee_type,
(char *)struct_ptr + (i * elem_size),
false,
nullptr,
false);
}
}
return;
}
if (SvTYPE(perl_sv) == SVt_PVHV) {
_populate_hv_from_c_struct(aTHX_ affix, (HV *)perl_sv, info->pointee_type, struct_ptr, false, nullptr, false);
}
else if (SvROK(perl_sv) && SvTYPE(SvRV(perl_sv)) == SVt_PVAV) {
// Array of structs decay
AV * av = (AV *)SvRV(perl_sv);
size_t count = av_len(av) + 1;
size_t elem_size = infix_type_get_size(info->pointee_type);
for (size_t i = 0; i < count; ++i) {
SV ** item_ptr = av_fetch(av, i, 0);
if (item_ptr && SvROK(*item_ptr) && SvTYPE(SvRV(*item_ptr)) == SVt_PVHV) {
_populate_hv_from_c_struct(aTHX_ affix,
(HV *)SvRV(*item_ptr),
info->pointee_type,
(char *)struct_ptr + (i * elem_size),
false,
nullptr,
false);
}
}
}
}
static void writeback_pointer_to_string(pTHX_ Affix * affix,
const OutParamInfo * info,
SV * perl_sv,
void * c_arg_ptr) {
PERL_UNUSED_VAR(affix);
PERL_UNUSED_VAR(info);
if (UNLIKELY(SvTYPE(perl_sv) >= SVt_PVAV))
return;
char ** p = *(char ***)c_arg_ptr;
if (p && *p)
sv_setpv(perl_sv, *p);
else
sv_setsv(perl_sv, &PL_sv_undef);
}
static void writeback_pointer_generic(pTHX_ Affix * affix, const OutParamInfo * info, SV * perl_sv, void * c_arg_ptr) {
void * inner_ptr = *(void **)c_arg_ptr;
// If the function didn't touch the output slot, inner_ptr might be a nullptr
// But inner_ptr is the address of our temp_slot if it's an lvalue
if (!inner_ptr)
return;
// Direct AV check
if (SvTYPE(perl_sv) == SVt_PVAV) {
AV * av = (AV *)perl_sv;
size_t count = av_len(av) + 1;
size_t elem_size = infix_type_get_size(info->pointee_type);
void * elem_ptr = nullptr;
for (size_t i = 0; i < count; ++i) {
SV ** item_ptr = av_fetch(av, i, 0);
if (item_ptr) {
elem_ptr = (char *)inner_ptr + (i * elem_size);
ptr2sv(aTHX_ affix, (char *)inner_ptr + (i * elem_size), *item_ptr, info->pointee_type, false);
}
}
return;
}
if (SvROK(perl_sv)) { // reference to an SV*
SV * rv = SvRV(perl_sv);
if (SvTYPE(rv) == SVt_PVAV) {
// Array Decay for Pointer[Pointer]
AV * av = (AV *)rv;
size_t count = av_len(av) + 1;
size_t elem_size = infix_type_get_size(info->pointee_type);
for (size_t i = 0; i < count; ++i) {
SV * val_sv = newSV(0);
// inner_ptr is T*. Array elements are at inner_ptr[i].
ptr2sv(aTHX_ affix, (char *)inner_ptr + (i * elem_size), val_sv, info->pointee_type, false);
av_store(av, i, val_sv);
}
return;
}
if (SvTYPE(rv) == SVt_PVHV)
return;
ptr2sv(aTHX_ affix, inner_ptr, rv, info->pointee_type, false);
}
else {
if (UNLIKELY(SvTYPE(perl_sv) >= SVt_PVAV))
return;
ptr2sv(aTHX_ affix, inner_ptr, perl_sv, info->pointee_type, false);
}
}
Affix_Out_Param_Writer get_out_param_writer(const infix_type * pointee_type) {
if (pointee_type->category == INFIX_TYPE_STRUCT)
return writeback_struct;
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)) {
return writeback_pointer_to_string;
lib/Affix.c view on Meta::CPAN
DISPATCH(); \
} \
CASE_OP_PUSH_POINTER: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
void * addr = get_address_v2(aTHX_ sv); \
if (addr) \
*(void **)ptr = addr; \
else if (is_pin_v2(aTHX_ sv)) \
*(void **)ptr = get_address_v2(aTHX_ sv); \
else if (!SvOK(sv) && SvREADONLY(sv)) \
*(void **)ptr = nullptr; \
else \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_SV: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
*(SV **)ptr = sv; \
DISPATCH(); \
} \
CASE_OP_PUSH_VECTOR: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
if (SvPOK(sv)) { \
STRLEN len; \
const char * buf = SvPV(sv, len); \
size_t sz = infix_type_get_size(step->data.type); \
if (len >= sz) { \
memcpy(ptr, buf, sz); \
DISPATCH(); \
} \
} \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_STRUCT: \
CASE_OP_PUSH_UNION: \
CASE_OP_PUSH_ARRAY: \
CASE_OP_PUSH_CALLBACK: \
CASE_OP_PUSH_ENUM: \
CASE_OP_PUSH_COMPLEX: \
{ \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_DONE: \
DISPATCH_END(); \
\
affix->cif(ret_buffer, c_args); \
\
switch (affix->ret_opcode) { \
case OP_RET_VOID: \
sv_setsv(TARG, &PL_sv_undef); \
break; \
case OP_RET_BOOL: \
sv_setbool(TARG, *(bool *)ret_buffer); \
break; \
case OP_RET_SINT8: \
sv_setiv(TARG, *(int8_t *)ret_buffer); \
break; \
case OP_RET_UINT8: \
sv_setuv(TARG, *(uint8_t *)ret_buffer); \
break; \
case OP_RET_SINT16: \
sv_setiv(TARG, *(int16_t *)ret_buffer); \
break; \
case OP_RET_UINT16: \
sv_setuv(TARG, *(uint16_t *)ret_buffer); \
break; \
case OP_RET_SINT32: \
sv_setiv(TARG, *(int32_t *)ret_buffer); \
break; \
case OP_RET_UINT32: \
sv_setuv(TARG, *(uint32_t *)ret_buffer); \
break; \
case OP_RET_SINT64: \
sv_setiv(TARG, *(int64_t *)ret_buffer); \
break; \
case OP_RET_UINT64: \
sv_setuv(TARG, *(uint64_t *)ret_buffer); \
break; \
case OP_RET_SINT128: \
sv_from_int128_safe(TARG, ret_buffer); \
break; \
case OP_RET_UINT128: \
sv_from_uint128_safe(TARG, ret_buffer); \
break; \
case OP_RET_FLOAT: \
sv_setnv(TARG, (double)*(float *)ret_buffer); \
break; \
case OP_RET_FLOAT16: \
sv_setnv(TARG, (double)half_to_float(*(infix_float16_t *)ret_buffer)); \
break; \
case OP_RET_DOUBLE: \
sv_setnv(TARG, *(double *)ret_buffer); \
break; \
case OP_RET_PTR: \
{ \
void * c_ptr = *(void **)ret_buffer; \
if (c_ptr == nullptr) \
sv_setsv(TARG, &PL_sv_undef); \
else \
pull_pointer_as_pin(aTHX_ nullptr, TARG, affix->ret_type, ret_buffer, affix->ret_readonly); \
break; \
} \
case OP_RET_PTR_CHAR: \
{ \
char * p = *(char **)ret_buffer; \
if (p) \
sv_setpv(TARG, p); \
else \
sv_setsv(TARG, &PL_sv_undef); \
break; \
} \
case OP_RET_PTR_WCHAR: \
pull_pointer_as_wstring(aTHX_ affix, TARG, affix->ret_type, ret_buffer, affix->ret_readonly); \
break; \
case OP_RET_SV: \
{ \
SV * s = *(SV **)ret_buffer; \
if (s) \
sv_setsv(TARG, s); \
else \
sv_setsv(TARG, &PL_sv_undef); \
break; \
} \
case OP_RET_CUSTOM: \
default: \
if (affix->ret_pull_handler) \
affix->ret_pull_handler(aTHX_ affix, TARG, affix->ret_type, ret_buffer, affix->ret_readonly); \
break; \
} \
if (UNLIKELY(affix->num_out_params > 0)) { \
for (size_t i = 0; i < affix->num_out_params; ++i) { \
const OutParamInfo * info = &affix->out_param_info[i]; \
SV * arg_sv = ST(info->perl_stack_index); \
if (SvROK(arg_sv) && !is_pin_v2(aTHX_ arg_sv)) { \
SV * rsv = SvRV(arg_sv); \
info->writer(aTHX_ affix, info, rsv, c_args[info->perl_stack_index]); \
} \
else if (!SvOK(arg_sv) && !SvREADONLY(arg_sv)) \
info->writer(aTHX_ affix, info, arg_sv, c_args[info->perl_stack_index]); \
} \
} \
infix_arena_rewind(affix->call_args_arena, args_mark); \
infix_arena_rewind(affix->call_ret_arena, ret_mark); \
\
ST(0) = TARG; \
XSRETURN(1); \
}
// Generate the two XSUBs
GENERATE_TRIGGER_XSUB(Affix_trigger_stack, 1)
GENERATE_TRIGGER_XSUB(Affix_trigger_arena, 0)
static void _lib_registry_inc_ref(pTHX_ infix_library_t * lib) {
dMY_CXT;
if (MY_CXT.lib_registry == nullptr)
return;
hv_iterinit(MY_CXT.lib_registry);
HE * he;
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++;
break;
}
}
}
static infix_library_t * _get_lib_from_registry(pTHX_ const char * path) {
dMY_CXT;
const char * lookup_path = (path == nullptr) ? "" : path;
SV ** entry_sv_ptr = hv_fetch(MY_CXT.lib_registry, lookup_path, strlen(lookup_path), 0);
if (entry_sv_ptr) {
LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(*entry_sv_ptr));
entry->ref_count++;
return entry->lib;
}
infix_library_t * lib = infix_library_open(path);
if (lib) {
LibRegistryEntry * new_entry;
Newxz(new_entry, 1, LibRegistryEntry);
lib/Affix.c view on Meta::CPAN
}
XS_INTERNAL(Affix_affix) {
dXSARGS;
dXSI32;
dMY_CXT;
if (ix == 2 || ix == 4) {
if (items != 3)
croak_xs_usage(cv, "Affix::affix_bundle($target, $name, $signature)");
}
else {
// Allow 2 items for wrap($ptr, $sig)
if (items < 2 || items > 4)
croak_xs_usage(cv, "Affix::affix($target, ...)");
}
void * symbol = nullptr;
SV * target_sv = ST(0);
// Detect target type (library vs raw pointer)
bool is_raw_ptr_target = false;
symbol = get_address_v2(aTHX_ target_sv);
if (symbol)
is_raw_ptr_target = true;
else if (SvIOK(target_sv) && !sv_isobject(target_sv)) {
symbol = INT2PTR(void *, SvUV(target_sv));
is_raw_ptr_target = true;
}
// Symbol lookup (unles it's a raw pointer)
const char * symbol_name_str = nullptr;
const char * rename_str = nullptr;
infix_library_t * lib_handle_for_symbol = nullptr;
bool created_implicit_handle = false;
// We only process names/libraries if we don't already have a raw pointer address
if (!is_raw_ptr_target) {
SV * name_sv = ST(1);
// Handle rename: affix($lib, ['real', 'alias'], ...)
if (SvROK(name_sv) && SvTYPE(SvRV(name_sv)) == SVt_PVAV) {
if (ix == 1 || ix == 3) // wrap/direct_wrap
croak("Cannot rename an anonymous Affix'd wrapper");
AV * name_av = (AV *)SvRV(name_sv);
if (av_count(name_av) != 2)
croak("Name spec arrayref must contain exactly two elements: [symbol_name, new_sub_name]");
SV ** sym_sv = av_fetch(name_av, 0, 0);
SV ** alias_sv = av_fetch(name_av, 1, 0);
if (!sym_sv || !alias_sv)
croak("Invalid name spec");
rename_str = SvPV_nolen(*alias_sv);
// Is the symbol inside the array a raw pointer?
// affix(undef, [$ptr, 'name'], ...)
symbol = get_address_v2(aTHX_ * sym_sv);
if (symbol)
;
else if (SvIOK(*sym_sv))
symbol = INT2PTR(void *, SvUV(*sym_sv));
else
symbol_name_str = SvPV_nolen(*sym_sv);
}
else {
// Name a Scalar? (string or raw pointer)
// wrap(undef, $ptr, ...)
symbol = get_address_v2(aTHX_ name_sv);
if (symbol)
;
else if (SvIOK(name_sv))
symbol = INT2PTR(void *, SvUV(name_sv));
else {
// It's a string name
symbol_name_str = SvPV_nolen(name_sv);
rename_str = symbol_name_str;
}
}
// Only load library if we don't have a direct symbol pointer yet
if (!symbol) {
if (sv_isobject(target_sv) && sv_derived_from(target_sv, "Affix::Lib")) {
IV tmp = SvIV((SV *)SvRV(target_sv));
lib_handle_for_symbol = INT2PTR(infix_library_t *, tmp);
_lib_registry_inc_ref(aTHX_ lib_handle_for_symbol);
created_implicit_handle = true;
}
else {
const char * path = SvOK(target_sv) ? SvPV_nolen(target_sv) : nullptr;
lib_handle_for_symbol = _get_lib_from_registry(aTHX_ path);
if (lib_handle_for_symbol)
created_implicit_handle = true;
}
if (lib_handle_for_symbol && symbol_name_str)
symbol = infix_library_get_symbol(lib_handle_for_symbol, symbol_name_str);
}
if (symbol == nullptr) {
if (created_implicit_handle) {
const char * lookup_path = SvOK(target_sv) ? SvPV_nolen(target_sv) : "";
SV ** entry_sv_ptr = hv_fetch(MY_CXT.lib_registry, lookup_path, strlen(lookup_path), 0);
if (entry_sv_ptr) {
LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(*entry_sv_ptr));
entry->ref_count--;
if (entry->ref_count == 0) {
infix_library_close(entry->lib);
safefree(entry);
hv_delete_ent(MY_CXT.lib_registry, newSVpvn(lookup_path, strlen(lookup_path)), G_DISCARD, 0);
}
}
}
warn("Failed to locate symbol '%s'", symbol_name_str ? symbol_name_str : "(null)");
XSRETURN_UNDEF;
}
}
// Argument shifting (Determine where signature starts)
SV * args_sv = nullptr;
SV * ret_sv = nullptr;
SV * sig_sv = nullptr;
bool explicit_args = false; // true if using [Args] => Ret format
if (is_raw_ptr_target) {
// Mode A: wrap($ptr, [Args], Ret) -> items=3
// Mode B: wrap($ptr, "Signature") -> items=2
if (items == 3) {
lib/Affix.c view on Meta::CPAN
static void pull_sint8(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
sv_setiv(sv, *(int8_t *)p);
}
static void pull_uint8(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
sv_setuv(sv, *(uint8_t *)p);
}
static void pull_sint16(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
int16_t val;
memcpy(&val, p, sizeof val);
sv_setiv(sv, val);
}
static void pull_uint16(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
uint16_t val;
memcpy(&val, p, sizeof val);
sv_setuv(sv, val);
}
static void pull_sint32(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
int32_t val;
memcpy(&val, p, sizeof val);
sv_setiv(sv, val);
}
static void pull_uint32(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
uint32_t val;
memcpy(&val, p, sizeof val);
sv_setuv(sv, val);
}
static void pull_sint64(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
int64_t val;
memcpy(&val, p, sizeof val);
sv_setiv(sv, val);
}
static void pull_uint64(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
uint64_t val;
memcpy(&val, p, sizeof val);
sv_setuv(sv, val);
}
static void pull_float16(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
infix_float16_t val;
memcpy(&val, p, sizeof val);
sv_setnv(sv, (double)half_to_float(val));
}
static void pull_float(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
float val;
memcpy(&val, p, sizeof val);
sv_setnv(sv, val);
}
static void pull_double(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
double val;
memcpy(&val, p, sizeof val);
sv_setnv(sv, val);
}
static void pull_long_double(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
long double val;
memcpy(&val, p, sizeof val);
sv_setnv(sv, (double)val);
}
static void pull_bool(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
sv_setbool(sv, *(bool *)p);
}
static void pull_void(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
sv_setsv(sv, &PL_sv_undef);
}
#if !defined(INFIX_COMPILER_MSVC)
static void pull_sint128(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
sv_from_int128_safe(sv, p);
}
static void pull_uint128(pTHX_ Affix * affix, SV * sv, const infix_type * t, void * p, bool readonly) {
sv_from_uint128_safe(sv, p);
}
#endif
static void pull_struct(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
HV * hv;
bool live = (sv_isobject(sv) && sv_derived_from(sv, "Affix::Const")) ||
(SvROK(sv) && sv_isobject(SvRV(sv)) && sv_derived_from(SvRV(sv), "Affix::Const"));
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV)
hv = (HV *)SvRV(sv);
else {
hv = newHV();
SV * rv = newRV_noinc(MUTABLE_SV(hv));
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
_populate_hv_from_c_struct(aTHX_ affix, hv, type, p, false, nullptr, live);
}
static void pull_union(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
HV * hv;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) {
hv = (HV *)SvRV(sv);
}
else {
hv = newHV();
SV * rv = newRV_noinc(MUTABLE_SV(hv));
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
_populate_hv_from_c_struct(aTHX_ affix, hv, type, p, true, nullptr, false);
}
// Helper for portability if strnlen isn't available
static size_t _safe_strnlen(const char * s, size_t maxlen) {
size_t len;
for (len = 0; len < maxlen; len++, s++)
if (!*s)
break;
return len;
}
static void pull_array(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
const infix_type * element_type = type->meta.array_info.element_type;
if (element_type->category == INFIX_TYPE_PRIMITIVE) {
if (element_type->meta.primitive_id == INFIX_PRIMITIVE_SINT8) {
size_t len = type->meta.array_info.num_elements;
const char * ptr = (const char *)p;
while (len > 0 && ptr[len - 1] == '\0')
len--;
sv_setpvn(sv, ptr, len);
lib/Affix.c view on Meta::CPAN
static void pull_complex(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
AV * av;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
av = (AV *)SvRV(sv);
}
else {
av = newAV();
SV * rv = newRV_noinc(MUTABLE_SV(av));
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
const infix_type * base_type = type->meta.complex_info.base_type;
size_t base_size = infix_type_get_size(base_type);
SV ** real_ptr = av_fetch(av, 0, 0);
SV * real_sv = real_ptr ? *real_ptr : newSV(0);
ptr2sv(aTHX_ affix, p, real_sv, base_type, readonly);
if (!real_ptr && !av_store(av, 0, real_sv))
SvREFCNT_dec(real_sv);
SV ** imag_ptr = av_fetch(av, 1, 0);
SV * imag_sv = imag_ptr ? *imag_ptr : newSV(0);
ptr2sv(aTHX_ affix, (char *)p + base_size, imag_sv, base_type, readonly);
if (!imag_ptr && !av_store(av, 1, imag_sv))
SvREFCNT_dec(imag_sv);
}
static void pull_vector(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
AV * av;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
av = (AV *)SvRV(sv);
}
else {
av = newAV();
SV * rv = newRV_noinc(MUTABLE_SV(av));
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
const infix_type * element_type = type->meta.vector_info.element_type;
size_t num_elements = type->meta.vector_info.num_elements;
size_t element_size = infix_type_get_size(element_type);
av_extend(av, num_elements);
Affix_Pull h = get_pull_handler(aTHX_ element_type);
if (!h)
croak("Cannot convert C vector element type to Perl SV");
for (size_t i = 0; i < num_elements; ++i) {
void * element_ptr = (char *)p + (i * element_size);
SV ** existing_sv_ptr = av_fetch(av, i, 0);
SV * element_sv = existing_sv_ptr ? *existing_sv_ptr : newSV(0);
h(aTHX_ affix, element_sv, element_type, element_ptr, readonly);
if (!existing_sv_ptr) {
if (!av_store(av, i, element_sv))
SvREFCNT_dec(element_sv);
}
}
}
static void pull_pointer_as_string(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
void * c_ptr = *(void **)p;
if (c_ptr == nullptr)
sv_setsv(sv, &PL_sv_undef);
else
sv_setpv(sv, (const char *)c_ptr);
}
static void pull_pointer_as_struct(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
void * c_ptr = *(void **)p;
if (c_ptr == nullptr)
sv_setsv(sv, &PL_sv_undef);
else {
const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
pull_struct(aTHX_ affix, sv, pointee_type, c_ptr, readonly);
}
}
#if 0
static void pull_struct_as_live(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
void * c_ptr = *(void **)p;
if (c_ptr == nullptr) {
sv_setsv(sv, &PL_sv_undef);
return;
}
const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
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_ affix, hv, pointee_type, c_ptr, true, nullptr, readonly);
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
#endif
static void pull_pointer_as_array(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
void * c_ptr = *(void **)p;
if (c_ptr == nullptr)
sv_setsv(sv, &PL_sv_undef);
else {
const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
pull_array(aTHX_ affix, sv, pointee_type, c_ptr, readonly);
}
}
void pull_pointer_as_pin(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
/* p is the address of the pointer variable in the C stack frame */
void * c_ptr = *(void **)p;
if (c_ptr == nullptr) {
sv_setsv(sv, &PL_sv_undef);
return;
}
const infix_type * pointee = _unwrap_pin_type(type);
const infix_type * res_pointee = resolve_type(aTHX_ pointee);
infix_type_category cat = infix_type_get_category(res_pointee);
if (cat == INFIX_TYPE_STRUCT || cat == INFIX_TYPE_UNION || cat == INFIX_TYPE_ARRAY || cat == INFIX_TYPE_VECTOR) {
/* Return HashRef or ArrayRef for complex types */
SV * rv = bind_aggregate(aTHX_ c_ptr, pointee, NULL, readonly);
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
else {
/* FOR PRIMITIVES: Return a SCALAR REFERENCE to a magical scalar.
This allows the user to use $$p_a to read the value. */
SV * magic_scalar = newSV(0);
bind_placeholder(aTHX_ magic_scalar, c_ptr, pointee, 0, 0, true, NULL, NULL, readonly, true);
SV * rv = newRV_noinc(magic_scalar);
sv_setsv(sv, rv);
SvREFCNT_dec(rv);
}
}
static void pull_sv(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
void * c_ptr = *(void **)p;
if (c_ptr == nullptr)
sv_setsv(sv, &PL_sv_undef);
else
sv_setsv(sv, (SV *)c_ptr);
}
static void pull_file(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
PERL_UNUSED_VAR(affix);
PERL_UNUSED_VAR(type);
FILE * fp = *(FILE **)p;
if (!fp) {
sv_setsv(sv, &PL_sv_undef);
return;
}
// Duplicate FD to avoid double-close issues
int fd =
#ifdef _WIN32
_fileno
#else
fileno
#endif
(fp);
if (fd < 0) {
sv_setsv(sv, &PL_sv_undef);
return;
}
int new_fd = PerlLIO_dup(fd);
if (new_fd < 0) {
sv_setsv(sv, &PL_sv_undef);
return;
}
PerlIO * new_pio = PerlIO_fdopen(new_fd, "r+"); // Assuming R/W safe
if (!new_pio) {
PerlLIO_close(new_fd);
sv_setsv(sv, &PL_sv_undef);
return;
}
GV * gv = newGVgen("Affix::FileHandle");
if (do_open(gv, "+<&", 3, FALSE, 0, 0, new_pio))
sv_setsv(sv, sv_2mortal(newRV((SV *)gv)));
else {
PerlIO_close(new_pio);
sv_setsv(sv, &PL_sv_undef);
}
}
static void pull_perlio(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
PERL_UNUSED_VAR(affix);
PERL_UNUSED_VAR(type);
PerlIO * pio = *(PerlIO **)p;
if (!pio) {
sv_setsv(sv, &PL_sv_undef);
return;
}
int fd = PerlIO_fileno(pio);
if (fd < 0) {
sv_setsv(sv, &PL_sv_undef);
return;
}
int new_fd = PerlLIO_dup(fd);
if (new_fd < 0) {
sv_setsv(sv, &PL_sv_undef);
return;
}
PerlIO * new_pio = PerlIO_fdopen(new_fd, "r+");
if (!new_pio) {
PerlLIO_close(new_fd);
sv_setsv(sv, &PL_sv_undef);
return;
}
GV * gv = newGVgen("Affix::FileHandle");
if (do_open(gv, "+<&", 3, FALSE, 0, 0, new_pio))
sv_setsv(sv, sv_2mortal(newRV((SV *)gv)));
else {
PerlIO_close(new_pio);
sv_setsv(sv, &PL_sv_undef);
}
}
static void push_stringlist(pTHX_ Affix * affix, SV * sv, void * c_arg_ptr) {
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
*(void **)c_arg_ptr = nullptr;
return;
}
AV * av = (AV *)SvRV(sv);
size_t len = av_len(av) + 1;
// Allocate array of pointers + 1 for nullptr terminator
// We use the args_arena so this memory is automatically freed after the call
char ** list = (char **)infix_arena_alloc(affix->call_args_arena, (len + 1) * sizeof(char *), _Alignof(char *));
for (size_t i = 0; i < len; ++i) {
SV ** elem = av_fetch(av, i, 0);
if (elem && SvPOK(*elem)) {
STRLEN slen;
const char * s = SvPV(*elem, slen);
// Copy string content to arena to ensure stability
char * buf = (char *)infix_arena_alloc(affix->call_args_arena, slen + 1, 1);
memcpy(buf, s, slen + 1);
list[i] = buf;
}
else {
list[i] = nullptr;
}
}
list[len] = nullptr; // Terminator
*(char ***)c_arg_ptr = list;
}
static void pull_stringlist(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
PERL_UNUSED_VAR(affix);
PERL_UNUSED_VAR(type);
char ** list = *(char ***)p;
AV * av = newAV();
if (list) {
while (*list) {
av_push(av, newSVpv(*list, 0));
list++;
}
}
// Return ArrayRef
sv_setsv(sv, sv_2mortal(newRV_noinc(MUTABLE_SV(av))));
}
// Mutable Buffer: Passes pointer to Perl's string buffer directly.
// Allows C to write to the Perl scalar.
static void push_buffer(pTHX_ Affix * affix, SV * sv, void * c_arg_ptr) {
PERL_UNUSED_VAR(affix);
if (!SvOK(sv)) {
*(void **)c_arg_ptr = nullptr;
return;
}
lib/Affix.c view on Meta::CPAN
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;
}
}
lib/Affix.c view on Meta::CPAN
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);
for (size_t i = 0; i < num_args; ++i) {
const infix_type * type = infix_reverse_get_arg_type(ctx, i);
Affix_Pull puller = get_pull_handler(aTHX_ type);
if (!puller)
croak("Unsupported callback argument type");
SV * arg_sv = newSV(0);
puller(aTHX_ nullptr, arg_sv, type, args[i], false);
mXPUSHs(arg_sv);
}
PUTBACK;
const infix_type * ret_type = infix_reverse_get_return_type(ctx);
U32 call_flags = /* G_EVAL |*/ G_KEEPERR | ((ret_type->category == INFIX_TYPE_VOID) ? G_VOID : G_SCALAR);
size_t count = call_sv(cb_data->coderef_rv, call_flags);
if (SvTRUE(ERRSV)) {
Perl_warn(aTHX_ "Perl callback died: %" SVf, ERRSV);
sv_setsv(ERRSV, &PL_sv_undef);
if (retval && !(call_flags & G_VOID))
memset(retval, 0, infix_type_get_size(ret_type));
}
else if (call_flags & G_SCALAR) {
SPAGAIN;
SV * return_sv = (count == 1) ? POPs : &PL_sv_undef;
sv2ptr(aTHX_ nullptr, return_sv, retval, ret_type);
PUTBACK;
}
FREETMPS;
LEAVE;
}
XS_INTERNAL(Affix_as_string) {
dVAR;
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "$affix");
{
char * RETVAL;
dXSTARG;
Affix * affix;
if (sv_derived_from(ST(0), "Affix")) {
IV tmp = SvIV((SV *)SvRV(ST(0)));
affix = INT2PTR(Affix *, tmp);
}
else
croak("affix is not of type Affix");
RETVAL = (char *)affix->infix->target_fn;
char addr_buf[32];
snprintf(addr_buf, sizeof(addr_buf), "0x%p", RETVAL);
sv_setpv(TARG, addr_buf);
XSprePUSH;
PUSHTARG;
}
XSRETURN(1);
};
XS_INTERNAL(Affix_END) {
dXSARGS;
dMY_CXT;
PERL_UNUSED_VAR(items);
if (MY_CXT.lib_registry) {
hv_iterinit(MY_CXT.lib_registry);
HE * he;
while ((he = hv_iternext(MY_CXT.lib_registry))) {
LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(HeVAL(he)));
if (entry) {
#if DEBUG > 0
if (entry->ref_count > 0)
warn("Affix: library handle for '%s' has %d outstanding references at END.",
HeKEY(he),
(int)entry->ref_count);
#endif
// Temp fix: Disable library unloading at process exit.
//
// Many modern C libraries (WebUI, Go runtimes, Audio libs) spawn background
// threads that persist until the process dies. If we dlclose() the library
// here, the code segment is unmapped. When the background thread wakes up
// to do cleanup or work, it executes garbage memory and segfaults.
//
// Since the process is ending, the OS will reclaim file handles and memory
// automatically. It's (in my opinion) safer to leak the handle than to crash the process.
#if defined(__linux__) || defined(__linux)
// Leak the library handle but free our wrapper
if (entry->lib)
infix_free(entry->lib);
#else
// This extra symbol check is here to prevent shared libs written in Go from crashing Affix.
// The issue is that Go inits the full Go runtime when the lib is loaded but DOES NOT STOP
// IT when the lib is unloaded. Threads and everything else still run and we crash when perl
// exits. This only happens on Windows.
// See:
// - https://github.com/golang/go/issues/43591
// - https://github.com/golang/go/issues/22192
// - https://github.com/golang/go/issues/11100
if (entry->lib
#ifdef _WIN32
&& infix_library_get_symbol(entry->lib, "_cgo_dummy_export") == nullptr
#endif
)
infix_library_close(entry->lib);
#endif
safefree(entry);
}
}
hv_undef(MY_CXT.lib_registry);
MY_CXT.lib_registry = nullptr;
}
if (MY_CXT.callback_registry) {
hv_iterinit(MY_CXT.callback_registry);
HE * he;
while ((he = hv_iternext(MY_CXT.callback_registry))) {
SV * entry_sv = HeVAL(he);
Implicit_Callback_Magic * magic_data = INT2PTR(Implicit_Callback_Magic *, SvIV(entry_sv));
if (magic_data) {
infix_reverse_t * ctx = magic_data->reverse_ctx;
if (ctx) {
Affix_Callback_Data * cb_data = (Affix_Callback_Data *)infix_reverse_get_user_data(ctx);
if (cb_data) {
SvREFCNT_dec(cb_data->coderef_rv);
safefree(cb_data);
}
infix_reverse_destroy(ctx);
}
safefree(magic_data);
}
}
hv_undef(MY_CXT.callback_registry);
MY_CXT.callback_registry = nullptr;
}
if (MY_CXT.registry) {
infix_registry_destroy(MY_CXT.registry);
MY_CXT.registry = nullptr;
}
_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;
}
lib/Affix.c view on Meta::CPAN
memmove(dest, src, n);
XSRETURN(1);
}
XS_INTERNAL(Affix_memset) {
dXSARGS;
if (items != 3)
croak_xs_usage(cv, "dest, val, n");
void * dest = _resolve_writable_ptr(aTHX_ ST(0));
if (!dest) {
warn("dest must be a pinned pointer or address");
XSRETURN_UNDEF;
}
int val = (int)SvIV(ST(1));
size_t n = (size_t)SvUV(ST(2));
memset(dest, val, n);
XSRETURN(1);
}
XS_INTERNAL(Affix_memcmp) {
dXSARGS;
if (items != 3)
croak_xs_usage(cv, "lhs, rhs, n");
const void * lhs = _resolve_readable_ptr(aTHX_ ST(0));
const void * rhs = _resolve_readable_ptr(aTHX_ ST(1));
if (!lhs || !rhs) {
warn("arguments must be pinned pointers, addresses, or strings");
XSRETURN_UNDEF;
}
size_t n = (size_t)SvUV(ST(2));
int ret = memcmp(lhs, rhs, n);
ST(0) = sv_2mortal(newSViv(ret));
XSRETURN(1);
}
XS_INTERNAL(Affix_memchr) {
dXSARGS;
if (items != 3)
croak_xs_usage(cv, "ptr, val, n");
const void * ptr = _resolve_readable_ptr(aTHX_ ST(0));
if (!ptr) {
warn("ptr must be a pinned pointer, address, or string");
XSRETURN_UNDEF;
}
int val = (int)SvIV(ST(1));
size_t n = (size_t)SvUV(ST(2));
void * res = memchr(ptr, val, n);
if (res) {
SV * sv = newSV(0);
SV * owner = _borrow_lifeline(aTHX_ ST(0));
dMY_CXT;
infix_type * new_type = nullptr;
infix_arena_t * local_arena = nullptr;
if (infix_type_from_signature(&new_type, &local_arena, "*void", MY_CXT.registry) == INFIX_SUCCESS) {
bind_placeholder(aTHX_ sv, res, new_type, 0, 0, false, owner, local_arena, false, true);
ST(0) = sv_2mortal(newRV_noinc(sv));
}
else {
if (local_arena)
infix_arena_destroy(local_arena);
ST(0) = &PL_sv_undef;
}
XSRETURN(1);
}
XSRETURN_UNDEF;
}
XS_INTERNAL(Affix_ptr_add) {
dXSARGS;
if (items != 2)
croak_xs_usage(cv, "ptr, offset_bytes");
void * ptr_val = get_address_v2(aTHX_ ST(0));
if (!ptr_val)
XSRETURN_UNDEF;
IV offset = SvIV(ST(1));
void * new_addr = (char *)ptr_val + offset;
const infix_type * type = nullptr;
bool readonly = false;
Affix_Pin_2_Point_Oh * pin = get_pin_v2(aTHX_ ST(0));
if (pin) {
type = pin->type;
readonly = pin->readonly;
}
SV * owner = _borrow_lifeline(aTHX_ ST(0));
if (type && type->category == INFIX_TYPE_ARRAY)
type = type->meta.array_info.element_type;
if (!type)
type = infix_type_create_void();
SV * sv = newSV(0);
/* Set absolute=true: new_addr is the direct target location */
bind_placeholder(aTHX_ sv, new_addr, type, 0, 0, false, owner, nullptr, readonly, true);
ST(0) = sv_2mortal(newRV_noinc(sv));
XSRETURN(1);
}
XS_INTERNAL(Affix_ptr_diff) {
dXSARGS;
if (items != 2)
croak_xs_usage(cv, "ptr1, ptr2");
// Use resolve_readable to accept pins or ints
const void * p1 = _resolve_readable_ptr(aTHX_ ST(0));
const void * p2 = _resolve_readable_ptr(aTHX_ ST(1));
if (!p1 || !p2)
XSRETURN_UNDEF;
IV diff = (const char *)p1 - (const char *)p2;
ST(0) = sv_2mortal(newSViv(diff));
XSRETURN(1);
}
XS_INTERNAL(Affix_strdup) {
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "string");
lib/Affix.c view on Meta::CPAN
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__, "$");
{
(void)newXSproto_portable("main::define_types", XS_main_define_types, __FILE__, "$");
(void)newXSproto_portable("main::sizeof_type", XS_main_sizeof_type, __FILE__, "$");
(void)newXSproto_portable("main::offsetof_member", XS_main_offsetof_member, __FILE__, "$$");
(void)newXSproto_portable("main::wrap_owned", XS_main_wrap_owned, __FILE__, "$$");
(void)newXSproto_portable("main::alloc_owned", XS_main_alloc_owned, __FILE__, "$");
(void)newXSproto_portable("main::free_owned", XS_main_free_owned, __FILE__, "$");
(void)newXSproto_portable("Affix::Memory::DESTROY", XS_main_free_owned, __FILE__, "$");
(void)newXSproto_portable("main::alloc_raw", XS_main_alloc_raw, __FILE__, "$");
(void)newXSproto_portable("main::set_mem_u128", XS_main_set_mem_u128, __FILE__, "$$$");
(void)newXSproto_portable("main::get_string_ptr", XS_main_get_string_ptr, __FILE__, "");
(void)newXSproto_portable("main::test_invoke_callback", XS_main_test_invoke_callback, __FILE__, "$$$");
(void)newXSproto_portable("main::test_invoke_callback_128", XS_main_test_invoke_callback_128, __FILE__, "$$");
(void)newXSproto_portable("main::get_file_ptr", XS_main_get_file_ptr, __FILE__, "$");
(void)newXSproto_portable("main::verify_marshalling_128", XS_main_verify_marshalling_128, __FILE__, "$");
(void)newXSproto_portable("main::mock_cxx_new", XS_main_mock_cxx_new, __FILE__, "$");
(void)newXSproto_portable("main::mock_cxx_delete", XS_main_mock_cxx_delete, __FILE__, "$");
(void)newXSproto_portable("main::get_mock_cxx_dtor", XS_main_get_mock_cxx_dtor, __FILE__, "");
(void)newXSproto_portable("main::get_mock_cxx_dtor_calls", XS_main_get_mock_cxx_dtor_calls, __FILE__, "");
//(void)newXSproto_portable("::is_pin", XS_main_is_pin, __FILE__, nullptr);
}
#undef XSUB_EXPORT
Perl_xs_boot_epilog(aTHX_ ax);
}
( run in 1.154 second using v1.01-cache-2.11-cpan-d80b1682f3f )