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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;
 }