static void
do_bucket_sort(SV** svs, int svcount, int bucket_bits)
{
U32 *minor_b;
U32 *major_b;
int major_bucket_count = 1 << bucket_bits;
int *count_by_bucket, max_count_by_bucket;
ms_elt_t *by_bucket_storage, *by_bucket;
ms_elt_t **by_bucket_cursor_storage, **by_bucket_cursor;
/* Compute the major and minor bucket values for each SV */
Newx(major_b, svcount, U32);
Newx(minor_b, svcount, U32);
calculate_bucket_values(svcount, svs, major_b, minor_b, bucket_bits);
/* Count the number of SVs that will fall into each major bucket */
Newxz(count_by_bucket, major_bucket_count, int);
sb__populate_count_by_bucket(count_by_bucket, major_b, major_b+svcount);
max_count_by_bucket = sb__max_count_by_bucket(
major_bucket_count, count_by_bucket);
/* Allocate storage for a vector of count (SV*, minor bucket) pairs,
* into which we will load the input SVs and their minor bucket values
* in major bucket order. Allow max_count_by_bucket extra slots at
* the start, to be sure there's enough room for the partially in-place
* sort within each bucket. */
Newx(by_bucket_storage, svcount+max_count_by_bucket, ms_elt_t);
by_bucket = by_bucket_storage + max_count_by_bucket;
/* We'll need a vector of pointers into by_bucket, to keep track of
* where we should place the next entry for each possible major bucket
* value. */
Newx(by_bucket_cursor_storage, major_bucket_count+1, ms_elt_t*);
by_bucket_cursor = by_bucket_cursor_storage+1;
sb__init_by_bucket_cursor(by_bucket, by_bucket_cursor,
major_bucket_count, count_by_bucket);
/* Now we're ready to load the SVs and their minor bucket values into
* by_bucket in major bucket order. */
sb__populate_buckets(by_bucket_cursor, major_b, minor_b, svs, svcount);
Safefree(major_b);
Safefree(minor_b);
/* Now by_bucket_cursor[b] points to the first slot beyond bucket b,
* i.e. the start of bucket b+1. Adjust so that by_bucket_cursor[b]
* points to the start of bucket b again. */
--by_bucket_cursor;
by_bucket_cursor[0] = by_bucket;
/* Sort the SVs within each major bucket, and copy the sorted SV*s
* into the SV vector that we're sorting. */
sb__sort_within_major_buckets(
by_bucket_cursor, major_bucket_count, count_by_bucket, svs);
Safefree(by_bucket_cursor_storage);
Safefree(by_bucket_storage);
Safefree(count_by_bucket);
}
void _check_for_duplicates(pTHX_ srl_splitter_t * splitter, char* binary_start_pos, UV len, bool is_utf8) {
dedupe_el_t *element = NULL;
if (is_utf8) {
HASH_FIND(hh, dedupe_hashtable_utf8, splitter->pos, len, element);
} else {
HASH_FIND(hh, dedupe_hashtable, splitter->pos, len, element);
}
if ( element != NULL) {
SRL_SPLITTER_TRACE(" * FOUND DEDUP key %s value %lu", element->key, element->value);
_maybe_flush_chunk(aTHX_ splitter, binary_start_pos, splitter->pos + len);
/* the copy tag */
char tmp[SRL_MAX_VARINT_LENGTH];
tmp[0] = 0x2f;
_cat_to_chunk(aTHX_ splitter, tmp, 1 );
UV len = (UV) (_set_varint_nocheck(tmp, element->value) - tmp);
_cat_to_chunk(aTHX_ splitter, tmp, len);
} else {
UV offset = splitter->chunk_current_offset + ( binary_start_pos - splitter->chunk_iter_start);
Newx(element, 1, dedupe_el_t);
element->key = "";
element->value = offset;
SRL_SPLITTER_TRACE(" * ADDED DEDUP offset %lu", offset);
if (is_utf8) {
HASH_ADD_KEYPTR(hh, dedupe_hashtable_utf8, splitter->pos, len, element);
} else {
HASH_ADD_KEYPTR(hh, dedupe_hashtable, splitter->pos, len, element);
}
}
splitter->pos += len;
return;
}
void initialize_typesafedata(TypeSafeData* self){
initialize_listable((Listable*)self);
// create datatype object
Newx(self->datatype,1,Datatype);
initialize_datatype(self->datatype);
}
/* allocate an empty encoder struct - flags still to be set up */
static SRL_INLINE srl_encoder_t *
srl_empty_encoder_struct(pTHX)
{
srl_encoder_t *enc;
Newx(enc, 1, srl_encoder_t);
if (enc == NULL)
croak("Out of memory");
/* Init struct */
Newx(enc->buf_start, INITIALIZATION_SIZE, char);
if (enc->buf_start == NULL) {
Safefree(enc);
croak("Out of memory");
}
enc->buf_end = enc->buf_start + INITIALIZATION_SIZE - 1;
enc->pos = enc->buf_start;
enc->depth = 0;
enc->operational_flags = 0;
/*enc->flags = 0;*/ /* to be set elsewhere */
enc->weak_seenhash = NULL;
enc->str_seenhash = NULL;
enc->ref_seenhash = NULL;
enc->snappy_workmem = NULL;
return enc;
}
SRL_STATIC_INLINE srl_merger_t *
srl_empty_merger_struct(pTHX)
{
srl_merger_t *mrg = NULL;
Newx(mrg, 1, srl_merger_t);
if (mrg == NULL)
croak("Out of memory");
/* Init buffer struct */
if (expect_false(srl_buf_init_buffer(aTHX_ &mrg->obuf, INITIALIZATION_SIZE) != 0)) {
Safefree(mrg);
croak("Out of memory");
}
SRL_RDR_CLEAR(&mrg->ibuf);
mrg->pibuf = &mrg->ibuf;
mrg->recursion_depth = 0;
mrg->max_recursion_depth = DEFAULT_MAX_RECUR_DEPTH;
/* Zero fields */
mrg->cnt_of_merged_elements = 0;
mrg->obuf_padding_bytes_offset = 0;
mrg->obuf_last_successfull_offset = 0;
mrg->protocol_version = SRL_PROTOCOL_VERSION;
mrg->classname_deduper_tbl = NULL;
mrg->string_deduper_tbl = NULL;
mrg->tracked_offsets_tbl = NULL;
mrg->tracked_offsets = NULL;
mrg->snappy_workmem = NULL;
mrg->flags = 0;
return mrg;
}
inline zmq_msg_t *Zmqxs_msg_start_allocate(pTHX_ SV *self) {
zmq_msg_t *msg;
zmqxs_ensure_unallocated(self);
Newx(msg, 1, zmq_msg_t);
if(msg == NULL)
croak("Error allocating memory for zmq_msg_t structure!");
return msg;
}
sarRootNode_p sar_buildRootNode_c() {
sarRootNode_p newNode;
Newx(newNode, 1, sarRootNode_t);
newNode->sarNode = sar_buildNode_c();
newNode->procFlags = 0;
return newNode;
}
SRL_STATIC_INLINE srl_splitter_t * srl_empty_splitter_struct(pTHX) {
srl_splitter_t *splitter = NULL;
Newx(splitter, 1, srl_splitter_t);
if (splitter == NULL) {
croak("Out of memory");
}
return splitter;
}
srl_iterator_t *
srl_build_iterator_struct(pTHX_ HV *opt)
{
srl_iterator_t *iter = NULL;
Newx(iter, 1, srl_iterator_t);
if (iter == NULL) croak("Out of memory");
srl_init_iterator(aTHX_ iter, opt);
return iter;
}
srl_iterator_t *
srl_build_iterator_struct(pTHX_ HV *opt)
{
srl_stack_t *stack = NULL;
srl_iterator_t *iter = NULL;
Newx(iter, 1, srl_iterator_t);
if (iter == NULL)
croak("Out of memory");
Newx(stack, 1, srl_stack_t);
if (stack == NULL) {
Safefree(iter);
croak("Out of memory");
}
// TODO inline stack
// TODO keep fixed stack size ???
if (expect_false(srl_stack_init(aTHX_ stack, 1024) != 0)) {
Safefree(iter);
Safefree(stack);
croak("Out of memory");
}
SRL_RDR_CLEAR(&iter->buf);
iter->pbuf = &iter->buf;
iter->stack = stack;
iter->document = NULL;
iter->tmp_buf_owner = NULL;
iter->first_tag_offset = 0;
iter->dec = NULL;
/* load options */
if (opt != NULL) {
/* svp = hv_fetchs(opt, "dedupe_strings", 0);
if (svp && SvTRUE(*svp))
SRL_iter_SET_OPTION(iter, SRL_F_DEDUPE_STRINGS); */
}
return iter;
}
SOCKET
open_ifs_socket(int af, int type, int protocol)
{
dTHX;
char *s;
unsigned long proto_buffers_len = 0;
int error_code;
SOCKET out = INVALID_SOCKET;
if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s))
return WSASocket(af, type, protocol, NULL, 0, 0);
if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR
&& error_code == WSAENOBUFS)
{
WSAPROTOCOL_INFOW *proto_buffers;
int protocols_available = 0;
Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW),
WSAPROTOCOL_INFOW);
if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers,
&proto_buffers_len, &error_code)) != SOCKET_ERROR)
{
int i;
for (i = 0; i < protocols_available; i++)
{
WSAPROTOCOL_INFOA proto_info;
if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily)
|| (type != proto_buffers[i].iSocketType)
|| (protocol != 0 && proto_buffers[i].iProtocol != 0 &&
protocol != proto_buffers[i].iProtocol))
continue;
if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
continue;
convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
out = WSASocket(af, type, protocol, &proto_info, 0, 0);
break;
}
}
Safefree(proto_buffers);
}
return out;
}
srl_path_t *
srl_build_path_struct(pTHX_ HV *opt)
{
srl_path_t *path = NULL;
Newx(path, 1, srl_path_t);
if (path == NULL) croak("Out of memory");
path->iter = NULL;
path->expr = NULL;
path->results = NULL;
path->i_own_iterator = 0;
if (opt != NULL) {}
return path;
}
SRL_STATIC_INLINE srl_stack_t *
srl_init_tracked_offsets(pTHX_ srl_merger_t *mrg)
{
mrg->tracked_offsets = NULL;
Newx(mrg->tracked_offsets, 1, srl_stack_t);
if (expect_false(mrg->tracked_offsets == NULL))
croak("Out of memory");
if (expect_false(srl_stack_init(aTHX_ mrg->tracked_offsets, 16) != 0)) {
Safefree(mrg->tracked_offsets);
mrg->tracked_offsets = NULL;
croak("Out of memory");
}
return mrg->tracked_offsets;
}
plu_table_t *
plu_new_table_object(pTHX_ lua_State *ls)
{
plu_table_t *t;
int tblid;
PLU_dSTACKASSERT;
PLU_ENTER_STACKASSERT(ls);
tblid = luaL_ref(ls, LUA_REGISTRYINDEX);
Newx(t, 1, plu_table_t);
t->L = ls;
t->registry_index = tblid;
PLU_LEAVE_STACKASSERT_MODIFIED(ls, -1);
return t;
}
/* Builds the C-level configuration and state struct.
* Automatically freed at scope boundary. */
ddl_encoder_t *
build_encoder_struct(pTHX_ HV *opt)
{
ddl_encoder_t *enc;
SV **svp;
Newx(enc, 1, ddl_encoder_t);
/* Register our structure for destruction on scope exit */
SAVEDESTRUCTOR(&ddl_destructor_hook, (void *)enc);
/* Init struct */
Newx(enc->buf_start, INITIALIZATION_SIZE, char);
enc->buf_end = enc->buf_start + INITIALIZATION_SIZE;
enc->pos = enc->buf_start;
enc->depth = 0;
enc->flags = 0;
/* TODO: We could do this lazily: Only if there's references with high refcount/weakrefs */
enc->seenhash = PTABLE_new();
/* load options */
if (opt != NULL) {
if ( (svp = hv_fetchs(opt, "undef_blessed", 0)) && SvTRUE(*svp))
enc->flags |= F_UNDEF_BLESSED;
if ( (svp = hv_fetchs(opt, "disallow_multi", 0)) && SvTRUE(*svp))
enc->flags |= F_DISALLOW_MULTI_OCCURRENCE;
if ( (svp = hv_fetchs(opt, "objects_as_unblessed", 0)) && SvTRUE(*svp))
enc->flags |= F_DUMP_OBJECTS_AS_UNBLESSED;
if ( (svp = hv_fetchs(opt, "dump_objects", 0)) && SvTRUE(*svp))
enc->flags |= F_DUMP_OBJECTS_AS_BLESSED;
}
/* option vlaidation */
/* FIXME my bit field fu is weak, apparently. Needs replacing with proper idiom */
if ( (enc->flags & F_UNDEF_BLESSED ? 1 : 0)
+ (enc->flags & F_DUMP_OBJECTS_AS_UNBLESSED ? 1 : 0)
+ (enc->flags & F_DUMP_OBJECTS_AS_BLESSED ? 1 : 0)
> 1)
{
croak("Can only have one of 'undef_blessed', "
"'objects_as_unblessed', and 'dump_objects' options at a time.");
}
return enc;
}
sarNode_p sar_buildNode_c() {
sarNode_p newNode;
Newx(newNode, 1, sarNode_t);
char * nodeChars;
sarNode_p *nodes;
newNode->charNumber = 0;
newNode->sarNodes = nodes;
newNode->sarPathChars = nodeChars;
newNode->plusNode = (sarNode_p)NULL;
newNode->digitNode = (sarNode_p)NULL;
newNode->alphaNumNode = (sarNode_p)NULL;
newNode->alphaNode = (sarNode_p)NULL;
newNode->dotNode = (sarNode_p)NULL;
newNode->spaceNode = (sarNode_p)NULL;
newNode->negativeNode = (sarNode_p)NULL;
Newx(newNode->callFunc, 1, SV*);
newNode->callFunc[0] = (SV*)NULL;
newNode->getCallFunc = SAR_FALSE;
return newNode;
}
void
PLCBA_request(
SV *self,
int cmd, int reqtype,
SV *callcb, SV *cbdata, int cbtype,
AV *params)
{
PLCBA_cmd_t cmdtype;
struct PLCBA_request_st r;
PLCBA_t *async;
libcouchbase_t instance;
PLCB_t *base;
AV *reqav;
PLCBA_cookie_t *cookie;
int nreq, i;
libcouchbase_error_t *errors;
int errcount;
int has_conversion;
SV **tmpsv;
time_t *multi_exp;
void **multi_key;
size_t *multi_nkey;
libcouchbase_error_t err;
libcouchbase_storage_t storop;
_mk_common_vars(self, instance, base, async);
Newxz(cookie, 1, PLCBA_cookie_t);
if(SvTYPE(callcb) == SVt_NULL) {
die("Must have callback for asynchronous request");
}
if(reqtype == PLCBA_REQTYPE_MULTI) {
nreq = av_len(params) + 1;
if(!nreq) {
die("No requests specified");
}
} else {
nreq = 1;
}
cookie->callcb = callcb; SvREFCNT_inc(callcb);
cookie->cbdata = cbdata; SvREFCNT_inc(cbdata);
cookie->cbtype = cbtype;
cookie->results = newHV();
cookie->parent = async;
cookie->remaining = nreq;
/*pseudo-multi system:
Most commands do not have a libcouchbase-level 'multi' implementation, but
nevertheless it's more efficient to allow a 'multi' option from Perl because
sub and xsub overhead is very expensive.
Each operation defines a macro '_do_cbop' which does the following:
1) call the libcouchbase api function appropriate for that operation
2) set the function variable 'err' to the error which ocurred.
the predefined pseudo_perform macro does the rest by doing the following:
1) check to see if the request is multiple or single
in the case of multiple requests, it:
I) fetches the current request AV
II) ensures the request is valid and defined
III) extracts the information from the request into our request_st
structure named 'r'
IV) calls the locally-defined _do_cbop (which sets the error)
V) checks the current value of 'err', if it is not a success, the
error counter is incremented
VI) when the loop has terminated, the error counter is checked again,
and if it is greater than zero, the error dispatcher is called
in the case of a single request, it:
I) treats 'params' as the request AV
II) passes the AV to av2request,
III) calls _do_cbop once, and checks for errors
IV) if there is an erorr, the dispatcher is called
*/
#define _fetch_assert(idx) \
if((tmpsv = av_fetch(params, idx, 0)) == NULL) { \
die("Null request found in request list"); \
} \
if(!SvROK(*tmpsv)) { \
die("Expected reference type in parameter list."); \
} \
av2request(async, cmd, (AV*)(SvRV(*tmpsv)), &r);
#define pseudo_multi_begin \
Newxz(errors, nreq, libcouchbase_error_t); \
errcount = 0;
#define pseudo_multi_maybe_add \
if( (errors[i] = err) != LIBCOUCHBASE_SUCCESS ) \
errcount++;
#define pseudo_multi_end \
if(errcount) \
error_pseudo_multi(async, params, errors, cookie); \
Safefree(errors);
#define pseudo_perform \
if(reqtype == PLCBA_REQTYPE_MULTI) { \
pseudo_multi_begin; \
for(i = 0; i < nreq; i++) { \
_fetch_assert(i); \
_do_cbop(); \
pseudo_multi_maybe_add; \
} \
if(errcount < nreq) { \
libcouchbase_wait(instance); \
} \
} else { \
av2request(async, cmd, params, &r); \
_do_cbop(); \
if(err != LIBCOUCHBASE_SUCCESS) { \
warn("Key %s did not return OK (%d)", r.key, err); \
error_single(async, cookie, r.key, r.nkey, err); \
} else { \
libcouchbase_wait(instance); \
} \
} \
switch(cmd) {
case PLCBA_CMD_GET:
case PLCBA_CMD_TOUCH:
#define _do_cbop(klist, szlist, explist) \
if(cmd == PLCBA_CMD_GET) { \
err = libcouchbase_mget(instance, cookie, nreq, \
(const void* const*)klist, \
(szlist), explist); \
} else { \
err = libcouchbase_mtouch(instance, cookie, nreq, \
(const void* const*)klist, \
szlist, explist); \
}
if(reqtype == PLCBA_REQTYPE_MULTI) {
Newx(multi_key, nreq, void*);
Newx(multi_nkey, nreq, size_t);
Newx(multi_exp, nreq, time_t);
for(i = 0; i < nreq; i++) {
_fetch_assert(i);
multi_key[i] = r.key;
multi_nkey[i] = r.nkey;
multi_exp[i] = r.exp;
}
_do_cbop(multi_key, multi_nkey, multi_exp);
if(err != LIBCOUCHBASE_SUCCESS) {
error_true_multi(
async, cookie, nreq, (const char**)multi_key, multi_nkey, err);
} else {
libcouchbase_wait(instance);
}
Safefree(multi_key);
Safefree(multi_nkey);
Safefree(multi_exp);
} else {
av2request(async, cmd, params, &r);
_do_cbop(&(r.key), &(r.nkey), &(r.exp));
if(err != LIBCOUCHBASE_SUCCESS) {
error_single(async, cookie, r.key, r.nkey, err);
} else {
libcouchbase_wait(instance);
}
}
break;
#undef _do_cbop
case PLCBA_CMD_SET:
case PLCBA_CMD_ADD:
case PLCBA_CMD_REPLACE:
case PLCBA_CMD_APPEND:
case PLCBA_CMD_PREPEND:
storop = async_cmd_to_storop(cmd);
//warn("Storop is %x (cmd=%x)", storop, cmd);
has_conversion = plcba_cmd_needs_conversion(cmd);
#define _do_cbop() \
err = libcouchbase_store(instance, cookie, storop, r.key, r.nkey, \
SvPVX(r.value), r.nvalue, r.store_flags, \
r.exp, r.cas); \
if(has_conversion) { \
plcb_convert_storage_free(base, r.value, r.store_flags); \
}
pseudo_perform;
break;
#undef _do_cbop
case PLCBA_CMD_ARITHMETIC:
#define _do_cbop() \
err = libcouchbase_arithmetic(instance, cookie, r.key, r.nkey, \
r.arithmetic.delta, r.exp, \
r.arithmetic.create, r.arithmetic.initial);
pseudo_perform;
break;
#undef _do_cbop
case PLCBA_CMD_REMOVE:
#define _do_cbop() \
err = libcouchbase_remove(instance, cookie, r.key, r.nkey, r.cas);
pseudo_perform;
break;
#undef _do_cbop
default:
die("Unimplemented!");
}
#undef _fetch_assert
#undef pseudo_multi_begin
#undef pseduo_multi_maybe_add
#undef pseudo_multi_end
#undef pseudo_perform
}
Datum* create(const char * classname) {
Datum *self;
Newx(self,1,Datum);
initialize_datum(self);
return self;
}
Perl_yyparse (pTHX_ int gramtype)
#endif
{
dVAR;
int yystate;
int yyn;
int yyresult;
/* Lookahead token as an internal (translated) token number. */
int yytoken = 0;
yy_parser *parser; /* the parser object */
yy_stack_frame *ps; /* current parser stack frame */
#define YYPOPSTACK parser->ps = --ps
#define YYPUSHSTACK parser->ps = ++ps
/* The variable used to return semantic value and location from the
action routines: ie $$. */
YYSTYPE yyval;
#ifndef PERL_IN_MADLY_C
# ifdef PERL_MAD
if (PL_madskills)
return madparse(gramtype);
# endif
#endif
YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
parser = PL_parser;
ENTER; /* force parser state cleanup/restoration before we return */
SAVEPPTR(parser->yylval.pval);
SAVEINT(parser->yychar);
SAVEINT(parser->yyerrstatus);
SAVEINT(parser->stack_size);
SAVEINT(parser->yylen);
SAVEVPTR(parser->stack);
SAVEVPTR(parser->ps);
/* initialise state for this parse */
parser->yychar = gramtype;
parser->yyerrstatus = 0;
parser->stack_size = YYINITDEPTH;
parser->yylen = 0;
Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
ps = parser->ps = parser->stack;
ps->state = 0;
SAVEDESTRUCTOR_X(S_clear_yystack, parser);
/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate. |
`------------------------------------------------------------*/
yynewstate:
yystate = ps->state;
YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
parser->yylen = 0;
{
size_t size = ps - parser->stack + 1;
/* grow the stack? We always leave 1 spare slot,
* in case of a '' -> 'foo' reduction */
if (size >= (size_t)parser->stack_size - 1) {
/* this will croak on insufficient memory */
parser->stack_size *= 2;
Renew(parser->stack, parser->stack_size, yy_stack_frame);
ps = parser->ps = parser->stack + size -1;
YYDPRINTF((Perl_debug_log,
"parser stack size increased to %lu frames\n",
(unsigned long int)parser->stack_size));
}
}
/* Do appropriate processing given the current state. */
/* Read a lookahead token if we need one and don't already have one. */
/* First try to decide what to do without reference to lookahead token. */
yyn = yypact[yystate];
if (yyn == YYPACT_NINF)
goto yydefault;
/* Not known => get a lookahead token if don't already have one. */
/* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
if (parser->yychar == YYEMPTY) {
YYDPRINTF ((Perl_debug_log, "Reading a token: "));
#ifdef PERL_IN_MADLY_C
parser->yychar = PL_madskills ? madlex() : yylex();
#else
parser->yychar = yylex();
#endif
# ifdef EBCDIC
if (parser->yychar >= 0 && parser->yychar < 255) {
parser->yychar = NATIVE_TO_ASCII(parser->yychar);
}
# endif
}
if (parser->yychar <= YYEOF) {
parser->yychar = yytoken = YYEOF;
YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
}
else {
yytoken = YYTRANSLATE (parser->yychar);
YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
}
/* If the proper action on seeing token YYTOKEN is to reduce or to
detect an error, take that action. */
yyn += yytoken;
if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
goto yydefault;
yyn = yytable[yyn];
if (yyn <= 0) {
if (yyn == 0 || yyn == YYTABLE_NINF)
goto yyerrlab;
yyn = -yyn;
goto yyreduce;
}
if (yyn == YYFINAL)
YYACCEPT;
/* Shift the lookahead token. */
YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
/* Discard the token being shifted unless it is eof. */
if (parser->yychar != YYEOF)
parser->yychar = YYEMPTY;
YYPUSHSTACK;
ps->state = yyn;
ps->val = parser->yylval;
ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
ps->savestack_ix = PL_savestack_ix;
#ifdef DEBUGGING
ps->name = (const char *)(yytname[yytoken]);
#endif
/* Count tokens shifted since error; after three, turn off error
status. */
if (parser->yyerrstatus)
parser->yyerrstatus--;
goto yynewstate;
/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state. |
`-----------------------------------------------------------*/
yydefault:
yyn = yydefact[yystate];
if (yyn == 0)
goto yyerrlab;
goto yyreduce;
/*-----------------------------.
| yyreduce -- Do a reduction. |
`-----------------------------*/
yyreduce:
/* yyn is the number of a rule to reduce with. */
parser->yylen = yyr2[yyn];
/* If YYLEN is nonzero, implement the default value of the action:
"$$ = $1".
Otherwise, the following line sets YYVAL to garbage.
This behavior is undocumented and Bison
users should not rely upon it. Assigning to YYVAL
unconditionally makes the parser a bit smaller, and it avoids a
GCC warning that YYVAL may be used uninitialized. */
yyval = ps[1-parser->yylen].val;
YY_STACK_PRINT(parser);
YY_REDUCE_PRINT (yyn);
switch (yyn) {
#define dep() deprecate("\"do\" to call subroutines")
#ifdef PERL_IN_MADLY_C
# define IVAL(i) (i)->tk_lval.ival
# define PVAL(p) (p)->tk_lval.pval
# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
# define TOKEN_FREE(a) token_free(a)
# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
# define IF_MAD(a,b) (a)
# define DO_MAD(a) a
# define MAD
#else
# define IVAL(i) (i)
# define PVAL(p) (p)
# define TOKEN_GETMAD(a,b,c)
# define TOKEN_FREE(a)
# define OP_GETMAD(a,b,c)
# define IF_MAD(a,b) (b)
# define DO_MAD(a)
# undef MAD
#endif
/* contains all the rule actions; auto-generated from perly.y */
#include "perly.act"
}
{
int i;
for (i=0; i< parser->yylen; i++) {
SvREFCNT_dec(ps[-i].compcv);
}
}
parser->ps = ps -= (parser->yylen-1);
/* Now shift the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
number reduced by. */
ps->val = yyval;
ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
ps->savestack_ix = PL_savestack_ix;
#ifdef DEBUGGING
ps->name = (const char *)(yytname [yyr1[yyn]]);
#endif
yyn = yyr1[yyn];
yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
yystate = yytable[yystate];
else
yystate = yydefgoto[yyn - YYNTOKENS];
ps->state = yystate;
goto yynewstate;
/*------------------------------------.
| yyerrlab -- here on detecting error |
`------------------------------------*/
yyerrlab:
/* If not already recovering from an error, report this error. */
if (!parser->yyerrstatus) {
yyerror ("syntax error");
}
if (parser->yyerrstatus == 3) {
/* If just tried and failed to reuse lookahead token after an
error, discard it. */
/* Return failure if at end of input. */
if (parser->yychar == YYEOF) {
/* Pop the error token. */
SvREFCNT_dec(ps->compcv);
YYPOPSTACK;
/* Pop the rest of the stack. */
while (ps > parser->stack) {
YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
LEAVE_SCOPE(ps->savestack_ix);
if (yy_type_tab[yystos[ps->state]] == toketype_opval
&& ps->val.opval)
{
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
if (ps->compcv != PL_compcv) {
PL_compcv = ps->compcv;
PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
}
op_free(ps->val.opval);
}
SvREFCNT_dec(ps->compcv);
YYPOPSTACK;
}
YYABORT;
}
YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
parser->yychar = YYEMPTY;
}
/* Else will try to reuse lookahead token after shifting the error
token. */
goto yyerrlab1;
/*----------------------------------------------------.
| yyerrlab1 -- error raised explicitly by an action. |
`----------------------------------------------------*/
yyerrlab1:
parser->yyerrstatus = 3; /* Each real token shifted decrements this. */
for (;;) {
yyn = yypact[yystate];
if (yyn != YYPACT_NINF) {
yyn += YYTERROR;
if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
yyn = yytable[yyn];
if (0 < yyn)
break;
}
}
/* Pop the current state because it cannot handle the error token. */
if (ps == parser->stack)
YYABORT;
YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
LEAVE_SCOPE(ps->savestack_ix);
if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
if (ps->compcv != PL_compcv) {
PL_compcv = ps->compcv;
PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
}
op_free(ps->val.opval);
}
SvREFCNT_dec(ps->compcv);
YYPOPSTACK;
yystate = ps->state;
YY_STACK_PRINT(parser);
}
if (yyn == YYFINAL)
YYACCEPT;
YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
YYPUSHSTACK;
ps->state = yyn;
ps->val = parser->yylval;
ps->compcv = (CV*)SvREFCNT_inc(PL_compcv);
ps->savestack_ix = PL_savestack_ix;
#ifdef DEBUGGING
ps->name ="<err>";
#endif
goto yynewstate;
/*-------------------------------------.
| yyacceptlab -- YYACCEPT comes here. |
`-------------------------------------*/
yyacceptlab:
yyresult = 0;
for (ps=parser->ps; ps > parser->stack; ps--) {
SvREFCNT_dec(ps->compcv);
}
parser->ps = parser->stack; /* disable cleanup */
goto yyreturn;
/*-----------------------------------.
| yyabortlab -- YYABORT comes here. |
`-----------------------------------*/
yyabortlab:
yyresult = 1;
goto yyreturn;
yyreturn:
LEAVE; /* force parser stack cleanup before we return */
return yyresult;
}
Datatype* create(const char * classname) {
Datatype *self;
Newx(self,1,Datatype);
initialize_datatype(self);
return self;
}
STATIC I32
S_do_trans_simple_utf8(pTHX_ SV * const sv)
{
dVAR;
U8 *s;
U8 *send;
U8 *d;
U8 *start;
U8 *dstart, *dend;
I32 matches = 0;
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
STRLEN len;
SV* const rv =
#ifdef USE_ITHREADS
PAD_SVl(cPADOP->op_padix);
#else
(SV*)cSVOP->op_sv;
#endif
HV* const hv = (HV*)SvRV(rv);
SV* const * svp = hv_fetchs(hv, "NONE", FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
UV final = 0;
U8 hibit = 0;
s = (U8*)SvPV(sv, len);
if (!SvUTF8(sv)) {
const U8 *t = s;
const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
hibit = !NATIVE_IS_INVARIANT(ch);
if (hibit) {
s = bytes_to_utf8(s, &len);
break;
}
}
}
send = s + len;
start = s;
svp = hv_fetchs(hv, "FINAL", FALSE);
if (svp)
final = SvUV(*svp);
if (grows) {
/* d needs to be bigger than s, in case e.g. upgrading is required */
Newx(d, len * 3 + UTF8_MAXBYTES, U8);
dend = d + len * 3;
dstart = d;
}
else {
dstart = d = s;
dend = d + len;
}
while (s < send) {
const UV uv = swash_fetch(rv, s, TRUE);
if (uv < none) {
s += UTF8SKIP(s);
matches++;
d = uvuni_to_utf8(d, uv);
}
else if (uv == none) {
const int i = UTF8SKIP(s);
Move(s, d, i, U8);
d += i;
s += i;
}
else if (uv == extra) {
s += UTF8SKIP(s);
matches++;
d = uvuni_to_utf8(d, final);
}
else
STATIC I32
S_do_trans_simple(pTHX_ SV * const sv)
{
dVAR;
I32 matches = 0;
STRLEN len;
U8 *s = (U8*)SvPV(sv,len);
U8 * const send = s+len;
const short * const tbl = (short*)cPVOP->op_pv;
if (!tbl)
Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
/* First, take care of non-UTF-8 input strings, because they're easy */
if (!SvUTF8(sv)) {
while (s < send) {
const I32 ch = tbl[*s];
if (ch >= 0) {
matches++;
*s = (U8)ch;
}
s++;
}
SvSETMAGIC(sv);
}
else {
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
U8 *d;
U8 *dstart;
/* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
if (grows)
Newx(d, len*2+1, U8);
else
d = s;
dstart = d;
while (s < send) {
STRLEN ulen;
I32 ch;
/* Need to check this, otherwise 128..255 won't match */
const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT);
if (c < 0x100 && (ch = tbl[c]) >= 0) {
matches++;
d = uvchr_to_utf8(d, ch);
s += ulen;
}
else { /* No match -> copy */
Move(s, d, ulen, U8);
d += ulen;
s += ulen;
}
}
if (grows) {
sv_setpvn(sv, (char*)dstart, d - dstart);
Safefree(dstart);
}
else {
*d = '\0';
SvCUR_set(sv, d - dstart);
}
SvUTF8_on(sv);
SvSETMAGIC(sv);
}
return matches;
}
STATIC I32
S_do_trans_complex(pTHX_ SV * const sv)
{
dVAR;
STRLEN len;
U8 *s = (U8*)SvPV(sv, len);
U8 * const send = s+len;
I32 matches = 0;
const short * const tbl = (short*)cPVOP->op_pv;
if (!tbl)
Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__);
if (!SvUTF8(sv)) {
U8 *d = s;
U8 * const dstart = d;
if (PL_op->op_private & OPpTRANS_SQUASH) {
const U8* p = send;
while (s < send) {
const I32 ch = tbl[*s];
if (ch >= 0) {
*d = (U8)ch;
matches++;
if (p != d - 1 || *p != *d)
p = d++;
}
else if (ch == -1) /* -1 is unmapped character */
*d++ = *s;
else if (ch == -2) /* -2 is delete character */
matches++;
s++;
}
}
else {
while (s < send) {
const I32 ch = tbl[*s];
if (ch >= 0) {
matches++;
*d++ = (U8)ch;
}
else if (ch == -1) /* -1 is unmapped character */
*d++ = *s;
else if (ch == -2) /* -2 is delete character */
matches++;
s++;
}
}
*d = '\0';
SvCUR_set(sv, d - dstart);
}
else { /* is utf8 */
const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
const I32 del = PL_op->op_private & OPpTRANS_DELETE;
U8 *d;
U8 *dstart;
STRLEN rlen = 0;
if (grows)
Newx(d, len*2+1, U8);
else
d = s;
dstart = d;
if (complement && !del)
rlen = tbl[0x100];
#ifdef MACOS_TRADITIONAL
#define comp CoMP /* "comp" is a keyword in some compilers ... */
#endif
if (PL_op->op_private & OPpTRANS_SQUASH) {
UV pch = 0xfeedface;
while (s < send) {
STRLEN len;
const UV comp = utf8n_to_uvchr(s, send - s, &len,
UTF8_ALLOW_DEFAULT);
I32 ch;
if (comp > 0xff) {
if (!complement) {
Move(s, d, len, U8);
d += len;
}
else {
matches++;
if (!del) {
ch = (rlen == 0) ? (I32)comp :
(comp - 0x100 < rlen) ?
tbl[comp+1] : tbl[0x100+rlen];
if ((UV)ch != pch) {
d = uvchr_to_utf8(d, ch);
pch = (UV)ch;
}
s += len;
continue;
}
}
}
else if ((ch = tbl[comp]) >= 0) {
matches++;
if ((UV)ch != pch) {
d = uvchr_to_utf8(d, ch);
pch = (UV)ch;
}
s += len;
continue;
}
else if (ch == -1) { /* -1 is unmapped character */
Move(s, d, len, U8);
d += len;
}
else if (ch == -2) /* -2 is delete character */
matches++;
s += len;
pch = 0xfeedface;
}
}
else {
while (s < send) {
STRLEN len;
const UV comp = utf8n_to_uvchr(s, send - s, &len,
UTF8_ALLOW_DEFAULT);
I32 ch;
if (comp > 0xff) {
if (!complement) {
Move(s, d, len, U8);
d += len;
}
else {
matches++;
if (!del) {
if (comp - 0x100 < rlen)
d = uvchr_to_utf8(d, tbl[comp+1]);
else
d = uvchr_to_utf8(d, tbl[0x100+rlen]);
}
}
}
else if ((ch = tbl[comp]) >= 0) {
d = uvchr_to_utf8(d, ch);
matches++;
}
else if (ch == -1) { /* -1 is unmapped character */
Move(s, d, len, U8);
d += len;
}
else if (ch == -2) /* -2 is delete character */
matches++;
s += len;
}
}
if (grows) {
sv_setpvn(sv, (char*)dstart, d - dstart);
Safefree(dstart);
}
else {
*d = '\0';
SvCUR_set(sv, d - dstart);
}
SvUTF8_on(sv);
}
SvSETMAGIC(sv);
return matches;
}
TypeSafeData* create(const char * classname) {
TypeSafeData *self;
Newx(self,1,TypeSafeData);
initialize_typesafedata(self);
return self;
}
SRL_STATIC_INLINE int _parse(pTHX_ srl_splitter_t * splitter) {
char tag;
while( ! stack_is_empty(splitter->status_stack) ) {
UV status = stack_pop(splitter->status_stack);
UV absolute_offset;
SRL_SPLITTER_TRACE("* ITERATING -- deepness value: %d", splitter->deepness);
switch(status) {
case ST_DEEPNESS_UP:
splitter->deepness--;
SRL_SPLITTER_TRACE(" * DEEPNESS UP -- deepness value: %d", splitter->deepness);
break;
case ST_VALUE:
tag = *(splitter->pos);
SRL_SPLITTER_TRACE(" * VALUE tag %d -- deepness value: %d", tag, splitter->deepness);
if (tag & SRL_HDR_TRACK_FLAG) {
tag = tag & ~SRL_HDR_TRACK_FLAG;
SRL_SPLITTER_TRACE(" * tag must be tracked, %ld\n", splitter->pos - splitter->input_body_pos);
offset_el_t *element = NULL;
UV origin_offset = splitter->pos - splitter->input_body_pos + 1;
UV new_offset = splitter->chunk_current_offset + (splitter->pos - splitter->chunk_iter_start);
HASH_FIND(hh, offset_hashtable, &origin_offset, sizeof(UV), element);
if(element == NULL) {
Newx(element, 1, offset_el_t);
element->key = origin_offset;
element->value = new_offset;
SRL_SPLITTER_TRACE(" * adding %lu -> %lu\n", element->key, element->value);
HASH_ADD_KEYPTR(hh, offset_hashtable, &(element->key), sizeof(UV), element);
}
}
splitter->pos++;
_read_tag(aTHX_ splitter, tag);
break;
case ST_ABSOLUTE_JUMP:
/* before jumping, flush the chunk */
_maybe_flush_chunk(aTHX_ splitter, NULL, NULL);
absolute_offset = stack_pop(splitter->status_stack);
SRL_SPLITTER_TRACE(" * ABSOLUTE_JUMP to %lu", (UV) ( (char*)absolute_offset - splitter->input_str ) );
splitter->pos = (char*) absolute_offset;
splitter->chunk_iter_start = splitter->pos;
break;
default:
croak("unknown stack value %lu", status);
}
if ( splitter->deepness == 0) {
/* Here it means we have properly parsed a full VALUE, so we have
an additional array element in our chunk */
splitter->chunk_nb_elts++;
if ( (UV)(splitter->chunk_size +
splitter->pos - splitter->chunk_iter_start) >= splitter->size_limit) {
_maybe_flush_chunk(aTHX_ splitter, NULL, NULL);
return 1;
}
}
}
SRL_SPLITTER_TRACE("* END ITERATING (deepness value: %d)", splitter->deepness);
if (splitter->deepness != 0)
croak("Something wrong happens: parsing finished but deepness is not zero");
/* iteration is finished, if we had to flush something return success */
if (_maybe_flush_chunk(aTHX_ splitter, NULL, NULL))
return 1;
/* maybe we didn't have to flush but the chunk is not empty: return success */
if (splitter->chunk_size > 0)
return 1;
/* otherwise, no data anymore, return failure */
return 0;
}