Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
// 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);
break;
}
case OP_RET_PTR_WCHAR:
pull_pointer_as_wstring(aTHX_ nullptr, TARG, backend->ret_type, ret_buffer);
break;
case OP_RET_SV:
{
SV * s = *(SV **)ret_buffer;
if (s)
sv_setsv(TARG, s);
else
sv_setsv(TARG, &PL_sv_undef);
break;
}
case OP_RET_CUSTOM:
lib/Affix.c view on Meta::CPAN
static void plan_step_push_array(pTHX_ Affix *, Affix_Plan_Step *, SV **, void *, void **, void *);
static void plan_step_push_enum(pTHX_ Affix *, Affix_Plan_Step *, SV **, void *, void **, void *);
static void plan_step_push_complex(pTHX_ Affix *, Affix_Plan_Step *, SV **, void *, void **, void *);
static void plan_step_push_vector(pTHX_ Affix *, Affix_Plan_Step *, SV **, void *, void **, void *);
static void plan_step_push_sv(pTHX_ Affix *, Affix_Plan_Step *, SV **, void *, void **, void *);
static void plan_step_push_callback(pTHX_ Affix *, Affix_Plan_Step *, SV **, void *, void **, void *);
static void push_handler_bool(pTHX_ Affix *, SV *, void *);
static void push_handler_sint8(pTHX_ Affix *, SV *, void *);
static void push_handler_uint8(pTHX_ Affix *, SV *, void *);
static void push_handler_sint16(pTHX_ Affix *, SV *, void *);
static void push_handler_uint16(pTHX_ Affix *, SV *, void *);
static void push_handler_sint32(pTHX_ Affix *, SV *, void *);
static void push_handler_uint32(pTHX_ Affix *, SV *, void *);
static void push_handler_sint64(pTHX_ Affix *, SV *, void *);
static void push_handler_uint64(pTHX_ Affix *, SV *, void *);
static void push_handler_float16(pTHX_ Affix *, SV *, void *);
static void push_handler_float(pTHX_ Affix *, SV *, void *);
static void push_handler_double(pTHX_ Affix *, SV *, void *);
static void push_handler_long_double(pTHX_ Affix *, SV *, void *);
static void pull_sint8(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint8(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sint16(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint16(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sint32(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint32(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sint64(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint64(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_float16(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_float(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_double(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_long_double(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_bool(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_void(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_struct(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_union(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_array(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_enum(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_enum_dualvar(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_complex(pTHX_ Affix *, SV *, const infix_type *, void * p);
static void pull_vector(pTHX_ Affix *, SV *, const infix_type *, void * p);
static void pull_pointer(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_string(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_struct(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_array(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_pointer_as_pin(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_sv(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_reverse_trampoline(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_file(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_perlio(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_stringlist(pTHX_ Affix *, SV *, const infix_type *, void *);
#if !defined(INFIX_COMPILER_MSVC)
static void pull_sint128(pTHX_ Affix *, SV *, const infix_type *, void *);
static void pull_uint128(pTHX_ Affix *, SV *, const infix_type *, void *);
#endif
#define DEFINE_PUSH_PRIMITIVE_EXECUTOR(name, c_type, sv_accessor) \
static void plan_step_push_##name(pTHX_ Affix * affix, \
Affix_Plan_Step * step, \
SV ** perl_stack_frame, \
void * args_buffer, \
void ** c_args, \
void * ret_buffer) { \
PERL_UNUSED_VAR(affix); \
PERL_UNUSED_VAR(ret_buffer); \
SV * sv = perl_stack_frame[step->data.index]; \
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(c_type *)c_arg_ptr = (c_type)sv_accessor(sv); \
c_args[step->data.index] = c_arg_ptr; \
}
#define DEFINE_IV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvIV(sv); \
} \
return; \
}
#define DEFINE_UV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvUV(sv); \
} \
return; \
}
#define DEFINE_NV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(c_type *)c_ptr = SvNVX(sv); \
else if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvNV(sv); \
} \
return; \
}
#define DEFINE_I128_PUSH_HANDLER(name) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
lib/Affix.c view on Meta::CPAN
return OP_RET_CUSTOM;
}
if (pointee->category == INFIX_TYPE_PRIMITIVE) {
if (pointee->meta.primitive_id == INFIX_PRIMITIVE_SINT8 ||
pointee->meta.primitive_id == INFIX_PRIMITIVE_UINT8) {
return OP_RET_PTR_CHAR;
}
#if defined(INFIX_OS_WINDOWS)
if (infix_type_get_size(pointee) == sizeof(wchar_t))
return OP_RET_PTR_WCHAR;
#endif
}
return OP_RET_PTR;
}
if (type->category == INFIX_TYPE_STRUCT) {
if (is_perl_sv_type(type))
croak("Type 'SV' cannot be returned by value. Use 'Pointer[SV]' instead.");
}
return OP_RET_CUSTOM;
}
DEFINE_IV_PUSH_HANDLER(sint8, int8_t)
DEFINE_UV_PUSH_HANDLER(uint8, uint8_t)
DEFINE_IV_PUSH_HANDLER(sint16, int16_t)
DEFINE_UV_PUSH_HANDLER(uint16, uint16_t)
DEFINE_IV_PUSH_HANDLER(sint32, int32_t)
DEFINE_UV_PUSH_HANDLER(uint32, uint32_t)
DEFINE_IV_PUSH_HANDLER(sint64, int64_t)
DEFINE_UV_PUSH_HANDLER(uint64, uint64_t)
#ifdef __SIZEOF_INT128__
DEFINE_I128_PUSH_HANDLER(sint128)
DEFINE_U128_PUSH_HANDLER(uint128)
#endif
static void push_handler_float16(pTHX_ Affix * affix, SV * sv, void * c_ptr) {
PERL_UNUSED_VAR(affix);
*(infix_float16_t *)c_ptr = float_to_half((float)SvNV(sv));
}
DEFINE_NV_PUSH_HANDLER(float, float);
DEFINE_NV_PUSH_HANDLER(double, double);
DEFINE_NV_PUSH_HANDLER(long_double, long double);
static void push_handler_bool(pTHX_ Affix * affix, SV * perl_sv, void * c_ptr) {
PERL_UNUSED_VAR(affix);
*(bool *)c_ptr = SvTRUE(perl_sv);
}
DEFINE_PUSH_PRIMITIVE_EXECUTOR(bool, bool, SvTRUE)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(sint8, int8_t, SvIV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(uint8, uint8_t, SvUV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(sint16, int16_t, SvIV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(uint16, uint16_t, SvUV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(sint32, int32_t, SvIV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(uint32, uint32_t, SvUV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(sint64, int64_t, SvIV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(uint64, uint64_t, SvUV)
static void plan_step_push_float16(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
SV * sv = perl_stack_frame[step->data.index];
infix_float16_t h = float_to_half((float)SvNV(sv));
void * p = (char *)args_buffer + step->data.c_arg_offset;
*(infix_float16_t *)p = h;
c_args[step->data.index] = p;
}
DEFINE_PUSH_PRIMITIVE_EXECUTOR(float, float, SvNV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(double, double, SvNV)
DEFINE_PUSH_PRIMITIVE_EXECUTOR(long_double, long double, SvNV)
#if !defined(INFIX_COMPILER_MSVC)
static void plan_step_push_sint128(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
SV * sv = perl_stack_frame[step->data.index];
void * ptr = (char *)args_buffer + step->data.c_arg_offset;
sv_to_int128_safe(sv, ptr);
c_args[step->data.index] = ptr;
}
static void plan_step_push_uint128(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
SV * sv = perl_stack_frame[step->data.index];
void * ptr = (char *)args_buffer + step->data.c_arg_offset;
sv_to_uint128_safe(sv, ptr);
c_args[step->data.index] = ptr;
}
#endif
static MGVTBL Affix_pin_vtbl = {
Affix_get_pin, Affix_set_pin, Affix_len_pin, nullptr, Affix_free_pin, nullptr, Affix_pin_dup, nullptr};
static const Affix_Step_Executor primitive_executors[] = {
[INFIX_PRIMITIVE_BOOL] = plan_step_push_bool,
[INFIX_PRIMITIVE_SINT8] = plan_step_push_sint8,
[INFIX_PRIMITIVE_UINT8] = plan_step_push_uint8,
[INFIX_PRIMITIVE_SINT16] = plan_step_push_sint16,
[INFIX_PRIMITIVE_UINT16] = plan_step_push_uint16,
[INFIX_PRIMITIVE_SINT32] = plan_step_push_sint32,
[INFIX_PRIMITIVE_UINT32] = plan_step_push_uint32,
[INFIX_PRIMITIVE_SINT64] = plan_step_push_sint64,
[INFIX_PRIMITIVE_UINT64] = plan_step_push_uint64,
[INFIX_PRIMITIVE_FLOAT16] = plan_step_push_float16,
[INFIX_PRIMITIVE_FLOAT] = plan_step_push_float,
[INFIX_PRIMITIVE_DOUBLE] = plan_step_push_double,
[INFIX_PRIMITIVE_LONG_DOUBLE] = plan_step_push_long_double,
#if !defined(INFIX_COMPILER_MSVC)
[INFIX_PRIMITIVE_SINT128] = plan_step_push_sint128,
[INFIX_PRIMITIVE_UINT128] = plan_step_push_uint128,
#endif
};
static const Affix_Push_Handler primitive_push_handlers[] = {
[INFIX_PRIMITIVE_BOOL] = push_handler_bool,
[INFIX_PRIMITIVE_SINT8] = push_handler_sint8,
[INFIX_PRIMITIVE_UINT8] = push_handler_uint8,
[INFIX_PRIMITIVE_SINT16] = push_handler_sint16,
[INFIX_PRIMITIVE_UINT16] = push_handler_uint16,
[INFIX_PRIMITIVE_SINT32] = push_handler_sint32,
[INFIX_PRIMITIVE_UINT32] = push_handler_uint32,
[INFIX_PRIMITIVE_SINT64] = push_handler_sint64,
[INFIX_PRIMITIVE_UINT64] = push_handler_uint64,
[INFIX_PRIMITIVE_FLOAT16] = push_handler_float16,
[INFIX_PRIMITIVE_FLOAT] = push_handler_float,
[INFIX_PRIMITIVE_DOUBLE] = push_handler_double,
[INFIX_PRIMITIVE_LONG_DOUBLE] = push_handler_long_double,
#ifdef __SIZEOF_INT128__
[INFIX_PRIMITIVE_SINT128] = push_handler_sint128,
[INFIX_PRIMITIVE_UINT128] = push_handler_uint128,
#endif
};
static void plan_step_push_pointer(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
if (is_pin(aTHX_ sv)) {
*(void **)c_arg_ptr = _get_pin_from_sv(aTHX_ sv)->pointer;
return;
}
const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
if (pointee_type == nullptr)
croak("Internal error in push_pointer: pointee_type is nullptr");
if (!SvOK(sv)) {
if (!SvREADONLY(sv)) {
size_t size = infix_type_get_size(pointee_type);
size_t align = infix_type_get_alignment(pointee_type);
if (size == 0) {
size = sizeof(void *);
align = _Alignof(void *);
}
void * temp_slot = infix_arena_alloc(affix->args_arena, size, align > 0 ? align : 1);
memset(temp_slot, 0, size);
*(void **)c_arg_ptr = temp_slot;
return;
}
*(void **)c_arg_ptr = nullptr;
return;
}
if (SvIOK(sv)) { // Treat integer value as a raw memory address
*(void **)c_arg_ptr = INT2PTR(void *, SvUV(sv));
return;
}
const char * type_name = infix_type_get_name(type);
if (type_name &&
(strEQ(type_name, "Buffer") || strEQ(type_name, "@Buffer") || strEQ(type_name, "SockAddr") ||
strEQ(type_name, "@SockAddr") || strEQ(type_name, "StringList") || strEQ(type_name, "@StringList"))) {
sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
return;
}
const char * pointee_name = infix_type_get_name(pointee_type);
if (pointee_name &&
(strEQ(pointee_name, "File") || strEQ(pointee_name, "@File") || strEQ(pointee_name, "PerlIO") ||
strEQ(pointee_name, "@PerlIO"))) {
sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
return;
}
if (pointee_type->category == INFIX_TYPE_REVERSE_TRAMPOLINE &&
(SvTYPE(sv) == SVt_PVCV || (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV))) {
push_reverse_trampoline(aTHX_ affix, pointee_type, sv, c_arg_ptr);
return;
}
if (SvROK(sv)) {
SV * const rv = SvRV(sv);
if (pointee_type->category == INFIX_TYPE_POINTER) {
lib/Affix.c view on Meta::CPAN
*ptr_slot = SvPV_nolen(rv);
*(void **)c_arg_ptr = ptr_slot;
return;
}
}
}
if (SvTYPE(rv) == SVt_PVAV) {
AV * av = (AV *)rv;
size_t len = av_len(av) + 1;
size_t element_size = infix_type_get_size(pointee_type);
size_t total_size = len * element_size;
char * c_array = (char *)infix_arena_alloc(affix->args_arena, total_size, _Alignof(void *));
if (!c_array)
croak("Failed to allocate from arena for array marshalling");
memset(c_array, 0, total_size);
for (size_t i = 0; i < len; ++i) {
SV ** elem_sv_ptr = av_fetch(av, i, 0);
if (elem_sv_ptr)
sv2ptr(aTHX_ affix, *elem_sv_ptr, c_array + (i * element_size), pointee_type);
}
*(void **)c_arg_ptr = c_array;
return;
}
const infix_type * copy_type = (pointee_type->category == INFIX_TYPE_VOID)
? (SvIOK(rv) ? infix_type_create_primitive(INFIX_PRIMITIVE_SINT64)
: SvNOK(rv) ? infix_type_create_primitive(INFIX_PRIMITIVE_DOUBLE)
: SvPOK(rv) ? (*(void **)c_arg_ptr = SvPV_nolen(rv), (infix_type *)nullptr)
: (croak("Cannot pass reference to this type of scalar for a 'void*' parameter"),
(infix_type *)nullptr))
: pointee_type;
if (!copy_type)
return;
void * dest_c_ptr =
infix_arena_alloc(affix->args_arena, infix_type_get_size(copy_type), infix_type_get_alignment(copy_type));
SV * sv_to_marshal = (SvTYPE(rv) == SVt_PVHV) ? sv : rv;
sv2ptr(aTHX_ affix, sv_to_marshal, dest_c_ptr, copy_type);
*(void **)c_arg_ptr = dest_c_ptr;
return;
}
if (SvPOK(sv)) {
bool is_char_ptr = (pointee_type->category == INFIX_TYPE_PRIMITIVE &&
(pointee_type->meta.primitive_id == INFIX_PRIMITIVE_SINT8 ||
pointee_type->meta.primitive_id == INFIX_PRIMITIVE_UINT8));
bool is_void_ptr = (pointee_type->category == INFIX_TYPE_VOID);
if (is_char_ptr || is_void_ptr) {
*(const char **)c_arg_ptr = SvPV_nolen(sv);
return;
}
}
sv_dump(sv);
char signature_buf[256];
if (infix_type_print(signature_buf, sizeof(signature_buf), (infix_type *)type, INFIX_DIALECT_SIGNATURE) !=
INFIX_SUCCESS) {
strncpy(signature_buf, "[error printing type]", sizeof(signature_buf));
}
croak("Don't know how to handle this type of scalar as a pointer argument yet: %s", signature_buf);
}
static void plan_step_push_struct(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
push_struct(aTHX_ affix, type, sv, c_arg_ptr);
}
static void plan_step_push_union(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
push_union(aTHX_ affix, type, sv, c_arg_ptr);
}
static void plan_step_push_array(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
// args_buffer slot is sizeof(void*) because we substituted Pointer for Array in the JIT
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
// Handle NULL/Undef
if (!SvOK(sv)) {
*(void **)c_arg_ptr = nullptr;
return;
}
const infix_type * element_type = type->meta.array_info.element_type;
size_t element_size = infix_type_get_size(element_type);
if (SvPOK(sv) && element_type->category == INFIX_TYPE_PRIMITIVE && element_size == 1) {
STRLEN len;
const char * s = SvPV(sv, len);
size_t fixed_len = type->meta.array_info.num_elements;
size_t alloc_len = (fixed_len > 0) ? fixed_len : len + 1; // +1 for null if dynamic
void * temp_array = infix_arena_alloc(affix->args_arena, alloc_len, 1);
if (!temp_array)
croak("Failed to allocate memory for array argument");
memset(temp_array, 0, alloc_len);
// Copy what fits
size_t copy_len = (len < alloc_len) ? len : alloc_len;
memcpy(temp_array, s, copy_len);
if (element_type->meta.primitive_id == INFIX_PRIMITIVE_SINT8 && len >= alloc_len && alloc_len > 0)
((char *)temp_array)[alloc_len - 1] = '\0';
*(void **)c_arg_ptr = temp_array;
return;
}
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
croak("Expected an ARRAY reference or String for array marshalling");
AV * av = (AV *)SvRV(sv);
size_t input_len = av_len(av) + 1;
size_t fixed_len = type->meta.array_info.num_elements;
size_t alloc_len = (fixed_len > 0 && fixed_len > input_len) ? fixed_len : input_len;
size_t total_size = alloc_len * element_size;
// Allocate transient memory in the args_arena
void * temp_array =
infix_arena_alloc(affix->args_arena, total_size > 0 ? total_size : 1, infix_type_get_alignment(element_type));
if (!temp_array)
croak("Failed to allocate memory for array argument");
memset(temp_array, 0, total_size); // Zero-fill (important for padding fixed arrays)
for (size_t i = 0; i < input_len; ++i) { // Copy data
SV ** elem_sv_ptr = av_fetch(av, i, 0);
if (elem_sv_ptr) {
void * elem_ptr = (char *)temp_array + (i * element_size);
sv2ptr(aTHX_ affix, *elem_sv_ptr, elem_ptr, element_type);
}
}
// Write the POINTER to the argument slot
*(void **)c_arg_ptr = temp_array;
}
static void plan_step_push_enum(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
sv2ptr(aTHX_ affix, sv, c_arg_ptr, type);
}
static void plan_step_push_complex(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
croak("Expected an ARRAY reference with two numbers for complex type marshalling");
AV * av = (AV *)SvRV(sv);
if (av_len(av) != 1)
croak("Expected exactly two elements (real, imaginary) for complex type");
const infix_type * base_type = type->meta.complex_info.base_type;
size_t base_size = infix_type_get_size(base_type);
SV ** real_sv_ptr = av_fetch(av, 0, 0);
SV ** imag_sv_ptr = av_fetch(av, 1, 0);
if (!real_sv_ptr || !imag_sv_ptr)
croak("Failed to fetch real or imaginary part from array for complex type");
sv2ptr(aTHX_ affix, *real_sv_ptr, c_arg_ptr, base_type);
sv2ptr(aTHX_ affix, *imag_sv_ptr, (char *)c_arg_ptr + base_size, base_type);
}
static void plan_step_push_vector(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
// If it's a string, assume it's a packed buffer (e.g. pack 'f4')
// and copy it directly. This is much faster than iterating an AV.
if (SvPOK(sv)) {
STRLEN len;
const char * buf = SvPV(sv, len);
size_t expected_size = infix_type_get_size(type);
if (len >= expected_size) {
memcpy(c_arg_ptr, buf, expected_size);
return;
}
// If string is too short, fall through to AV check or error
}
if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
croak("Expected an ARRAY reference or Packed String for vector marshalling");
AV * av = (AV *)SvRV(sv);
size_t num_elements = av_len(av) + 1;
size_t c_vector_len = type->meta.vector_info.num_elements;
if (num_elements != c_vector_len)
croak("Perl array has %lu elements, but C vector type requires %lu.",
(unsigned long)num_elements,
(unsigned long)c_vector_len);
const infix_type * element_type = type->meta.vector_info.element_type;
size_t element_size = infix_type_get_size(element_type);
for (size_t i = 0; i < num_elements; ++i) {
SV ** element_sv_ptr = av_fetch(av, i, 0);
if (element_sv_ptr) {
void * element_ptr = (char *)c_arg_ptr + (i * element_size);
sv2ptr(aTHX_ affix, *element_sv_ptr, element_ptr, element_type);
}
}
}
static void plan_step_push_sv(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_args[step->data.index] = c_arg_ptr;
*(void **)c_arg_ptr = sv;
}
static void plan_step_push_callback(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(ret_buffer);
const infix_type * type = step->data.type;
SV * sv = perl_stack_frame[step->data.index];
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset;
c_args[step->data.index] = c_arg_ptr;
push_reverse_trampoline(aTHX_ affix, type, sv, c_arg_ptr);
}
static void plan_step_call_c_function(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(step);
PERL_UNUSED_VAR(perl_stack_frame);
PERL_UNUSED_VAR(args_buffer);
affix->cif(ret_buffer, c_args);
}
static void plan_step_pull_return_value(pTHX_ Affix * affix,
Affix_Plan_Step * step,
SV ** perl_stack_frame,
void * args_buffer,
void ** c_args,
void * ret_buffer) {
PERL_UNUSED_VAR(perl_stack_frame);
PERL_UNUSED_VAR(args_buffer);
PERL_UNUSED_VAR(c_args);
step->data.pull_handler(aTHX_ affix, affix->return_sv, step->data.type, ret_buffer);
}
Affix_Step_Executor get_plan_step_executor(const infix_type * type) {
switch (type->category) {
case INFIX_TYPE_PRIMITIVE:
return primitive_executors[type->meta.primitive_id];
case INFIX_TYPE_POINTER:
{
if (is_perl_sv_type(type))
return plan_step_push_sv;
return plan_step_push_pointer;
}
case INFIX_TYPE_STRUCT:
{
if (is_perl_sv_type(type))
return plan_step_push_sv;
return plan_step_push_struct;
}
case INFIX_TYPE_UNION:
return plan_step_push_union;
case INFIX_TYPE_ARRAY:
return plan_step_push_array;
case INFIX_TYPE_REVERSE_TRAMPOLINE:
return plan_step_push_callback;
case INFIX_TYPE_ENUM:
return plan_step_push_enum;
case INFIX_TYPE_COMPLEX:
return plan_step_push_complex;
case INFIX_TYPE_VECTOR:
return plan_step_push_vector;
default:
return nullptr;
}
}
static void writeback_primitive(pTHX_ Affix * affix, const OutParamInfo * info, SV * perl_sv, void * c_arg_ptr) {
void * actual_data_ptr = *(void **)c_arg_ptr;
if (!actual_data_ptr)
return;
// Handle the case where perl_sv IS the AV (because it was unwrapped in the trigger)
if (SvTYPE(perl_sv) == SVt_PVAV) {
// Array Decay Writeback: Update each element of the Perl array from the C array
AV * av = (AV *)perl_sv;
size_t count = av_len(av) + 1;
size_t elem_size = infix_type_get_size(info->pointee_type);
for (size_t i = 0; i < count; ++i) {
// Calculate pointer to current element in C array
void * elem_ptr = (char *)actual_data_ptr + (i * elem_size);
// Fetch the existing SV* from the AV (to update in place if possible)
SV ** sv_ptr = av_fetch(av, i, 0);
if (sv_ptr) {
ptr2sv(aTHX_ affix, elem_ptr, *sv_ptr, info->pointee_type);
}
else {
// Slot was empty, create new SV and store it
( run in 0.534 second using v1.01-cache-2.11-cpan-df04353d9ac )