From: Dave Mitchell <davem@fdisolutions.com>
Date: Sun, 11 Apr 2004 13:13:35 +0000 (+0000)
Subject: Make global cleanup fractionally faster by giving S_visit()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=055972dc609b4a79791de1e554064be888603159;p=p5sagit%2Fp5-mst-13.2.git

Make global cleanup fractionally faster by giving S_visit()
flags/mask to compare SVs against.

p4raw-id: //depot/perl@22687
---

diff --git a/embed.fnc b/embed.fnc
index 5ed740e..49e6052 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1220,7 +1220,7 @@ s	|void	|del_xpvbm	|XPVBM* p
 s	|void	|del_xrv	|XRV* p
 s	|void	|sv_unglob	|SV* sv
 s	|void	|not_a_number	|SV *sv
-s	|I32	|visit		|SVFUNC_t f
+s	|I32	|visit		|SVFUNC_t f|U32 flags|U32 mask
 s	|void	|sv_add_backref	|SV *tsv|SV *sv
 s	|void	|sv_del_backref	|SV *sv
 #  ifdef DEBUGGING
diff --git a/embed.h b/embed.h
index 7d725fe..808e010 100644
--- a/embed.h
+++ b/embed.h
@@ -4342,7 +4342,7 @@
 #define not_a_number(a)		S_not_a_number(aTHX_ a)
 #endif
 #ifdef PERL_CORE
-#define visit(a)		S_visit(aTHX_ a)
+#define visit(a,b,c)		S_visit(aTHX_ a,b,c)
 #endif
 #ifdef PERL_CORE
 #define sv_add_backref(a,b)	S_sv_add_backref(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index ec2cdb7..86b32a0 100644
--- a/proto.h
+++ b/proto.h
@@ -1172,7 +1172,7 @@ STATIC void	S_del_xpvbm(pTHX_ XPVBM* p);
 STATIC void	S_del_xrv(pTHX_ XRV* p);
 STATIC void	S_sv_unglob(pTHX_ SV* sv);
 STATIC void	S_not_a_number(pTHX_ SV *sv);
-STATIC I32	S_visit(pTHX_ SVFUNC_t f);
+STATIC I32	S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask);
 STATIC void	S_sv_add_backref(pTHX_ SV *tsv, SV *sv);
 STATIC void	S_sv_del_backref(pTHX_ SV *sv);
 #  ifdef DEBUGGING
diff --git a/sv.c b/sv.c
index 77ad8d0..b776f56 100644
--- a/sv.c
+++ b/sv.c
@@ -321,10 +321,11 @@ S_more_sv(pTHX)
     return sv;
 }
 
-/* visit(): call the named function for each non-free SV in the arenas. */
+/* visit(): call the named function for each non-free SV in the arenas
+ * whose flags field matches the flags/mask args. */
 
 STATIC I32
-S_visit(pTHX_ SVFUNC_t f)
+S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
 {
     SV* sva;
     SV* sv;
@@ -334,7 +335,10 @@ S_visit(pTHX_ SVFUNC_t f)
     for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
 	svend = &sva[SvREFCNT(sva)];
 	for (sv = sva + 1; sv < svend; ++sv) {
-	    if (SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv)) {
+	    if (SvTYPE(sv) != SVTYPEMASK
+		    && (sv->sv_flags & mask) == flags
+		    && SvREFCNT(sv))
+	    {
 		(FCALL)(aTHX_ sv);
 		++visited;
 	    }
@@ -369,7 +373,7 @@ void
 Perl_sv_report_used(pTHX)
 {
 #ifdef DEBUGGING
-    visit(do_report_used);
+    visit(do_report_used, 0, 0);
 #endif
 }
 
@@ -429,10 +433,10 @@ void
 Perl_sv_clean_objs(pTHX)
 {
     PL_in_clean_objs = TRUE;
-    visit(do_clean_objs);
+    visit(do_clean_objs, SVf_ROK, SVf_ROK);
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
     /* some barnacles may yet remain, clinging to typeglobs */
-    visit(do_clean_named_objs);
+    visit(do_clean_named_objs, SVt_PVGV, SVTYPEMASK);
 #endif
     PL_in_clean_objs = FALSE;
 }
@@ -462,7 +466,7 @@ Perl_sv_clean_all(pTHX)
 {
     I32 cleaned;
     PL_in_clean_all = TRUE;
-    cleaned = visit(do_clean_all);
+    cleaned = visit(do_clean_all, 0,0);
     PL_in_clean_all = FALSE;
     return cleaned;
 }