Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
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);
new_entry->lib = lib;
new_entry->ref_count = 1;
hv_store(MY_CXT.lib_registry, lookup_path, strlen(lookup_path), newSViv(PTR2IV(new_entry)), 0);
return lib;
}
return nullptr;
}
static void _affix_destroy(pTHX_ Affix * affix) {
if (!affix)
return;
dMY_CXT;
if (affix->lib_handle != nullptr && MY_CXT.lib_registry != nullptr) {
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 == affix->lib_handle) {
entry->ref_count--;
if (entry->ref_count == 0) {
STRLEN klen;
const char * kstr = HePV(he, klen);
SV * key_sv = newSVpvn(kstr, klen);
if (HeKUTF8(he))
SvUTF8_on(key_sv);
// On Linux, dlclose() is notoriously dangerous for libraries that
// spawn background threads or register global handlers (Go, .NET, Audio, etc.)
// unmapping the code while these threads are active causes a SEGV.
#if defined(__linux__) || defined(__linux)
// Leak the library handle but free our wrapper
infix_free(entry->lib);
#else
infix_library_close(entry->lib);
#endif
safefree(entry);
hv_delete_ent(MY_CXT.lib_registry, key_sv, G_DISCARD, 0);
SvREFCNT_dec(key_sv);
}
break;
}
}
}
if (affix->variadic_cache) {
// Destroy all cached JIT trampolines
hv_iterinit(affix->variadic_cache);
HE * he;
while ((he = hv_iternext(affix->variadic_cache))) {
SV * val = HeVAL(he);
infix_forward_t * t = INT2PTR(infix_forward_t *, SvIV(val));
infix_forward_destroy(t);
}
SvREFCNT_dec(affix->variadic_cache);
}
if (affix->infix)
infix_forward_destroy(affix->infix);
if (affix->args_arena)
infix_arena_destroy(affix->args_arena);
if (affix->ret_arena)
infix_arena_destroy(affix->ret_arena);
if (affix->plan)
safefree(affix->plan);
if (affix->out_param_info)
safefree(affix->out_param_info);
if (affix->c_args)
safefree(affix->c_args);
if (affix->sig_str)
safefree(affix->sig_str);
if (affix->sym_name)
safefree(affix->sym_name);
if (affix->return_sv)
SvREFCNT_dec(affix->return_sv);
safefree(affix);
}
static int Affix_cv_free(pTHX_ SV * sv, MAGIC * mg) {
Affix * affix = (Affix *)mg->mg_ptr;
if (affix) {
#ifdef MULTIPLICITY
if (affix->owner_perl != aTHX) {
// warn("Affix_cv_free: %p (owner=%p, current=%p) SKIPPING", affix, (void*)affix->owner_perl, (void*)aTHX);
return 0;
}
#endif
_affix_destroy(aTHX_ affix);
}
return 0;
}
static int Affix_cv_dup(pTHX_ MAGIC * mg, CLONE_PARAMS * param) {
lib/Affix.c view on Meta::CPAN
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
av = (AV *)SvRV(sv);
av_clear(av);
}
else {
av = newAV();
sv_setsv(sv, sv_2mortal(newRV_noinc(MUTABLE_SV(av))));
}
size_t num_elements = type->meta.array_info.num_elements;
size_t element_size = infix_type_get_size(element_type);
av_extend(av, num_elements);
for (size_t i = 0; i < num_elements; ++i) {
void * element_ptr = (char *)p + (i * element_size);
SV * element_sv = newSV(0);
ptr2sv(aTHX_ affix, element_ptr, element_sv, element_type);
av_push(av, element_sv);
}
}
static void pull_reverse_trampoline(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p) {
sv_setiv(sv, PTR2IV(*(void **)p));
}
static void pull_enum(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p) {
ptr2sv(aTHX_ affix, p, sv, type->meta.enum_info.underlying_type);
}
static void pull_enum_dualvar(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p) {
// We assume standard 'e:int' (int32/64 based on platform 'int').
// But type->meta.enum_info.underlying_type tells us the exact size.
const infix_type * int_type = type->meta.enum_info.underlying_type;
IV val = 0;
// Quick and dirty reader based on size.
// Ideally use 'ptr2sv' to get the IV, then upgrade.
// Optimization: Inline specific sizes.
size_t size = infix_type_get_size(int_type);
if (size == 4)
val = *(int32_t *)p;
else if (size == 8)
val = *(int64_t *)p;
else if (size == 1)
val = *(int8_t *)p;
else if (size == 2)
val = *(int16_t *)p;
else
val = *(int *)p; // Fallback?
// Set the Integer Value
sv_setiv(sv, val);
// Look up the Name
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, "vals", 4, 0);
if (enum_map_ptr) {
HV * enum_map = (HV *)SvRV(*enum_map_ptr);
// Look up the integer value in the hash
// Keys in Perl hashes are strings, so we format the IV.
char key[64];
snprintf(key, 64, "%" IVdf, val);
SV ** name_sv = hv_fetch(enum_map, key, strlen(key), 0);
if (name_sv && SvPOK(*name_sv)) {
// Set the String Value (creating Dualvar)
// sv_setpv overwrites the IV. We need to set PV while keeping IOK.
const char * name_str = SvPV_nolen(*name_sv);
sv_setpv(sv, name_str); // Sets PV, clears IV? No, usually clears flags, right?
// Force dualvar state by manually reinstating the IV
SvIV_set(sv, val);
SvIOK_on(sv); // It is valid Integer
// SvPOK is on from sv_setpv
}
}
}
}
}
static void pull_complex(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p) {
AV * av;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
av = (AV *)SvRV(sv);
av_clear(av);
}
else {
av = newAV();
sv_setsv(sv, sv_2mortal(newRV_noinc(MUTABLE_SV(av))));
}
const infix_type * base_type = type->meta.complex_info.base_type;
size_t base_size = infix_type_get_size(base_type);
SV * real_sv = newSV(0);
ptr2sv(aTHX_ affix, p, real_sv, base_type);
av_push(av, real_sv);
SV * imag_sv = newSV(0);
ptr2sv(aTHX_ affix, (char *)p + base_size, imag_sv, base_type);
av_push(av, imag_sv);
}
static void pull_vector(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p) {
AV * av;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
av = (AV *)SvRV(sv);
av_clear(av);
}
else {
av = newAV();
sv_setsv(sv, sv_2mortal(newRV_noinc(MUTABLE_SV(av))));
}
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);
for (size_t i = 0; i < num_elements; ++i) {
void * element_ptr = (char *)p + (i * element_size);
SV * element_sv = newSV(0);
ptr2sv(aTHX_ affix, element_ptr, element_sv, element_type);
av_push(av, element_sv);
}
}
static void pull_pointer_as_string(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
void * c_ptr = *(void **)ptr;
lib/Affix.c view on Meta::CPAN
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
croak("Expected a HASH or HASH reference for struct marshalling");
for (size_t i = 0; i < type->meta.aggregate_info.num_members; ++i) {
const infix_struct_member * member = &type->meta.aggregate_info.members[i];
if (!member->name)
continue;
void * member_ptr = (char *)p + member->offset;
SV ** member_sv_ptr = hv_fetch(hv, member->name, strlen(member->name), 0);
if (member_sv_ptr) {
if (member->is_bitfield) {
// Bitfield push: requires mask and shift
uint64_t val = (uint64_t)SvUV(*member_sv_ptr);
uint64_t mask = ((uint64_t)1 << member->bit_width) - 1;
val &= mask;
// Load existing value to preserve other bitfields in the same storage unit
size_t sz = infix_type_get_size(member->type);
uint64_t current = 0;
memcpy(¤t, member_ptr, sz);
// Clear target bits and set new ones
current &= ~(mask << member->bit_offset);
current |= (val << member->bit_offset);
memcpy(member_ptr, ¤t, sz);
}
else {
sv2ptr(aTHX_ affix, *member_sv_ptr, member_ptr, member->type);
}
}
}
}
void push_union(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
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;
sv_setpv(TARG, RETVAL);
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))) {
SV * entry_sv = HeVAL(he);
LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(entry_sv));
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.
lib/Affix.c view on Meta::CPAN
_populate_hv_from_c_struct(aTHX_ nullptr, hv, elem_type, target, true, pin->owner_sv ? pin->owner_sv : ST(0));
ST(0) = sv_2mortal(rv);
}
else if (elem_type->category == INFIX_TYPE_ARRAY) {
// Return a new Affix::Pointer for this sub-array (Live view)
Affix_Pin * new_pin;
Newxz(new_pin, 1, Affix_Pin);
new_pin->pointer = target;
new_pin->managed = false;
new_pin->owner_sv = pin->owner_sv ? pin->owner_sv : ST(0);
SvREFCNT_inc(new_pin->owner_sv);
// We need to keep the type info alive. For now, copy it.
new_pin->type_arena = infix_arena_create(256);
new_pin->type = _copy_type_graph_to_arena(new_pin->type_arena, elem_type);
ST(0) = sv_2mortal(_new_pointer_obj(aTHX_ new_pin));
}
else {
SV * res = sv_newmortal();
ptr2sv(aTHX_ nullptr, target, res, elem_type);
ST(0) = res;
}
XSRETURN(1);
}
XS_INTERNAL(Affix_pin_set_at) {
dXSARGS;
if (items != 3)
croak_xs_usage(cv, "pin, index, value");
Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
IV index = SvIV(ST(1));
SV * val_sv = ST(2);
if (!pin || !pin->type)
croak("Not a valid pinned pointer");
const infix_type * type = pin->type;
const infix_type * elem_type = type;
if (type->category == INFIX_TYPE_ARRAY)
elem_type = type->meta.array_info.element_type;
else if (type->category == INFIX_TYPE_POINTER && type->meta.pointer_info.pointee_type->category == INFIX_TYPE_VOID)
elem_type = type->meta.pointer_info.pointee_type;
else
croak("Cannot index into non-aggregate type");
size_t elem_size = infix_type_get_size(elem_type);
if (elem_size == 0 && elem_type->category == INFIX_TYPE_VOID) {
elem_size = 1;
elem_type = infix_type_create_primitive(INFIX_PRIMITIVE_UINT8);
}
if (elem_size == 0)
croak("Cannot index into zero-sized type");
void * target = (char *)pin->pointer + (index * elem_size);
sv2ptr(aTHX_ nullptr, val_sv, target, elem_type);
XSRETURN_EMPTY;
}
// Helper to register core internal types
static void _register_core_types(infix_registry_t * registry) {
// Register SV as a named type (dummy struct ensures it keeps the name in the registry).
// This allows signature parsing of "@SV" or "SV" (via hack) to map to a named opaque type.
// Direct usage of this type is blocked in get_opcode_for_type; it must be wrapped in Pointer[].
if (infix_register_types(registry, "@SV = { __sv_opaque: uint8 };") != INFIX_SUCCESS)
croak("Failed to register internal type alias '@SV'");
// We register File and PerlIO as opaque structs.
// This semantically matches C's FILE struct which (for now) will remain opaque to the user.
// We require "Pointer[File]" to mean "FILE*"
if (infix_register_types(registry, "@File = { _opaque: [0:uchar] };") != INFIX_SUCCESS)
croak("Failed to register internal type alias '@File'");
if (infix_register_types(registry, "@PerlIO = { _opaque: [0:uchar] };") != INFIX_SUCCESS)
croak("Failed to register internal type alias '@PerlIO'");
// Other special types are opaque structs too. ...but they don't always mean anything in particular.
if (infix_register_types(registry, "@StringList = *void;") != INFIX_SUCCESS)
croak("Failed to register internal type alias '@StringList'");
if (infix_register_types(registry, "@Buffer = *void;") != INFIX_SUCCESS)
croak("Failed to register internal type alias '@Buffer'");
if (infix_register_types(registry, "@SockAddr = *void;") != INFIX_SUCCESS)
croak("Failed to register internal type alias '@SockAddr'");
}
XS_INTERNAL(Affix_CLONE) {
dXSARGS;
PERL_UNUSED_VAR(items);
// Initialize the new thread's context (copies bitwise from parent)
MY_CXT_CLONE;
// Capture the parent's registry pointer.
// After MY_CXT_CLONE, MY_CXT refers to the new thread's context,
// which has been initialized as a bitwise copy of the parent's context.
infix_registry_t * parent_registry = MY_CXT.registry;
// Overwrite shared pointers with fresh objects for the new thread
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;
// Deep copy the type registry.
// This ensures typedefs and structs defined in the parent thread exist in the child thread,
// but the child owns its own memory arena, making it thread-safe.
if (parent_registry)
MY_CXT.registry = infix_registry_clone(parent_registry);
else
MY_CXT.registry = infix_registry_create();
if (!MY_CXT.registry)
warn("Failed to initialize the global type registry in new thread");
// Don't ccall _register_core_types here if we cloned, because the clone already contains @SV, @File, etc.
if (!parent_registry)
_register_core_types(MY_CXT.registry);
XSRETURN_EMPTY;
}
void boot_Affix(pTHX_ CV * cv) {
dVAR;
( run in 1.390 second using v1.01-cache-2.11-cpan-39bf76dae61 )