X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2Fre%2Fre.xs;h=b4d3e34c4a11c1ae7a7efd687a87c7ba7edd1cc8;hb=e9d185f8391f09209c11be82e97358d853f1ba30;hp=f12ce39811ccbb16f964e66c91139d0b74b3d24a;hpb=256ddcd0907fa1fc11538ea1a70ff79ba0167b40;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/re/re.xs b/ext/re/re.xs index f12ce39..b4d3e34 100644 --- a/ext/re/re.xs +++ b/ext/re/re.xs @@ -11,35 +11,56 @@ START_EXTERN_C -extern regexp* my_regcomp (pTHX_ char* exp, char* xend, PMOP* pm); -extern I32 my_regexec (pTHX_ regexp* prog, char* stringarg, char* strend, +extern REGEXP* my_re_compile (pTHX_ const SV * const pattern, const U32 pm_flags); +extern I32 my_regexec (pTHX_ REGEXP * const prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags); -extern void my_regfree (pTHX_ struct regexp* r); -extern char* my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos, - char *strend, U32 flags, + +extern char* my_re_intuit_start (pTHX_ REGEXP * const prog, SV *sv, char *strpos, + char *strend, const U32 flags, struct re_scream_pos_data_s *data); -extern SV* my_re_intuit_string (pTHX_ regexp *prog); -extern char* my_reg_stringify (pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval); +extern SV* my_re_intuit_string (pTHX_ REGEXP * const prog); + +extern void my_regfree (pTHX_ REGEXP * const r); + +extern void my_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren, + SV * const usesv); +extern void my_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren, + SV const * const value); +extern I32 my_reg_numbered_buff_length(pTHX_ REGEXP * const rx, + const SV * const sv, const I32 paren); +extern SV* my_reg_named_buff(pTHX_ REGEXP * const, SV * const, SV * const, + const U32); +extern SV* my_reg_named_buff_iter(pTHX_ REGEXP * const rx, + const SV * const lastkey, const U32 flags); + +extern SV* my_reg_qr_package(pTHX_ REGEXP * const rx); #if defined(USE_ITHREADS) -extern regexp* my_regdupe (pTHX_ const regexp *r, CLONE_PARAMS *param); +extern void* my_regdupe (pTHX_ REGEXP * const r, CLONE_PARAMS *param); #endif -EXTERN_C const struct regexp_engine my_reg_engine = { - my_regcomp, +EXTERN_C const struct regexp_engine my_reg_engine; + +END_EXTERN_C + +const struct regexp_engine my_reg_engine = { + my_re_compile, my_regexec, my_re_intuit_start, my_re_intuit_string, my_regfree, - my_reg_stringify, + my_reg_numbered_buff_fetch, + my_reg_numbered_buff_store, + my_reg_numbered_buff_length, + my_reg_named_buff, + my_reg_named_buff_iter, + my_reg_qr_package, #if defined(USE_ITHREADS) my_regdupe #endif }; -END_EXTERN_C - MODULE = re PACKAGE = re void @@ -51,33 +72,11 @@ install() void -is_regexp(sv) - SV * sv -PROTOTYPE: $ -PREINIT: - MAGIC *mg; -PPCODE: -{ - if (SvMAGICAL(sv)) - mg_get(sv); - if (SvROK(sv) && - (sv = (SV*)SvRV(sv)) && /* assign deliberate */ - SvTYPE(sv) == SVt_PVMG && - (mg = mg_find(sv, PERL_MAGIC_qr))) /* assign deliberate */ - { - XSRETURN_YES; - } else { - XSRETURN_NO; - } - /* NOTREACHED */ -} - -void regexp_pattern(sv) SV * sv PROTOTYPE: $ PREINIT: - MAGIC *mg; + REGEXP *re; PPCODE: { /* @@ -91,17 +90,10 @@ PPCODE: on the object. */ - if (SvMAGICAL(sv)) - mg_get(sv); - if (SvROK(sv) && - (sv = (SV*)SvRV(sv)) && /* assign deliberate */ - SvTYPE(sv) == SVt_PVMG && - (mg = mg_find(sv, PERL_MAGIC_qr))) /* assign deliberate */ + if ((re = SvRX(sv))) /* assign deliberate */ { - /* Housten, we have a regex! */ SV *pattern; - regexp *re = (regexp *)mg->mg_obj; STRLEN patlen = 0; STRLEN left = 0; char reflags[6]; @@ -113,19 +105,19 @@ PPCODE: modifiers" in this scenario. */ - char *fptr = "msix"; + char *fptr = INT_PAT_MODS; char ch; - U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12); + U16 match_flags = (U16)((re->extflags & PMf_COMPILETIME) >> 12); while((ch = *fptr++)) { - if(reganch & 1) { + if(match_flags & 1) { reflags[left++] = ch; } - reganch >>= 1; + match_flags >>= 1; } pattern = sv_2mortal(newSVpvn(re->precomp,re->prelen)); - if (re->reganch & ROPT_UTF8) SvUTF8_on(pattern); + if (re->extflags & RXf_UTF8) SvUTF8_on(pattern); /* return the pattern and the modifiers */ XPUSHs(pattern); @@ -133,12 +125,9 @@ PPCODE: XSRETURN(2); } else { /* Scalar, so use the string that Perl would return */ - if (!mg->mg_ptr) - CALLREG_STRINGIFY(mg,0,0); - /* return the pattern in (?msix:..) format */ - pattern = sv_2mortal(newSVpvn(mg->mg_ptr,mg->mg_len)); - if (re->reganch & ROPT_UTF8) + pattern = sv_2mortal(newSVpvn(re->wrapped,re->wraplen)); + if (re->extflags & RXf_UTF8) SvUTF8_on(pattern); XPUSHs(pattern); XSRETURN(1); @@ -172,19 +161,13 @@ regmust(sv) SV * sv PROTOTYPE: $ PREINIT: - MAGIC *mg; + REGEXP *re; PPCODE: { - if (SvMAGICAL(sv)) - mg_get(sv); - if (SvROK(sv) && - (sv = (SV*)SvRV(sv)) && /* assign deliberate */ - SvTYPE(sv) == SVt_PVMG && - (mg = mg_find(sv, PERL_MAGIC_qr))) /* assign deliberate */ + if ((re = SvRX(sv))) /* assign deliberate */ { SV *an = &PL_sv_no; SV *fl = &PL_sv_no; - regexp *re = (regexp *)mg->mg_obj; if (re->anchored_substr) { an = newSVsv(re->anchored_substr); } else if (re->anchored_utf8) { @@ -201,3 +184,4 @@ PPCODE: } XSRETURN_UNDEF; } +