Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
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)));
return val;
}
static void affix_aggregate_marshaller(void * sv_raw, void * dest_buffer, const infix_type * type) {
dTHX;
// This ensures optional fields and padding are 0.
memset(dest_buffer, 0, infix_type_get_size(type));
SV * sv = (SV *)sv_raw;
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVHV)
return;
HV * hv = (HV *)SvRV(sv);
for (size_t i = 0; i < infix_type_get_member_count(type); ++i) {
const infix_struct_member * member = infix_type_get_member(type, i);
if (member->name) {
SV ** member_sv_ptr = hv_fetch(hv, member->name, strlen(member->name), 0);
if (member_sv_ptr) {
void * member_ptr = (char *)dest_buffer + member->offset;
sv2ptr(aTHX_ nullptr, *member_sv_ptr, member_ptr, member->type);
}
}
}
}
static void affix_aggregate_writeback(void * sv_raw, void * src_buffer, const infix_type * type) {
dTHX;
SV * sv = (SV *)sv_raw;
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVHV)
return;
HV * hv = (HV *)SvRV(sv);
for (size_t i = 0; i < infix_type_get_member_count(type); ++i) {
const infix_struct_member * member = infix_type_get_member(type, i);
if (member->name) {
void * member_ptr = (char *)src_buffer + member->offset;
SV * member_sv = newSV(0);
ptr2sv(aTHX_ nullptr, member_ptr, member_sv, member->type, false);
lib/Affix.c view on Meta::CPAN
p += 2;
start = p;
}
else // Not a standalone "SV", skip this occurrence
p++;
}
// Append remainder
sv_catpv(modified, start);
// only return modified string if we actually changed something
if (SvCUR(modified) > strlen(str))
return SvPV_nolen(modified);
}
return str;
}
int64_t affix_perl_shim_sv_to_sint64(pTHX_ void * sv_raw) { return SvIVX((SV *)sv_raw); }
double affix_perl_shim_sv_to_double(pTHX_ void * sv_raw) { return SvNVX((SV *)sv_raw); }
const char * affix_perl_shim_sv_to_string(pTHX_ void * sv_raw) { return SvPV_nolen((SV *)sv_raw); }
void * affix_perl_shim_sv_to_pointer(pTHX_ void * sv_raw) {
SV * sv = (SV *)sv_raw;
if (!SvOK(sv) || !SvROK(sv))
return nullptr;
return INT2PTR(void *, SvIV(SvRV(sv)));
}
void * affix_perl_shim_newSViv(pTHX_ int64_t value) { return newSViv(value); }
void * affix_perl_shim_newSVnv(pTHX_ double value) { return newSVnv(value); }
void * affix_perl_shim_newSVpv(pTHX_ const char * value) { return newSVpv(value, 0); }
void _pin_sv(pTHX_ SV * sv,
const infix_type * type,
void * pointer,
bool managed,
SV * owner_sv,
size_t bit_offset,
size_t bit_width);
static void push_union(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p);
#define DEFINE_PUSH_PRIMITIVE_EXECUTOR(name, c_type, sv_accessor) \
static void plan_step_push_##name(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_type *)c_arg_ptr = (c_type)sv_accessor(sv); \
c_args[step->data.index] = c_arg_ptr; \
}
#define DEFINE_IV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
c_type val; \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
val = (c_type)SvUVX(sv); \
else \
val = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
val = (c_type)SvIV(sv); \
} \
memcpy(c_ptr, &val, sizeof val); \
return; \
}
#define DEFINE_UV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
c_type val; \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
val = (c_type)SvUVX(sv); \
else \
val = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
val = (c_type)SvUV(sv); \
} \
memcpy(c_ptr, &val, sizeof val); \
return; \
}
#define DEFINE_NV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
c_type val; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
val = SvNVX(sv); \
else if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
val = (c_type)SvUVX(sv); \
else \
val = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
val = SvNV(sv); \
} \
memcpy(c_ptr, &val, sizeof val); \
return; \
}
#define DEFINE_I128_PUSH_HANDLER(name) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
sv_to_int128_safe(sv, c_ptr); \
return; \
}
#define DEFINE_U128_PUSH_HANDLER(name) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
sv_to_uint128_safe(sv, c_ptr); \
return; \
}
static Affix_Opcode get_opcode_for_type(pTHX_ const infix_type * type) {
switch (type->category) {
case INFIX_TYPE_PRIMITIVE:
switch (type->meta.primitive_id) {
case INFIX_PRIMITIVE_BOOL:
return OP_PUSH_BOOL;
case INFIX_PRIMITIVE_SINT8:
return OP_PUSH_SINT8;
case INFIX_PRIMITIVE_UINT8:
return OP_PUSH_UINT8;
case INFIX_PRIMITIVE_SINT16:
return OP_PUSH_SINT16;
case INFIX_PRIMITIVE_UINT16:
return OP_PUSH_UINT16;
case INFIX_PRIMITIVE_SINT32:
return OP_PUSH_SINT32;
case INFIX_PRIMITIVE_UINT32:
return OP_PUSH_UINT32;
case INFIX_PRIMITIVE_SINT64:
return OP_PUSH_SINT64;
case INFIX_PRIMITIVE_UINT64:
return OP_PUSH_UINT64;
case INFIX_PRIMITIVE_FLOAT16:
return OP_PUSH_FLOAT16;
case INFIX_PRIMITIVE_FLOAT:
return OP_PUSH_FLOAT;
case INFIX_PRIMITIVE_DOUBLE:
return OP_PUSH_DOUBLE;
case INFIX_PRIMITIVE_LONG_DOUBLE:
return OP_PUSH_LONGDOUBLE;
#ifdef __SIZEOF_INT128__
case INFIX_PRIMITIVE_SINT128:
return OP_PUSH_SINT128;
case INFIX_PRIMITIVE_UINT128:
lib/Affix.c view on Meta::CPAN
CASE_OP_PUSH_SINT32: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(int32_t *)ptr = (int32_t)SvIV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_UINT32: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(uint32_t *)ptr = (uint32_t)SvUV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_SINT64: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(int64_t *)ptr = (int64_t)SvIV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_UINT64: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(uint64_t *)ptr = (uint64_t)SvUV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_SINT128: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
sv_to_int128_safe(sv, ptr); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_UINT128: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
sv_to_uint128_safe(sv, ptr); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_FLOAT16: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(infix_float16_t *)ptr = float_to_half((float)SvNV(sv)); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_FLOAT: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(float *)ptr = (float)SvNVX(sv); \
else if (flags & SVf_IOK) \
*(float *)ptr = (float)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(float *)ptr = (float)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_DOUBLE: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(double *)ptr = SvNVX(sv); \
else if (flags & SVf_IOK) \
*(double *)ptr = (double)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(double *)ptr = (double)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_LONGDOUBLE: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(long double *)ptr = SvNVX(sv); \
else if (flags & SVf_IOK) \
*(long double *)ptr = (long double)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(long double *)ptr = (long double)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_PTR_CHAR: \
{ \
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)) \
*(const char **)ptr = SvPV_nolen(sv); \
else if (!SvOK(sv)) \
*(void **)ptr = nullptr; \
else if (is_pin_v2(aTHX_ sv)) \
*(void **)ptr = get_address_v2(aTHX_ sv); \
else \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_PTR_WCHAR: \
{ \
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; \
U8 * s = (U8 *)SvPVutf8(sv, len); \
U8 * e = s + len; \
Newx(*(void **)ptr, len + 1, wchar_t); \
wchar_t * d = *(void **)ptr; \
while (s < e) { \
UV uv = utf8_to_uvchr_buf(s, e, nullptr); \
if (sizeof(wchar_t) == 2 && uv > 0xFFFF) { \
uv -= 0x10000; \
*d++ = (wchar_t)((uv >> 10) + 0xD800); \
*d++ = (wchar_t)((uv & 0x3FF) + 0xDC00); \
} \
else \
*d++ = (wchar_t)uv; \
s += UTF8SKIP(s); \
} \
*d = 0; \
SAVEFREEPV(*(void **)ptr); \
} \
else if (!SvOK(sv)) \
*(void **)ptr = nullptr; \
else if (is_pin_v2(aTHX_ sv)) \
*(void **)ptr = get_address_v2(aTHX_ sv); \
else \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
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) \
lib/Affix.c view on Meta::CPAN
}
static void pull_reverse_trampoline(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
sv_setiv(sv, PTR2IV(*(void **)p));
}
static void pull_enum(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
ptr2sv(aTHX_ affix, p, sv, type->meta.enum_info.underlying_type, readonly);
}
static void pull_enum_dualvar(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
// 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
croak("Affix: unsupported enum underlying type size %zu", size);
// 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 && type->category == INFIX_TYPE_NAMED_REFERENCE)
type_name = type->meta.named_reference.name;
if (type_name) {
SV ** enum_info_ptr = hv_fetch(MY_CXT.enum_registry, type_name, strlen(type_name), 0);
if (enum_info_ptr) {
HV * enum_info = (HV *)SvRV(*enum_info_ptr);
SV ** enum_map_ptr = hv_fetch(enum_info, "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
SvUPGRADE(sv, SVt_PVIV);
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, 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) {
lib/Affix.c view on Meta::CPAN
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);
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
( run in 1.034 second using v1.01-cache-2.11-cpan-a49fcb8fa48 )