static amf0_data_t* _amf0_data(SV* sv) {
amf0_data_t* d;
if (NULL == sv || !SvOK(sv)) {
d = (amf0_data_t*)amf0_null_init();
}
else if (SvPOKp(sv)) {
STRLEN len;
char* c = SvPV(sv, len);
d = (amf0_data_t*)amf0_string_init_len(c, len);
}
else if (SvNOKp(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvNVX(sv));
}
else if (SvIOK_UV(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvUV(sv));
}
else if (SvIOKp(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvIV(sv));
}
else if (SvROK(sv)) {
d = _amf0_data_rv(SvRV(sv));
}
else {
Perl_croak(aTHX_ "Data::AMF::XS doesn't support SvTYPE: %d\n", SvTYPE(sv));
}
return d;
}
static void pe_tracevar(pe_watcher *wa, SV *sv, int got) {
/* Adapted from tkGlue.c
We are a "magic" set processor.
So we are (I think) supposed to look at "private" flags
and set the public ones if appropriate.
e.g. "chop" sets SvPOKp as a hint but not SvPOK
presumably other operators set other private bits.
Question are successive "magics" called in correct order?
i.e. if we are tracing a tied variable should we call
some magic list or be careful how we insert ourselves in the list?
*/
pe_ioevent *ev;
if (SvPOKp(sv)) SvPOK_on(sv);
if (SvNOKp(sv)) SvNOK_on(sv);
if (SvIOKp(sv)) SvIOK_on(sv);
ev = (pe_ioevent*) (*wa->vtbl->new_event)(wa);
++ev->base.hits;
ev->got |= got;
queueEvent((pe_event*) ev);
}
SEXP
GetRScalar(SV *val)
{
dTHX;
SEXP ans = NULL_USER_OBJECT;
if(SvIOKp(val)) {
PROTECT(ans = NEW_INTEGER(1));
INTEGER_DATA(ans)[0] = SvIV(val);
UNPROTECT(1);
} else if(SvNOKp(val)) {
PROTECT(ans = NEW_NUMERIC(1));
NUMERIC_DATA(ans)[0] = SvNV(val);
UNPROTECT(1);
} else if(SvPOK(val)) {
PROTECT(ans = NEW_CHARACTER(1));
SET_STRING_ELT(ans, 0, COPY_TO_USER_STRING(SvPV(val, PL_na)));
UNPROTECT(1);
} else if(SvROK(val)) {
fprintf(stderr, "Not handling nested references in conversion from Perl to R at present. Suggestions for semantics welcome!\n");fflush(stderr);
} else if(SvTYPE(val) == SVt_PVMG) {
/*XXX get more info about the type of the magic object.
struct magic *mg = SvMAGIC(val);
*/
PROTECT(ans = createPerlReference(val));
UNPROTECT(1);
} else {
fprintf(stderr, "Cannot deal currently with Perl types %d\n", SvTYPE(val));fflush(stderr);
}
return(ans);
}
/* Entry point for serialization. Dumps generic SVs and delegates
* to more specialized functions for RVs, etc. */
void
ddl_dump_sv(pTHX_ ddl_encoder_t *enc, SV *src)
{
SvGETMAGIC(src);
/* dump strings */
if (SvPOKp(src)) {
STRLEN len;
char *str = SvPV(src, len);
BUF_SIZE_ASSERT(enc, 2 + len);
ddl_dump_pv(aTHX_ enc, str, len, SvUTF8(src));
}
/* dump floats */
else if (SvNOKp(src)) {
BUF_SIZE_ASSERT(enc, NV_DIG + 32);
Gconvert(SvNVX(src), NV_DIG, 0, enc->pos);
enc->pos += strlen(enc->pos);
}
/* dump ints */
else if (SvIOKp(src)) {
/* we assume we can always read an IV as a UV and vice versa
* we assume two's complement
* we assume no aliasing issues in the union */
if (SvIsUV(src) ? SvUVX(src) <= 59000
: SvIVX(src) <= 59000 && SvIVX(src) >= -59000)
{
/* optimise the "small number case"
* code will likely be branchless and use only a single multiplication
* works for numbers up to 59074 */
I32 i = SvIVX(src);
U32 u;
char digit, nz = 0;
BUF_SIZE_ASSERT(enc, 6);
*enc->pos = '-'; enc->pos += i < 0 ? 1 : 0;
u = i < 0 ? -i : i;
/* convert to 4.28 fixed-point representation */
u *= ((0xfffffff + 10000) / 10000); /* 10**5, 5 fractional digits */
/* now output digit by digit, each time masking out the integer part
* and multiplying by 5 while moving the decimal point one to the right,
* resulting in a net multiplication by 10.
* we always write the digit to memory but conditionally increment
* the pointer, to enable the use of conditional move instructions. */
digit = u >> 28; *enc->pos = digit + '0'; enc->pos += (nz = nz || digit); u = (u & 0xfffffffUL) * 5;
digit = u >> 27; *enc->pos = digit + '0'; enc->pos += (nz = nz || digit); u = (u & 0x7ffffffUL) * 5;
digit = u >> 26; *enc->pos = digit + '0'; enc->pos += (nz = nz || digit); u = (u & 0x3ffffffUL) * 5;
digit = u >> 25; *enc->pos = digit + '0'; enc->pos += (nz = nz || digit); u = (u & 0x1ffffffUL) * 5;
digit = u >> 24; *enc->pos = digit + '0'; enc->pos += 1; /* correctly generate '0' */
}
else {
int RPerl_SvNOKp(SV* input_sv) { return(SvNOKp(input_sv)); }
