Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
XS_INTERNAL(Affix_coerce) {
dXSARGS;
if (items != 2)
croak_xs_usage(cv, "type, value_sv");
SV * type_sv = ST(0);
SV * target_sv = ST(1);
if (SvREADONLY(target_sv))
croak("Cannot coerce a read-only value");
const char * sig = _get_string_from_type_obj(aTHX_ type_sv);
if (!sig)
croak("Invalid type object passed to coerce");
// Attach magic to the SV containing the signature string
sv_magicext(target_sv, nullptr, PERL_MAGIC_ext, &Affix_coercion_vtbl, sig, strlen(sig));
// Return the modified SV
ST(0) = target_sv;
XSRETURN(1);
}
XS_INTERNAL(Affix_affix) {
dXSARGS;
dXSI32;
dMY_CXT;
if (ix == 2 || ix == 4) {
if (items != 3)
croak_xs_usage(cv, "Affix::affix_bundle($target, $name, $signature)");
}
else {
// Allow 2 items for wrap($ptr, $sig)
if (items < 2 || items > 4)
croak_xs_usage(cv, "Affix::affix($target, ...)");
}
void * symbol = nullptr;
SV * target_sv = ST(0);
// Detect target type (library vs raw pointer)
bool is_raw_ptr_target = false;
symbol = get_address_v2(aTHX_ target_sv);
if (symbol)
is_raw_ptr_target = true;
else if (SvIOK(target_sv) && !sv_isobject(target_sv)) {
symbol = INT2PTR(void *, SvUV(target_sv));
is_raw_ptr_target = true;
}
// Symbol lookup (unles it's a raw pointer)
const char * symbol_name_str = nullptr;
const char * rename_str = nullptr;
infix_library_t * lib_handle_for_symbol = nullptr;
bool created_implicit_handle = false;
// We only process names/libraries if we don't already have a raw pointer address
if (!is_raw_ptr_target) {
SV * name_sv = ST(1);
// Handle rename: affix($lib, ['real', 'alias'], ...)
if (SvROK(name_sv) && SvTYPE(SvRV(name_sv)) == SVt_PVAV) {
if (ix == 1 || ix == 3) // wrap/direct_wrap
croak("Cannot rename an anonymous Affix'd wrapper");
AV * name_av = (AV *)SvRV(name_sv);
if (av_count(name_av) != 2)
croak("Name spec arrayref must contain exactly two elements: [symbol_name, new_sub_name]");
SV ** sym_sv = av_fetch(name_av, 0, 0);
SV ** alias_sv = av_fetch(name_av, 1, 0);
if (!sym_sv || !alias_sv)
croak("Invalid name spec");
rename_str = SvPV_nolen(*alias_sv);
// Is the symbol inside the array a raw pointer?
// affix(undef, [$ptr, 'name'], ...)
symbol = get_address_v2(aTHX_ * sym_sv);
if (symbol)
;
else if (SvIOK(*sym_sv))
symbol = INT2PTR(void *, SvUV(*sym_sv));
else
symbol_name_str = SvPV_nolen(*sym_sv);
}
else {
// Name a Scalar? (string or raw pointer)
// wrap(undef, $ptr, ...)
symbol = get_address_v2(aTHX_ name_sv);
if (symbol)
;
else if (SvIOK(name_sv))
symbol = INT2PTR(void *, SvUV(name_sv));
else {
// It's a string name
symbol_name_str = SvPV_nolen(name_sv);
rename_str = symbol_name_str;
}
}
// Only load library if we don't have a direct symbol pointer yet
if (!symbol) {
if (sv_isobject(target_sv) && sv_derived_from(target_sv, "Affix::Lib")) {
IV tmp = SvIV((SV *)SvRV(target_sv));
lib_handle_for_symbol = INT2PTR(infix_library_t *, tmp);
_lib_registry_inc_ref(aTHX_ lib_handle_for_symbol);
created_implicit_handle = true;
}
else {
const char * path = SvOK(target_sv) ? SvPV_nolen(target_sv) : nullptr;
lib_handle_for_symbol = _get_lib_from_registry(aTHX_ path);
if (lib_handle_for_symbol)
created_implicit_handle = true;
}
lib/Affix.c view on Meta::CPAN
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
// 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.
hv_undef(MY_CXT.enum_registry);
MY_CXT.enum_registry = nullptr;
}
if (MY_CXT.coercion_cache) {
lib/Affix.c view on Meta::CPAN
// 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 0.757 second using v1.01-cache-2.11-cpan-a5162978ef8 )