This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make struct regexp the body of SVt_REGEXP SVs, REGEXPs become SVs,
authorNicholas Clark <nick@ccl4.org>
Wed, 2 Jan 2008 13:47:42 +0000 (13:47 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 2 Jan 2008 13:47:42 +0000 (13:47 +0000)
and regexp reference counting is via the regular SV reference counting.
This was not as easy at it looks.

p4raw-id: //depot/perl@32804

18 files changed:
cflags.SH
dump.c
embed.fnc
embed.h
ext/B/B.xs
ext/Devel/Peek/t/Peek.t
mg.c
perl.h
pp_ctl.c
pp_hot.c
proto.h
regcomp.c
regcomp.h
regexec.c
regexp.h
sv.c
sv.h
util.c

index 9dd6181..4e62f92 100755 (executable)
--- 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 9010c65..dee5c10 100644 (file)
--- 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)) {
index 678cf99..c041296 100644 (file)
--- 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 ed58cc1..ba24871 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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
 #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
 #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)
 #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
 #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)
index a6f1d22..8f22122 100644 (file)
@@ -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
 
index 2c4cfbf..af9dc02 100644 (file)
@@ -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 b81570d..48618c0 100644 (file)
--- 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 3bad1eb..0f65572 100644 (file)
--- 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
index ae0c61e..8681cd9 100644 (file)
--- 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, \
index e686b2a..9099c88 100644 (file)
--- 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 79e2428..668aea1 100644 (file)
--- 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);
index 775049d..8bd1894 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
 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);
index d3c75f0..dee7d78 100644 (file)
--- 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 */
 
index 59fc53e..2b7ae4a 100644 (file)
--- 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;
index 17dfbb6..6fd42c6 100644 (file)
--- 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 7844c49..551d458 100644 (file)
--- 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 443a3de..df42dcf 100644 (file)
--- 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 fef0393..1710e6f 100644 (file)
--- 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;
         }
     }