Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
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;
lib/Affix.c view on Meta::CPAN
#define DISPATCH_START() goto * dispatch_table[step->opcode]
// Sentinel does nothing, execution falls through
#define DISPATCH_END() (void)0
// Define the table
#define DEFINE_DISPATCH_TABLE() \
static void * dispatch_table[] = \
{OP_LABEL(OP_PUSH_BOOL), OP_LABEL(OP_PUSH_SINT8), OP_LABEL(OP_PUSH_UINT8), \
OP_LABEL(OP_PUSH_SINT16), OP_LABEL(OP_PUSH_UINT16), OP_LABEL(OP_PUSH_SINT32), \
OP_LABEL(OP_PUSH_UINT32), OP_LABEL(OP_PUSH_SINT64), OP_LABEL(OP_PUSH_UINT64), \
OP_LABEL(OP_PUSH_FLOAT), OP_LABEL(OP_PUSH_FLOAT16), OP_LABEL(OP_PUSH_DOUBLE), \
OP_LABEL(OP_PUSH_LONGDOUBLE), OP_LABEL(OP_PUSH_SINT128), OP_LABEL(OP_PUSH_UINT128), \
OP_LABEL(OP_PUSH_PTR_CHAR), OP_LABEL(OP_PUSH_PTR_WCHAR), OP_LABEL(OP_PUSH_POINTER), \
OP_LABEL(OP_PUSH_SV), OP_LABEL(OP_PUSH_STRUCT), OP_LABEL(OP_PUSH_UNION), \
OP_LABEL(OP_PUSH_ARRAY), OP_LABEL(OP_PUSH_CALLBACK), OP_LABEL(OP_PUSH_ENUM), \
OP_LABEL(OP_PUSH_COMPLEX), OP_LABEL(OP_PUSH_VECTOR), OP_LABEL(OP_DONE)};
#else
#define USE_THREADED_CODE 0
// Label is a case statement
#define OP_LABEL(op) case op:
// Break to loop again
#define DISPATCH() \
step++; \
break
// Start loop and switch
#define DISPATCH_START() \
while (1) { \
switch (step->opcode) {
// Close switch and break loop
#define DISPATCH_END() \
} \
break; \
}
// No table needed
#define DEFINE_DISPATCH_TABLE()
#endif
// Forward declaration for the lazy rebuilder
static void rebuild_affix_data(pTHX_ Affix * affix);
// We use a macro to generate two variants (Stack vs Arena) to ensure logic sync.
#define GENERATE_TRIGGER_XSUB(NAME, USE_STACK_ALLOC) \
void NAME(pTHX_ CV * cv) { \
if (UNLIKELY(PL_dirty)) \
return; \
dSP; \
dAXMARK; \
dXSTARG; \
Affix * affix = (Affix *)CvXSUBANY(cv).any_ptr; \
\
if (UNLIKELY(!affix->infix)) \
rebuild_affix_data(aTHX_ affix); \
\
I32 items = (I32)(SP - MARK); \
/* LAZY REBUILD: If we are in a new thread and data hasn't been built yet */ \
if (UNLIKELY(!affix->infix)) \
rebuild_affix_data(aTHX_ affix); \
\
if (UNLIKELY((SP - MARK) != affix->num_args)) \
croak("Wrong number of arguments. Expected %d, got %d", (int)affix->num_args, (int)(SP - MARK)); \
\
register Affix_Plan_Step * step = affix->plan; \
for (I32 i = 0; i < items; i++) { \
SV * arg = ST(i); \
SV * target = (arg && SvROK(arg)) ? SvRV(arg) : arg; \
if (target && SvMAGICAL(target)) { \
MAGIC * mg = mg_find(target, PERL_MAGIC_ext); \
if (mg && (mg->mg_virtual == &vtbl_lazy_aggregate || mg->mg_virtual == &vtbl_array)) { \
if (mg->mg_virtual->svt_set) \
mg->mg_virtual->svt_set(aTHX_ target, mg); \
} \
} \
} \
\
affix->call_args_arena = infix_arena_create(4096); \
affix->call_ret_arena = infix_arena_create(1024); \
SAVEDESTRUCTOR_X(_cleanup_arena, affix->call_args_arena); \
SAVEDESTRUCTOR_X(_cleanup_arena, affix->call_ret_arena); \
\
/* ALLOCATION STRATEGY */ \
infix_arena_mark_t args_mark = infix_arena_get_mark(affix->call_args_arena); \
infix_arena_mark_t ret_mark = infix_arena_get_mark(affix->call_ret_arena); \
void * args_buffer; \
if (USE_STACK_ALLOC && affix->total_args_size <= 2048) { \
/* Fast path: Stack allocation if under 2k */ \
args_buffer = alloca(affix->total_args_size); \
memset(args_buffer, 0, affix->total_args_size); \
} \
else { \
/* Slow path: Arena allocation */ \
args_buffer = infix_arena_calloc(affix->call_args_arena, 1, affix->total_args_size, 64); \
} \
\
size_t c_args_alloc_size = affix->num_args * sizeof(void *); \
register void ** c_args; \
if (c_args_alloc_size <= 2048) \
c_args = (void **)alloca(c_args_alloc_size); \
else { \
Newx(c_args, affix->num_args, void *); \
SAVEFREEPV(c_args); \
} \
memset(c_args, 0, c_args_alloc_size); \
\
size_t ret_align = affix->ret_type->alignment; \
if (ret_align < 1) \
ret_align = 1; \
void * ret_buffer = infix_arena_calloc(affix->call_ret_arena, 1, affix->ret_type->size, ret_align); \
\
DEFINE_DISPATCH_TABLE(); \
\
DISPATCH_START(); \
\
CASE_OP_PUSH_BOOL: \
{ \
SV * sv = ST(step->data.index); \
lib/Affix.c view on Meta::CPAN
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);
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) {
Affix * old_affix = (Affix *)mg->mg_ptr;
Affix * new_affix;
Newxz(new_affix, 1, Affix);
//~ warn("Affix_cv_dup: old=%p -> new=%p", old_affix, new_affix);
/* Basic copy of metadata */
new_affix->num_args = old_affix->num_args;
new_affix->plan_length = old_affix->plan_length;
new_affix->total_args_size = old_affix->total_args_size;
new_affix->ret_opcode = old_affix->ret_opcode;
new_affix->num_out_params = old_affix->num_out_params;
new_affix->num_fixed_args = old_affix->num_fixed_args;
new_affix->ret_readonly = old_affix->ret_readonly;
/* Reconstruct strings */
if (old_affix->sig_str)
new_affix->sig_str = savepv(old_affix->sig_str);
if (old_affix->sym_name)
new_affix->sym_name = savepv(old_affix->sym_name);
new_affix->target_addr = old_affix->target_addr;
new_affix->infix = nullptr;
new_affix->args_arena = nullptr;
new_affix->ret_arena = nullptr;
new_affix->call_args_arena = nullptr;
new_affix->call_ret_arena = nullptr;
new_affix->c_args = nullptr;
new_affix->plan = nullptr;
new_affix->out_param_info = nullptr;
new_affix->return_sv = nullptr;
new_affix->variadic_cache = nullptr; // Don't copy cache, let it rebuild
mg->mg_ptr = (char *)new_affix;
#ifdef MULTIPLICITY
new_affix->owner_perl = aTHX;
#endif
// Update the new CV's fast access pointer
CV * new_cv = (CV *)mg->mg_obj;
CvXSUBANY(new_cv).any_ptr = (void *)new_affix;
return 1;
}
// Helper to rebuild Affix data in the new thread
static void rebuild_affix_data(pTHX_ Affix * affix) {
//~ warn("rebuild_affix_data: %p", affix);
dMY_CXT;
infix_arena_t * parse_arena = nullptr;
infix_type * ret_type = nullptr;
infix_function_argument * args = nullptr;
size_t num_args = 0, num_fixed = 0;
// Re-parse signature using THIS thread's registry
infix_status status =
infix_signature_parse(affix->sig_str, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);
if (status != INFIX_SUCCESS) {
if (parse_arena)
infix_arena_destroy(parse_arena);
croak("Affix failed to rebuild in new thread: signature parse error");
}
// Prepare JIT types (handle array decay)
infix_type ** jit_arg_types = nullptr;
if (num_args > 0) {
jit_arg_types = safemalloc(sizeof(infix_type *) * num_args);
for (size_t i = 0; i < num_args; ++i) {
infix_type * t = args[i].type;
if (t->category == INFIX_TYPE_ARRAY) {
infix_type * ptr_type = nullptr;
status = infix_type_create_pointer_to(parse_arena, &ptr_type, t->meta.array_info.element_type);
if (status != INFIX_SUCCESS) {
if (parse_arena)
infix_arena_destroy(parse_arena);
croak("Affix failed to rebuild in new thread: type clone error");
}
jit_arg_types[i] = ptr_type;
}
else
jit_arg_types[i] = t;
}
}
// Create trampoline
status =
infix_forward_create_manual(&affix->infix, ret_type, jit_arg_types, num_args, num_fixed, affix->target_addr);
if (jit_arg_types)
safefree(jit_arg_types);
if (status != INFIX_SUCCESS) {
infix_arena_destroy(parse_arena);
croak("Affix failed to rebuild trampoline in new thread");
}
affix->cif = infix_forward_get_code(affix->infix);
affix->ret_type = infix_forward_get_return_type(affix->infix);
affix->unwrapped_ret_type = _unwrap_pin_type(affix->ret_type);
affix->ret_pull_handler = get_pull_handler(aTHX_ affix->ret_type);
// affix->ret_opcode is already set from parent, but safe to assume it matches
// Allocate arenas & SV
affix->args_arena = infix_arena_create(4096);
affix->ret_arena = infix_arena_create(1024);
affix->return_sv = newSV(0);
if (affix->num_args > 0)
Newx(affix->c_args, affix->num_args, void *);
affix->variadic_cache = newHV();
// Rebuild plan
Newxz(affix->plan, affix->plan_length + 1, Affix_Plan_Step);
size_t out_param_count = 0;
OutParamInfo * temp_out_info = safemalloc(sizeof(OutParamInfo) * (affix->num_args > 0 ? affix->num_args : 1));
size_t current_offset = 0;
for (size_t i = 0; i < affix->num_args; ++i) {
// Deep copy types from parse_arena to persistent args_arena
const infix_type * original_type = _copy_type_graph_to_arena(affix->args_arena, args[i].type);
// Recalculate offsets (logic duplication from Affix_affix, but necessary)
size_t alignment, size;
if (original_type->category == INFIX_TYPE_ARRAY) {
alignment = _Alignof(void *);
size = sizeof(void *);
}
else {
alignment = infix_type_get_alignment(original_type);
size = infix_type_get_size(original_type);
}
if (alignment == 0)
alignment = 1;
current_offset = (current_offset + alignment - 1) & ~(alignment - 1);
affix->plan[i].data.c_arg_offset = current_offset;
current_offset += size;
affix->plan[i].executor = get_plan_step_executor(original_type);
affix->plan[i].opcode = get_opcode_for_type(aTHX_ original_type);
affix->plan[i].data.type = original_type;
affix->plan[i].data.index = i;
// Re-detect out params
if (original_type->category == INFIX_TYPE_POINTER) {
const infix_type * pointee = original_type->meta.pointer_info.pointee_type;
const char * pointee_name = infix_type_get_name(pointee);
if (!pointee_name && pointee->category == INFIX_TYPE_NAMED_REFERENCE)
pointee_name = pointee->meta.named_reference.name;
bool is_sv_pointer = pointee_name && (strEQ(pointee_name, "SV") || strEQ(pointee_name, "@SV"));
if (!is_sv_pointer && pointee->category != INFIX_TYPE_REVERSE_TRAMPOLINE &&
pointee->category != INFIX_TYPE_VOID) {
lib/Affix.c view on Meta::CPAN
hv_delete_ent(MY_CXT.lib_registry, key_to_delete, G_DISCARD, 0);
}
XSRETURN_EMPTY;
}
XS_INTERNAL(Affix_load_library) {
dXSARGS;
dMY_CXT;
if (items != 1)
croak_xs_usage(cv, "library_path");
const char * path = SvPV_nolen(ST(0));
SV ** entry_sv_ptr = hv_fetch(MY_CXT.lib_registry, path, strlen(path), 0);
if (entry_sv_ptr) {
LibRegistryEntry * entry = INT2PTR(LibRegistryEntry *, SvIV(*entry_sv_ptr));
entry->ref_count++;
SV * obj_data = newSV(0);
sv_setiv(obj_data, PTR2IV(entry->lib));
ST(0) = sv_2mortal(sv_bless(newRV_inc(obj_data), gv_stashpv("Affix::Lib", GV_ADD)));
XSRETURN(1);
}
infix_library_t * lib = infix_library_open(path);
if (lib) {
LibRegistryEntry * new_entry;
Newxz(new_entry, 1, LibRegistryEntry);
new_entry->lib = lib;
new_entry->ref_count = 1;
hv_store(MY_CXT.lib_registry, path, strlen(path), newSViv(PTR2IV(new_entry)), 0);
SV * obj_data = newSV(0);
sv_setiv(obj_data, PTR2IV(lib));
ST(0) = sv_2mortal(sv_bless(newRV_inc(obj_data), gv_stashpv("Affix::Lib", GV_ADD)));
XSRETURN(1);
}
XSRETURN_UNDEF;
}
XS_INTERNAL(Affix_get_last_error_message) {
dXSARGS;
PERL_UNUSED_VAR(items);
infix_error_details_t err = infix_get_last_error();
if (err.message[0] != '\0')
ST(0) = sv_2mortal(newSVpv(err.message, 0));
#if defined(INFIX_OS_WINDOWS)
else if (err.system_error_code != 0) {
char buf[256];
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
nullptr,
err.system_error_code,
0,
buf,
sizeof(buf),
nullptr);
ST(0) = sv_2mortal(newSVpvf("System error: %s (code %ld)", buf, err.system_error_code));
}
#endif
else
ST(0) = sv_2mortal(newSVpvf("Infix error code %d at position %zu", (int)err.code, err.position));
XSRETURN(1);
}
XS_INTERNAL(Affix_find_symbol) {
dXSARGS;
dMY_CXT; // Require the thread-local context
if (items != 2 || !sv_isobject(ST(0)) || !sv_derived_from(ST(0), "Affix::Lib"))
croak_xs_usage(cv, "Affix_Lib_object, symbol_name");
IV tmp = SvIV((SV *)SvRV(ST(0)));
infix_library_t * lib = INT2PTR(infix_library_t *, tmp);
const char * name = SvPV_nolen(ST(1));
void * symbol = infix_library_get_symbol(lib, name);
if (symbol) {
SV * sv = newSV(0);
/* Symbols are addresses. Use 'void' type so address() returns the symbol value itself. */
bind_placeholder(aTHX_ sv, symbol, infix_type_create_void(), 0, 0, false, ST(0), nullptr, false, true);
ST(0) = sv_2mortal(newRV_noinc(sv));
XSRETURN(1);
}
XSRETURN_UNDEF;
}
XS_INTERNAL(Affix_sizeof) {
dXSARGS;
dMY_CXT;
if (items != 1)
croak_xs_usage(cv, "type_signature");
SV * type_sv = ST(0);
if (SvIOK(type_sv) && !sv_isobject(type_sv)) {
ST(0) = sv_2mortal(newSVuv(SvUV(type_sv)));
XSRETURN(1);
}
const char * signature = _get_string_from_type_obj(aTHX_ type_sv);
infix_type * type = nullptr;
infix_arena_t * arena = nullptr;
if (infix_type_from_signature(&type, &arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
SV * err_sv = _format_parse_error(aTHX_ "for sizeof", signature, infix_get_last_error());
warn_sv(err_sv);
if (arena)
infix_arena_destroy(arena);
XSRETURN_UNDEF;
}
size_t type_size = infix_type_get_size(type);
infix_arena_destroy(arena);
ST(0) = sv_2mortal(newSVuv(type_size));
XSRETURN(1);
}
XS_INTERNAL(Affix_alignof) {
dXSARGS;
dMY_CXT;
if (items != 1)
croak_xs_usage(cv, "type_signature");
SV * type_sv = ST(0);
const char * signature = _get_string_from_type_obj(aTHX_ type_sv);
infix_type * type = nullptr;
infix_arena_t * arena = nullptr;
if (infix_type_from_signature(&type, &arena, signature, MY_CXT.registry) != INFIX_SUCCESS) {
SV * err_sv = _format_parse_error(aTHX_ "for alignof", signature, infix_get_last_error());
warn_sv(err_sv);
if (arena)
infix_arena_destroy(arena);
XSRETURN_UNDEF;
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;
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.
lib/Affix.c view on Meta::CPAN
// Other special types are opaque structs too. ...but they don't always mean anything in particular.
if (infix_register_types(registry, "@StringList = **char;") != 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'");
}
static void _set_readonly_recursive(pTHX_ SV * sv, bool ro) {
if (!sv || !SvOK(sv))
return;
SV * target = SvROK(sv) ? SvRV(sv) : sv;
Affix_Pin_2_Point_Oh * pin = get_pin_v2(aTHX_ target);
if (pin)
pin->readonly = ro;
if (SvTYPE(target) == SVt_PVHV) {
HV * hv = (HV *)target;
HE * entry;
hv_iterinit(hv);
while ((entry = hv_iternext(hv)))
_set_readonly_recursive(aTHX_ hv_iterval(hv, entry), ro);
}
else if (SvTYPE(target) == SVt_PVAV) {
AV * av = (AV *)target;
SSize_t len = av_len(av);
for (SSize_t i = 0; i <= len; i++) {
SV ** val = av_fetch(av, i, 0);
if (val && *val)
_set_readonly_recursive(aTHX_ * val, ro);
}
}
}
XS_INTERNAL(Affix_readonly) {
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "pin, [readonly]");
// Check for V2 Pin first
if (is_pin_v2(aTHX_ ST(0))) {
Affix_Pin_2_Point_Oh * pin_v2 = get_pin_v2(aTHX_ ST(0));
if (items > 1) {
bool ro = SvTRUE(ST(1));
_set_readonly_recursive(aTHX_ ST(0), ro);
}
ST(0) = pin_v2->readonly ? &PL_sv_yes : &PL_sv_no;
XSRETURN(1);
}
XSRETURN_UNDEF;
}
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;
}
#include "Affix/marshal.c"
// Runtime allocator callbacks that route infix's memory through Perl's
// allocator. They are installed once at load time via infix_set_allocator() in
// boot_Affix below; infix then dispatches every internal heap allocation
// through this table, so libinfix.a stays a plain standalone library with zero
// knowledge of Perl. The explicit (MEM_SIZE) casts keep this correct on any
// perl configuration, and Perl_safesys* derive the current interpreter from
// the calling thread's thread-local storage (dTHX under ALWAYS_NEED_THX
// builds), so the allocation is attributed to whichever interpreter the infix
// call happens on. Combined with Affix's per-thread ownership of infix objects
// (see Affix_CLONE and Affix_cv_dup), every infix allocation is both created
// and destroyed on the same interpreter, so Perl's pool validation
// (PERL_TRACK_MEMPOOL) never fires.
static void * affix_infix_malloc(size_t nbytes) { return Perl_safesysmalloc((MEM_SIZE)nbytes); }
static void * affix_infix_calloc(size_t nelem, size_t size) {
return Perl_safesyscalloc((MEM_SIZE)nelem, (MEM_SIZE)size);
}
static void * affix_infix_realloc(void * ptr, size_t nbytes) { return Perl_safesysrealloc(ptr, (MEM_SIZE)nbytes); }
static void affix_infix_free(void * ptr) { Perl_safesysfree(ptr); }
void boot_Affix(pTHX_ CV * cv) {
dVAR;
dXSBOOTARGSXSAPIVERCHK;
PERL_UNUSED_VAR(items);
#ifdef USE_ITHREADS
my_perl = (PerlInterpreter *)PERL_GET_CONTEXT;
#endif
MY_CXT_INIT;
MY_CXT.lib_registry = newHV();
MY_CXT.callback_registry = newHV();
MY_CXT.enum_registry = newHV();
MY_CXT.coercion_cache = newHV();
MY_CXT.stash_pointer = nullptr;
// Route all of infix's internal allocations through Perl's allocator before
// any infix call below. infix_set_allocator() copies the table, and the
// affix_infix_* callbacks above forward to Perl_safesys*, so Perl tracks
// infix memory and pool validation (PERL_TRACK_MEMPOOL) never fires.
// infix_allocator is process-global and single-threaded here (module load),
// and cloned interpreters inherit the installed table.
infix_set_allocator(&(infix_allocator_t){
.malloc = affix_infix_malloc,
.calloc = affix_infix_calloc,
.realloc = affix_infix_realloc,
.free = affix_infix_free,
});
MY_CXT.registry = infix_registry_create();
if (!MY_CXT.registry)
croak("Failed to initialize the global type registry");
_register_core_types(MY_CXT.registry);
// Helper macro to define and export an XSUB in one line.
// Assumes C function is Affix_name and Perl sub is Affix::name.
#define XSUB_EXPORT(name, proto, tag) \
(void)newXSproto_portable("Affix::" #name, Affix_##name, __FILE__, proto); \
export_function("Affix", #name, tag)
{
// Core affix/wrap construction (Manual due to aliasing via XSANY)
cv = newXSproto_portable("Affix::affix", Affix_affix, __FILE__, "$$$;$");
XSANY.any_i32 = 0;
export_function("Affix", "affix", "core");
cv = newXSproto_portable("Affix::wrap", Affix_affix, __FILE__, "$$$;$");
XSANY.any_i32 = 1;
export_function("Affix", "wrap", "core");
cv = newXSproto_portable("Affix::direct_affix", Affix_affix, __FILE__, "$$$;$");
XSANY.any_i32 = 2;
export_function("Affix", "direct_affix", "core");
cv = newXSproto_portable("Affix::direct_wrap", Affix_affix, __FILE__, "$$$;$");
XSANY.any_i32 = 3;
export_function("Affix", "direct_wrap", "core");
// Destructors
newXS("Affix::Bundled::DESTROY", Affix_Bundled_DESTROY, __FILE__);
// newXS("Affix::DESTROY", Affix_DESTROY, __FILE__);
newXS("Affix::END", Affix_END, __FILE__);
newXS("Affix::Lib::DESTROY", Affix_Lib_DESTROY, __FILE__);
newXS("Affix::CLONE", Affix_CLONE, __FILE__);
// Overloads
sv_setsv(get_sv("Affix::()", TRUE), &PL_sv_yes);
(void)newXSproto_portable("Affix::()", Affix_as_string, __FILE__, "$;@");
sv_setsv(get_sv("Affix::Lib::()", TRUE), &PL_sv_yes);
(void)newXSproto_portable("Affix::Lib::(0+", Affix_Lib_as_string, __FILE__, "$;@");
(void)newXSproto_portable("Affix::Lib::()", Affix_as_string, __FILE__, "$;@");
// Library & core utils
XSUB_EXPORT(load_library, "$", "lib");
XSUB_EXPORT(find_symbol, "$$", "lib");
XSUB_EXPORT(get_last_error_message, "", "core");
// Introspection
XSUB_EXPORT(sizeof, "$", "core");
( run in 2.380 seconds using v1.01-cache-2.11-cpan-d01c6094234 )