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_wstring(aTHX_ nullptr, TARG, backend->ret_type, ret_buffer);
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);
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;
if (is_pin(aTHX_ sv))
val.ptr = _get_pin_from_sv(aTHX_ sv)->pointer;
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);
hv_store(hv, member->name, strlen(member->name), member_sv, 0);
lib/Affix.c view on Meta::CPAN
static void push_handler_uint64(pTHX_ Affix *, SV *, void *);
static void push_handler_float16(pTHX_ Affix *, SV *, void *);
static void push_handler_float(pTHX_ Affix *, SV *, void *);
static void push_handler_double(pTHX_ Affix *, SV *, void *);
static void push_handler_long_double(pTHX_ Affix *, SV *, void *);
static void pull_sint8(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint8(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sint16(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint16(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sint32(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint32(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sint64(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint64(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_float16(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_float(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_double(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_long_double(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_bool(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_void(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_struct(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_union(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_array(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_enum(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_enum_dualvar(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_complex(pTHX_ Affix *, SV *, const infix_type *, void * p);
static void pull_vector(pTHX_ Affix *, SV *, const infix_type *, void * p);
static void pull_pointer(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_string(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_struct(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_array(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_pin(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sv(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_reverse_trampoline(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_file(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_perlio(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_stringlist(pTHX_ Affix *, SV *, const infix_type *, void *);
#if !defined(INFIX_COMPILER_MSVC)
static void pull_sint128(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint128(pTHX_ Affix *, SV *, const infix_type *, void *);
#endif
#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); \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvIV(sv); \
} \
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); \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvUV(sv); \
} \
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); \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(c_type *)c_ptr = SvNVX(sv); \
else if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvNV(sv); \
} \
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(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:
return OP_PUSH_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(aTHX_ sv)) \
*(void **)ptr = _get_pin_from_sv(aTHX_ sv)->pointer; \
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(aTHX_ sv)) \
*(void **)ptr = _get_pin_from_sv(aTHX_ sv)->pointer; \
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; \
if (is_pin(aTHX_ sv)) \
*(void **)ptr = _get_pin_from_sv(aTHX_ sv)->pointer; \
lib/Affix.c view on Meta::CPAN
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;
if (c_ptr == nullptr)
sv_setsv(sv, &PL_sv_undef);
else
sv_setpv(sv, (const char *)c_ptr);
}
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]);
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;
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.
( run in 0.526 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )