Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
#define sv_from_uint128_safe(targ, ptr) croak("128-bit not supported")
#endif
typedef uint16_t infix_float16_t;
// Fast Float32 to Float16 conversion (IEEE 754)
static uint16_t float_to_half(float f) {
uint32_t i;
memcpy(&i, &f, 4);
uint32_t s = (i >> 16) & 0x8000;
uint32_t e = ((i >> 23) & 0xFF) - (127 - 15);
uint32_t m = i & 0x7FFFFF;
if (e <= 0) {
if (e < -10)
return s;
m = (m | 0x800000) >> (1 - e);
return s | (m >> 13);
}
else if (e == 0xFF - (127 - 15)) {
if (m == 0)
return s | 0x7C00;
return s | 0x7C00 | (m >> 13) | (m ? 1 : 0);
}
else {
if (e > 30)
return s | 0x7C00;
return s | (e << 10) | (m >> 13);
}
}
static float half_to_float(uint16_t h) {
uint32_t s = (h & 0x8000) << 16;
uint32_t e = (h & 0x7C00) >> 10;
uint32_t m = (h & 0x03FF) << 13;
if (e == 0) {
if (m == 0) {
float f;
memcpy(&f, &s, 4);
return f;
}
while (!(m & 0x00800000)) {
m <<= 1;
e--;
}
e++;
m &= ~0x00800000;
}
else if (e == 31) {
uint32_t i = s | 0x7F800000 | m;
float f;
memcpy(&f, &i, 4);
return f;
}
e = e + (127 - 15);
uint32_t i = s | (e << 23) | m;
float f;
memcpy(&f, &i, 4);
return f;
}
// Handles thread cloning for pins. Deep copies metadata and managed memory
static int Affix_pin_dup(pTHX_ MAGIC * mg, CLONE_PARAMS * param) {
Affix_Pin * old_pin = (Affix_Pin *)mg->mg_ptr;
if (!old_pin)
return 0;
Affix_Pin * new_pin;
Newxz(new_pin, 1, Affix_Pin);
// Copy metadata
new_pin->size = old_pin->size;
new_pin->destructor = old_pin->destructor;
// Handle data ownership
if (old_pin->managed && old_pin->pointer && old_pin->size > 0) {
// Deep copy managed memory so new thread owns its own block.
// This prevents double-free and context violations.
new_pin->pointer = safemalloc(new_pin->size); // Allocates on heap
memcpy(new_pin->pointer, old_pin->pointer, new_pin->size);
new_pin->managed = true; // Explicitly set to true: pointer is heap-allocated and managed by safefree.
}
else {
// Unmanaged/Global/Null: Shallow copy pointer.
new_pin->pointer = old_pin->pointer;
new_pin->managed = false; // Explicitly set to false: pointer is not managed by safefree.
}
if (old_pin->owner_sv) {
#ifdef USE_ITHREADS
new_pin->owner_sv = sv_dup(old_pin->owner_sv, param);
#else
new_pin->owner_sv = old_pin->owner_sv;
#endif
SvREFCNT_inc(new_pin->owner_sv);
}
if (old_pin->destructor_lib_sv) {
#ifdef USE_ITHREADS
new_pin->destructor_lib_sv = sv_dup(old_pin->destructor_lib_sv, param);
#else
new_pin->destructor_lib_sv = old_pin->destructor_lib_sv;
#endif
SvREFCNT_inc(new_pin->destructor_lib_sv);
}
// Handle type arena (Deep Copy)
if (old_pin->type_arena && old_pin->type) {
new_pin->type_arena = infix_arena_create(4096);
new_pin->type = _copy_type_graph_to_arena(new_pin->type_arena, old_pin->type);
}
else {
// Likely a raw void* or simple cast where arena wasn't used/needed
new_pin->type = old_pin->type;
new_pin->type_arena = nullptr;
}
mg->mg_ptr = (char *)new_pin;
return 1;
}
// 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 * ptr) {
PERL_UNUSED_VAR(affix);
PERL_UNUSED_VAR(type);
wchar_t * wstr = *(wchar_t **)ptr;
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.
SvGROW(sv, (wlen * sizeof(wchar_t)) + 1);
char * d = SvPVX(sv);
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
// Forward declarations for static helpers
static infix_direct_value_t affix_marshaller_sint(void * sv_raw);
static infix_direct_value_t affix_marshaller_uint(void * sv_raw);
static infix_direct_value_t affix_marshaller_double(void * sv_raw);
static infix_direct_value_t affix_marshaller_pointer(void * sv_raw);
static void affix_aggregate_marshaller(void * sv_raw, void * dest, const infix_type * type);
static void affix_aggregate_writeback(void * sv_raw, void * src, const infix_type * type);
static infix_direct_arg_handler_t get_direct_handler_for_type(const infix_type * type);
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));
void * ret_buffer = alloca(infix_type_get_size(backend->ret_type));
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);
lib/Affix.c view on Meta::CPAN
// Jump to next instruction
#define DISPATCH() goto * dispatch_table[(++step)->opcode]
// Jump to first instruction
#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; \
\
/* 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; \
\
/* ALLOCATION STRATEGY */ \
size_t arena_mark = affix->args_arena->current_offset; \
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 */ \
arena_mark = affix->args_arena->current_offset; \
/* Alignment 64 is safe for AVX-512 vectors */ \
args_buffer = infix_arena_calloc(affix->args_arena, 1, affix->total_args_size, 64); \
} \
\
register void ** c_args = (void **)alloca(affix->num_args * sizeof(void *)); \
memset(c_args, 0, affix->num_args * sizeof(void *)); \
\
size_t ret_align = affix->ret_type->alignment; \
if (ret_align < 1) \
ret_align = 1; \
void * ret_buffer = infix_arena_calloc(affix->ret_arena, 1, affix->ret_type->size, ret_align); \
\
DEFINE_DISPATCH_TABLE(); \
\
DISPATCH_START(); \
\
CASE_OP_PUSH_BOOL: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(bool *)ptr = SvTRUE(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_SINT8: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(int8_t *)ptr = (int8_t)SvIV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_UINT8: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(uint8_t *)ptr = (uint8_t)SvUV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_SINT16: \
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; // Copied too
/* 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->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 = NULL;
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 = NULL;
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(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);
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) {
temp_out_info[out_param_count].perl_stack_index = i;
temp_out_info[out_param_count].pointee_type = pointee;
lib/Affix.c view on Meta::CPAN
return mg_findext(SvRV(sv), PERL_MAGIC_ext, &Affix_pin_vtbl) != nullptr;
}
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) {
if (SvREADONLY(sv))
return;
SvUPGRADE(sv, SVt_PVMG);
MAGIC * mg = mg_findext(sv, PERL_MAGIC_ext, &Affix_pin_vtbl);
Affix_Pin * pin;
if (mg) {
pin = (Affix_Pin *)mg->mg_ptr;
if (pin && pin->managed && pin->pointer)
safefree(pin->pointer);
if (pin && pin->type_arena) {
infix_arena_destroy(pin->type_arena);
pin->type_arena = nullptr;
}
if (pin && pin->owner_sv) {
SvREFCNT_dec(pin->owner_sv);
pin->owner_sv = nullptr;
}
}
else {
Newxz(pin, 1, Affix_Pin);
mg = sv_magicext(sv, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
}
// Re-assign mg_ptr because sv_magicext(..., 0) likely corrupted it by treating pin as a string
mg->mg_ptr = (char *)pin;
pin->pointer = pointer;
pin->managed = managed;
pin->bit_offset = bit_offset;
pin->bit_width = bit_width;
if (owner_sv) {
pin->owner_sv = owner_sv;
SvREFCNT_inc(pin->owner_sv);
}
pin->type_arena = infix_arena_create(2048);
if (!pin->type_arena) {
safefree(pin);
mg->mg_ptr = nullptr;
croak("Failed to create memory arenas for pin's type information");
}
pin->type = _copy_type_graph_to_arena(pin->type_arena, type);
if (!pin->type) {
infix_arena_destroy(pin->type_arena);
safefree(pin);
mg->mg_ptr = nullptr;
croak("Failed to copy type information into pin");
}
}
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) {
Affix_Pin * pin;
Newxz(pin, 1, Affix_Pin);
pin->pointer = symbol;
pin->managed = false;
pin->owner_sv = ST(0);
SvREFCNT_inc(pin->owner_sv);
pin->type_arena = infix_arena_create(256);
infix_type * void_ptr_type = nullptr;
if (infix_type_create_pointer_to(pin->type_arena, &void_ptr_type, infix_type_create_void()) != INFIX_SUCCESS) {
safefree(pin);
infix_arena_destroy(pin->type_arena);
croak("Internal error: Failed to create pointer type for pin");
}
pin->type = void_ptr_type;
SV * obj_data = newSV(0);
sv_setiv(obj_data, PTR2IV(pin));
SV * rv = newRV_inc(obj_data);
// Bless into Affix::Pointer BEFORE attaching magic to avoid triggering 'set' during blessing
(void)sv_bless(rv, gv_stashpv("Affix::Pointer", GV_ADD));
MAGIC * mg = sv_magicext(obj_data, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
mg->mg_ptr = (char *)pin;
ST(0) = sv_2mortal(rv);
XSRETURN(1);
}
XSRETURN_UNDEF;
}
XS_INTERNAL(Affix_pin) {
dXSARGS;
dMY_CXT;
if (items != 4)
croak_xs_usage(cv, "var, lib, symbol, type");
SV * target_sv = ST(0);
const char * lib_path_or_name = SvPV_nolen(ST(1));
const char * symbol_name = SvPV_nolen(ST(2));
const char * signature = SvPV_nolen(ST(3));
infix_library_t * lib = infix_library_open(lib_path_or_name);
if (lib == nullptr) {
warn("Failed to load library from path '%s' for pinning: %s", lib_path_or_name, infix_get_last_error().message);
XSRETURN_UNDEF;
}
void * ptr = infix_library_get_symbol(lib, symbol_name);
infix_library_close(lib);
if (ptr == nullptr) {
warn("Failed to locate symbol '%s' in library '%s'", symbol_name, lib_path_or_name);
XSRETURN_UNDEF;
}
infix_type * type = nullptr;
infix_arena_t * arena = nullptr;
const char * sig_to_parse = signature;
char * clean_sig = nullptr;
lib/Affix.c view on Meta::CPAN
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.
#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
sv_setuv(dual, (UV)err_code);
char * buf = nullptr;
DWORD len =
FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
nullptr,
err_code,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
(LPSTR)&buf,
0,
nullptr);
if (buf) {
while (len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r'))
buf[--len] = '\0';
sv_setpvn(dual, buf, len);
LocalFree(buf);
}
else
sv_setpvn(dual, "Unknown system error", 20);
SvIOK_on(dual);
SvIsUV_on(dual); // Mark as unsigned for DWORD
#else
int err_code = errno;
sv_setiv(dual, err_code);
const char * msg = strerror(err_code);
if (msg)
sv_setpv(dual, msg);
else
sv_setpv(dual, "Unknown system error");
SvIV_set(dual, (IV)err_code);
SvIOK_on(dual);
#endif
ST(0) = sv_2mortal(dual);
XSRETURN(1);
}
XS_INTERNAL(Affix_dump) {
dVAR;
dXSARGS;
if (items != 2)
croak_xs_usage(cv, "scalar, length_in_bytes");
Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
if (!pin) {
warn("scalar is not a valid pointer");
XSRETURN_EMPTY;
}
if (!pin->pointer) {
warn("Cannot dump a nullptr pointer");
XSRETURN_EMPTY;
}
UV length = SvUV(ST(1));
if (length == 0) {
warn("Dump length cannot be zero");
XSRETURN_EMPTY;
}
// PL_curcop may be nullptr during thread destruction or callbacks?
const char * file = "Unknown";
int line = 0;
if (LIKELY(PL_curcop)) {
file = OutCopFILE(PL_curcop);
line = CopLINE(PL_curcop);
}
_DumpHex(aTHX_ pin->pointer, length, file, line);
ST(0) = ST(0);
XSRETURN(1);
}
static void * _resolve_writable_ptr(pTHX_ SV * sv) {
if (is_pin(aTHX_ sv)) {
Affix_Pin * p = _get_pin_from_sv(aTHX_ sv);
return p ? p->pointer : nullptr;
}
if (SvIOK(sv))
return INT2PTR(void *, SvUV(sv));
return nullptr;
}
static const void * _resolve_readable_ptr(pTHX_ SV * sv) {
if (is_pin(aTHX_ sv)) {
Affix_Pin * p = _get_pin_from_sv(aTHX_ sv);
return p ? p->pointer : nullptr;
}
if (SvIOK(sv))
return INT2PTR(void *, SvUV(sv));
if (SvPOK(sv))
return (const void *)SvPV_nolen(sv);
return nullptr;
}
XS_INTERNAL(Affix_memcpy) {
dXSARGS;
if (items != 3)
croak_xs_usage(cv, "dest, src, n");
void * dest = _resolve_writable_ptr(aTHX_ ST(0));
if (!dest) {
warn("dest must be a pinned pointer or address");
XSRETURN_UNDEF;
}
const void * src = _resolve_readable_ptr(aTHX_ ST(1));
if (!src) {
warn("src must be a pinned pointer, address, or string");
XSRETURN_UNDEF;
}
size_t n = (size_t)SvUV(ST(2));
memcpy(dest, src, n);
XSRETURN(1);
}
XS_INTERNAL(Affix_memmove) {
dXSARGS;
if (items != 3)
croak_xs_usage(cv, "dest, src, n");
void * dest = _resolve_writable_ptr(aTHX_ ST(0));
if (!dest) {
warn("dest must be a pinned pointer or address");
XSRETURN_UNDEF;
lib/Affix.c view on Meta::CPAN
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;
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;
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);
( run in 0.935 second using v1.01-cache-2.11-cpan-39bf76dae61 )