perl: use more efficent strategy for memory allocation.this code taken from JSON::XS. thanks to mlehmann++

This commit is contained in:
Tokuhiro Matsuno 2009-04-15 22:43:59 +09:00
parent 2aeeef3368
commit e53799d779

View File

@ -1,3 +1,7 @@
/*
* code is written by tokuhirom.
* buffer alocation technique is taken from JSON::XS. thanks to mlehmann.
*/
#ifdef __cplusplus
extern "C" {
#endif
@ -17,43 +21,64 @@ extern "C" {
#define msgpack_pack_inline_func_cint(name) \
static inline void msgpack_pack ## name
#define msgpack_pack_user SV*
typedef struct {
char *cur; /* SvPVX (sv) + current output position */
char *end; /* SvEND (sv) */
SV *sv; /* result scalar */
} enc_t;
void need(enc_t *enc, STRLEN len);
#define msgpack_pack_append_buffer(user, buf, len) \
sv_catpvn(user, (const char*)(buf), 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 _PACK_WRAPPER(t) msgpack_pack_##t
#define PACK_WRAPPER(t) _PACK_WRAPPER(t)
#define INIT_SIZE 32 /* initial scalar size to be allocated */
static void _msgpack_pack_sv(SV* buf, SV* val) {
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 void _msgpack_pack_sv(enc_t *enc, SV* val) {
if (val==NULL) {
msgpack_pack_nil(buf);
msgpack_pack_nil(enc);
return;
}
switch (SvTYPE(val)) {
case SVt_NULL:
msgpack_pack_nil(buf);
msgpack_pack_nil(enc);
break;
case SVt_IV:
if (SvIOK_UV(val)) {
msgpack_pack_uint32(buf, SvUV(val));
msgpack_pack_uint32(enc, SvUV(val));
} else {
PACK_WRAPPER(IVTYPE)(buf, SvIV(val));
PACK_WRAPPER(IVTYPE)(enc, SvIV(val));
}
break;
case SVt_PVNV:
{
STRLEN len = 0;
need(enc, 1);
char *pv = SvPV(val, len);
if (len == 1 && *pv == '1') {
msgpack_pack_true(buf);
msgpack_pack_true(enc);
} else if (len == 0 && *pv==0) {
msgpack_pack_false(buf);
msgpack_pack_false(enc);
} else {
msgpack_pack_nil(buf);
msgpack_pack_nil(enc);
}
}
break;
@ -61,25 +86,26 @@ static void _msgpack_pack_sv(SV* buf, SV* val) {
{
STRLEN len;
char * cval = SvPV(val, len);
msgpack_pack_raw(buf, len);
msgpack_pack_raw_body(buf, cval, len);
msgpack_pack_raw(enc, len);
msgpack_pack_raw_body(enc, cval, len);
}
break;
case SVt_NV:
PACK_WRAPPER(NVTYPE)(buf, SvNV(val));
PACK_WRAPPER(NVTYPE)(enc, SvNV(val));
break;
case SVt_PVAV:
{
AV* ary = (AV*)val;
int len = av_len(ary) + 1;
int i;
msgpack_pack_array(buf, len);
need(enc, 1);
msgpack_pack_array(enc, len);
for (i=0; i<len; i++) {
SV** svp = av_fetch(ary, i, 0);
if (svp) {
_msgpack_pack_sv(buf, *svp);
_msgpack_pack_sv(enc, *svp);
} else {
msgpack_pack_nil(buf);
msgpack_pack_nil(enc);
}
}
}
@ -90,16 +116,17 @@ static void _msgpack_pack_sv(SV* buf, SV* val) {
int count = hv_iterinit(hval);
HE* he;
msgpack_pack_map(buf, count);
need(enc, 1);
msgpack_pack_map(enc, count);
while (he = hv_iternext(hval)) {
_msgpack_pack_sv(buf, hv_iterkeysv(he));
_msgpack_pack_sv(buf, HeVAL(he));
_msgpack_pack_sv(enc, hv_iterkeysv(he));
_msgpack_pack_sv(enc, HeVAL(he));
}
}
break;
case SVt_RV:
_msgpack_pack_sv(buf, SvRV(val));
_msgpack_pack_sv(enc, SvRV(val));
break;
default:
sv_dump(val);
@ -109,13 +136,21 @@ static void _msgpack_pack_sv(SV* buf, SV* val) {
XS(xs_pack) {
dXSARGS;
PERL_UNUSED_VAR(items);
PERL_UNUSED_VAR(items); /* TODO: check argument count */
SV* buf = newSVpv("", 0);
SV* val = ST(1);
_msgpack_pack_sv(buf, val);
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);
ST(0) = buf;
_msgpack_pack_sv(&enc, val);
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);
}