msgpack/perl/xs-src/unpack.c
Fuji, Goro fedc37d079 Revert "perl: cleanup"
This reverts commit bc8d8ab65a0f0cecfa5af03b4c3b39a13da22a7b.
2010-10-28 16:31:19 +09:00

514 lines
12 KiB
C

#define NEED_newRV_noinc
#define NEED_sv_2pv_flags
#include "xshelper.h"
#define MY_CXT_KEY "Data::MessagePack::_unpack_guts" XS_VERSION
typedef struct {
SV* msgpack_true;
SV* msgpack_false;
} my_cxt_t;
START_MY_CXT
// context data for execute_template()
typedef struct {
bool finished;
bool utf8;
SV* buffer;
} unpack_user;
#define UNPACK_USER_INIT { false, false, NULL }
#include "msgpack/unpack_define.h"
#define msgpack_unpack_struct(name) \
struct template ## name
#define msgpack_unpack_func(ret, name) \
STATIC_INLINE ret template ## name
#define msgpack_unpack_callback(name) \
template_callback ## name
#define msgpack_unpack_object SV*
#define msgpack_unpack_user unpack_user
void init_Data__MessagePack_unpack(pTHX_ bool const cloning) {
// booleans are load on demand (lazy load).
if(!cloning) {
MY_CXT_INIT;
MY_CXT.msgpack_true = NULL;
MY_CXT.msgpack_false = NULL;
}
else {
MY_CXT_CLONE;
MY_CXT.msgpack_true = NULL;
MY_CXT.msgpack_false = NULL;
}
}
/* ---------------------------------------------------------------------- */
/* utility functions */
static SV*
load_bool(pTHX_ const char* const name) {
CV* const cv = get_cv(name, GV_ADD);
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
call_sv((SV*)cv, G_SCALAR);
SPAGAIN;
SV* const sv = newSVsv(POPs);
PUTBACK;
FREETMPS;
LEAVE;
assert(sv);
assert(sv_isobject(sv));
if(!SvOK(sv)) {
croak("Oops: Failed to load %"SVf, name);
}
return sv;
}
static SV*
get_bool(bool const value) {
dTHX;
dMY_CXT;
if(value) {
if(!MY_CXT.msgpack_true) {
MY_CXT.msgpack_true = load_bool(aTHX_ "Data::MessagePack::true");
}
return newSVsv(MY_CXT.msgpack_true);
}
else {
if(!MY_CXT.msgpack_false) {
MY_CXT.msgpack_false = load_bool(aTHX_ "Data::MessagePack::false");
}
return newSVsv(MY_CXT.msgpack_false);
}
}
/* ---------------------------------------------------------------------- */
struct template_context;
typedef struct template_context msgpack_unpack_t;
static void template_init(msgpack_unpack_t* u);
static SV* template_data(msgpack_unpack_t* u);
static int template_execute(msgpack_unpack_t* u PERL_UNUSED_DECL,
const char* data, size_t len, size_t* off);
STATIC_INLINE SV* template_callback_root(unpack_user* u PERL_UNUSED_DECL)
{
return NULL;
}
#if IVSIZE == 4
STATIC_INLINE int template_callback_UV(unpack_user* u PERL_UNUSED_DECL, UV const d, SV** o)
{
dTHX;
*o = newSVuv(d);
return 0;
}
STATIC_INLINE int template_callback_IV(unpack_user* u PERL_UNUSED_DECL, IV const d, SV** o)
{
dTHX;
*o = newSViv(d);
return 0;
}
/* workaround win32 problems (my_snprintf(%llu) returns incorrect values ) */
static char* str_from_uint64(char* buf_end, uint64_t v)
{
char *p = buf_end;
*--p = '\0';
do {
*--p = '0' + v % 10;
} while ((v /= 10) != 0);
return p;
}
static const char* str_from_int64(char* buf_end, int64_t const v) {
bool const minus = v < 0;
char* p = str_from_uint64(buf_end, minus ? -v : v);
if (minus)
*--p = '-';
return p;
}
static int template_callback_uint64(unpack_user* u PERL_UNUSED_DECL, uint64_t const d, SV** o)
{
dTHX;
char tbuf[64];
const char* const s = str_from_uint64(tbuf + sizeof(tbuf), d);
*o = newSVpvn(s, tbuf + sizeof(tbuf) - 1 - s);
return 0;
}
static int template_callback_int64(unpack_user* u PERL_UNUSED_DECL, int64_t const d, SV** o)
{
dTHX;
char tbuf[64];
const char* const s = str_from_int64(tbuf + sizeof(tbuf), d);
*o = newSVpvn(s, tbuf + sizeof(tbuf) - 1 - s);
return 0;
}
#else /* IVSIZE == 8 */
STATIC_INLINE int template_callback_UV(unpack_user* u PERL_UNUSED_DECL, UV const d, SV** o)
{
dTHX;
*o = newSVuv(d);
return 0;
}
#define template_callback_uint64 template_callback_UV
STATIC_INLINE int template_callback_IV(unpack_user* u PERL_UNUSED_DECL, IV const d, SV** o)
{
dTHX;
*o = newSViv(d);
return 0;
}
#define template_callback_int64 template_callback_IV
#endif /* IVSIZE */
#define template_callback_uint8 template_callback_UV
#define template_callback_uint16 template_callback_UV
#define template_callback_uint32 template_callback_UV
#define template_callback_int8 template_callback_IV
#define template_callback_int16 template_callback_IV
#define template_callback_int32 template_callback_IV
#define template_callback_float template_callback_double
STATIC_INLINE int template_callback_double(unpack_user* u PERL_UNUSED_DECL, double d, SV** o)
{
dTHX;
*o = newSVnv(d);
return 0;
}
/* &PL_sv_undef is not so good. see http://gist.github.com/387743 */
STATIC_INLINE int template_callback_nil(unpack_user* u PERL_UNUSED_DECL, SV** o)
{
dTHX;
*o = newSV(0);
return 0;
}
STATIC_INLINE int template_callback_true(unpack_user* u PERL_UNUSED_DECL, SV** o)
{
*o = get_bool(true);
return 0;
}
STATIC_INLINE int template_callback_false(unpack_user* u PERL_UNUSED_DECL, SV** o)
{
*o = get_bool(false);
return 0;
}
STATIC_INLINE int template_callback_array(unpack_user* u PERL_UNUSED_DECL, unsigned int n, SV** o)
{
dTHX;
AV* const a = newAV();
*o = newRV_noinc((SV*)a);
av_extend(a, n + 1);
return 0;
}
STATIC_INLINE int template_callback_array_item(unpack_user* u PERL_UNUSED_DECL, SV** c, SV* o)
{
dTHX;
AV* const a = (AV*)SvRV(*c);
assert(SvTYPE(a) == SVt_PVAV);
(void)av_store(a, AvFILLp(a) + 1, o); // the same as av_push(a, o)
return 0;
}
STATIC_INLINE int template_callback_map(unpack_user* u PERL_UNUSED_DECL, unsigned int n, SV** o)
{
dTHX;
HV* const h = newHV();
hv_ksplit(h, n);
*o = newRV_noinc((SV*)h);
return 0;
}
STATIC_INLINE int template_callback_map_item(unpack_user* u PERL_UNUSED_DECL, SV** c, SV* k, SV* v)
{
dTHX;
HV* const h = (HV*)SvRV(*c);
assert(SvTYPE(h) == SVt_PVHV);
(void)hv_store_ent(h, k, v, 0);
SvREFCNT_dec(k);
return 0;
}
STATIC_INLINE int template_callback_raw(unpack_user* u PERL_UNUSED_DECL, const char* b PERL_UNUSED_DECL, const char* p, unsigned int l, SV** o)
{
dTHX;
/* newSVpvn(p, l) returns an undef if p == NULL */
*o = ((l==0) ? newSVpvs("") : newSVpvn(p, l));
if(u->utf8) {
sv_utf8_decode(*o);
}
return 0;
}
#include "msgpack/unpack_template.h"
#define UNPACKER(from, name) \
msgpack_unpack_t *name; \
{ \
SV* const obj = from; \
if(!(SvROK(obj) && SvIOK(SvRV(obj)))) { \
Perl_croak(aTHX_ "Invalid unpacker instance for " #name); \
} \
name = INT2PTR(msgpack_unpack_t*, SvIVX(SvRV((obj)))); \
if(name == NULL) { \
Perl_croak(aTHX_ "NULL found for " # name " when shouldn't be"); \
} \
}
XS(xs_unpack) {
dXSARGS;
SV* const data = ST(1);
size_t limit;
if (items == 2) {
limit = sv_len(data);
}
else if(items == 3) {
limit = SvUVx(ST(2));
}
else {
Perl_croak(aTHX_ "Usage: Data::MessagePack->unpack('data' [, $limit])");
}
STRLEN dlen;
const char* const dptr = SvPV_const(data, dlen);
msgpack_unpack_t mp;
template_init(&mp);
unpack_user const u = UNPACK_USER_INIT;
mp.user = u;
size_t from = 0;
int const ret = template_execute(&mp, dptr, (size_t)dlen, &from);
SV* const obj = template_data(&mp);
sv_2mortal(obj);
if(ret < 0) {
Perl_croak(aTHX_ "Data::MessagePack->unpack: parse error");
} else if(ret == 0) {
Perl_croak(aTHX_ "Data::MessagePack->unpack: insufficient bytes");
} else {
if(from < dlen) {
Perl_croak(aTHX_ "Data::MessagePack->unpack: extra bytes");
}
}
ST(0) = obj;
XSRETURN(1);
}
/* ------------------------------ stream -- */
/* http://twitter.com/frsyuki/status/13249304748 */
XS(xs_unpacker_new) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Data::MessagePack::Unpacker->new()");
}
SV* const self = sv_newmortal();
msgpack_unpack_t *mp;
Newxz(mp, 1, msgpack_unpack_t);
template_init(mp);
unpack_user const u = UNPACK_USER_INIT;
mp->user = u;
mp->user.buffer = newSV(80);
sv_setpvs(mp->user.buffer, "");
sv_setref_pv(self, "Data::MessagePack::Unpacker", mp);
ST(0) = self;
XSRETURN(1);
}
XS(xs_unpacker_utf8) {
dXSARGS;
if (!(items == 1 || items == 2)) {
Perl_croak(aTHX_ "Usage: $unpacker->utf8([$bool)");
}
UNPACKER(ST(0), mp);
mp->user.utf8 = (items == 1 || sv_true(ST(1))) ? true : false;
XSRETURN(1); // returns $self
}
XS(xs_unpacker_get_utf8) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->get_utf8()");
}
UNPACKER(ST(0), mp);
ST(0) = boolSV(mp->user.utf8);
XSRETURN(1);
}
STATIC_INLINE size_t
_execute_impl(SV* const self, SV* const data, UV const offset, UV const limit) {
dTHX;
if(offset >= limit) {
Perl_croak(aTHX_
"offset (%"UVuf") is bigger than data buffer size (%"UVuf")",
offset, limit);
}
UNPACKER(self, mp);
size_t from = offset;
const char* dptr = SvPV_nolen_const(data);
STRLEN dlen = limit;
if(SvCUR(mp->user.buffer) != 0) {
sv_catpvn(mp->user.buffer, dptr, dlen);
dptr = SvPV_const(mp->user.buffer, dlen);
from = 0;
}
int const ret = template_execute(mp, dptr, dlen, &from);
// ret < 0 : error
// ret == 0 : insufficient
// ret > 0 : success
if(ret < 0) {
Perl_croak(aTHX_
"Data::MessagePack::Unpacker: parse error while executing");
}
mp->user.finished = (ret > 0) ? true : false;
if(!mp->user.finished) {
template_init(mp); // reset the state
sv_setpvn(mp->user.buffer, dptr, dlen);
from = 0;
}
else {
sv_setpvs(mp->user.buffer, "");
}
//warn(">> (%d) dlen=%d, from=%d, rest=%d",
// (int)ret, (int)dlen, (int)from, dlen - from);
return from;
}
XS(xs_unpacker_execute) {
dXSARGS;
SV* const self = ST(0);
SV* const data = ST(1);
UV offset;
if (items == 2) {
offset = 0;
}
else if (items == 3) {
offset = SvUVx(ST(2));
}
else {
Perl_croak(aTHX_ "Usage: $unpacker->execute(data, offset = 0)");
}
dXSTARG;
sv_setuv(TARG, _execute_impl(self, data, offset, sv_len(data)));
ST(0) = TARG;
XSRETURN(1);
}
XS(xs_unpacker_execute_limit) {
dXSARGS;
if (items != 4) {
Perl_croak(aTHX_ "Usage: $unpacker->execute_limit(data, offset, limit)");
}
SV* const self = ST(0);
SV* const data = ST(1);
UV const offset = SvUVx(ST(2));
UV const limit = SvUVx(ST(3));
dXSTARG;
sv_setuv(TARG, _execute_impl(self, data, offset, limit));
ST(0) = TARG;
XSRETURN(1);
}
XS(xs_unpacker_is_finished) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->is_finished()");
}
UNPACKER(ST(0), mp);
ST(0) = boolSV(mp->user.finished);
XSRETURN(1);
}
XS(xs_unpacker_data) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->data()");
}
UNPACKER(ST(0), mp);
ST(0) = template_data(mp);
XSRETURN(1);
}
XS(xs_unpacker_reset) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->reset()");
}
UNPACKER(ST(0), mp);
SV* const data = template_data(mp);
SvREFCNT_dec(data);
template_init(mp);
sv_setpvs(mp->user.buffer, "");
XSRETURN(0);
}
XS(xs_unpacker_destroy) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->DESTROY()");
}
UNPACKER(ST(0), mp);
SV* const data = template_data(mp);
SvREFCNT_dec(data);
SvREFCNT_dec(mp->user.buffer);
Safefree(mp);
XSRETURN(0);
}