X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=blobdiff_plain;f=Plugin.xs;h=6036d87fff2bf36dfea4aa33fa3a6bbe9fdd4243;hp=5095c730d47133255bc6526a415295f16cd16428;hb=182fcce5112d0394e1678a80b3f17b3581918f7e;hpb=1563077bd33bb07b7ef50968c22739c722452769 diff --git a/Plugin.xs b/Plugin.xs index 5095c73..6036d87 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -6,168 +6,22 @@ #include "perl.h" #include "XSUB.h" -#define __PACKAGE__ "re::engine::Plugin" -#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1) - -#define REP_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) +/* --- Helpers ------------------------------------------------------------- */ -#ifndef REP_WORKAROUND_REQUIRE_PROPAGATION -# define REP_WORKAROUND_REQUIRE_PROPAGATION !REP_HAS_PERL(5, 10, 1) -#endif +#define XSH_PACKAGE "re::engine::Plugin" -/* ... Thread safety and multiplicity ...................................... */ +#include "xsh/caps.h" +#include "xsh/util.h" -/* Safe unless stated otherwise in Makefile.PL */ -#ifndef REP_FORKSAFE -# define REP_FORKSAFE 1 -#endif - -#ifndef REP_MULTIPLICITY -# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) -# define REP_MULTIPLICITY 1 -# else -# define REP_MULTIPLICITY 0 -# endif -#endif -#if REP_MULTIPLICITY && !defined(tTHX) -# define tTHX PerlInterpreter* -#endif - -#if REP_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV)) -# define REP_THREADSAFE 1 -# ifndef MY_CXT_CLONE -# define MY_CXT_CLONE \ - dMY_CXT_SV; \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \ - Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) -# endif -#else -# define REP_THREADSAFE 0 -# undef dMY_CXT -# define dMY_CXT dNOOP -# undef MY_CXT -# define MY_CXT rep_globaldata -# undef START_MY_CXT -# define START_MY_CXT STATIC my_cxt_t MY_CXT; -# undef MY_CXT_INIT -# define MY_CXT_INIT NOOP -# undef MY_CXT_CLONE -# define MY_CXT_CLONE NOOP -#endif - -/* --- Helpers ------------------------------------------------------------- */ - -/* ... Thread-safe hints ................................................... */ +/* ... Lexical hints ....................................................... */ typedef struct { SV *comp; SV *exec; -#if REP_WORKAROUND_REQUIRE_PROPAGATION - IV require_tag; -#endif -} rep_hint_t; - -#if REP_THREADSAFE - -#define PTABLE_VAL_FREE(V) { \ - rep_hint_t *h = (V); \ - SvREFCNT_dec(h->comp); \ - SvREFCNT_dec(h->exec); \ - PerlMemShared_free(h); \ -} - -#define pPTBL pTHX -#define pPTBL_ pTHX_ -#define aPTBL aTHX -#define aPTBL_ aTHX_ - -#include "ptable.h" - -#define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V)) -#define ptable_free(T) ptable_free(aTHX_ (T)) - -#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION - -typedef struct { - ptable *tbl; - tTHX owner; -} my_cxt_t; - -START_MY_CXT - -typedef struct { - ptable *tbl; -#if REP_HAS_PERL(5, 13, 2) - CLONE_PARAMS *params; -#else - CLONE_PARAMS params; -#endif -} rep_ptable_clone_ud; - -#if REP_HAS_PERL(5, 13, 2) -# define rep_ptable_clone_ud_init(U, T, O) \ - (U).tbl = (T); \ - (U).params = Perl_clone_params_new((O), aTHX) -# define rep_ptable_clone_ud_deinit(U) Perl_clone_params_del((U).params) -# define rep_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), (U)->params)) -#else -# define rep_ptable_clone_ud_init(U, T, O) \ - (U).tbl = (T); \ - (U).params.stashes = newAV(); \ - (U).params.flags = 0; \ - (U).params.proto_perl = (O) -# define rep_ptable_clone_ud_deinit(U) SvREFCNT_dec((U).params.stashes) -# define rep_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), &((U)->params))) -#endif - -STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { - rep_ptable_clone_ud *ud = ud_; - rep_hint_t *h1 = ent->val; - rep_hint_t *h2; - - h2 = PerlMemShared_malloc(sizeof *h2); - h2->comp = rep_dup_inc(h1->comp, ud); - h2->exec = rep_dup_inc(h1->exec, ud); -#if REP_WORKAROUND_REQUIRE_PROPAGATION - h2->require_tag = PTR2IV(rep_dup_inc(INT2PTR(SV *, h1->require_tag), ud)); -#endif - - ptable_store(ud->tbl, ent->key, h2); -} - -STATIC void rep_thread_cleanup(pTHX_ void *ud) { - dMY_CXT; - - ptable_free(MY_CXT.tbl); -} - -STATIC int rep_endav_free(pTHX_ SV *sv, MAGIC *mg) { - SAVEDESTRUCTOR_X(rep_thread_cleanup, NULL); - - return 0; -} + SV *free; +} xsh_hints_user_t; -STATIC MGVTBL rep_endav_vtbl = { - 0, - 0, - 0, - 0, - rep_endav_free -#if MGf_COPY - , 0 -#endif -#if MGf_DUP - , 0 -#endif -#if MGf_LOCAL - , 0 -#endif -}; - -#endif /* REP_THREADSAFE */ - -STATIC SV *rep_validate_callback(SV *code) { +static SV *rep_validate_callback(SV *code) { if (!SvROK(code)) return NULL; @@ -178,147 +32,85 @@ STATIC SV *rep_validate_callback(SV *code) { return SvREFCNT_inc_simple_NN(code); } -#if REP_WORKAROUND_REQUIRE_PROPAGATION -STATIC IV rep_require_tag(pTHX) { -#define rep_require_tag() rep_require_tag(aTHX) - const CV *cv, *outside; - - cv = PL_compcv; - - if (!cv) { - /* If for some reason the pragma is operational at run-time, try to discover - * the current cv in use. */ - const PERL_SI *si; - - for (si = PL_curstackinfo; si; si = si->si_prev) { - I32 cxix; - - for (cxix = si->si_cxix; cxix >= 0; --cxix) { - const PERL_CONTEXT *cx = si->si_cxstack + cxix; - - switch (CxTYPE(cx)) { - case CXt_SUB: - case CXt_FORMAT: - /* The propagation workaround is only needed up to 5.10.0 and at that - * time format and sub contexts were still identical. And even later the - * cv members offsets should have been kept the same. */ - cv = cx->blk_sub.cv; - goto get_enclosing_cv; - case CXt_EVAL: - cv = cx->blk_eval.cv; - goto get_enclosing_cv; - default: - break; - } - } - } +static void xsh_hints_user_init(pTHX_ xsh_hints_user_t *hv, xsh_hints_user_t *v) { + hv->comp = rep_validate_callback(v->comp); + hv->exec = rep_validate_callback(v->exec); + hv->free = rep_validate_callback(v->free); - cv = PL_main_cv; - } + return; +} -get_enclosing_cv: - for (outside = CvOUTSIDE(cv); outside; outside = CvOUTSIDE(cv)) - cv = outside; +#if XSH_THREADSAFE - return PTR2IV(cv); -} -#endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */ - -STATIC SV *rep_tag(pTHX_ SV *comp, SV *exec) { -#define rep_tag(C, E) rep_tag(aTHX_ (C), (E)) - rep_hint_t *h; - - h = PerlMemShared_malloc(sizeof *h); - h->comp = rep_validate_callback(comp); - h->exec = rep_validate_callback(exec); -#if REP_WORKAROUND_REQUIRE_PROPAGATION - h->require_tag = rep_require_tag(); -#endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */ - -#if REP_THREADSAFE - { - dMY_CXT; - /* We only need for the key to be an unique tag for looking up the value later - * Allocated memory provides convenient unique identifiers, so that's why we - * use the hint as the key itself. */ - ptable_store(MY_CXT.tbl, h, h); - } -#endif /* REP_THREADSAFE */ +static void xsh_hints_user_clone(pTHX_ xsh_hints_user_t *nv, xsh_hints_user_t *ov, CLONE_PARAMS *params) { + nv->comp = xsh_dup_inc(ov->comp, params); + nv->exec = xsh_dup_inc(ov->exec, params); + nv->free = xsh_dup_inc(ov->free, params); - return newSViv(PTR2IV(h)); + return; } -STATIC const rep_hint_t *rep_detag(pTHX_ const SV *hint) { -#define rep_detag(H) rep_detag(aTHX_ (H)) - rep_hint_t *h; +#endif /* XSH_THREADSAFE */ - if (!(hint && SvIOK(hint))) - return NULL; +static void xsh_hints_user_deinit(pTHX_ xsh_hints_user_t *hv) { + SvREFCNT_dec(hv->comp); + SvREFCNT_dec(hv->exec); + SvREFCNT_dec(hv->free); - h = INT2PTR(rep_hint_t *, SvIVX(hint)); -#if REP_THREADSAFE - { - dMY_CXT; - h = ptable_fetch(MY_CXT.tbl, h); - } -#endif /* REP_THREADSAFE */ + return; +} -#if REP_WORKAROUND_REQUIRE_PROPAGATION - if (rep_require_tag() != h->require_tag) - return NULL; -#endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */ +#define rep_hint() xsh_hints_detag(xsh_hints_fetch()) - return h; -} +#define XSH_HINTS_TYPE_USER 1 +#define XSH_HINTS_ONLY_COMPILE_TIME 0 -STATIC U32 rep_hash = 0; +#include "xsh/hints.h" -STATIC const rep_hint_t *rep_hint(pTHX) { -#define rep_hint() rep_hint(aTHX) - SV *hint; +/* ... Thread-local storage ................................................ */ -#ifdef cop_hints_fetch_pvn - hint = cop_hints_fetch_pvn(PL_curcop, - __PACKAGE__, __PACKAGE_LEN__, rep_hash, 0); -#else - /* We already require 5.9.5 for the regexp engine API. */ - hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, - NULL, - __PACKAGE__, __PACKAGE_LEN__, - 0, - rep_hash); -#endif +#define XSH_THREADS_USER_CONTEXT 0 +#define XSH_THREADS_USER_LOCAL_SETUP 0 +#define XSH_THREADS_USER_LOCAL_TEARDOWN 0 +#define XSH_THREADS_USER_GLOBAL_TEARDOWN 0 +#define XSH_THREADS_COMPILE_TIME_PROTECTION 0 - return rep_detag(hint); -} +#include "xsh/threads.h" /* --- Custom regexp engine ------------------------------------------------ */ -#define GET_SELF_FROM_PPRIVATE(pprivate) \ - re__engine__Plugin self; \ - SELF_FROM_PPRIVATE(self,pprivate); - /* re__engine__Plugin self; SELF_FROM_PPRIVATE(self,rx->pprivate) */ -#define SELF_FROM_PPRIVATE(self, pprivate) \ - if (sv_isobject(pprivate)) { \ - SV * ref = SvRV((SV*)pprivate); \ - IV tmp = SvIV((SV*)ref); \ - self = INT2PTR(re__engine__Plugin,tmp); \ - } else { \ - Perl_croak(aTHX_ "Not an object"); \ - } +#define SELF_FROM_PPRIVATE(self, pprivate) \ + if (sv_isobject(pprivate)) { \ + SV *ref = SvRV((SV *) pprivate); \ + IV tmp = SvIV((SV *) ref); \ + self = INT2PTR(re__engine__Plugin, tmp); \ + } else { \ + Perl_croak(aTHX_ "Not an object"); \ + } + +#if XSH_HAS_PERL(5, 19, 4) +# define REP_ENG_EXEC_MINEND_TYPE SSize_t +#else +# define REP_ENG_EXEC_MINEND_TYPE I32 +#endif START_EXTERN_C EXTERN_C const regexp_engine engine_plugin; -#if PERL_VERSION <= 10 -EXTERN_C REGEXP * Plugin_comp(pTHX_ const SV * const, const U32); -#else +#if XSH_HAS_PERL(5, 11, 0) EXTERN_C REGEXP * Plugin_comp(pTHX_ SV * const, U32); +#else +EXTERN_C REGEXP * Plugin_comp(pTHX_ const SV * const, const U32); #endif EXTERN_C I32 Plugin_exec(pTHX_ REGEXP * const, char *, char *, - char *, I32, SV *, void *, U32); + char *, REP_ENG_EXEC_MINEND_TYPE, SV *, void *, U32); +#if XSH_HAS_PERL(5, 19, 1) +EXTERN_C char * Plugin_intuit(pTHX_ REGEXP * const, SV *, const char * const, + char *, char *, U32, re_scream_pos_data *); +#else EXTERN_C char * Plugin_intuit(pTHX_ REGEXP * const, SV *, char *, char *, U32, re_scream_pos_data *); +#endif EXTERN_C SV * Plugin_checkstr(pTHX_ REGEXP * const); EXTERN_C void Plugin_free(pTHX_ REGEXP * const); EXTERN_C void * Plugin_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *); @@ -328,289 +120,306 @@ EXTERN_C void Plugin_numbered_buff_STORE(pTHX_ REGEXP * const, const I32, SV const * const); EXTERN_C I32 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const, const SV * const, const I32); -EXTERN_C SV * Plugin_named_buff (pTHX_ REGEXP * const, SV * const, - SV * const, const U32); -EXTERN_C SV * Plugin_named_buff_iter (pTHX_ REGEXP * const, const SV * const, - const U32); +EXTERN_C SV * Plugin_named_buff(pTHX_ REGEXP * const, SV * const, + SV * const, const U32); +EXTERN_C SV * Plugin_named_buff_iter(pTHX_ REGEXP * const, const SV * const, + const U32); EXTERN_C SV * Plugin_package(pTHX_ REGEXP * const); #ifdef USE_ITHREADS EXTERN_C void * Plugin_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *); #endif -END_EXTERN_C -START_EXTERN_C EXTERN_C const regexp_engine engine_plugin; END_EXTERN_C #define RE_ENGINE_PLUGIN (&engine_plugin) const regexp_engine engine_plugin = { - Plugin_comp, - Plugin_exec, - Plugin_intuit, - Plugin_checkstr, - Plugin_free, - Plugin_numbered_buff_FETCH, - Plugin_numbered_buff_STORE, - Plugin_numbered_buff_LENGTH, - Plugin_named_buff, - Plugin_named_buff_iter, - Plugin_package, + Plugin_comp, + Plugin_exec, + Plugin_intuit, + Plugin_checkstr, + Plugin_free, + Plugin_numbered_buff_FETCH, + Plugin_numbered_buff_STORE, + Plugin_numbered_buff_LENGTH, + Plugin_named_buff, + Plugin_named_buff_iter, + Plugin_package #if defined(USE_ITHREADS) - Plugin_dupe, + , Plugin_dupe +#endif +#if XSH_HAS_PERL(5, 17, 0) + , 0 #endif }; typedef struct replug { - /* Pointer back to the containing regexp struct so that accessors - * can modify nparens, gofs etc. */ - struct regexp * rx; + /* Pointer back to the containing regexp struct so that accessors + * can modify nparens, gofs, etc... */ + struct regexp *rx; - /* A copy of the pattern given to comp, for ->pattern */ - SV * pattern; + /* A copy of the pattern given to comp, for ->pattern */ + SV *pattern; - /* A copy of the string being matched against, for ->str */ - SV * str; + /* A copy of the string being matched against, for ->str */ + SV *str; - /* The ->stash */ - SV * stash; + /* The ->stash */ + SV *stash; - /* Callbacks */ - SV * cb_exec; - SV * cb_free; + /* Callbacks */ + SV *cb_exec; + SV *cb_free; - /* ->num_captures */ - SV * cb_num_capture_buff_FETCH; - SV * cb_num_capture_buff_STORE; - SV * cb_num_capture_buff_LENGTH; + /* ->num_captures */ + SV *cb_num_capture_buff_FETCH; + SV *cb_num_capture_buff_STORE; + SV *cb_num_capture_buff_LENGTH; } *re__engine__Plugin; -#if PERL_VERSION >= 11 +#if XSH_HAS_PERL(5, 11, 0) # define rxREGEXP(RX) (SvANY(RX)) -# define newREGEXP(RX) ((RX) = ((REGEXP*) newSV_type(SVt_REGEXP))) +# define newREGEXP(RX) ((RX) = ((REGEXP *) newSV_type(SVt_REGEXP))) #else # define rxREGEXP(RX) (RX) # define newREGEXP(RX) (Newxz((RX), 1, struct regexp)) #endif REGEXP * -#if PERL_VERSION <= 10 -Plugin_comp(pTHX_ const SV * const pattern, const U32 flags) -#else +#if XSH_HAS_PERL(5, 11, 0) Plugin_comp(pTHX_ SV * const pattern, U32 flags) +#else +Plugin_comp(pTHX_ const SV * const pattern, const U32 flags) #endif { - dSP; - struct regexp * rx; - REGEXP *RX; - - re__engine__Plugin re; - const rep_hint_t *h; - - STRLEN plen; - char *pbuf; - - SV *obj; - - h = rep_hint(); - if (!h) /* This looks like a pragma leak. Apply the default behaviour */ - return re_compile(pattern, flags); - - /* exp/xend version of the pattern & length */ - pbuf = SvPV((SV*)pattern, plen); - - /* Our blessed object */ - obj = newSV(0); - SvREFCNT_inc_simple_void_NN(obj); - Newxz(re, 1, struct replug); - sv_setref_pv(obj, "re::engine::Plugin", (void*)re); - - newREGEXP(RX); - rx = rxREGEXP(RX); - - re->rx = rx; /* Make the rx accessible from self->rx */ - rx->intflags = flags; /* Flags for internal use */ - rx->extflags = flags; /* Flags for perl to use */ - rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */ + const xsh_hints_user_t *h; + REGEXP *RX; + struct regexp *rx; + re__engine__Plugin re; + char *pbuf; + STRLEN plen; + SV *obj; + + h = rep_hint(); + if (!h) /* This looks like a pragma leak. Apply the default behaviour */ + return re_compile(pattern, flags); + + /* exp/xend version of the pattern & length */ + pbuf = SvPV((SV *) pattern, plen); + + /* Our blessed object */ + obj = newSV(0); + Newx(re, 1, struct replug); + sv_setref_pv(obj, XSH_PACKAGE, (void *) re); + + newREGEXP(RX); + rx = rxREGEXP(RX); + + re->rx = rx; /* Make the rx accessible from self->rx */ + rx->intflags = flags; /* Flags for internal use */ + rx->extflags = flags; /* Flags for perl to use */ + rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */ + +#if !XSH_HAS_PERL(5, 11, 0) + rx->refcnt = 1; /* Refcount so we won't be destroyed */ + + /* Precompiled pattern for pp_regcomp to use */ + rx->prelen = plen; + rx->precomp = savepvn(pbuf, rx->prelen); + + /* Set up qr// stringification to be equivalent to the supplied + * pattern, this should be done via overload eventually */ + rx->wraplen = rx->prelen; + Newx(rx->wrapped, rx->wraplen, char); + Copy(rx->precomp, rx->wrapped, rx->wraplen, char); +#endif -#if PERL_VERSION <= 10 - rx->refcnt = 1; /* Refcount so we won't be destroyed */ + /* Store our private object */ + rx->pprivate = obj; - /* Precompiled pattern for pp_regcomp to use */ - rx->prelen = plen; - rx->precomp = savepvn(pbuf, rx->prelen); + /* Store the pattern for ->pattern */ + re->pattern = (SV *) pattern; + SvREFCNT_inc_simple_void(re->pattern); - /* Set up qr// stringification to be equivalent to the supplied - * pattern, this should be done via overload eventually. - */ - rx->wraplen = rx->prelen; - Newx(rx->wrapped, rx->wraplen, char); - Copy(rx->precomp, rx->wrapped, rx->wraplen, char); -#endif + re->str = NULL; + re->stash = NULL; - /* Store our private object */ - rx->pprivate = obj; + /* Store the default exec callback (which may be NULL) into the regexp + * object. */ + re->cb_exec = h->exec; + SvREFCNT_inc_simple_void(h->exec); - /* Store the pattern for ->pattern */ - re->pattern = (SV*)pattern; - SvREFCNT_inc_simple_void(re->pattern); + /* Same goes for the free callback. */ + re->cb_free = h->free; + SvREFCNT_inc_simple_void(h->free); - /* If there's an exec callback, store it into the private object so - * that it will be the one to be called, even if the engine changes - * in between */ - if (h->exec) { - re->cb_exec = h->exec; - SvREFCNT_inc_simple_void_NN(h->exec); - } + re->cb_num_capture_buff_FETCH = NULL; + re->cb_num_capture_buff_STORE = NULL; + re->cb_num_capture_buff_LENGTH = NULL; - re->cb_num_capture_buff_FETCH = NULL; - re->cb_num_capture_buff_STORE = NULL; - re->cb_num_capture_buff_LENGTH = NULL; + /* Call our callback function if one was defined, if not we've already set up + * all the stuff we're going to to need for subsequent exec and other calls */ + if (h->comp) { + dSP; - /* Call our callback function if one was defined, if not we've - * already set up all the stuff we're going to to need for - * subsequent exec and other calls */ - if (h->comp) { - ENTER; - SAVETMPS; + ENTER; + SAVETMPS; - PUSHMARK(SP); - XPUSHs(obj); - PUTBACK; + PUSHMARK(SP); + XPUSHs(obj); + PUTBACK; - call_sv(h->comp, G_DISCARD); + call_sv(h->comp, G_DISCARD); - FREETMPS; - LEAVE; - } - - /* If any of the comp-time accessors were called we'll have to - * update the regexp struct with the new info. - */ + FREETMPS; + LEAVE; + } - Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair); + /* If any of the comp-time accessors were called we'll have to + * update the regexp struct with the new info */ + Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair); - return RX; + return RX; } I32 Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend, - char *strbeg, I32 minend, SV *sv, void *data, U32 flags) + char *strbeg, REP_ENG_EXEC_MINEND_TYPE minend, + SV *sv, void *data, U32 flags) { - dSP; - I32 matched; - struct regexp *rx = rxREGEXP(RX); - GET_SELF_FROM_PPRIVATE(rx->pprivate); + struct regexp *rx; + re__engine__Plugin self; + I32 matched; - if (self->cb_exec) { - SV *ret; + rx = rxREGEXP(RX); + SELF_FROM_PPRIVATE(self, rx->pprivate); - /* Store the current str for ->str */ - SvREFCNT_dec(self->str); - self->str = sv; - SvREFCNT_inc_simple_void(self->str); + if (self->cb_exec) { + SV *ret; + dSP; - ENTER; - SAVETMPS; + /* Store the current str for ->str */ + SvREFCNT_dec(self->str); + self->str = sv; + SvREFCNT_inc_simple_void(self->str); - PUSHMARK(SP); - XPUSHs(rx->pprivate); - XPUSHs(sv); - PUTBACK; + ENTER; + SAVETMPS; - call_sv(self->cb_exec, G_SCALAR); + PUSHMARK(SP); + XPUSHs(rx->pprivate); + XPUSHs(sv); + PUTBACK; - SPAGAIN; + call_sv(self->cb_exec, G_SCALAR); - ret = POPs; - if (SvTRUE(ret)) - matched = 1; - else - matched = 0; + SPAGAIN; - PUTBACK; - FREETMPS; - LEAVE; - } else { - matched = 0; - } + ret = POPs; + if (SvTRUE(ret)) + matched = 1; + else + matched = 0; - return matched; + PUTBACK; + FREETMPS; + LEAVE; + } else { + matched = 0; + } + + return matched; } char * +#if XSH_HAS_PERL(5, 19, 1) +Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, const char * const strbeg, + char *strpos, char *strend, U32 flags, re_scream_pos_data *data) +#else Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, char *strpos, - char *strend, U32 flags, re_scream_pos_data *data) + char *strend, U32 flags, re_scream_pos_data *data) +#endif { - PERL_UNUSED_ARG(RX); - PERL_UNUSED_ARG(sv); - PERL_UNUSED_ARG(strpos); - PERL_UNUSED_ARG(strend); - PERL_UNUSED_ARG(flags); - PERL_UNUSED_ARG(data); - return NULL; + PERL_UNUSED_ARG(RX); + PERL_UNUSED_ARG(sv); +#if XSH_HAS_PERL(5, 19, 1) + PERL_UNUSED_ARG(strbeg); +#endif + PERL_UNUSED_ARG(strpos); + PERL_UNUSED_ARG(strend); + PERL_UNUSED_ARG(flags); + PERL_UNUSED_ARG(data); + + return NULL; } SV * Plugin_checkstr(pTHX_ REGEXP * const RX) { - PERL_UNUSED_ARG(RX); - return NULL; + PERL_UNUSED_ARG(RX); + + return NULL; } void Plugin_free(pTHX_ REGEXP * const RX) { - struct regexp *rx; - re__engine__Plugin self; + struct regexp *rx; + re__engine__Plugin self; + SV *callback; - if (PL_dirty) - return; + if (PL_dirty) + return; - rx = rxREGEXP(RX); - SELF_FROM_PPRIVATE(self, rx->pprivate); + rx = rxREGEXP(RX); + SELF_FROM_PPRIVATE(self, rx->pprivate); - SvREFCNT_dec(self->pattern); - SvREFCNT_dec(self->str); + callback = self->cb_free; - SvREFCNT_dec(self->cb_exec); + if (callback) { + dSP; - SvREFCNT_dec(self->cb_num_capture_buff_FETCH); - SvREFCNT_dec(self->cb_num_capture_buff_STORE); - SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); + ENTER; + SAVETMPS; - self->rx = NULL; - Safefree(self); + PUSHMARK(SP); + XPUSHs(rx->pprivate); + PUTBACK; -/* - dSP; - SV * callback; + call_sv(callback, G_DISCARD); - callback = self->cb_free; + PUTBACK; + FREETMPS; + LEAVE; + } + + SvREFCNT_dec(self->pattern); + SvREFCNT_dec(self->str); + SvREFCNT_dec(self->stash); + + SvREFCNT_dec(self->cb_exec); - if (callback) { - ENTER; - SAVETMPS; + SvREFCNT_dec(self->cb_num_capture_buff_FETCH); + SvREFCNT_dec(self->cb_num_capture_buff_STORE); + SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); - PUSHMARK(SP); - XPUSHs(rx->pprivate); - PUTBACK; + self->rx = NULL; - call_sv(callback, G_DISCARD); + Safefree(self); - PUTBACK; - FREETMPS; - LEAVE; - } - return; -*/ + SvREFCNT_dec(rx->pprivate); + + return; } void * Plugin_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param) { - struct regexp *rx = rxREGEXP(RX); - Perl_croak(aTHX_ "dupe not supported yet"); - return rx->pprivate; + struct regexp *rx = rxREGEXP(RX); + + Perl_croak(aTHX_ "dupe not supported yet"); + + return rx->pprivate; } @@ -618,173 +427,153 @@ void Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren, SV * const sv) { - dSP; - I32 items; - SV * callback; - struct regexp *rx = rxREGEXP(RX); - GET_SELF_FROM_PPRIVATE(rx->pprivate); - - callback = self->cb_num_capture_buff_FETCH; - - if (callback) { - ENTER; - SAVETMPS; - - PUSHMARK(SP); - XPUSHs(rx->pprivate); - XPUSHs(sv_2mortal(newSViv(paren))); - PUTBACK; - - items = call_sv(callback, G_SCALAR); - - if (items == 1) { - SV *ret; - - SPAGAIN; - ret = POPs; - sv_setsv(sv, ret); - } else { - sv_setsv(sv, &PL_sv_undef); - } - - PUTBACK; - FREETMPS; - LEAVE; - } else { - sv_setsv(sv, &PL_sv_undef); - } + struct regexp *rx; + re__engine__Plugin self; + SV *callback; + + rx = rxREGEXP(RX); + SELF_FROM_PPRIVATE(self, rx->pprivate); + + callback = self->cb_num_capture_buff_FETCH; + + if (callback) { + I32 items; + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(rx->pprivate); + mXPUSHi(paren); + PUTBACK; + + items = call_sv(callback, G_SCALAR); + + if (items == 1) { + SV *ret; + SPAGAIN; + ret = POPs; + sv_setsv(sv, ret); + } else { + sv_setsv(sv, &PL_sv_undef); + } + + PUTBACK; + FREETMPS; + LEAVE; + } else { + sv_setsv(sv, &PL_sv_undef); + } } void Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren, SV const * const value) { - dSP; - SV * callback; - struct regexp *rx = rxREGEXP(RX); - GET_SELF_FROM_PPRIVATE(rx->pprivate); + struct regexp *rx; + re__engine__Plugin self; + SV *callback; + + rx = rxREGEXP(RX); + SELF_FROM_PPRIVATE(self, rx->pprivate); + + callback = self->cb_num_capture_buff_STORE; - callback = self->cb_num_capture_buff_STORE; + if (callback) { + dSP; - if (callback) { - ENTER; - SAVETMPS; + ENTER; + SAVETMPS; - PUSHMARK(SP); - XPUSHs(rx->pprivate); - XPUSHs(sv_2mortal(newSViv(paren))); - XPUSHs((SV *) value); - PUTBACK; + PUSHMARK(SP); + XPUSHs(rx->pprivate); + mXPUSHi(paren); + XPUSHs((SV *) value); + PUTBACK; - call_sv(callback, G_DISCARD); + call_sv(callback, G_DISCARD); - PUTBACK; - FREETMPS; - LEAVE; - } + PUTBACK; + FREETMPS; + LEAVE; + } } I32 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv, - const I32 paren) + const I32 paren) { - dSP; - SV * callback; - struct regexp *rx = rxREGEXP(RX); - GET_SELF_FROM_PPRIVATE(rx->pprivate); + struct regexp *rx; + re__engine__Plugin self; + SV *callback; - callback = self->cb_num_capture_buff_LENGTH; + rx = rxREGEXP(RX); + SELF_FROM_PPRIVATE(self, rx->pprivate); - if (callback) { - IV ret; + callback = self->cb_num_capture_buff_LENGTH; - ENTER; - SAVETMPS; + if (callback) { + IV ret; + dSP; - PUSHMARK(SP); - XPUSHs(rx->pprivate); - XPUSHs(sv_2mortal(newSViv(paren))); - PUTBACK; + ENTER; + SAVETMPS; - call_sv(callback, G_SCALAR); + PUSHMARK(SP); + XPUSHs(rx->pprivate); + mXPUSHi(paren); + PUTBACK; - SPAGAIN; + call_sv(callback, G_SCALAR); - ret = POPi; + SPAGAIN; - PUTBACK; - FREETMPS; - LEAVE; + ret = POPi; - return (I32)ret; - } else { - /* TODO: call FETCH and get the length on that value */ - return 0; - } -} + PUTBACK; + FREETMPS; + LEAVE; + return (I32) ret; + } else { + /* TODO: call FETCH and get the length on that value */ + return 0; + } +} -SV* -Plugin_named_buff (pTHX_ REGEXP * const RX, SV * const key, SV * const value, - const U32 flags) +SV * +Plugin_named_buff(pTHX_ REGEXP * const RX, SV * const key, SV * const value, + const U32 flags) { - return NULL; + return NULL; } -SV* -Plugin_named_buff_iter (pTHX_ REGEXP * const RX, const SV * const lastkey, - const U32 flags) +SV * +Plugin_named_buff_iter(pTHX_ REGEXP * const RX, const SV * const lastkey, + const U32 flags) { - return NULL; + return NULL; } -SV* +SV * Plugin_package(pTHX_ REGEXP * const RX) { - PERL_UNUSED_ARG(RX); - return newSVpvs("re::engine::Plugin"); -} - -#if REP_THREADSAFE - -STATIC U32 rep_initialized = 0; - -STATIC void rep_teardown(pTHX_ void *root) { - if (!rep_initialized || aTHX != root) - return; + PERL_UNUSED_ARG(RX); - { - dMY_CXT; - ptable_free(MY_CXT.tbl); - } - - rep_initialized = 0; + return newSVpvs(XSH_PACKAGE); } -STATIC void rep_setup(pTHX) { -#define rep_setup() rep_setup(aTHX) - if (rep_initialized) - return; - - { - MY_CXT_INIT; - MY_CXT.tbl = ptable_new(); - MY_CXT.owner = aTHX; - } +static void xsh_user_global_setup(pTHX) { + HV *stash; - call_atexit(rep_teardown, aTHX); + stash = gv_stashpvn(XSH_PACKAGE, XSH_PACKAGE_LEN, 1); + newCONSTSUB(stash, "REP_THREADSAFE", newSVuv(XSH_THREADSAFE)); + newCONSTSUB(stash, "REP_FORKSAFE", newSVuv(XSH_FORKSAFE)); - rep_initialized = 1; + return; } -#else /* REP_THREADSAFE */ - -#define rep_setup() - -#endif /* !REP_THREADSAFE */ - -STATIC U32 rep_booted = 0; - /* --- XS ------------------------------------------------------------------ */ MODULE = re::engine::Plugin PACKAGE = re::engine::Plugin @@ -793,196 +582,173 @@ PROTOTYPES: DISABLE BOOT: { - if (!rep_booted++) { - HV *stash; - - PERL_HASH(rep_hash, __PACKAGE__, __PACKAGE_LEN__); - - stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1); - newCONSTSUB(stash, "REP_THREADSAFE", newSVuv(REP_THREADSAFE)); - newCONSTSUB(stash, "REP_FORKSAFE", newSVuv(REP_FORKSAFE)); - } - - rep_setup(); + xsh_setup(); } -#if REP_THREADSAFE +#if XSH_THREADSAFE void CLONE(...) -PREINIT: - ptable *t; - GV *gv; -PPCODE: - { - rep_ptable_clone_ud ud; - dMY_CXT; - - t = ptable_new(); - rep_ptable_clone_ud_init(ud, t, MY_CXT.owner); - ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud); - rep_ptable_clone_ud_deinit(ud); - } - { - MY_CXT_CLONE; - MY_CXT.tbl = t; - MY_CXT.owner = aTHX; - } - gv = gv_fetchpv(__PACKAGE__ "::_THREAD_CLEANUP", 0, SVt_PVCV); - if (gv) { - CV *cv = GvCV(gv); - if (!PL_endav) - PL_endav = newAV(); - SvREFCNT_inc(cv); - if (!av_store(PL_endav, av_len(PL_endav) + 1, (SV *) cv)) - SvREFCNT_dec(cv); - sv_magicext((SV *) PL_endav, NULL, PERL_MAGIC_ext, &rep_endav_vtbl, NULL, 0); - } - XSRETURN(0); - -void -_THREAD_CLEANUP(...) -PROTOTYPE: DISABLE PPCODE: - rep_thread_cleanup(aTHX_ NULL); - XSRETURN(0); + xsh_clone(); + XSRETURN(0); -#endif /* REP_THREADSAFE */ +#endif /* XSH_THREADSAFE */ void pattern(re::engine::Plugin self, ...) PPCODE: - XPUSHs(self->pattern); + XPUSHs(self->pattern); + XSRETURN(1); void str(re::engine::Plugin self, ...) PPCODE: - XPUSHs(self->str); + XPUSHs(self->str); + XSRETURN(1); void mod(re::engine::Plugin self) PREINIT: - U32 flags; - char mods[5 + 1]; - int n = 0, i; + U32 flags; + char mods[5 + 1]; + int n = 0, i; PPCODE: - flags = self->rx->intflags; - if (flags & PMf_FOLD) /* /i */ - mods[n++] = 'i'; - if (flags & PMf_MULTILINE) /* /m */ - mods[n++] = 'm'; - if (flags & PMf_SINGLELINE) /* /s */ - mods[n++] = 's'; - if (flags & PMf_EXTENDED) /* /x */ - mods[n++] = 'x'; - if (flags & RXf_PMf_KEEPCOPY) /* /p */ - mods[n++] = 'p'; - mods[n] = '\0'; - EXTEND(SP, 2 * n); - for (i = 0; i < n; ++i) { - mPUSHp(mods + i, 1); - PUSHs(&PL_sv_yes); - } - XSRETURN(2 * n); + flags = self->rx->intflags; + if (flags & PMf_FOLD) /* /i */ + mods[n++] = 'i'; + if (flags & PMf_MULTILINE) /* /m */ + mods[n++] = 'm'; + if (flags & PMf_SINGLELINE) /* /s */ + mods[n++] = 's'; + if (flags & PMf_EXTENDED) /* /x */ + mods[n++] = 'x'; + if (flags & RXf_PMf_KEEPCOPY) /* /p */ + mods[n++] = 'p'; + mods[n] = '\0'; + EXTEND(SP, 2 * n); + for (i = 0; i < n; ++i) { + mPUSHp(mods + i, 1); + PUSHs(&PL_sv_yes); + } + XSRETURN(2 * n); void stash(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - SvREFCNT_dec(self->stash); - self->stash = ST(1); - SvREFCNT_inc_simple_void(self->stash); - XSRETURN_EMPTY; - } else { - XPUSHs(self->stash); - } + if (items > 1) { + SvREFCNT_dec(self->stash); + self->stash = ST(1); + SvREFCNT_inc_simple_void(self->stash); + XSRETURN_EMPTY; + } else { + XPUSHs(self->stash); + XSRETURN(1); + } void minlen(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - self->rx->minlen = (I32)SvIV(ST(1)); - XSRETURN_EMPTY; - } else { - if (self->rx->minlen) { - XPUSHs(sv_2mortal(newSViv(self->rx->minlen))); - } else { - XPUSHs(sv_2mortal(&PL_sv_undef)); - } - } + if (items > 1) { + self->rx->minlen = (I32)SvIV(ST(1)); + XSRETURN_EMPTY; + } else if (self->rx->minlen) { + mXPUSHi(self->rx->minlen); + XSRETURN(1); + } else { + XSRETURN_UNDEF; + } void gofs(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - self->rx->gofs = (U32)SvIV(ST(1)); - XSRETURN_EMPTY; - } else { - if (self->rx->gofs) { - XPUSHs(sv_2mortal(newSVuv(self->rx->gofs))); - } else { - XPUSHs(sv_2mortal(&PL_sv_undef)); - } - } + if (items > 1) { + self->rx->gofs = (U32)SvIV(ST(1)); + XSRETURN_EMPTY; + } else if (self->rx->gofs) { + mXPUSHu(self->rx->gofs); + XSRETURN(1); + } else { + XSRETURN_UNDEF; + } void nparens(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - self->rx->nparens = (U32)SvIV(ST(1)); - XSRETURN_EMPTY; - } else { - if (self->rx->nparens) { - XPUSHs(sv_2mortal(newSVuv(self->rx->nparens))); - } else { - XPUSHs(sv_2mortal(&PL_sv_undef)); - } - } + if (items > 1) { + self->rx->nparens = (U32)SvIV(ST(1)); + XSRETURN_EMPTY; + } else if (self->rx->nparens) { + mXPUSHu(self->rx->nparens); + XSRETURN(1); + } else { + XSRETURN_UNDEF; + } void _exec(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - SvREFCNT_dec(self->cb_exec); - self->cb_exec = ST(1); - SvREFCNT_inc_simple_void(self->cb_exec); - } + if (items > 1) { + SvREFCNT_dec(self->cb_exec); + self->cb_exec = ST(1); + SvREFCNT_inc_simple_void(self->cb_exec); + } + XSRETURN(0); + +void +_free(re::engine::Plugin self, ...) +PPCODE: + if (items > 1) { + SvREFCNT_dec(self->cb_free); + self->cb_free = ST(1); + SvREFCNT_inc_simple_void(self->cb_free); + } + XSRETURN(0); void _num_capture_buff_FETCH(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - SvREFCNT_dec(self->cb_num_capture_buff_FETCH); - self->cb_num_capture_buff_FETCH = ST(1); - SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH); - } + if (items > 1) { + SvREFCNT_dec(self->cb_num_capture_buff_FETCH); + self->cb_num_capture_buff_FETCH = ST(1); + SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH); + } + XSRETURN(0); void _num_capture_buff_STORE(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - SvREFCNT_dec(self->cb_num_capture_buff_STORE); - self->cb_num_capture_buff_STORE = ST(1); - SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE); - } + if (items > 1) { + SvREFCNT_dec(self->cb_num_capture_buff_STORE); + self->cb_num_capture_buff_STORE = ST(1); + SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE); + } + XSRETURN(0); void _num_capture_buff_LENGTH(re::engine::Plugin self, ...) PPCODE: - if (items > 1) { - SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); - self->cb_num_capture_buff_LENGTH = ST(1); - SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH); - } + if (items > 1) { + SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); + self->cb_num_capture_buff_LENGTH = ST(1); + SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH); + } + XSRETURN(0); SV * -_tag(SV *comp, SV *exec) +_tag(SV *comp, SV *exec, SV *free) +PREINIT: + xsh_hints_user_t arg; CODE: - RETVAL = rep_tag(comp, exec); + arg.comp = comp; + arg.exec = exec; + arg.free = free; + RETVAL = xsh_hints_tag(&arg); OUTPUT: - RETVAL + RETVAL void ENGINE() PPCODE: - XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin)))); + mXPUSHi(PTR2IV(&engine_plugin)); + XSRETURN(1);