inline SvREFCNT_dec:

Subject: [PATCH] Copy on write for $& and $1...
Message-ID: <20030209230008.GF299@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@18725

diff --git a/embed.fnc b/embed.fnc
index c59106a..ae820cb 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -726,6 +726,7 @@ Ap  |void   |sv_dump        |SV* sv
 Apd    |bool   |sv_derived_from|SV* sv|const char* name
 Apd    |I32    |sv_eq          |SV* sv1|SV* sv2
 Apd    |void   |sv_free        |SV* sv
+po     |void   |sv_free2       |SV* sv
 pd     |void   |sv_free_arenas
 Apd    |char*  |sv_gets        |SV* sv|PerlIO* fp|I32 append
 Apd    |char*  |sv_grow        |SV* sv|STRLEN newlen

diff --git a/embed.h b/embed.h
index e369c33..1881499 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1003,6 +1003,8 @@
 #define sv_eq                  Perl_sv_eq
 #define sv_free                        Perl_sv_free
 #ifdef PERL_CORE
+#endif
+#ifdef PERL_CORE
 #define sv_free_arenas         Perl_sv_free_arenas
 #endif
 #define sv_gets                        Perl_sv_gets
@@ -3456,6 +3458,8 @@
 #define sv_eq(a,b)             Perl_sv_eq(aTHX_ a,b)
 #define sv_free(a)             Perl_sv_free(aTHX_ a)
 #ifdef PERL_CORE
+#endif
+#ifdef PERL_CORE
 #define sv_free_arenas()       Perl_sv_free_arenas(aTHX)
 #endif
 #define sv_gets(a,b,c)         Perl_sv_gets(aTHX_ a,b,c)

diff --git a/proto.h b/proto.h
index 4b527cd..2abd2d9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -763,6 +763,7 @@ PERL_CALLCONV void  Perl_sv_dump(pTHX_ SV* sv);
 PERL_CALLCONV bool     Perl_sv_derived_from(pTHX_ SV* sv, const char* name);
 PERL_CALLCONV I32      Perl_sv_eq(pTHX_ SV* sv1, SV* sv2);
 PERL_CALLCONV void     Perl_sv_free(pTHX_ SV* sv);
+PERL_CALLCONV void     Perl_sv_free2(pTHX_ SV* sv);
 PERL_CALLCONV void     Perl_sv_free_arenas(pTHX);
 PERL_CALLCONV char*    Perl_sv_gets(pTHX_ SV* sv, PerlIO* fp, I32 append);
 PERL_CALLCONV char*    Perl_sv_grow(pTHX_ SV* sv, STRLEN newlen);

diff --git a/sv.c b/sv.c
index 1caf879..b67b435 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5436,6 +5436,12 @@ Perl_sv_free(pTHX_ SV *sv)
     }
     if (--(SvREFCNT(sv)) > 0)
        return;
+    Perl_sv_free2(aTHX_ sv);
+}
+
+void
+Perl_sv_free2(pTHX_ SV *sv)
+{
 #ifdef DEBUGGING
     if (SvTEMP(sv)) {
        if (ckWARN_d(WARN_DEBUGGING))

diff --git a/sv.h b/sv.h
index 3ba04fe..cf408e8 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -138,7 +138,22 @@ perform the upgrade if necessary.  See C<svtype>.
        ((PL_Sv=(SV*)(sv)), (PL_Sv && ++(SvREFCNT(PL_Sv))), (SV*)PL_Sv)
 #endif
 
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
+#  define SvREFCNT_dec(sv)             \
+    ({                                 \
+       SV *nsv = (SV*)(sv);            \
+       if (nsv) {                      \
+           if (SvREFCNT(nsv)) {        \
+               if (--(SvREFCNT(nsv)) == 0) \
+                   Perl_sv_free2(aTHX_ nsv);   \
+           } else {                    \
+               sv_free(nsv);           \
+           }                           \
+       }                               \
+    })
+#else
 #define SvREFCNT_dec(sv)       sv_free((SV*)(sv))
+#endif
 
 #define SVTYPEMASK     0xff
 #define SvTYPE(sv)     ((sv)->sv_flags & SVTYPEMASK)