[svn:ponie] r341 - trunk/perl

Author: nicholas
Date: Thu Aug 25 04:48:05 2005
New Revision: 341

Modified:
   trunk/perl/embed.fnc
   trunk/perl/embed.h
   trunk/perl/global.sym
   trunk/perl/proto.h
   trunk/perl/sv.c
Log:
For the next steps in refactoring, need to be able to call sv_clear without
temporarily setting the reference count to zero. So add a new sv_clear_backend
function that does not assert this. For future expansion possibilities add
a flags parameter, which currently is unused.


Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc	(original)
+++ trunk/perl/embed.fnc	Thu Aug 25 04:48:05 2005
@@ -736,6 +736,7 @@ Apd	|void	|sv_chop	|SV* sv|char* ptr
 pd	|I32	|sv_clean_all
 pd	|void	|sv_clean_objs
 Apd	|void	|sv_clear	|SV* sv
+Apd	|void	|sv_clear_backend|SV* sv|I32 flags
 Apd	|I32	|sv_cmp		|SV* sv1|SV* sv2
 Apd	|I32	|sv_cmp_locale	|SV* sv1|SV* sv2
 #if defined(USE_LOCALE_COLLATE)

Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h	(original)
+++ trunk/perl/embed.h	Thu Aug 25 04:48:05 2005
@@ -996,6 +996,7 @@
 #define sv_clean_objs		Perl_sv_clean_objs
 #endif
 #define sv_clear		Perl_sv_clear
+#define sv_clear_backend	Perl_sv_clear_backend
 #define sv_cmp			Perl_sv_cmp
 #define sv_cmp_locale		Perl_sv_cmp_locale
 #if defined(USE_LOCALE_COLLATE)
@@ -3494,6 +3495,7 @@
 #define sv_clean_objs()		Perl_sv_clean_objs(aTHX)
 #endif
 #define sv_clear(a)		Perl_sv_clear(aTHX_ a)
+#define sv_clear_backend(a,b)	Perl_sv_clear_backend(aTHX_ a,b)
 #define sv_cmp(a,b)		Perl_sv_cmp(aTHX_ a,b)
 #define sv_cmp_locale(a,b)	Perl_sv_cmp_locale(aTHX_ a,b)
 #if defined(USE_LOCALE_COLLATE)

Modified: trunk/perl/global.sym
==============================================================================
--- trunk/perl/global.sym	(original)
+++ trunk/perl/global.sym	Thu Aug 25 04:48:05 2005
@@ -455,6 +455,7 @@ Perl_sv_catpvn
 Perl_sv_catsv
 Perl_sv_chop
 Perl_sv_clear
+Perl_sv_clear_backend
 Perl_sv_cmp
 Perl_sv_cmp_locale
 Perl_sv_collxfrm

Modified: trunk/perl/proto.h
==============================================================================
--- trunk/perl/proto.h	(original)
+++ trunk/perl/proto.h	Thu Aug 25 04:48:05 2005
@@ -705,6 +705,7 @@ PERL_CALLCONV void	Perl_sv_chop(pTHX_ SV
 PERL_CALLCONV I32	Perl_sv_clean_all(pTHX);
 PERL_CALLCONV void	Perl_sv_clean_objs(pTHX);
 PERL_CALLCONV void	Perl_sv_clear(pTHX_ SV* sv);
+PERL_CALLCONV void	Perl_sv_clear_backend(pTHX_ SV* sv, I32 flags);
 PERL_CALLCONV I32	Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2);
 PERL_CALLCONV I32	Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2);
 #if defined(USE_LOCALE_COLLATE)

Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c	(original)
+++ trunk/perl/sv.c	Thu Aug 25 04:48:05 2005
@@ -4885,7 +4885,13 @@ Perl_sv_clear(pTHX_ register SV *sv)
 {
     assert(sv);
     assert(SvREFCNT(sv) == 0);
+    sv_clear_backend(sv, 0);
+}
 
+void
+Perl_sv_clear_backend(pTHX_ register SV *sv, I32 flags)
+{
+    U32 refcount = SvREFCNT(sv);
     if (SvOBJECT(sv)) {
 	if (PL_defstash) {		/* Still have a symbol table? */
 	    dSP;
@@ -4924,7 +4930,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	    } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
 
 
-	    if (SvREFCNT(sv)) {
+	    if (SvREFCNT(sv) > refcount) {
 		if (PL_in_clean_objs)
 		    Perl_croak(aTHX_ "DESTROY created new reference to dead object '%s'",
 			  HvNAME(stash));

• [svn:ponie] r341 - trunk/perl by nicholas