Affix
view release on metacpan or search on metacpan
lib/Affix.c view on Meta::CPAN
}
XS_INTERNAL(Affix_unpin) {
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "var");
SV * sv = ST(0);
// Pins are often references to magical scalars; unwrap if necessary
if (SvROK(sv) && !sv_isobject(sv))
sv = SvRV(sv);
if (SvMAGICAL(sv)) {
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);
lib/Affix.c view on Meta::CPAN
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(float *)ptr = (float)SvNVX(sv); \
else if (flags & SVf_IOK) \
*(float *)ptr = (float)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(float *)ptr = (float)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_DOUBLE: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(double *)ptr = SvNVX(sv); \
else if (flags & SVf_IOK) \
*(double *)ptr = (double)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(double *)ptr = (double)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_LONGDOUBLE: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(long double *)ptr = SvNVX(sv); \
else if (flags & SVf_IOK) \
*(long double *)ptr = (long double)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(long double *)ptr = (long double)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_PTR_CHAR: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
if (SvPOK(sv)) \
*(const char **)ptr = SvPV_nolen(sv); \
else if (!SvOK(sv)) \
*(void **)ptr = nullptr; \
else if (is_pin_v2(aTHX_ sv)) \
*(void **)ptr = get_address_v2(aTHX_ sv); \
else \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_PTR_WCHAR: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
if (SvPOK(sv)) { \
STRLEN len; \
U8 * s = (U8 *)SvPVutf8(sv, len); \
U8 * e = s + len; \
Newx(*(void **)ptr, len + 1, wchar_t); \
wchar_t * d = *(void **)ptr; \
while (s < e) { \
UV uv = utf8_to_uvchr_buf(s, e, nullptr); \
if (sizeof(wchar_t) == 2 && uv > 0xFFFF) { \
uv -= 0x10000; \
*d++ = (wchar_t)((uv >> 10) + 0xD800); \
*d++ = (wchar_t)((uv & 0x3FF) + 0xDC00); \
} \
else \
*d++ = (wchar_t)uv; \
s += UTF8SKIP(s); \
} \
*d = 0; \
SAVEFREEPV(*(void **)ptr); \
} \
else if (!SvOK(sv)) \
*(void **)ptr = nullptr; \
else if (is_pin_v2(aTHX_ sv)) \
*(void **)ptr = get_address_v2(aTHX_ sv); \
else \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_POINTER: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
void * addr = get_address_v2(aTHX_ sv); \
if (addr) \
*(void **)ptr = addr; \
else if (is_pin_v2(aTHX_ sv)) \
*(void **)ptr = get_address_v2(aTHX_ sv); \
else if (!SvOK(sv) && SvREADONLY(sv)) \
*(void **)ptr = nullptr; \
else \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
} \
CASE_OP_PUSH_SV: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
*(SV **)ptr = sv; \
DISPATCH(); \
} \
CASE_OP_PUSH_VECTOR: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
if (SvPOK(sv)) { \
STRLEN len; \
const char * buf = SvPV(sv, len); \
size_t sz = infix_type_get_size(step->data.type); \
if (len >= sz) { \
memcpy(ptr, buf, sz); \
DISPATCH(); \
} \
} \
step->executor(aTHX_ affix, step, &ST(0), args_buffer, c_args, ret_buffer); \
DISPATCH(); \
( run in 0.892 second using v1.01-cache-2.11-cpan-ad19def0cd9 )