From: Ævar Arnfjörð Bjarmason Date: Thu, 29 Mar 2007 22:52:49 +0000 (+0000) Subject: Re: Proposed changes and to regular expression interfaces in core X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fe578d7fdd84ab0398dc36da7f84e59e1f2bb290;p=p5sagit%2Fp5-mst-13.2.git Re: Proposed changes and to regular expression interfaces in core From: "Ævar Arnfjörð Bjarmason" Message-ID: <51dd1af80703291552y1073bcb6r954b043eb68a4459@mail.gmail.com> p4raw-id: //depot/perl@30849 --- diff --git a/embed.fnc b/embed.fnc index 679b443..eb7817e 100644 --- a/embed.fnc +++ b/embed.fnc @@ -696,6 +696,7 @@ ApR |regnode*|regnext |NN regnode* p EXp |SV*|reg_named_buff_get |NN const REGEXP * const rx|NN SV* namesv|U32 flags EXp |SV*|reg_numbered_buff_get|NN const REGEXP * const rx|I32 paren|NULLOK SV* usesv +EXp |SV*|reg_qr_pkg|NN const REGEXP * const rx Ep |void |regprop |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o Ap |void |repeatcpy |NN char* to|NN const char* from|I32 len|I32 count diff --git a/embed.h b/embed.h index a41de9d..182afca 100644 --- a/embed.h +++ b/embed.h @@ -706,6 +706,7 @@ #if defined(PERL_CORE) || defined(PERL_EXT) #define reg_named_buff_get Perl_reg_named_buff_get #define reg_numbered_buff_get Perl_reg_numbered_buff_get +#define reg_qr_pkg Perl_reg_qr_pkg #endif #if defined(PERL_CORE) || defined(PERL_EXT) #define regprop Perl_regprop @@ -2949,6 +2950,7 @@ #if defined(PERL_CORE) || defined(PERL_EXT) #define reg_named_buff_get(a,b,c) Perl_reg_named_buff_get(aTHX_ a,b,c) #define reg_numbered_buff_get(a,b,c) Perl_reg_numbered_buff_get(aTHX_ a,b,c) +#define reg_qr_pkg(a) Perl_reg_qr_pkg(aTHX_ a) #endif #if defined(PERL_CORE) || defined(PERL_EXT) #define regprop(a,b,c) Perl_regprop(aTHX_ a,b,c) diff --git a/ext/re/re.xs b/ext/re/re.xs index 5ab5f7c..aa87bb6 100644 --- a/ext/re/re.xs +++ b/ext/re/re.xs @@ -24,6 +24,7 @@ extern SV* my_re_intuit_string (pTHX_ regexp *prog); extern void my_regfree (pTHX_ struct regexp* r); extern SV* my_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv); extern SV* my_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags); +extern SV* my_reg_qr_pkg(pTHX_ const REGEXP * const rx); #if defined(USE_ITHREADS) extern void* my_regdupe (pTHX_ const regexp *r, CLONE_PARAMS *param); #endif @@ -40,6 +41,7 @@ const struct regexp_engine my_reg_engine = { my_regfree, my_reg_numbered_buff_get, my_reg_named_buff_get, + my_reg_qr_pkg, #if defined(USE_ITHREADS) my_regdupe #endif diff --git a/ext/re/re_top.h b/ext/re/re_top.h index 7f53a74..39e0276 100644 --- a/ext/re/re_top.h +++ b/ext/re/re_top.h @@ -18,6 +18,7 @@ #define Perl_regdupe_internal my_regdupe #define Perl_reg_numbered_buff_get my_reg_numbered_buff_get #define Perl_reg_named_buff_get my_reg_named_buff_get +#define Perl_reg_qr_pkg my_reg_qr_pkg #define PERL_NO_GET_CONTEXT diff --git a/global.sym b/global.sym index 3ac17bc..57405d0 100644 --- a/global.sym +++ b/global.sym @@ -407,6 +407,7 @@ Perl_regexec_flags Perl_regnext Perl_reg_named_buff_get Perl_reg_numbered_buff_get +Perl_reg_qr_pkg Perl_repeatcpy Perl_rninstr Perl_rsignal diff --git a/perl.h b/perl.h index d7d4f64..452b70d 100644 --- a/perl.h +++ b/perl.h @@ -225,6 +225,8 @@ #define CALLREG_NAMEDBUF(rx,name,flags) \ CALL_FPTR((rx)->engine->named_buff_get)(aTHX_ (rx),(name),(flags)) +#define CALLREG_QRPKG(rx) \ + CALL_FPTR((rx)->engine->qr_pkg)(aTHX_ (rx)) #if defined(USE_ITHREADS) #define CALLREGDUPE(prog,param) \ diff --git a/pp_hot.c b/pp_hot.c index 9e47946..9d0cf95 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1178,12 +1178,13 @@ PP(pp_qr) { dVAR; dSP; register PMOP * const pm = cPMOP; + REGEXP * rx = PM_GETRE(pm); + SV * const pkg = CALLREG_QRPKG(rx); SV * const rv = sv_newmortal(); - SV * const sv = newSVrv(rv, "Regexp"); - regexp *re = PM_GETRE(pm); - if (re->extflags & RXf_TAINTED) + SV * const sv = newSVrv(rv, SvPV_nolen(pkg)); + if (rx->extflags & RXf_TAINTED) SvTAINTED_on(rv); - sv_magic(sv,(SV*)ReREFCNT_inc(re), PERL_MAGIC_qr,0,0); + sv_magic(sv,(SV*)ReREFCNT_inc(rx), PERL_MAGIC_qr,0,0); XPUSHs(rv); RETURN; } diff --git a/proto.h b/proto.h index a59cdd4..2fa2a0c 100644 --- a/proto.h +++ b/proto.h @@ -1902,6 +1902,9 @@ PERL_CALLCONV SV* Perl_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* nam PERL_CALLCONV SV* Perl_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv) __attribute__nonnull__(pTHX_1); +PERL_CALLCONV SV* Perl_reg_qr_pkg(pTHX_ const REGEXP * const rx) + __attribute__nonnull__(pTHX_1); + PERL_CALLCONV void Perl_regprop(pTHX_ const regexp *prog, SV* sv, const regnode* o) __attribute__nonnull__(pTHX_2) diff --git a/regcomp.c b/regcomp.c index ae9efbf..2cf97ec 100644 --- a/regcomp.c +++ b/regcomp.c @@ -4836,6 +4836,12 @@ Perl_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv) return sv; } +SV* +Perl_reg_qr_pkg(pTHX_ const REGEXP * const rx) +{ + PERL_UNUSED_ARG(rx); + return newSVpvs("Regexp"); +} /* Scans the name of a named buffer from the pattern. * If flags is REG_RSN_RETURN_NULL returns null. diff --git a/regcomp.h b/regcomp.h index a13d487..1a0916a 100644 --- a/regcomp.h +++ b/regcomp.h @@ -453,13 +453,14 @@ EXTCONST U8 PL_simple[] = { EXTCONST regexp_engine PL_core_reg_engine; #else /* DOINIT */ EXTCONST regexp_engine PL_core_reg_engine = { - Perl_re_compile, + Perl_re_compile, Perl_regexec_flags, Perl_re_intuit_start, Perl_re_intuit_string, Perl_regfree_internal, Perl_reg_numbered_buff_get, Perl_reg_named_buff_get, + Perl_reg_qr_pkg, #if defined(USE_ITHREADS) Perl_regdupe_internal #endif diff --git a/regexp.h b/regexp.h index fb723b3..a833c6b 100644 --- a/regexp.h +++ b/regexp.h @@ -123,6 +123,7 @@ typedef struct regexp_engine { void (*free) (pTHX_ struct regexp* r); SV* (*numbered_buff_get) (pTHX_ const REGEXP * const rx, I32 paren, SV* usesv); SV* (*named_buff_get)(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags); + SV* (*qr_pkg)(pTHX_ const REGEXP * const rx); #ifdef USE_ITHREADS void* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param); #endif