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)); }