1 /* This file is part of the re::engine::Plugin Perl module.
2 * See http://search.cpan.org/dist/re-engine-Plugin/ */
4 #define PERL_NO_GET_CONTEXT
9 /* --- Helpers ------------------------------------------------------------- */
11 #define XSH_PACKAGE "re::engine::Plugin"
16 /* ... Lexical hints ....................................................... */
24 static SV *rep_validate_callback(SV *code) {
29 if (SvTYPE(code) < SVt_PVCV)
32 return SvREFCNT_inc_simple_NN(code);
35 static void xsh_hints_user_init(pTHX_ xsh_hints_user_t *hv, xsh_hints_user_t *v) {
36 hv->comp = rep_validate_callback(v->comp);
37 hv->exec = rep_validate_callback(v->exec);
38 hv->free = rep_validate_callback(v->free);
45 static void xsh_hints_user_clone(pTHX_ xsh_hints_user_t *nv, xsh_hints_user_t *ov, CLONE_PARAMS *params) {
46 nv->comp = xsh_dup_inc(ov->comp, params);
47 nv->exec = xsh_dup_inc(ov->exec, params);
48 nv->free = xsh_dup_inc(ov->free, params);
53 #endif /* XSH_THREADSAFE */
55 static void xsh_hints_user_deinit(pTHX_ xsh_hints_user_t *hv) {
56 SvREFCNT_dec(hv->comp);
57 SvREFCNT_dec(hv->exec);
58 SvREFCNT_dec(hv->free);
63 #define rep_hint() xsh_hints_detag(xsh_hints_fetch())
65 #define XSH_HINTS_TYPE_USER 1
66 #define XSH_HINTS_ONLY_COMPILE_TIME 0
68 #include "xsh/hints.h"
70 /* ... Thread-local storage ................................................ */
72 #define XSH_THREADS_USER_CONTEXT 0
73 #define XSH_THREADS_USER_LOCAL_SETUP 0
74 #define XSH_THREADS_USER_LOCAL_TEARDOWN 0
75 #define XSH_THREADS_USER_GLOBAL_TEARDOWN 0
76 #define XSH_THREADS_COMPILE_TIME_PROTECTION 0
78 #include "xsh/threads.h"
80 /* --- Custom regexp engine ------------------------------------------------ */
82 /* re__engine__Plugin self; SELF_FROM_PPRIVATE(self,rx->pprivate) */
83 #define SELF_FROM_PPRIVATE(self, pprivate) \
84 if (sv_isobject(pprivate)) { \
85 SV *ref = SvRV((SV *) pprivate); \
86 IV tmp = SvIV((SV *) ref); \
87 self = INT2PTR(re__engine__Plugin, tmp); \
89 Perl_croak(aTHX_ "Not an object"); \
92 #if XSH_HAS_PERL(5, 19, 4)
93 # define REP_ENG_EXEC_MINEND_TYPE SSize_t
95 # define REP_ENG_EXEC_MINEND_TYPE I32
99 EXTERN_C const regexp_engine engine_plugin;
100 #if XSH_HAS_PERL(5, 11, 0)
101 EXTERN_C REGEXP * Plugin_comp(pTHX_ SV * const, U32);
103 EXTERN_C REGEXP * Plugin_comp(pTHX_ const SV * const, const U32);
105 EXTERN_C I32 Plugin_exec(pTHX_ REGEXP * const, char *, char *,
106 char *, REP_ENG_EXEC_MINEND_TYPE, SV *, void *, U32);
107 #if XSH_HAS_PERL(5, 19, 1)
108 EXTERN_C char * Plugin_intuit(pTHX_ REGEXP * const, SV *, const char * const,
109 char *, char *, U32, re_scream_pos_data *);
111 EXTERN_C char * Plugin_intuit(pTHX_ REGEXP * const, SV *, char *,
112 char *, U32, re_scream_pos_data *);
114 EXTERN_C SV * Plugin_checkstr(pTHX_ REGEXP * const);
115 EXTERN_C void Plugin_free(pTHX_ REGEXP * const);
116 EXTERN_C void * Plugin_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *);
117 EXTERN_C void Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const,
118 const I32, SV * const);
119 EXTERN_C void Plugin_numbered_buff_STORE(pTHX_ REGEXP * const,
120 const I32, SV const * const);
121 EXTERN_C I32 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const,
122 const SV * const, const I32);
123 EXTERN_C SV * Plugin_named_buff(pTHX_ REGEXP * const, SV * const,
124 SV * const, const U32);
125 EXTERN_C SV * Plugin_named_buff_iter(pTHX_ REGEXP * const, const SV * const,
127 EXTERN_C SV * Plugin_package(pTHX_ REGEXP * const);
129 EXTERN_C void * Plugin_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *);
132 EXTERN_C const regexp_engine engine_plugin;
135 #define RE_ENGINE_PLUGIN (&engine_plugin)
136 const regexp_engine engine_plugin = {
142 Plugin_numbered_buff_FETCH,
143 Plugin_numbered_buff_STORE,
144 Plugin_numbered_buff_LENGTH,
146 Plugin_named_buff_iter,
148 #if defined(USE_ITHREADS)
151 #if XSH_HAS_PERL(5, 17, 0)
156 typedef struct replug {
157 /* Pointer back to the containing regexp struct so that accessors
158 * can modify nparens, gofs, etc... */
161 /* A copy of the pattern given to comp, for ->pattern */
164 /* A copy of the string being matched against, for ->str */
175 SV *cb_num_capture_buff_FETCH;
176 SV *cb_num_capture_buff_STORE;
177 SV *cb_num_capture_buff_LENGTH;
178 } *re__engine__Plugin;
180 #if XSH_HAS_PERL(5, 11, 0)
181 # define rxREGEXP(RX) (SvANY(RX))
182 # define newREGEXP(RX) ((RX) = ((REGEXP *) newSV_type(SVt_REGEXP)))
184 # define rxREGEXP(RX) (RX)
185 # define newREGEXP(RX) (Newxz((RX), 1, struct regexp))
189 #if XSH_HAS_PERL(5, 11, 0)
190 Plugin_comp(pTHX_ SV * const pattern, U32 flags)
192 Plugin_comp(pTHX_ const SV * const pattern, const U32 flags)
199 re__engine__Plugin re;
200 const xsh_hints_user_t *h;
208 if (!h) /* This looks like a pragma leak. Apply the default behaviour */
209 return re_compile(pattern, flags);
211 /* exp/xend version of the pattern & length */
212 pbuf = SvPV((SV *) pattern, plen);
214 /* Our blessed object */
216 Newxz(re, 1, struct replug);
217 sv_setref_pv(obj, XSH_PACKAGE, (void *) re);
222 re->rx = rx; /* Make the rx accessible from self->rx */
223 rx->intflags = flags; /* Flags for internal use */
224 rx->extflags = flags; /* Flags for perl to use */
225 rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */
227 #if !XSH_HAS_PERL(5, 11, 0)
228 rx->refcnt = 1; /* Refcount so we won't be destroyed */
230 /* Precompiled pattern for pp_regcomp to use */
232 rx->precomp = savepvn(pbuf, rx->prelen);
234 /* Set up qr// stringification to be equivalent to the supplied
235 * pattern, this should be done via overload eventually */
236 rx->wraplen = rx->prelen;
237 Newx(rx->wrapped, rx->wraplen, char);
238 Copy(rx->precomp, rx->wrapped, rx->wraplen, char);
241 /* Store our private object */
244 /* Store the pattern for ->pattern */
245 re->pattern = (SV *) pattern;
246 SvREFCNT_inc_simple_void(re->pattern);
248 /* If there's an exec callback, store it into the private object so that it
249 * will be the one to be called, even if the engine changes in between */
251 re->cb_exec = h->exec;
252 SvREFCNT_inc_simple_void_NN(h->exec);
255 /* Same goes for the free callback, if there's one. */
257 re->cb_free = h->free;
258 SvREFCNT_inc_simple_void_NN(h->free);
261 re->cb_num_capture_buff_FETCH = NULL;
262 re->cb_num_capture_buff_STORE = NULL;
263 re->cb_num_capture_buff_LENGTH = NULL;
265 /* Call our callback function if one was defined, if not we've already set up
266 * all the stuff we're going to to need for subsequent exec and other calls */
275 call_sv(h->comp, G_DISCARD);
281 /* If any of the comp-time accessors were called we'll have to
282 * update the regexp struct with the new info */
283 Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair);
289 Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
290 char *strbeg, REP_ENG_EXEC_MINEND_TYPE minend,
291 SV *sv, void *data, U32 flags)
294 re__engine__Plugin self;
298 SELF_FROM_PPRIVATE(self, rx->pprivate);
304 /* Store the current str for ->str */
305 SvREFCNT_dec(self->str);
307 SvREFCNT_inc_simple_void(self->str);
313 XPUSHs(rx->pprivate);
317 call_sv(self->cb_exec, G_SCALAR);
338 #if XSH_HAS_PERL(5, 19, 1)
339 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, const char * const strbeg,
340 char *strpos, char *strend, U32 flags, re_scream_pos_data *data)
342 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, char *strpos,
343 char *strend, U32 flags, re_scream_pos_data *data)
348 #if XSH_HAS_PERL(5, 19, 1)
349 PERL_UNUSED_ARG(strbeg);
351 PERL_UNUSED_ARG(strpos);
352 PERL_UNUSED_ARG(strend);
353 PERL_UNUSED_ARG(flags);
354 PERL_UNUSED_ARG(data);
360 Plugin_checkstr(pTHX_ REGEXP * const RX)
368 Plugin_free(pTHX_ REGEXP * const RX)
371 re__engine__Plugin self;
379 SELF_FROM_PPRIVATE(self, rx->pprivate);
381 callback = self->cb_free;
388 XPUSHs(rx->pprivate);
391 call_sv(callback, G_DISCARD);
398 SvREFCNT_dec(self->pattern);
399 SvREFCNT_dec(self->str);
400 SvREFCNT_dec(self->stash);
402 SvREFCNT_dec(self->cb_exec);
404 SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
405 SvREFCNT_dec(self->cb_num_capture_buff_STORE);
406 SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
412 SvREFCNT_dec(rx->pprivate);
418 Plugin_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param)
420 struct regexp *rx = rxREGEXP(RX);
422 Perl_croak(aTHX_ "dupe not supported yet");
429 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
433 re__engine__Plugin self;
437 SELF_FROM_PPRIVATE(self, rx->pprivate);
439 callback = self->cb_num_capture_buff_FETCH;
449 XPUSHs(rx->pprivate);
453 items = call_sv(callback, G_SCALAR);
461 sv_setsv(sv, &PL_sv_undef);
468 sv_setsv(sv, &PL_sv_undef);
473 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren,
474 SV const * const value)
477 re__engine__Plugin self;
481 SELF_FROM_PPRIVATE(self, rx->pprivate);
483 callback = self->cb_num_capture_buff_STORE;
492 XPUSHs(rx->pprivate);
494 XPUSHs((SV *) value);
497 call_sv(callback, G_DISCARD);
506 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
510 re__engine__Plugin self;
514 SELF_FROM_PPRIVATE(self, rx->pprivate);
516 callback = self->cb_num_capture_buff_LENGTH;
526 XPUSHs(rx->pprivate);
530 call_sv(callback, G_SCALAR);
542 /* TODO: call FETCH and get the length on that value */
548 Plugin_named_buff(pTHX_ REGEXP * const RX, SV * const key, SV * const value,
555 Plugin_named_buff_iter(pTHX_ REGEXP * const RX, const SV * const lastkey,
562 Plugin_package(pTHX_ REGEXP * const RX)
566 return newSVpvs(XSH_PACKAGE);
569 static void xsh_user_global_setup(pTHX) {
572 stash = gv_stashpvn(XSH_PACKAGE, XSH_PACKAGE_LEN, 1);
573 newCONSTSUB(stash, "REP_THREADSAFE", newSVuv(XSH_THREADSAFE));
574 newCONSTSUB(stash, "REP_FORKSAFE", newSVuv(XSH_FORKSAFE));
579 /* --- XS ------------------------------------------------------------------ */
581 MODULE = re::engine::Plugin PACKAGE = re::engine::Plugin
598 #endif /* XSH_THREADSAFE */
601 pattern(re::engine::Plugin self, ...)
603 XPUSHs(self->pattern);
607 str(re::engine::Plugin self, ...)
613 mod(re::engine::Plugin self)
619 flags = self->rx->intflags;
620 if (flags & PMf_FOLD) /* /i */
622 if (flags & PMf_MULTILINE) /* /m */
624 if (flags & PMf_SINGLELINE) /* /s */
626 if (flags & PMf_EXTENDED) /* /x */
628 if (flags & RXf_PMf_KEEPCOPY) /* /p */
632 for (i = 0; i < n; ++i) {
639 stash(re::engine::Plugin self, ...)
642 SvREFCNT_dec(self->stash);
644 SvREFCNT_inc_simple_void(self->stash);
652 minlen(re::engine::Plugin self, ...)
655 self->rx->minlen = (I32)SvIV(ST(1));
657 } else if (self->rx->minlen) {
658 mXPUSHi(self->rx->minlen);
665 gofs(re::engine::Plugin self, ...)
668 self->rx->gofs = (U32)SvIV(ST(1));
670 } else if (self->rx->gofs) {
671 mXPUSHu(self->rx->gofs);
678 nparens(re::engine::Plugin self, ...)
681 self->rx->nparens = (U32)SvIV(ST(1));
683 } else if (self->rx->nparens) {
684 mXPUSHu(self->rx->nparens);
691 _exec(re::engine::Plugin self, ...)
694 SvREFCNT_dec(self->cb_exec);
695 self->cb_exec = ST(1);
696 SvREFCNT_inc_simple_void(self->cb_exec);
701 _free(re::engine::Plugin self, ...)
704 SvREFCNT_dec(self->cb_free);
705 self->cb_free = ST(1);
706 SvREFCNT_inc_simple_void(self->cb_free);
711 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
714 SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
715 self->cb_num_capture_buff_FETCH = ST(1);
716 SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH);
721 _num_capture_buff_STORE(re::engine::Plugin self, ...)
724 SvREFCNT_dec(self->cb_num_capture_buff_STORE);
725 self->cb_num_capture_buff_STORE = ST(1);
726 SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE);
731 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
734 SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
735 self->cb_num_capture_buff_LENGTH = ST(1);
736 SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH);
741 _tag(SV *comp, SV *exec, SV *free)
743 xsh_hints_user_t arg;
748 RETVAL = xsh_hints_tag(&arg);
755 mXPUSHi(PTR2IV(&engine_plugin));