summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xcflags.SH2
-rw-r--r--dump.c4
-rw-r--r--embed.fnc5
-rw-r--r--embed.h8
-rw-r--r--ext/B/B.xs8
-rw-r--r--ext/Devel/Peek/t/Peek.t5
-rw-r--r--mg.c11
-rw-r--r--perl.h7
-rw-r--r--pp_ctl.c8
-rw-r--r--pp_hot.c16
-rw-r--r--proto.h14
-rw-r--r--regcomp.c119
-rw-r--r--regcomp.h8
-rw-r--r--regexec.c80
-rw-r--r--regexp.h70
-rw-r--r--sv.c34
-rw-r--r--sv.h6
-rw-r--r--util.c2
18 files changed, 224 insertions, 183 deletions
diff --git a/cflags.SH b/cflags.SH
index 9dd6181e73..4e62f9200e 100755
--- a/cflags.SH
+++ b/cflags.SH
@@ -134,7 +134,7 @@ case "$gccversion" in
'') ;;
[12]*) ;; # gcc versions 1 (gasp!) and 2 are not good for this.
Intel*) ;; # # Is that you, Intel C++?
-*) for opt in -ansi -pedantic -std=c89 -W -Wextra -Wdeclaration-after-statement -Wendif-labels -Wc++-compat
+*) for opt in -ansi -std=c89 -W -Wextra -Wdeclaration-after-statement -Wendif-labels -Wc++-compat
do
case " $ccflags " in
*" $opt "*) ;; # Skip if already there.
diff --git a/dump.c b/dump.c
index 9010c6557e..dee5c10a04 100644
--- a/dump.c
+++ b/dump.c
@@ -1592,8 +1592,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
}
if (type == SVt_REGEXP) {
+ /* FIXME dumping
Perl_dump_indent(aTHX_ level, file, " REGEXP = 0x%"UVxf"\n",
- PTR2UV(((struct xregexp *)SvANY(sv))->xrx_regexp));
+ PTR2UV(((struct regexp *)SvANY(sv))->xrx_regexp));
+ */
}
if (type >= SVt_PVMG) {
if (type == SVt_PVMG && SvPAD_OUR(sv)) {
diff --git a/embed.fnc b/embed.fnc
index 678cf99a92..c041296261 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -437,7 +437,6 @@ dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg
p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg
p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg
p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg
-p |int |magic_freeregexp|NN SV* sv|NN MAGIC* mg
p |int |magic_freeovrld|NN SV* sv|NN MAGIC* mg
p |int |magic_get |NN SV* sv|NN MAGIC* mg
p |int |magic_getarylen|NN SV* sv|NN const MAGIC* mg
@@ -686,6 +685,7 @@ Ap |I32 |pregexec |NN REGEXP * const prog|NN char* stringarg \
|NN char* strend|NN char* strbeg|I32 minend \
|NN SV* screamer|U32 nosave
Ap |void |pregfree |NULLOK REGEXP* r
+Ap |void |pregfree2 |NN REGEXP* prog
EXp |REGEXP*|reg_temp_copy |NN REGEXP* r
Ap |void |regfree_internal|NULLOK REGEXP * const r
Ap |char * |reg_stringify |NN MAGIC *mg|NULLOK STRLEN *lp|NULLOK U32 *flags|NULLOK I32 *haseval
@@ -1085,7 +1085,8 @@ Apa |ANY* |ss_dup |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param
ApR |void* |any_dup |NULLOK void* v|NN const PerlInterpreter* proto_perl
ApR |HE* |he_dup |NULLOK const HE* e|bool shared|NN CLONE_PARAMS* param
ApR |HEK* |hek_dup |NULLOK HEK* e|NN CLONE_PARAMS* param
-ApR |REGEXP*|re_dup |NULLOK const REGEXP* r|NN CLONE_PARAMS* param
+Ap |void |re_dup_guts |NN const REGEXP *sstr|NN REGEXP *dstr \
+ |NN CLONE_PARAMS* param
Ap |PerlIO*|fp_dup |NULLOK PerlIO* fp|char type|NN CLONE_PARAMS* param
ApR |DIR* |dirp_dup |NULLOK DIR* dp
ApR |GP* |gp_dup |NULLOK GP* gp|NN CLONE_PARAMS* param
diff --git a/embed.h b/embed.h
index ed58cc1e40..ba248710a6 100644
--- a/embed.h
+++ b/embed.h
@@ -409,7 +409,6 @@
#define magic_clearpack Perl_magic_clearpack
#define magic_clearsig Perl_magic_clearsig
#define magic_existspack Perl_magic_existspack
-#define magic_freeregexp Perl_magic_freeregexp
#define magic_freeovrld Perl_magic_freeovrld
#define magic_get Perl_magic_get
#define magic_getarylen Perl_magic_getarylen
@@ -682,6 +681,7 @@
#define regclass_swash Perl_regclass_swash
#define pregexec Perl_pregexec
#define pregfree Perl_pregfree
+#define pregfree2 Perl_pregfree2
#if defined(PERL_CORE) || defined(PERL_EXT)
#define reg_temp_copy Perl_reg_temp_copy
#endif
@@ -1081,7 +1081,7 @@
#define any_dup Perl_any_dup
#define he_dup Perl_he_dup
#define hek_dup Perl_hek_dup
-#define re_dup Perl_re_dup
+#define re_dup_guts Perl_re_dup_guts
#define fp_dup Perl_fp_dup
#define dirp_dup Perl_dirp_dup
#define gp_dup Perl_gp_dup
@@ -2703,7 +2703,6 @@
#define magic_clearpack(a,b) Perl_magic_clearpack(aTHX_ a,b)
#define magic_clearsig(a,b) Perl_magic_clearsig(aTHX_ a,b)
#define magic_existspack(a,b) Perl_magic_existspack(aTHX_ a,b)
-#define magic_freeregexp(a,b) Perl_magic_freeregexp(aTHX_ a,b)
#define magic_freeovrld(a,b) Perl_magic_freeovrld(aTHX_ a,b)
#define magic_get(a,b) Perl_magic_get(aTHX_ a,b)
#define magic_getarylen(a,b) Perl_magic_getarylen(aTHX_ a,b)
@@ -2973,6 +2972,7 @@
#define regclass_swash(a,b,c,d,e) Perl_regclass_swash(aTHX_ a,b,c,d,e)
#define pregexec(a,b,c,d,e,f,g) Perl_pregexec(aTHX_ a,b,c,d,e,f,g)
#define pregfree(a) Perl_pregfree(aTHX_ a)
+#define pregfree2(a) Perl_pregfree2(aTHX_ a)
#if defined(PERL_CORE) || defined(PERL_EXT)
#define reg_temp_copy(a) Perl_reg_temp_copy(aTHX_ a)
#endif
@@ -3365,7 +3365,7 @@
#define any_dup(a,b) Perl_any_dup(aTHX_ a,b)
#define he_dup(a,b,c) Perl_he_dup(aTHX_ a,b,c)
#define hek_dup(a,b) Perl_hek_dup(aTHX_ a,b)
-#define re_dup(a,b) Perl_re_dup(aTHX_ a,b)
+#define re_dup_guts(a,b,c) Perl_re_dup_guts(aTHX_ a,b,c)
#define fp_dup(a,b,c) Perl_fp_dup(aTHX_ a,b,c)
#define dirp_dup(a) Perl_dirp_dup(aTHX_ a)
#define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b)
diff --git a/ext/B/B.xs b/ext/B/B.xs
index a6f1d22dab..8f221223e9 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1514,18 +1514,16 @@ IV
REGEX(sv)
B::REGEXP sv
CODE:
- RETVAL = PTR2IV(((struct xregexp *)SvANY(sv))->xrx_regexp);
+ /* FIXME - can we code this method more efficiently? */
+ RETVAL = PTR2IV(sv);
OUTPUT:
RETVAL
SV*
precomp(sv)
B::REGEXP sv
- REGEXP* rx = NO_INIT
CODE:
- rx = ((struct xregexp *)SvANY(sv))->xrx_regexp;
- /* FIXME - UTF-8? And the equivalent precomp methods? */
- RETVAL = newSVpvn( RX_PRECOMP(rx), RX_PRELEN(rx) );
+ RETVAL = newSVpvn( RX_PRECOMP(sv), RX_PRELEN(sv) );
OUTPUT:
RETVAL
diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t
index 2c4cfbf679..af9dc02156 100644
--- a/ext/Devel/Peek/t/Peek.t
+++ b/ext/Devel/Peek/t/Peek.t
@@ -283,12 +283,11 @@ do_test(15,
FLAGS = \\(ROK\\)
RV = $ADDR
SV = REGEXP\\($ADDR\\) at $ADDR
- REFCNT = 1
+ REFCNT = 2
FLAGS = \\(\\)
IV = 0
NV = 0
- PV = 0
- REGEXP = $ADDR');
+ PV = 0');
} else {
do_test(15,
qr(tic),
diff --git a/mg.c b/mg.c
index b81570d42b..48618c0a4a 100644
--- a/mg.c
+++ b/mg.c
@@ -2151,17 +2151,6 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
return sv_unmagic(sv, type);
}
-int
-Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
-{
- dVAR;
- regexp * const re = (regexp *)mg->mg_obj;
- PERL_UNUSED_ARG(sv);
-
- ReREFCNT_dec(re);
- return 0;
-}
-
#ifdef USE_LOCALE_COLLATE
int
Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
diff --git a/perl.h b/perl.h
index 3bad1eb69a..0f6557250c 100644
--- a/perl.h
+++ b/perl.h
@@ -2352,7 +2352,8 @@ typedef struct STRUCT_SV SV;
typedef struct av AV;
typedef struct hv HV;
typedef struct cv CV;
-typedef struct regexp REGEXP;
+typedef struct regexp ORANGE; /* This is the body structure. */
+typedef SV REGEXP;
typedef struct gp GP;
typedef struct gv GV;
typedef struct io IO;
@@ -3308,8 +3309,8 @@ struct nexttoken {
};
#endif
-#include "regexp.h"
#include "sv.h"
+#include "regexp.h"
#include "util.h"
#include "form.h"
#include "gv.h"
@@ -5075,7 +5076,7 @@ MGVTBL_SET(
MEMBER_TO_FPTR(Perl_magic_setregexp),
0,
0,
- MEMBER_TO_FPTR(Perl_magic_freeregexp),
+ 0,
0,
0,
0
diff --git a/pp_ctl.c b/pp_ctl.c
index ae0c61e046..8681cd9767 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -117,7 +117,7 @@ PP(pp_regcomp)
if (SvROK(tmpstr)) {
SV * const sv = SvRV(tmpstr);
if (SvTYPE(sv) == SVt_REGEXP)
- re = ((struct xregexp *)SvANY(sv))->xrx_regexp;
+ re = sv;
}
if (re) {
re = reg_temp_copy(re);
@@ -3905,11 +3905,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
# define SM_REGEX ( \
(SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP) \
- && (this_regex = ((struct xregexp *)SvANY(This))->xrx_regexp) \
+ && (this_regex = This) \
&& (Other = e)) \
|| \
(SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_REGEXP) \
- && (this_regex = ((struct xregexp *)SvANY(This))->xrx_regexp) \
+ && (this_regex = This) \
&& (Other = d)) )
@@ -3918,7 +3918,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
# define SM_OTHER_REGEX (SvROK(Other) \
&& (SvTYPE(SvRV(Other)) == SVt_REGEXP) \
- && (other_regex = ((struct xregexp *)SvANY(SvRV(Other)))->xrx_regexp))
+ && (other_regex = SvRV(Other)))
# define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
diff --git a/pp_hot.c b/pp_hot.c
index e686b2afba..9099c88529 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1194,11 +1194,21 @@ PP(pp_qr)
REGEXP * rx = PM_GETRE(pm);
SV * const pkg = CALLREG_PACKAGE(rx);
SV * const rv = sv_newmortal();
- SV * const sv = newSVrv(rv, pkg ? SvPV_nolen(pkg) : NULL);
+
+ SvUPGRADE(rv, SVt_IV);
+ /* This RV is about to own a reference to the regexp. (In addition to the
+ reference already owned by the PMOP. */
+ ReREFCNT_inc(rx);
+ SvRV_set(rv, rx);
+ SvROK_on(rv);
+
+ if (pkg) {
+ HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+ (void)sv_bless(rv, stash);
+ }
+
if (RX_EXTFLAGS(rx) & RXf_TAINTED)
SvTAINTED_on(rv);
- sv_upgrade(sv, SVt_REGEXP);
- ((struct xregexp *)SvANY(sv))->xrx_regexp = ReREFCNT_inc(rx);
XPUSHs(rv);
RETURN;
}
diff --git a/proto.h b/proto.h
index 79e242870c..668aea16e5 100644
--- a/proto.h
+++ b/proto.h
@@ -1108,10 +1108,6 @@ PERL_CALLCONV int Perl_magic_existspack(pTHX_ SV* sv, const MAGIC* mg)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
-PERL_CALLCONV int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg)
- __attribute__nonnull__(pTHX_1)
- __attribute__nonnull__(pTHX_2);
-
PERL_CALLCONV int Perl_magic_freeovrld(pTHX_ SV* sv, MAGIC* mg)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
@@ -1852,6 +1848,9 @@ PERL_CALLCONV I32 Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char
__attribute__nonnull__(pTHX_6);
PERL_CALLCONV void Perl_pregfree(pTHX_ REGEXP* r);
+PERL_CALLCONV void Perl_pregfree2(pTHX_ REGEXP* prog)
+ __attribute__nonnull__(pTHX_1);
+
PERL_CALLCONV REGEXP* Perl_reg_temp_copy(pTHX_ REGEXP* r)
__attribute__nonnull__(pTHX_1);
@@ -2892,9 +2891,10 @@ PERL_CALLCONV HEK* Perl_hek_dup(pTHX_ HEK* e, CLONE_PARAMS* param)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_2);
-PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ const REGEXP* r, CLONE_PARAMS* param)
- __attribute__warn_unused_result__
- __attribute__nonnull__(pTHX_2);
+PERL_CALLCONV void Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS* param)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_3);
PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type, CLONE_PARAMS* param)
__attribute__nonnull__(pTHX_3);
diff --git a/regcomp.c b/regcomp.c
index 775049db3d..8bd18940cf 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -102,6 +102,7 @@
typedef struct RExC_state_t {
U32 flags; /* are we folding, multilining? */
char *precomp; /* uncompiled string. */
+ REGEXP *rx_sv; /* The SV that is the regexp. */
regexp *rx; /* perl core regexp structure */
regexp_internal *rxi; /* internal data for regexp object pprivate field */
char *start; /* Start of input for compile */
@@ -149,6 +150,7 @@ typedef struct RExC_state_t {
#define RExC_flags (pRExC_state->flags)
#define RExC_precomp (pRExC_state->precomp)
+#define RExC_rx_sv (pRExC_state->rx_sv)
#define RExC_rx (pRExC_state->rx)
#define RExC_rxi (pRExC_state->rxi)
#define RExC_start (pRExC_state->start)
@@ -389,7 +391,7 @@ static const scan_data_t zero_scan_data =
IV len = RExC_end - RExC_precomp; \
\
if (!SIZE_ONLY) \
- SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
+ SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
if (len > RegexLengthToShowInErrorMessages) { \
/* chop 10 shorter than the max, to ensure meaning of "..." */ \
len = RegexLengthToShowInErrorMessages - 10; \
@@ -420,7 +422,7 @@ static const scan_data_t zero_scan_data =
*/
#define vFAIL(m) STMT_START { \
if (!SIZE_ONLY) \
- SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
+ SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
Simple_vFAIL(m); \
} STMT_END
@@ -438,7 +440,7 @@ static const scan_data_t zero_scan_data =
*/
#define vFAIL2(m,a1) STMT_START { \
if (!SIZE_ONLY) \
- SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
+ SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
Simple_vFAIL2(m, a1); \
} STMT_END
@@ -457,7 +459,7 @@ static const scan_data_t zero_scan_data =
*/
#define vFAIL3(m,a1,a2) STMT_START { \
if (!SIZE_ONLY) \
- SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
+ SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
Simple_vFAIL3(m, a1, a2); \
} STMT_END
@@ -4155,7 +4157,8 @@ REGEXP *
Perl_re_compile(pTHX_ const SV * const pattern, const U32 pm_flags)
{
dVAR;
- register REGEXP *r;
+ REGEXP *rx;
+ struct regexp *r;
register regexp_internal *ri;
STRLEN plen;
char* exp = SvPV((SV*)pattern, plen);
@@ -4264,7 +4267,8 @@ redo_first_pass:
/* Allocate space and zero-initialize. Note, the two step process
of zeroing when in debug mode, thus anything assigned has to
happen after that */
- Newxz(r, 1, regexp);
+ rx = newSV_type(SVt_REGEXP);
+ r = (struct regexp*)SvANY(rx);
Newxc(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode),
char, regexp_internal);
if ( r == NULL || ri == NULL )
@@ -4280,7 +4284,6 @@ redo_first_pass:
/* non-zero initialization begins here */
RXi_SET( r, ri );
r->engine= RE_ENGINE_PTR;
- r->refcnt = 1;
r->extflags = pm_flags;
{
bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
@@ -4347,6 +4350,7 @@ redo_first_pass:
(UV)((2*RExC_size+1) * sizeof(U32))));
#endif
SetProgLen(ri,RExC_size);
+ RExC_rx_sv = rx;
RExC_rx = r;
RExC_rxi = ri;
@@ -4364,7 +4368,7 @@ redo_first_pass:
RExC_rx->seen_evals = RExC_seen_evals;
REGC((U8)REG_MAGIC, (char*) RExC_emit++);
if (reg(pRExC_state, 0, &flags,1) == NULL) {
- ReREFCNT_dec(r);
+ ReREFCNT_dec(rx);
return(NULL);
}
/* XXXX To minimize changes to RE engine we always allocate
@@ -4856,7 +4860,7 @@ reStudy:
PerlIO_printf(Perl_debug_log, "\n");
});
#endif
- return(r);
+ return rx;
}
#undef RE_ENGINE_PTR
@@ -4904,10 +4908,12 @@ Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey,
}
SV*
-Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32 flags)
+Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
+ const U32 flags)
{
AV *retarray = NULL;
SV *ret;
+ struct regexp *const rx = (struct regexp *)SvANY(r);
if (flags & RXapif_ALL)
retarray=newAV();
@@ -4923,7 +4929,7 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32
&& rx->offs[nums[i]].end != -1)
{
ret = newSVpvs("");
- CALLREG_NUMBUF_FETCH(rx,nums[i],ret);
+ CALLREG_NUMBUF_FETCH(r,nums[i],ret);
if (!retarray)
return ret;
} else {
@@ -4942,14 +4948,15 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32
}
bool
-Perl_reg_named_buff_exists(pTHX_ REGEXP * const rx, SV * const key,
+Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key,
const U32 flags)
{
+ struct regexp *const rx = (struct regexp *)SvANY(r);
if (rx && rx->paren_names) {
if (flags & RXapif_ALL) {
return hv_exists_ent(rx->paren_names, key, 0);
} else {
- SV *sv = CALLREG_NAMED_BUFF_FETCH(rx, key, flags);
+ SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags);
if (sv) {
SvREFCNT_dec(sv);
return TRUE;
@@ -4963,20 +4970,22 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const rx, SV * const key,
}
SV*
-Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const rx, const U32 flags)
+Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags)
{
+ struct regexp *const rx = (struct regexp *)SvANY(r);
if ( rx && rx->paren_names ) {
(void)hv_iterinit(rx->paren_names);
- return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXapif_FIRSTKEY);
+ return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY);
} else {
return FALSE;
}
}
SV*
-Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const rx, const U32 flags)
+Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags)
{
+ struct regexp *const rx = (struct regexp *)SvANY(r);
if (rx && rx->paren_names) {
HV *hv = rx->paren_names;
HE *temphe;
@@ -5005,17 +5014,18 @@ Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const rx, const U32 flags)
}
SV*
-Perl_reg_named_buff_scalar(pTHX_ REGEXP * const rx, const U32 flags)
+Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags)
{
SV *ret;
AV *av;
I32 length;
+ struct regexp *const rx = (struct regexp *)SvANY(r);
if (rx && rx->paren_names) {
if (flags & (RXapif_ALL | RXapif_REGNAMES_COUNT)) {
return newSViv(HvTOTALKEYS(rx->paren_names));
} else if (flags & RXapif_ONE) {
- ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
+ ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES));
av = (AV*)SvRV(ret);
length = av_len(av);
return newSViv(length + 1);
@@ -5028,8 +5038,9 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const rx, const U32 flags)
}
SV*
-Perl_reg_named_buff_all(pTHX_ REGEXP * const rx, const U32 flags)
+Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags)
{
+ struct regexp *const rx = (struct regexp *)SvANY(r);
AV *av = newAV();
if (rx && rx->paren_names) {
@@ -5062,8 +5073,10 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const rx, const U32 flags)
}
void
-Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren, SV * const sv)
+Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren,
+ SV * const sv)
{
+ struct regexp *const rx = (struct regexp *)SvANY(r);
char *s = NULL;
I32 i = 0;
I32 s1, t1;
@@ -5149,9 +5162,10 @@ Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren,
}
I32
-Perl_reg_numbered_buff_length(pTHX_ REGEXP * const rx, const SV * const sv,
+Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv,
const I32 paren)
{
+ struct regexp *const rx = (struct regexp *)SvANY(r);
I32 i;
I32 s1, t1;
@@ -9095,9 +9109,10 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
}
SV *
-Perl_re_intuit_string(pTHX_ REGEXP * const prog)
+Perl_re_intuit_string(pTHX_ REGEXP * const r)
{ /* Assume that RE_INTUIT is set */
dVAR;
+ struct regexp *const prog = (struct regexp *)SvANY(r);
GET_RE_DEBUG_FLAGS_DECL;
PERL_UNUSED_CONTEXT;
@@ -9136,15 +9151,20 @@ Perl_re_intuit_string(pTHX_ REGEXP * const prog)
void
Perl_pregfree(pTHX_ REGEXP *r)
{
+ SvREFCNT_dec(r);
+}
+
+void
+Perl_pregfree2(pTHX_ REGEXP *rx)
+{
dVAR;
+ struct regexp *const r = (struct regexp *)SvANY(rx);
GET_RE_DEBUG_FLAGS_DECL;
- if (!r || (--r->refcnt > 0))
- return;
if (r->mother_re) {
ReREFCNT_dec(r->mother_re);
} else {
- CALLREGFREE_PVT(r); /* free the private data */
+ CALLREGFREE_PVT(rx); /* free the private data */
if (r->paren_names)
SvREFCNT_dec(r->paren_names);
Safefree(RXp_WRAPPED(r));
@@ -9160,14 +9180,13 @@ Perl_pregfree(pTHX_ REGEXP *r)
SvREFCNT_dec(r->float_utf8);
Safefree(r->substrs);
}
- RX_MATCH_COPY_FREE(r);
+ RX_MATCH_COPY_FREE(rx);
#ifdef PERL_OLD_COPY_ON_WRITE
if (r->saved_copy)
SvREFCNT_dec(r->saved_copy);
#endif
Safefree(r->swap);
Safefree(r->offs);
- Safefree(r);
}
/* reg_temp_copy()
@@ -9188,15 +9207,16 @@ Perl_pregfree(pTHX_ REGEXP *r)
REGEXP *
-Perl_reg_temp_copy (pTHX_ REGEXP *r) {
- regexp *ret;
+Perl_reg_temp_copy (pTHX_ REGEXP *rx) {
+ REGEXP *ret_x = newSV_type(SVt_REGEXP);
+ struct regexp *ret = (struct regexp *)SvANY(ret_x);
+ struct regexp *const r = (struct regexp *)SvANY(rx);
register const I32 npar = r->nparens+1;
- (void)ReREFCNT_inc(r);
- Newx(ret, 1, regexp);
+ (void)ReREFCNT_inc(rx);
+ /* FIXME ORANGE (once we start actually using the regular SV fields.) */
StructCopy(r, ret, regexp);
Newx(ret->offs, npar, regexp_paren_pair);
Copy(r->offs, ret->offs, npar, regexp_paren_pair);
- ret->refcnt = 1;
if (r->substrs) {
Newx(ret->substrs, 1, struct reg_substr_data);
StructCopy(r->substrs, ret->substrs, struct reg_substr_data);
@@ -9209,14 +9229,14 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) {
/* check_substr and check_utf8, if non-NULL, point to either their
anchored or float namesakes, and don't hold a second reference. */
}
- RX_MATCH_COPIED_off(ret);
+ RX_MATCH_COPIED_off(ret_x);
#ifdef PERL_OLD_COPY_ON_WRITE
ret->saved_copy = NULL;
#endif
- ret->mother_re = r;
+ ret->mother_re = rx;
ret->swap = NULL;
- return ret;
+ return ret_x;
}
#endif
@@ -9233,9 +9253,10 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) {
*/
void
-Perl_regfree_internal(pTHX_ REGEXP * const r)
+Perl_regfree_internal(pTHX_ REGEXP * const rx)
{
dVAR;
+ struct regexp *const r = (struct regexp *)SvANY(rx);
RXi_GET_DECL(r,ri);
GET_RE_DEBUG_FLAGS_DECL;
@@ -9366,23 +9387,15 @@ Perl_regfree_internal(pTHX_ REGEXP * const r)
*/
#if defined(USE_ITHREADS)
#ifndef PERL_IN_XSUB_RE
-regexp *
-Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
+void
+Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
{
dVAR;
- regexp *ret;
I32 npar;
-
- if (!r)
- return (REGEXP *)NULL;
-
- if ((ret = (REGEXP *)ptr_table_fetch(PL_ptr_table, r)))
- return ret;
-
+ const struct regexp *r = (const struct regexp *)SvANY(sstr);
+ struct regexp *ret = (struct regexp *)SvANY(dstr);
npar = r->nparens+1;
- Newx(ret, 1, regexp);
- StructCopy(r, ret, regexp);
Newx(ret->offs, npar, regexp_paren_pair);
Copy(r->offs, ret->offs, npar, regexp_paren_pair);
if(ret->swap) {
@@ -9424,9 +9437,9 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
ret->paren_names = hv_dup_inc(ret->paren_names, param);
if (ret->pprivate)
- RXi_SET(ret,CALLREGDUPE_PVT(ret,param));
+ RXi_SET(ret,CALLREGDUPE_PVT(dstr,param));
- if (RX_MATCH_COPIED(ret))
+ if (RX_MATCH_COPIED(dstr))
ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen);
else
ret->subbeg = NULL;
@@ -9437,9 +9450,6 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
ret->mother_re = NULL;
ret->gofs = 0;
ret->seen_evals = 0;
-
- ptr_table_store(PL_ptr_table, r, ret);
- return ret;
}
#endif /* PERL_IN_XSUB_RE */
@@ -9458,9 +9468,10 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
*/
void *
-Perl_regdupe_internal(pTHX_ REGEXP * const r, CLONE_PARAMS *param)
+Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
{
dVAR;
+ struct regexp *const r = (struct regexp *)SvANY(rx);
regexp_internal *reti;
int len, npar;
RXi_GET_DECL(r,ri);
diff --git a/regcomp.h b/regcomp.h
index d3c75f0585..dee7d78286 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -528,10 +528,10 @@ struct reg_data {
#define check_offset_max substrs->data[2].max_offset
#define check_end_shift substrs->data[2].end_shift
-#define RX_ANCHORED_SUBSTR(rx) ((rx)->anchored_substr)
-#define RX_ANCHORED_UTF8(rx) ((rx)->anchored_utf8)
-#define RX_FLOAT_SUBSTR(rx) ((rx)->float_substr)
-#define RX_FLOAT_UTF8(rx) ((rx)->float_utf8)
+#define RX_ANCHORED_SUBSTR(rx) (((struct regexp *)SvANY(rx))->anchored_substr)
+#define RX_ANCHORED_UTF8(rx) (((struct regexp *)SvANY(rx))->anchored_utf8)
+#define RX_FLOAT_SUBSTR(rx) (((struct regexp *)SvANY(rx))->float_substr)
+#define RX_FLOAT_UTF8(rx) (((struct regexp *)SvANY(rx))->float_utf8)
/* trie related stuff */
diff --git a/regexec.c b/regexec.c
index 59fc53e051..2b7ae4a445 100644
--- a/regexec.c
+++ b/regexec.c
@@ -371,10 +371,11 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend,
deleted from the finite automaton. */
char *
-Perl_re_intuit_start(pTHX_ REGEXP * const prog, SV *sv, char *strpos,
+Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
char *strend, const U32 flags, re_scream_pos_data *data)
{
dVAR;
+ struct regexp *const prog = (struct regexp *)SvANY(rx);
register I32 start_shift = 0;
/* Should be nonnegative! */
register I32 end_shift = 0;
@@ -394,7 +395,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const prog, SV *sv, char *strpos,
GET_RE_DEBUG_FLAGS_DECL;
- RX_MATCH_UTF8_set(prog,do_utf8);
+ RX_MATCH_UTF8_set(rx,do_utf8);
if (prog->extflags & RXf_UTF8) {
PL_reg_flags |= RF_utf8;
@@ -1742,7 +1743,7 @@ S_swap_match_buff (pTHX_ regexp *prog) {
- regexec_flags - match a regexp against a string
*/
I32
-Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *strend,
+Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend,
char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
/* strend: pointer to null at end of string */
/* strbeg: real beginning of string */
@@ -1753,6 +1754,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
/* nosave: For optimizations. */
{
dVAR;
+ struct regexp *const prog = (struct regexp *)SvANY(rx);
/*register*/ char *s;
register regnode *c;
/*register*/ char *startpos = stringarg;
@@ -1778,9 +1780,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
}
multiline = prog->extflags & RXf_PMf_MULTILINE;
- reginfo.prog = prog;
+ reginfo.prog = rx; /* Yes, sorry that this is confusing. */
- RX_MATCH_UTF8_set(prog, do_utf8);
+ RX_MATCH_UTF8_set(rx, do_utf8);
DEBUG_EXECUTE_r(
debug_start_match(prog, do_utf8, startpos, strend,
"Matching");
@@ -1842,7 +1844,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
} else /* pos() not defined */
reginfo.ganch = strbeg;
}
- if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
+ if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
swap_on_fail = 1;
swap_match_buff(prog); /* do we need a save destructor here for
eval dies? */
@@ -1852,7 +1854,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
d.scream_olds = &scream_olds;
d.scream_pos = &scream_pos;
- s = re_intuit_start(prog, sv, s, strend, flags, &d);
+ s = re_intuit_start(rx, sv, s, strend, flags, &d);
if (!s) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
goto phooey; /* not present */
@@ -1885,7 +1887,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
if (s > end)
goto phooey;
if (prog->extflags & RXf_USE_INTUIT) {
- s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
+ s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
if (!s)
goto phooey;
}
@@ -2144,7 +2146,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
goto phooey;
got_it:
- RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
+ RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
if (PL_reg_eval_set)
restore_pos(aTHX_ prog);
@@ -2153,7 +2155,7 @@ got_it:
/* make sure $`, $&, $', and $digit will work later */
if ( !(flags & REXEC_NOT_FIRST) ) {
- RX_MATCH_COPY_FREE(prog);
+ RX_MATCH_COPY_FREE(rx);
if (flags & REXEC_COPY_STR) {
const I32 i = PL_regeol - startpos + (stringarg - strbeg);
#ifdef PERL_OLD_COPY_ON_WRITE
@@ -2170,7 +2172,7 @@ got_it:
} else
#endif
{
- RX_MATCH_COPIED_on(prog);
+ RX_MATCH_COPIED_on(rx);
s = savepvn(strbeg, i);
prog->subbeg = s;
}
@@ -2205,7 +2207,8 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
{
dVAR;
CHECKPOINT lastcp;
- regexp *prog = reginfo->prog;
+ REGEXP *const rx = reginfo->prog;
+ regexp *const prog = (struct regexp *)SvANY(rx);
RXi_GET_DECL(prog,progi);
GET_RE_DEBUG_FLAGS_DECL;
reginfo->cutpoint=NULL;
@@ -2261,7 +2264,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
}
#endif
}
- PM_SETRE(PL_reg_curpm, prog);
+ PM_SETRE(PL_reg_curpm, rx);
PL_reg_oldcurpm = PL_curpm;
PL_curpm = PL_reg_curpm;
if (RXp_MATCH_COPIED(prog)) {
@@ -2696,7 +2699,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
register const bool do_utf8 = PL_reg_match_utf8;
const U32 uniflags = UTF8_ALLOW_DEFAULT;
- regexp *rex = reginfo->prog;
+ REGEXP *rex_sv = reginfo->prog;
+ regexp *rex = (struct regexp *)SvANY(rex_sv);
RXi_GET_DECL(rex,rexi);
I32 oldsave;
@@ -3629,6 +3633,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
#define ST st->u.eval
{
SV *ret;
+ SV *re_sv;
regexp *re;
regexp_internal *rei;
regnode *startpoint;
@@ -3645,9 +3650,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
} else {
nochange_depth = 0;
}
+ re_sv = rex_sv;
re = rex;
rei = rexi;
- (void)ReREFCNT_inc(rex);
+ (void)ReREFCNT_inc(rex_sv);
if (OP(scan)==GOSUB) {
startpoint = scan + ARG2L(scan);
ST.close_paren = ARG(scan);
@@ -3708,19 +3714,19 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
/* extract RE object from returned value; compiling if
* necessary */
MAGIC *mg = NULL;
- re = NULL;
+ REGEXP *rx = NULL;
if (SvROK(ret)) {
- const SV *const sv = SvRV(ret);
+ SV *const sv = SvRV(ret);
if (SvTYPE(sv) == SVt_REGEXP) {
- re = ((struct xregexp *)SvANY(sv))->xrx_regexp;
+ rx = sv;
} else if (SvSMAGICAL(sv)) {
mg = mg_find(sv, PERL_MAGIC_qr);
assert(mg);
}
} else if (SvTYPE(ret) == SVt_REGEXP) {
- re = ((struct xregexp *)SvANY(ret))->xrx_regexp;
+ rx = ret;
} else if (SvSMAGICAL(ret)) {
if (SvGMAGICAL(ret)) {
/* I don't believe that there is ever qr magic
@@ -3739,28 +3745,30 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
}
if (mg) {
- re = (regexp *)mg->mg_obj; /*XXX:dmq*/
+ rx = mg->mg_obj; /*XXX:dmq*/
assert(re);
}
- if (re)
- re = reg_temp_copy(re);
+ if (rx) {
+ rx = reg_temp_copy(rx);
+ }
else {
U32 pm_flags = 0;
const I32 osize = PL_regsize;
if (DO_UTF8(ret)) pm_flags |= RXf_UTF8;
- re = CALLREGCOMP(ret, pm_flags);
+ rx = CALLREGCOMP(ret, pm_flags);
if (!(SvFLAGS(ret)
& (SVs_TEMP | SVs_PADTMP | SVf_READONLY
| SVs_GMG))) {
/* This isn't a first class regexp. Instead, it's
caching a regexp onto an existing, Perl visible
scalar. */
- sv_magic(ret,(SV*)ReREFCNT_inc(re),
- PERL_MAGIC_qr,0,0);
+ sv_magic(ret, rx, PERL_MAGIC_qr, 0, 0);
}
PL_regsize = osize;
}
+ re_sv = rx;
+ re = (struct regexp *)SvANY(rx);
}
RXp_MATCH_COPIED_off(re);
re->subbeg = rex->subbeg;
@@ -3803,9 +3811,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
PL_reg_flags &= ~RF_utf8;
ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
- ST.prev_rex = rex;
+ ST.prev_rex = rex_sv;
ST.prev_curlyx = cur_curlyx;
- SETREX(rex,re);
+ SETREX(rex_sv,re_sv);
+ rex = re;
rexi = rei;
cur_curlyx = NULL;
ST.B = next;
@@ -3824,8 +3833,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
case EVAL_AB: /* cleanup after a successful (??{A})B */
/* note: this is called twice; first after popping B, then A */
PL_reg_flags ^= ST.toggle_reg_flags;
- ReREFCNT_dec(rex);
- SETREX(rex,ST.prev_rex);
+ ReREFCNT_dec(rex_sv);
+ SETREX(rex_sv,ST.prev_rex);
+ rex = (struct regexp *)SvANY(rex_sv);
rexi = RXi_GET(rex);
regcpblow(ST.cp);
cur_eval = ST.prev_eval;
@@ -3840,8 +3850,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
/* note: this is called twice; first after popping B, then A */
PL_reg_flags ^= ST.toggle_reg_flags;
- ReREFCNT_dec(rex);
- SETREX(rex,ST.prev_rex);
+ ReREFCNT_dec(rex_sv);
+ SETREX(rex_sv,ST.prev_rex);
+ rex = (struct regexp *)SvANY(rex_sv);
rexi = RXi_GET(rex);
PL_reginput = locinput;
REGCP_UNWIND(ST.lastcp);
@@ -4835,11 +4846,12 @@ NULL
= cur_eval->u.eval.toggle_reg_flags;
PL_reg_flags ^= st->u.eval.toggle_reg_flags;
- st->u.eval.prev_rex = rex; /* inner */
- SETREX(rex,cur_eval->u.eval.prev_rex);
+ st->u.eval.prev_rex = rex_sv; /* inner */
+ SETREX(rex_sv,cur_eval->u.eval.prev_rex);
+ rex = (struct regexp *)SvANY(rex_sv);
rexi = RXi_GET(rex);
cur_curlyx = cur_eval->u.eval.prev_curlyx;
- ReREFCNT_inc(rex);
+ ReREFCNT_inc(rex_sv);
st->u.eval.cp = regcppush(0); /* Save *all* the positions. */
REGCP_SET(st->u.eval.lastcp);
PL_reginput = locinput;
diff --git a/regexp.h b/regexp.h
index 17dfbb6315..6fd42c6f04 100644
--- a/regexp.h
+++ b/regexp.h
@@ -67,9 +67,11 @@ typedef struct regexp_paren_pair {
*/
typedef struct regexp {
+ _XPV_HEAD;
+ _XPVMG_HEAD;
/* what engine created this regexp? */
const struct regexp_engine* engine;
- struct regexp* mother_re; /* what re is this a lightweight copy of? */
+ REGEXP *mother_re; /* what re is this a lightweight copy of? */
/* Information about the match that the perl core uses to manage things */
U32 extflags; /* Flags used both externally and internally */
@@ -104,9 +106,6 @@ typedef struct regexp {
unsigned pre_prefix:4; /* offset from wrapped to the start of precomp */
unsigned seen_evals:28; /* number of eval groups in the pattern - for security checks */
HV *paren_names; /* Optional hash of paren names */
-
- /* Refcount of this regexp */
- I32 refcnt; /* Refcount of this regexp */
} regexp;
/* used for high speed searches */
@@ -369,25 +368,25 @@ and check for NULL.
#define RXp_EXTFLAGS(rx) ((rx)->extflags)
/* For source compatibility. We used to store these explicitly. */
-#define RX_PRECOMP(prog) ((prog)->wrapped + (prog)->pre_prefix)
-#define RX_PRELEN(prog) ((prog)->wraplen - (prog)->pre_prefix - 1)
-#define RX_WRAPPED(prog) ((prog)->wrapped)
-#define RX_WRAPLEN(prog) ((prog)->wraplen)
-#define RX_CHECK_SUBSTR(prog) ((prog)->check_substr)
-#define RX_EXTFLAGS(prog) ((prog)->extflags)
-#define RX_REFCNT(prog) ((prog)->refcnt)
-#define RX_ENGINE(prog) ((prog)->engine)
-#define RX_SUBBEG(prog) ((prog)->subbeg)
-#define RX_OFFS(prog) ((prog)->offs)
-#define RX_NPARENS(prog) ((prog)->nparens)
-#define RX_SUBLEN(prog) ((prog)->sublen)
-#define RX_SUBBEG(prog) ((prog)->subbeg)
-#define RX_MINLEN(prog) ((prog)->minlen)
-#define RX_MINLENRET(prog) ((prog)->minlenret)
-#define RX_GOFS(prog) ((prog)->gofs)
-#define RX_LASTPAREN(prog) ((prog)->lastparen)
-#define RX_LASTCLOSEPAREN(prog) ((prog)->lastcloseparen)
-#define RX_SEEN_EVALS(prog) ((prog)->seen_evals)
+#define RX_PRECOMP(prog) RXp_PRECOMP((struct regexp *)SvANY(prog))
+#define RX_PRELEN(prog) RXp_PRELEN((struct regexp *)SvANY(prog))
+#define RX_WRAPPED(prog) RXp_WRAPPED((struct regexp *)SvANY(prog))
+#define RX_WRAPLEN(prog) RXp_WRAPLEN((struct regexp *)SvANY(prog))
+#define RX_CHECK_SUBSTR(prog) (((struct regexp *)SvANY(prog))->check_substr)
+#define RX_EXTFLAGS(prog) RXp_EXTFLAGS((struct regexp *)SvANY(prog))
+#define RX_REFCNT(prog) SvREFCNT(prog)
+#define RX_ENGINE(prog) (((struct regexp *)SvANY(prog))->engine)
+#define RX_SUBBEG(prog) (((struct regexp *)SvANY(prog))->subbeg)
+#define RX_OFFS(prog) (((struct regexp *)SvANY(prog))->offs)
+#define RX_NPARENS(prog) (((struct regexp *)SvANY(prog))->nparens)
+#define RX_SUBLEN(prog) (((struct regexp *)SvANY(prog))->sublen)
+#define RX_SUBBEG(prog) (((struct regexp *)SvANY(prog))->subbeg)
+#define RX_MINLEN(prog) (((struct regexp *)SvANY(prog))->minlen)
+#define RX_MINLENRET(prog) (((struct regexp *)SvANY(prog))->minlenret)
+#define RX_GOFS(prog) (((struct regexp *)SvANY(prog))->gofs)
+#define RX_LASTPAREN(prog) (((struct regexp *)SvANY(prog))->lastparen)
+#define RX_LASTCLOSEPAREN(prog) (((struct regexp *)SvANY(prog))->lastcloseparen)
+#define RX_SEEN_EVALS(prog) (((struct regexp *)SvANY(prog))->seen_evals)
#endif /* PLUGGABLE_RE_EXTENSION */
@@ -424,8 +423,25 @@ and check for NULL.
#define REXEC_IGNOREPOS 0x08 /* \G matches at start. */
#define REXEC_NOT_FIRST 0x10 /* This is another iteration of //g. */
-#define ReREFCNT_inc(re) ((void)(re && re->refcnt++), re)
-#define ReREFCNT_dec(re) CALLREGFREE(re)
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
+# define ReREFCNT_inc(re) \
+ ({ \
+ /* This is here to generate a casting warning if incorrect. */ \
+ REGEXP *const zwapp = (re); \
+ SvREFCNT_inc(zwapp); \
+ })
+# define ReREFCNT_dec(re) \
+ ({ \
+ /* This is here to generate a casting warning if incorrect. */ \
+ REGEXP *const boff = (re); \
+ SvREFCNT_dec(boff); \
+ })
+#else
+# define ReREFCNT_dec(re) SvREFCNT_dec(re)
+# define ReREFCNT_inc(re) SvREFCNT_inc(re)
+#endif
+
+/* FIXME for plugins. */
#define FBMcf_TAIL_DOLLAR 1
#define FBMcf_TAIL_DOLLARM 2
@@ -446,7 +462,7 @@ typedef struct _reg_trie_accepted reg_trie_accepted;
* Perl_regexec_flags and then passed to regtry(), regmatch() etc */
typedef struct {
- regexp *prog;
+ REGEXP *prog;
char *bol;
char *till;
SV *sv;
@@ -516,7 +532,7 @@ typedef struct regmatch_state {
struct regmatch_state *prev_yes_state;
struct regmatch_state *prev_eval;
struct regmatch_state *prev_curlyx;
- regexp *prev_rex;
+ REGEXP *prev_rex;
U32 toggle_reg_flags; /* what bits in PL_reg_flags to
flip when transitioning between
inner and outer rexen */
diff --git a/sv.c b/sv.c
index 7844c498c5..551d458fdd 100644
--- a/sv.c
+++ b/sv.c
@@ -916,9 +916,9 @@ static const struct body_details bodies_by_type[] = {
{ sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
- /* 32 */
- { sizeof(struct xregexp), copy_length(struct xregexp, xrx_regexp), 0,
- SVt_REGEXP, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(struct xregexp))
+ /* something big */
+ { sizeof(struct regexp), sizeof(struct regexp), 0,
+ SVt_REGEXP, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(struct regexp))
},
/* 48 */
@@ -2713,8 +2713,9 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
I32 haseval = 0;
U32 flags = 0;
struct magic temp;
- temp.mg_obj
- = (SV*)((struct xregexp *)SvANY(referent))->xrx_regexp;
+ /* FIXME - get rid of this cast away of const, or work out
+ how to do it better. */
+ temp.mg_obj = (SV *)referent;
assert(temp.mg_obj);
(str) = CALLREG_AS_STR(&temp,lp,&flags,&haseval);
if (flags & 1)
@@ -4475,7 +4476,6 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
*/
if (!obj || obj == sv ||
how == PERL_MAGIC_arylen ||
- how == PERL_MAGIC_qr ||
how == PERL_MAGIC_symtab ||
(SvTYPE(obj) == SVt_PVGV &&
(GvSV(obj) == sv || GvHV(obj) == (HV*)sv || GvAV(obj) == (AV*)sv ||
@@ -5232,7 +5232,8 @@ Perl_sv_clear(pTHX_ register SV *sv)
Safefree(IoBOTTOM_NAME(sv));
goto freescalar;
case SVt_REGEXP:
- ReREFCNT_dec(((struct xregexp *)SvANY(sv))->xrx_regexp);
+ /* FIXME for plugins */
+ pregfree2(sv);
goto freescalar;
case SVt_PVCV:
case SVt_PVFM:
@@ -9822,10 +9823,13 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
nmg->mg_private = mg->mg_private;
nmg->mg_type = mg->mg_type;
nmg->mg_flags = mg->mg_flags;
+ /* FIXME for plugins
if (mg->mg_type == PERL_MAGIC_qr) {
nmg->mg_obj = (SV*)CALLREGDUPE((REGEXP*)mg->mg_obj, param);
}
- else if(mg->mg_type == PERL_MAGIC_backref) {
+ else
+ */
+ if(mg->mg_type == PERL_MAGIC_backref) {
/* The backref AV has its reference count deliberately bumped by
1. */
nmg->mg_obj = SvREFCNT_inc(av_dup_inc((AV*) mg->mg_obj, param));
@@ -10205,9 +10209,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
case SVt_PVMG:
break;
case SVt_REGEXP:
- ((struct xregexp *)SvANY(dstr))->xrx_regexp
- = CALLREGDUPE(((struct xregexp *)SvANY(dstr))->xrx_regexp,
- param);
+ /* FIXME for plugins */
+ re_dup_guts(sstr, dstr, param);
break;
case SVt_PVLV:
/* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */
@@ -11195,12 +11198,17 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
av_push(PL_regex_padav, sv_dup_inc_NN(regexen[0],param));
for(i = 1; i <= len; i++) {
const SV * const regex = regexen[i];
+ /* FIXME for plugins
+ newSViv(PTR2IV(CALLREGDUPE(
+ INT2PTR(REGEXP *, SvIVX(regex)), param))))
+ */
+ /* And while we're at it, can we FIXME on the whole hiding
+ pointer inside an IV hack? */
SV * const sv =
SvREPADTMP(regex)
? sv_dup_inc(regex, param)
: SvREFCNT_inc(
- newSViv(PTR2IV(CALLREGDUPE(
- INT2PTR(REGEXP *, SvIVX(regex)), param))))
+ newSViv(PTR2IV(sv_dup_inc(INT2PTR(REGEXP *, SvIVX(regex)), param))))
;
if (SvFLAGS(regex) & SVf_BREAK)
SvFLAGS(sv) |= SVf_BREAK; /* unrefcnted PL_curpm */
diff --git a/sv.h b/sv.h
index 443a3de14e..df42dcfcc8 100644
--- a/sv.h
+++ b/sv.h
@@ -471,12 +471,6 @@ struct xpvmg {
_XPVMG_HEAD;
};
-struct xregexp {
- _XPV_HEAD;
- _XPVMG_HEAD;
- REGEXP * xrx_regexp; /* Our regular expression */
-};
-
struct xpvlv {
_XPV_HEAD;
_XPVMG_HEAD;
diff --git a/util.c b/util.c
index fef039382a..1710e6f6e3 100644
--- a/util.c
+++ b/util.c
@@ -5922,7 +5922,7 @@ Perl_get_re_arg(pTHX_ SV *sv) {
(tmpsv = (SV*)SvRV(sv)) && /* assign deliberate */
SvTYPE(tmpsv) == SVt_REGEXP)
{
- return ((struct xregexp *)SvANY(tmpsv))->xrx_regexp;
+ return tmpsv;
}
}
View Lorry Controller Status