Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
case INFIX_TYPE_UNION:
h.aggregate_marshaller = &affix_aggregate_marshaller;
break;
default:
h.aggregate_marshaller = &affix_aggregate_marshaller;
break;
}
return h;
}
// Robustly check if a type represents an SV* (or aliased version thereof)
static bool is_perl_sv_type(const infix_type * t) {
if (!t)
return false;
// Check by name
const char * name = infix_type_get_name(t);
if (!name && t->category == INFIX_TYPE_NAMED_REFERENCE)
name = t->meta.named_reference.name;
if (name && (strEQ(name, "SV") || strEQ(name, "@SV")))
return true;
// Fallback: Structural check for the opaque SV struct defined in boot_Affix.
// This catches typedef aliases: typedef MySV => SV;
if (t->category == INFIX_TYPE_STRUCT && t->meta.aggregate_info.num_members == 1) {
const char * mname = t->meta.aggregate_info.members[0].name;
if (mname && strEQ(mname, "__sv_opaque"))
return true;
}
return false;
}
static const char * _get_string_from_type_obj(pTHX_ SV * type_sv) {
const char * str = nullptr;
if (sv_isobject(type_sv) && sv_derived_from(type_sv, "Affix::Type")) {
if (SvROK(type_sv)) {
SV * rv = SvRV(type_sv);
if (SvTYPE(rv) == SVt_PVHV) {
HV * hv = (HV *)rv;
SV ** sig_sv_ptr = hv_fetchs(hv, "signature", 0);
if (sig_sv_ptr && SvPOK(*sig_sv_ptr))
str = SvPV_nolen(*sig_sv_ptr);
else {
SV ** stringify_sv_ptr = hv_fetchs(hv, "stringify", 0);
if (stringify_sv_ptr && SvPOK(*stringify_sv_ptr))
str = SvPV_nolen(*stringify_sv_ptr);
}
}
}
}
if (!str)
str = SvPV_nolen(type_sv);
// Promote "SV" to "@SV" so the parser sees it as a named type.
// This allows the infix parser to recognize it as a named type.
if (str && strstr(str, "SV")) {
SV * modified = sv_newmortal();
sv_setpvn(modified, "", 0);
const char * p = str;
const char * start = str;
while ((p = strstr(p, "SV"))) {
// Check boundaries: Ensure we match whole word "SV"
// Start boundary: Beginning of string OR prev char is not alnum/_/@
bool start_ok = (p == start) || (!isALNUM((unsigned char)*(p - 1)) && *(p - 1) != '_' && *(p - 1) != '@');
// End boundary: End of string OR next char is not alnum/_
bool end_ok = (p[2] == '\0') || (!isALNUM((unsigned char)p[2]) && p[2] != '_');
if (start_ok && end_ok) {
// Append everything before this match
sv_catpvn(modified, start, p - start);
// Append the named type reference
sv_catpvs(modified, "@SV");
// Advance past "SV"
p += 2;
start = p;
}
else // Not a standalone "SV", skip this occurrence
p++;
}
// Append remainder
sv_catpv(modified, start);
// only return modified string if we actually changed something
if (SvCUR(modified) > strlen(str))
return SvPV_nolen(modified);
}
return str;
}
int64_t affix_perl_shim_sv_to_sint64(pTHX_ void * sv_raw) { return SvIVX((SV *)sv_raw); }
double affix_perl_shim_sv_to_double(pTHX_ void * sv_raw) { return SvNVX((SV *)sv_raw); }
const char * affix_perl_shim_sv_to_string(pTHX_ void * sv_raw) { return SvPV_nolen((SV *)sv_raw); }
void * affix_perl_shim_sv_to_pointer(pTHX_ void * sv_raw) {
SV * sv = (SV *)sv_raw;
if (!SvOK(sv) || !SvROK(sv))
return nullptr;
return INT2PTR(void *, SvIV(SvRV(sv)));
}
void * affix_perl_shim_newSViv(pTHX_ int64_t value) { return newSViv(value); }
void * affix_perl_shim_newSVnv(pTHX_ double value) { return newSVnv(value); }
void * affix_perl_shim_newSVpv(pTHX_ const char * value) { return newSVpv(value, 0); }
void _pin_sv(pTHX_ SV * sv,
const infix_type * type,
void * pointer,
bool managed,
SV * owner_sv,
size_t bit_offset,
size_t bit_width);
static void push_union(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p);
#define DEFINE_PUSH_PRIMITIVE_EXECUTOR(name, c_type, sv_accessor) \
static void plan_step_push_##name(pTHX_ Affix * affix, \
Affix_Plan_Step * step, \
SV ** perl_stack_frame, \
void * args_buffer, \
void ** c_args, \
void * ret_buffer) { \
PERL_UNUSED_VAR(affix); \
PERL_UNUSED_VAR(ret_buffer); \
SV * sv = perl_stack_frame[step->data.index]; \
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(c_type *)c_arg_ptr = (c_type)sv_accessor(sv); \
c_args[step->data.index] = c_arg_ptr; \
}
#define DEFINE_IV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
c_type val; \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
val = (c_type)SvUVX(sv); \
else \
val = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
lib/Affix.c view on Meta::CPAN
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;
}
if (lib_handle_for_symbol && symbol_name_str)
symbol = infix_library_get_symbol(lib_handle_for_symbol, symbol_name_str);
}
if (symbol == nullptr) {
if (created_implicit_handle) {
const char * lookup_path = SvOK(target_sv) ? SvPV_nolen(target_sv) : "";
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--;
if (entry->ref_count == 0) {
infix_library_close(entry->lib);
safefree(entry);
hv_delete_ent(MY_CXT.lib_registry, newSVpvn(lookup_path, strlen(lookup_path)), G_DISCARD, 0);
}
}
}
warn("Failed to locate symbol '%s'", symbol_name_str ? symbol_name_str : "(null)");
XSRETURN_UNDEF;
}
}
// Argument shifting (Determine where signature starts)
SV * args_sv = nullptr;
SV * ret_sv = nullptr;
SV * sig_sv = nullptr;
bool explicit_args = false; // true if using [Args] => Ret format
if (is_raw_ptr_target) {
// Mode A: wrap($ptr, [Args], Ret) -> items=3
// Mode B: wrap($ptr, "Signature") -> items=2
if (items == 3) {
args_sv = ST(1);
ret_sv = ST(2);
explicit_args = true;
}
else
sig_sv = ST(1);
}
else {
// Mode C: wrap($lib, $name, [Args], Ret) -> items=4
// Mode D: wrap($lib, $name, "Signature") -> items=3
if (items == 4) {
args_sv = ST(2);
ret_sv = ST(3);
explicit_args = true;
}
else
sig_sv = ST(2);
}
// Build infix signature string
char signature_buf[1024] = {0};
size_t sig_pos = 0;
size_t sig_remaining = sizeof(signature_buf) - 1;
const char * signature = nullptr;
if (explicit_args) {
if (!SvROK(args_sv) || SvTYPE(SvRV(args_sv)) != SVt_PVAV)
croak("Usage: affix(..., \\@args, $ret_type) - args must be an array reference");
signature_buf[sig_pos++] = '(';
sig_remaining--;
AV * args_av = (AV *)SvRV(args_sv);
SSize_t num_args = av_len(args_av) + 1;
for (SSize_t i = 0; i < num_args; ++i) {
SV ** type_sv_ptr = av_fetch(args_av, i, 0);
if (!type_sv_ptr)
continue;
const char * arg_sig = _get_string_from_type_obj(aTHX_ * type_sv_ptr);
if (!arg_sig)
croak("Invalid type object in signature");
size_t arg_len = strlen(arg_sig);
if (arg_len >= sig_remaining)
croak("Signature too long (buffer overflow)");
memcpy(signature_buf + sig_pos, arg_sig, arg_len);
sig_pos += arg_len;
sig_remaining -= arg_len;
// Logic to prevent adding commas around ';', which denotes VarArgs start
if (i < num_args - 1) {
if (strEQ(arg_sig, ";"))
continue;
SV ** next_sv_ptr = av_fetch(args_av, i + 1, 0);
if (next_sv_ptr) {
const char * next_sig = _get_string_from_type_obj(aTHX_ * next_sv_ptr);
if (next_sig && strEQ(next_sig, ";"))
continue;
}
if (sig_remaining < 2)
croak("Signature too long (buffer overflow)");
signature_buf[sig_pos++] = ',';
sig_remaining--;
}
}
{
const char * close_arrow = ") -> ";
size_t ca_len = strlen(close_arrow);
if (ca_len >= sig_remaining)
croak("Signature too long (buffer overflow)");
memcpy(signature_buf + sig_pos, close_arrow, ca_len);
sig_pos += ca_len;
sig_remaining -= ca_len;
}
const char * ret_sig = _get_string_from_type_obj(aTHX_ ret_sv);
if (!ret_sig)
croak("Invalid return type object");
size_t ret_len = strlen(ret_sig);
if (ret_len >= sig_remaining)
croak("Signature too long (buffer overflow)");
memcpy(signature_buf + sig_pos, ret_sig, ret_len);
sig_pos += ret_len;
signature_buf[sig_pos] = '\0';
signature = signature_buf;
}
else {
signature = _get_string_from_type_obj(aTHX_ sig_sv);
if (!signature)
signature = SvPV_nolen(sig_sv);
}
// Direct marshalling path
if (ix == 2) {
Affix_Backend * backend;
Newxz(backend, 1, Affix_Backend);
infix_arena_t * parse_arena = nullptr;
infix_type * ret_type = nullptr;
infix_function_argument * args = nullptr;
size_t num_args = 0, num_fixed = 0;
backend->ret_readonly = false;
if (ret_sv && _is_const_obj(aTHX_ ret_sv))
backend->ret_readonly = true;
else if (sig_sv && _is_const_obj(aTHX_ sig_sv))
backend->ret_readonly = true;
infix_status status =
infix_signature_parse(signature, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);
lib/Affix.c view on Meta::CPAN
SV ** entry_sv_ptr = hv_fetch(MY_CXT.callback_registry, key, strlen(key), 0);
if (entry_sv_ptr) {
Implicit_Callback_Magic * magic_data = INT2PTR(Implicit_Callback_Magic *, SvIV(*entry_sv_ptr));
*(void **)p = infix_reverse_get_code(magic_data->reverse_ctx);
}
else {
// Dereference through any Pointer wrappers to reach the REVERSE_TRAMPOLINE type with func_ptr_info.
// Callback signature already includes the pointer (*((args)->ret)), so Pointer[Callback[...]] is
// Pointer[Pointer[Function]].
const infix_type * ft = resolve_type(aTHX_ type);
while (ft && ft->category == INFIX_TYPE_POINTER)
ft = resolve_type(aTHX_ ft->meta.pointer_info.pointee_type);
if (!ft || ft->category != INFIX_TYPE_REVERSE_TRAMPOLINE)
croak("Expected a callback type for struct member");
Affix_Callback_Data * cb_data;
Newxz(cb_data, 1, Affix_Callback_Data);
cb_data->coderef_rv = newRV_inc(coderef_cv);
storeTHX(cb_data->perl);
infix_type * ret_type = ft->meta.func_ptr_info.return_type;
size_t num_args = ft->meta.func_ptr_info.num_args;
size_t num_fixed_args = ft->meta.func_ptr_info.num_fixed_args;
infix_type ** arg_types = nullptr;
if (num_args > 0) {
Newx(arg_types, num_args, infix_type *);
for (size_t i = 0; i < num_args; ++i)
arg_types[i] = ft->meta.func_ptr_info.args[i].type;
}
infix_reverse_t * reverse_ctx = nullptr;
infix_status status = infix_reverse_create_closure_manual(&reverse_ctx,
ret_type,
arg_types,
num_args,
num_fixed_args,
(void *)_affix_callback_handler_entry,
(void *)cb_data);
if (arg_types)
Safefree(arg_types);
if (status != INFIX_SUCCESS) {
SvREFCNT_dec(cb_data->coderef_rv);
safefree(cb_data);
croak("Failed to create callback: %s", infix_get_last_error().message);
}
Implicit_Callback_Magic * magic_data;
Newxz(magic_data, 1, Implicit_Callback_Magic);
magic_data->reverse_ctx = reverse_ctx;
hv_store(MY_CXT.callback_registry, key, strlen(key), newSViv(PTR2IV(magic_data)), 0);
*(void **)p = infix_reverse_get_code(reverse_ctx);
}
}
else if (!SvOK(sv))
*(void **)p = nullptr;
else
croak("Argument for a callback must be a code reference or undef.");
}
static SV * _format_parse_error(pTHX_ const char * context_msg, const char * signature, infix_error_details_t err) {
STRLEN sig_len = strlen(signature);
int radius = 20;
size_t start = (err.position > radius) ? (err.position - radius) : 0;
size_t end = (err.position + radius < sig_len) ? (err.position + radius) : sig_len;
const char * start_indicator = (start > 0) ? "... " : "";
const char * end_indicator = (end < sig_len) ? " ..." : "";
int start_indicator_len = (start > 0) ? 4 : 0;
char snippet[128];
snprintf(
snippet, sizeof(snippet), "%s%.*s%s", start_indicator, (int)(end - start), signature + start, end_indicator);
char pointer[128];
int caret_pos = err.position - start + start_indicator_len;
snprintf(pointer, sizeof(pointer), "%*s^", caret_pos, "");
return sv_2mortal(newSVpvf("Failed to parse signature %s:\n\n %s\n %s\n\nError: %s (at position %zu)",
context_msg,
snippet,
pointer,
err.message,
err.position));
}
XS_INTERNAL(Affix_Lib_as_string) {
dVAR;
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "$lib");
IV RETVAL;
{
infix_library_t * lib;
IV tmp = SvIV((SV *)SvRV(ST(0)));
lib = INT2PTR(infix_library_t *, tmp);
RETVAL = PTR2IV(lib->handle);
}
XSRETURN_IV(RETVAL);
};
XS_INTERNAL(Affix_Lib_DESTROY) {
dXSARGS;
dMY_CXT;
if (items != 1)
croak_xs_usage(cv, "$lib");
IV tmp = SvIV((SV *)SvRV(ST(0)));
infix_library_t * lib = INT2PTR(infix_library_t *, tmp);
if (MY_CXT.lib_registry) {
hv_iterinit(MY_CXT.lib_registry);
HE * he;
SV * key_to_delete = nullptr;
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--;
if (entry->ref_count == 0) {
key_to_delete = sv_2mortal(newSVsv(HeKEY_sv(he)));
infix_library_close(entry->lib);
safefree(entry);
}
break;
}
}
if (key_to_delete)
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));
lib/Affix.c view on Meta::CPAN
SV * name_sv = ST(0);
const char * raw_name = SvPV_nolen(name_sv);
const char * name = (raw_name[0] == '@') ? raw_name + 1 : raw_name;
SV * def_sv = sv_2mortal(newSVpvf("@%s", name));
if (items == 2) {
sv_catpv(def_sv, " = ");
SV * type_sv = ST(1);
const char * type_str = _get_string_from_type_obj(aTHX_ type_sv);
sv_catpv(def_sv, type_str ? type_str : SvPV_nolen(type_sv));
}
//~ else
// If no type is provided, define it as an empty (opaque) struct
// This prevents "Unexpected token" errors in infix.
//~ sv_catpv(def_sv, ";");
sv_catpv(def_sv, ";");
if (infix_register_types(MY_CXT.registry, SvPV_nolen(def_sv)) != INFIX_SUCCESS) {
SV * err_sv = _format_parse_error(aTHX_ "in typedef", SvPV_nolen(def_sv), infix_get_last_error());
warn_sv(err_sv);
XSRETURN_UNDEF;
}
#if DEBUG
char * blah;
Newxz(blah, 1024 * 5, char);
infix_registry_print(blah, 1024 * 5, MY_CXT.registry);
warn("registry: %s", blah);
safefree(blah);
#endif
// Export the constant sub so users can use the type name in Perl
HV * stash = CopSTASH(PL_curcop);
bool sub_exists = false;
if (stash) {
SV ** entry = hv_fetch(stash, name, strlen(name), 0);
if (entry && *entry && isGV(*entry)) {
if (GvCV((GV *)*entry))
sub_exists = true;
}
}
if (!sub_exists) {
SV * type_name_sv = newSVpvf("@%s", name);
newCONSTSUB(stash, (char *)name, type_name_sv);
}
XSRETURN_YES;
}
XS_INTERNAL(Affix_register_types_raw) {
dXSARGS;
dMY_CXT;
if (items != 1)
croak_xs_usage(cv, "definitions_string");
const char * defs = SvPV_nolen(ST(0));
if (infix_register_types(MY_CXT.registry, defs) != INFIX_SUCCESS) {
infix_error_details_t err = infix_get_last_error();
STRLEN sig_len = strlen(defs);
int radius = 20;
size_t start = (err.position > radius) ? (err.position - radius) : 0;
size_t end = (err.position + radius < sig_len) ? (err.position + radius) : sig_len;
const char * start_indicator = (start > 0) ? "... " : "";
const char * end_indicator = (end < sig_len) ? " ..." : "";
int start_indicator_len = (start > 0) ? 4 : 0;
char snippet[256];
snprintf(
snippet, sizeof(snippet), "%s%.*s%s", start_indicator, (int)(end - start), defs + start, end_indicator);
char pointer[256];
int caret_pos = err.position - start + start_indicator_len;
snprintf(pointer, sizeof(pointer), "%*s^", caret_pos, "");
warn("Failed to parse batch signature:\n\n %s\n %s\n\nError: %s (at position %zu)",
snippet,
pointer,
err.message,
err.position);
}
XSRETURN_YES;
}
XS_INTERNAL(Affix_dump_registry) {
dXSARGS;
dMY_CXT;
char * buffer;
size_t size = 1024 * 128; // 128KB
Newxz(buffer, size, char);
if (infix_registry_print(buffer, size, MY_CXT.registry) == INFIX_SUCCESS)
ST(0) = sv_2mortal(newSVpv(buffer, 0));
else
ST(0) = sv_2mortal(newSVpvs("[Registry too large or print failed]"));
safefree(buffer);
XSRETURN(1);
}
XS_INTERNAL(Affix_defined_types) {
dXSARGS;
dMY_CXT;
PERL_UNUSED_VAR(cv);
size_t count = 0;
infix_registry_iterator_t it_counter = infix_registry_iterator_begin(MY_CXT.registry);
while (infix_registry_iterator_next(&it_counter))
if (infix_registry_iterator_get_type(&it_counter))
count++;
if (GIMME_V == G_SCALAR) {
ST(0) = sv_2mortal(newSVuv(count));
XSRETURN(1);
}
if (count == 0)
XSRETURN(0);
EXTEND(SP, count);
infix_registry_iterator_t it = infix_registry_iterator_begin(MY_CXT.registry);
while (infix_registry_iterator_next(&it)) {
if (infix_registry_iterator_get_type(&it)) {
const char * name = infix_registry_iterator_get_name(&it);
PUSHs(sv_2mortal(newSVpv(name, 0)));
}
}
XSRETURN(count);
}
void _DumpHex(pTHX_ const void * addr, size_t len, const char * file, int line) {
if (addr == nullptr) {
printf("Dumping %lu bytes from null pointer %p at %s line %d\n", (unsigned long)len, addr, file, line);
fflush(stdout);
( run in 0.772 second using v1.01-cache-2.11-cpan-b301d465b3d )