removed commented out codes

This commit is contained in:
makamaka
2010-09-02 14:33:59 +09:00
parent af83a62474
commit 8fc86ce7fa
5 changed files with 0 additions and 13 deletions

43
perl/xs-src/MessagePack.c Normal file
View File

@@ -0,0 +1,43 @@
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define NEED_newCONSTSUB
#include "ppport.h"
#ifdef __cplusplus
};
#endif
XS(xs_pack);
XS(xs_unpack);
XS(xs_unpacker_new);
XS(xs_unpacker_execute);
XS(xs_unpacker_execute_limit);
XS(xs_unpacker_is_finished);
XS(xs_unpacker_data);
XS(xs_unpacker_reset);
XS(xs_unpacker_destroy);
void boot_Data__MessagePack_pack(void);
XS(boot_Data__MessagePack) {
dXSARGS;
HV * stash;
boot_Data__MessagePack_pack();
newXS("Data::MessagePack::pack", xs_pack, __FILE__);
newXS("Data::MessagePack::unpack", xs_unpack, __FILE__);
stash = gv_stashpvn("Data::MessagePack", strlen("Data::MessagePack"), TRUE);
newXS("Data::MessagePack::Unpacker::new", xs_unpacker_new, __FILE__);
newXS("Data::MessagePack::Unpacker::execute", xs_unpacker_execute, __FILE__);
newXS("Data::MessagePack::Unpacker::execute_limit", xs_unpacker_execute_limit, __FILE__);
newXS("Data::MessagePack::Unpacker::is_finished", xs_unpacker_is_finished, __FILE__);
newXS("Data::MessagePack::Unpacker::data", xs_unpacker_data, __FILE__);
newXS("Data::MessagePack::Unpacker::reset", xs_unpacker_reset, __FILE__);
newXS("Data::MessagePack::Unpacker::DESTROY", xs_unpacker_destroy, __FILE__);
}

272
perl/xs-src/pack.c Normal file
View File

@@ -0,0 +1,272 @@
/*
* code is written by tokuhirom.
* buffer alocation technique is taken from JSON::XS. thanks to mlehmann.
*/
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#ifdef __cplusplus
};
#endif
#include "msgpack/pack_define.h"
#define msgpack_pack_inline_func(name) \
static inline void msgpack_pack ## name
#define msgpack_pack_inline_func_cint(name) \
static inline void msgpack_pack ## name
typedef struct {
char *cur; /* SvPVX (sv) + current output position */
char *end; /* SvEND (sv) */
SV *sv; /* result scalar */
} enc_t;
static void need(enc_t *enc, STRLEN len);
#define msgpack_pack_user enc_t*
#define msgpack_pack_append_buffer(enc, buf, len) \
need(enc, len); \
memcpy(enc->cur, buf, len); \
enc->cur += len;
#include "msgpack/pack_template.h"
#define INIT_SIZE 32 /* initial scalar size to be allocated */
#if IVSIZE == 8
# define PACK_IV msgpack_pack_int64
#elif IVSIZE == 4
# define PACK_IV msgpack_pack_int32
#elif IVSIZE == 2
# define PACK_IV msgpack_pack_int16
#else
# error "msgpack only supports IVSIZE = 8,4,2 environment."
#endif
#define ERR_NESTING_EXCEEDED "perl structure exceeds maximum nesting level (max_depth set too low?)"
static void need(enc_t *enc, STRLEN len)
{
if (enc->cur + len >= enc->end) {
STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
enc->cur = SvPVX (enc->sv) + cur;
enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
}
}
static int s_pref_int = 0;
static int pref_int_set(pTHX_ SV* sv, MAGIC* mg) {
if (SvTRUE(sv)) {
s_pref_int = 1;
} else {
s_pref_int = 0;
}
return 0;
}
MGVTBL pref_int_vtbl = {
NULL,
pref_int_set,
NULL,
NULL,
NULL,
NULL,
NULL,
#ifdef MGf_LOCAL
NULL,
#endif
};
void boot_Data__MessagePack_pack(void) {
SV* var = get_sv("Data::MessagePack::PreferInteger", 0);
sv_magicext(var, NULL, PERL_MAGIC_ext, &pref_int_vtbl, NULL, 0);
SvSETMAGIC(var);
}
static int try_int(enc_t* enc, const char *p, size_t len) {
int negative = 0;
const char* pe = p + len;
uint64_t num = 0;
if (len == 0) { return 0; }
if (*p == '-') {
/* length(-0x80000000) == 11 */
if (len <= 1 || len > 11) { return 0; }
negative = 1;
++p;
} else {
/* length(0xFFFFFFFF) == 10 */
if (len > 10) { return 0; }
}
#if '9'=='8'+1 && '8'=='7'+1 && '7'=='6'+1 && '6'=='5'+1 && '5'=='4'+1 \
&& '4'=='3'+1 && '3'=='2'+1 && '2'=='1'+1 && '1'=='0'+1
do {
unsigned int c = ((int)*(p++)) - '0';
if (c > 9) { return 0; }
num = num * 10 + c;
} while(p < pe);
#else
do {
switch (*(p++)) {
case '0': num = num * 10 + 0; break;
case '1': num = num * 10 + 1; break;
case '2': num = num * 10 + 2; break;
case '3': num = num * 10 + 3; break;
case '4': num = num * 10 + 4; break;
case '5': num = num * 10 + 5; break;
case '6': num = num * 10 + 6; break;
case '7': num = num * 10 + 7; break;
case '8': num = num * 10 + 8; break;
case '9': num = num * 10 + 9; break;
default: return 0;
}
} while(p < pe);
#endif
if (negative) {
if (num > 0x80000000) { return 0; }
msgpack_pack_int32(enc, ((int32_t)num) * -1);
} else {
if (num > 0xFFFFFFFF) { return 0; }
msgpack_pack_uint32(enc, (uint32_t)num);
}
return 1;
}
static void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth);
static void _msgpack_pack_sv(enc_t *enc, SV* sv, int depth) {
if (depth <= 0) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
SvGETMAGIC(sv);
if (sv==NULL) {
msgpack_pack_nil(enc);
} else if (SvPOKp(sv)) {
STRLEN len;
char * csv = SvPV(sv, len);
if (s_pref_int && try_int(enc, csv, len)) {
return;
} else {
msgpack_pack_raw(enc, len);
msgpack_pack_raw_body(enc, csv, len);
}
} else if (SvNOKp(sv)) {
/* XXX long double is not supported yet. */
msgpack_pack_double(enc, (double)SvNVX(sv));
} else if (SvIOK_UV(sv)) {
msgpack_pack_uint32(enc, SvUV(sv));
} else if (SvIOKp(sv)) {
PACK_IV(enc, SvIV(sv));
} else if (SvROK(sv)) {
_msgpack_pack_rv(enc, SvRV(sv), depth-1);
} else if (!SvOK(sv)) {
msgpack_pack_nil(enc);
} else if (isGV(sv)) {
Perl_croak(aTHX_ "msgpack cannot pack the GV\n");
} else {
sv_dump(sv);
Perl_croak(aTHX_ "msgpack for perl doesn't supported this type: %d\n", SvTYPE(sv));
}
}
static void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth) {
svtype svt;
if (depth <= 0) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
SvGETMAGIC(sv);
svt = SvTYPE(sv);
if (SvOBJECT (sv)) {
HV *stash = gv_stashpv ("Data::MessagePack::Boolean", 1); // TODO: cache?
if (SvSTASH (sv) == stash) {
if (SvIV(sv)) {
msgpack_pack_true(enc);
} else {
msgpack_pack_false(enc);
}
} else {
croak ("encountered object '%s', Data::MessagePack doesn't allow the object",
SvPV_nolen(sv_2mortal(newRV_inc(sv))));
}
} else if (svt == SVt_PVHV) {
HV* hval = (HV*)sv;
int count = hv_iterinit(hval);
HE* he;
msgpack_pack_map(enc, count);
while (he = hv_iternext(hval)) {
_msgpack_pack_sv(enc, hv_iterkeysv(he), depth);
_msgpack_pack_sv(enc, HeVAL(he), depth);
}
} else if (svt == SVt_PVAV) {
AV* ary = (AV*)sv;
int len = av_len(ary) + 1;
int i;
msgpack_pack_array(enc, len);
for (i=0; i<len; i++) {
SV** svp = av_fetch(ary, i, 0);
if (svp) {
_msgpack_pack_sv(enc, *svp, depth);
} else {
msgpack_pack_nil(enc);
}
}
} else if (svt < SVt_PVAV) {
STRLEN len = 0;
char *pv = svt ? SvPV (sv, len) : 0;
if (len == 1 && *pv == '1')
msgpack_pack_true(enc);
else if (len == 1 && *pv == '0')
msgpack_pack_false(enc);
else {
sv_dump(sv);
croak("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
SvPV_nolen (sv_2mortal (newRV_inc (sv))));
}
} else {
croak ("encountered %s, but msgpack can only represent references to arrays or hashes",
SvPV_nolen (sv_2mortal (newRV_inc (sv))));
}
}
XS(xs_pack) {
dXSARGS;
if (items < 2) {
Perl_croak(aTHX_ "Usage: Data::MessagePack->pack($dat [,$max_depth])");
}
SV* val = ST(1);
int depth = 512;
if (items >= 3) depth = SvIV(ST(2));
enc_t enc;
enc.sv = sv_2mortal(NEWSV(0, INIT_SIZE));
enc.cur = SvPVX(enc.sv);
enc.end = SvEND(enc.sv);
SvPOK_only(enc.sv);
_msgpack_pack_sv(&enc, val, depth);
SvCUR_set(enc.sv, enc.cur - SvPVX (enc.sv));
*SvEND (enc.sv) = 0; /* many xs functions expect a trailing 0 for text strings */
ST(0) = enc.sv;
XSRETURN(1);
}

352
perl/xs-src/unpack.c Normal file
View File

@@ -0,0 +1,352 @@
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "util.h"
#define NEED_newRV_noinc
#define NEED_sv_2pv_flags
#include "ppport.h"
#ifdef __cplusplus
};
#endif
typedef struct {
int finished;
SV* source;
int incremented;
} unpack_user;
#include "msgpack/unpack_define.h"
#define msgpack_unpack_struct(name) \
struct template ## name
#define msgpack_unpack_func(ret, name) \
ret template ## name
#define msgpack_unpack_callback(name) \
template_callback ## name
#define msgpack_unpack_object SV*
#define msgpack_unpack_user unpack_user
/* ---------------------------------------------------------------------- */
/* utility functions */
static INLINE SV *
get_bool (const char *name) {
SV * sv = sv_mortalcopy(get_sv( name, 1 ));
SvREADONLY_on(sv);
SvREADONLY_on( SvRV(sv) );
return sv;
}
/* ---------------------------------------------------------------------- */
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,
const char* data, size_t len, size_t* off);
static INLINE SV* template_callback_root(unpack_user* u)
{ return &PL_sv_undef; }
static INLINE int template_callback_uint8(unpack_user* u, uint8_t d, SV** o)
{ *o = sv_2mortal(newSVuv(d)); return 0; }
static INLINE int template_callback_uint16(unpack_user* u, uint16_t d, SV** o)
{ *o = sv_2mortal(newSVuv(d)); return 0; }
static INLINE int template_callback_uint32(unpack_user* u, uint32_t d, SV** o)
{ *o = sv_2mortal(newSVuv(d)); return 0; }
static INLINE int template_callback_uint64(unpack_user* u, uint64_t d, SV** o)
{
#if IVSIZE==4
*o = sv_2mortal(newSVnv(d));
#else
*o = sv_2mortal(newSVuv(d));
#endif
return 0;
}
static INLINE int template_callback_int8(unpack_user* u, int8_t d, SV** o)
{ *o = sv_2mortal(newSViv((long)d)); return 0; }
static INLINE int template_callback_int16(unpack_user* u, int16_t d, SV** o)
{ *o = sv_2mortal(newSViv((long)d)); return 0; }
static INLINE int template_callback_int32(unpack_user* u, int32_t d, SV** o)
{ *o = sv_2mortal(newSViv((long)d)); return 0; }
static INLINE int template_callback_int64(unpack_user* u, int64_t d, SV** o)
{ *o = sv_2mortal(newSViv(d)); return 0; }
static INLINE int template_callback_float(unpack_user* u, float d, SV** o)
{ *o = sv_2mortal(newSVnv(d)); return 0; }
static INLINE int template_callback_double(unpack_user* u, double d, SV** o)
{ *o = sv_2mortal(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, SV** o)
{ *o = sv_newmortal(); return 0; }
static INLINE int template_callback_true(unpack_user* u, SV** o)
{ *o = get_bool("Data::MessagePack::true") ; return 0; }
static INLINE int template_callback_false(unpack_user* u, SV** o)
{ *o = get_bool("Data::MessagePack::false") ; return 0; }
static INLINE int template_callback_array(unpack_user* u, unsigned int n, SV** o)
{ AV* a = (AV*)sv_2mortal((SV*)newAV()); *o = sv_2mortal((SV*)newRV_inc((SV*)a)); av_extend(a, n); return 0; }
static INLINE int template_callback_array_item(unpack_user* u, SV** c, SV* o)
{ av_push((AV*)SvRV(*c), o); SvREFCNT_inc(o); return 0; } /* FIXME set value directry RARRAY_PTR(obj)[RARRAY_LEN(obj)++] */
static INLINE int template_callback_map(unpack_user* u, unsigned int n, SV** o)
{ HV * h = (HV*)sv_2mortal((SV*)newHV()); *o = sv_2mortal(newRV_inc((SV*)h)); return 0; }
static INLINE int template_callback_map_item(unpack_user* u, SV** c, SV* k, SV* v)
{ hv_store_ent((HV*)SvRV(*c), k, v, 0); SvREFCNT_inc(v); return 0; }
static INLINE int template_callback_raw(unpack_user* u, const char* b, const char* p, unsigned int l, SV** o)
{ *o = sv_2mortal((l==0) ? newSVpv("", 0) : newSVpv(p, l)); return 0; }
/* { *o = newSVpvn_flags(p, l, SVs_TEMP); return 0; } <= this does not works. */
#define UNPACKER(from, name) \
msgpack_unpack_t *name; \
name = INT2PTR(msgpack_unpack_t*, SvROK((from)) ? SvIV(SvRV((from))) : SvIV((from))); \
if(name == NULL) { \
Perl_croak(aTHX_ "NULL found for " # name " when shouldn't be."); \
}
#include "msgpack/unpack_template.h"
SV* _msgpack_unpack(SV* data, int limit) {
msgpack_unpack_t mp;
unpack_user u = {0, &PL_sv_undef};
int ret;
size_t from = 0;
STRLEN dlen;
const char * dptr = SvPV_const(data, dlen);
SV* obj;
template_init(&mp);
mp.user = u;
mp.user.source = data;
ret = template_execute(&mp, dptr, (size_t)dlen, &from);
mp.user.source = &PL_sv_undef;
obj = template_data(&mp);
if(ret < 0) {
Perl_croak(aTHX_ "parse error.");
} else if(ret == 0) {
Perl_croak(aTHX_ "insufficient bytes.");
} else {
if(from < dlen) {
Perl_croak(aTHX_ "extra bytes.");
}
return obj;
}
}
XS(xs_unpack_limit) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: Data::MessagePack->unpack('datadata', $limit)");
}
{
int limit = SvIV(ST(2));
ST(0) = _msgpack_unpack(ST(1), limit);
}
XSRETURN(1);
}
XS(xs_unpack) {
dXSARGS;
msgpack_unpack_t mp;
if (items != 2) {
Perl_croak(aTHX_ "Usage: Data::MessagePack->unpack('datadata')");
}
{
ST(0) = _msgpack_unpack(ST(1), sv_len(ST(1)));
}
XSRETURN(1);
}
/* ------------------------------ stream -- */
/* http://twitter.com/frsyuki/status/13249304748 */
static void _reset(SV* self) {
unpack_user u = {0, &PL_sv_undef, 0};
UNPACKER(self, mp);
template_init(mp);
mp->user = u;
}
XS(xs_unpacker_new) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: Data::MessagePack::Unpacker->new()");
}
SV* self = sv_newmortal();
msgpack_unpack_t *mp;
Newx(mp, 1, msgpack_unpack_t);
sv_setref_pv(self, "Data::MessagePack::Unpacker", mp);
_reset(self);
ST(0) = self;
XSRETURN(1);
}
static SV* _execute_impl(SV* self, SV* data, UV off, I32 limit) {
UNPACKER(self, mp);
size_t from = off;
const char* dptr = SvPV_nolen_const(data);
long dlen = limit;
int ret;
if(from >= dlen) {
Perl_croak(aTHX_ "offset is bigger than data buffer size.");
}
mp->user.source = data;
ret = template_execute(mp, dptr, (size_t)dlen, &from);
mp->user.source = &PL_sv_undef;
if(ret < 0) {
Perl_croak(aTHX_ "parse error.");
} else if(ret > 0) {
mp->user.finished = 1;
return sv_2mortal(newSVuv(from));
} else {
mp->user.finished = 0;
return sv_2mortal(newSVuv(from));
}
}
XS(xs_unpacker_execute) {
dXSARGS;
if (items != 3) {
Perl_croak(aTHX_ "Usage: $unpacker->execute_limit(data, off)");
}
UNPACKER(ST(0), mp);
{
SV* self = ST(0);
SV* data = ST(1);
IV off = SvIV(ST(2)); /* offset of $data. normaly, 0. */
ST(0) = _execute_impl(self, data, off, sv_len(data));
{
SV * d2 = template_data(mp);
if (!mp->user.incremented && d2) {
SvREFCNT_inc(d2);
mp->user.incremented = 1;
}
}
}
XSRETURN(1);
}
XS(xs_unpacker_execute_limit) {
dXSARGS;
if (items != 4) {
Perl_croak(aTHX_ "Usage: $unpacker->execute_limit(data, off, limit)");
}
SV* self = ST(0);
SV* data = ST(1);
IV off = SvIV(ST(2));
IV limit = SvIV(ST(3));
ST(0) = _execute_impl(self, data, off, limit);
XSRETURN(1);
}
XS(xs_unpacker_is_finished) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->is_finished()");
}
UNPACKER(ST(0), mp);
ST(0) = (mp->user.finished) ? &PL_sv_yes : &PL_sv_no;
XSRETURN(1);
}
XS(xs_unpacker_data) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->data()");
}
UNPACKER(ST(0), mp);
ST(0) = sv_2mortal(newSVsv(template_data(mp)));
XSRETURN(1);
}
XS(xs_unpacker_reset) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->reset()");
}
UNPACKER(ST(0), mp);
{
SV * data = template_data(mp);
if (data) {
SvREFCNT_dec(data);
}
}
_reset(ST(0));
XSRETURN(0);
}
XS(xs_unpacker_destroy) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->DESTROY()");
}
UNPACKER(ST(0), mp);
SV * data = template_data(mp);
if (SvOK(data)) {
SvREFCNT_dec(data);
}
Safefree(mp);
XSRETURN(0);
}