Re: [patch] Re: PL_ptr_table

       Message-Id: <Pine.LNX.4.21.0102071916270.29229-100000@mako.covalent.net>

p4raw-id: //depot/perl@8713

4 files changed, 60 insertions, 1 deletions

diff --git a/embed.pl b/embed.pl
index 1b8b7b0e15..b8f26f5c3d 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2209,6 +2209,8 @@ Ap	|PTR_TBL_t*|ptr_table_new
 Ap	|void*	|ptr_table_fetch|PTR_TBL_t *tbl|void *sv
 Ap	|void	|ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
 Ap	|void	|ptr_table_split|PTR_TBL_t *tbl
+Ap	|void	|ptr_table_clear|PTR_TBL_t *tbl
+Ap	|void	|ptr_table_free|PTR_TBL_t *tbl
 #endif
 #if defined(HAVE_INTERP_INTERN)
 Ap	|void	|sys_intern_clear
diff --git a/perl.c b/perl.c
index 21ca8aa068..c11007ef9a 100644
--- a/perl.c
+++ b/perl.c
@@ -698,6 +698,9 @@ perl_destruct(pTHXx)
     }
     SvREFCNT_dec(PL_strtab);
 
+    /* free the pointer table used for cloning */
+    ptr_table_free(PL_ptr_table);
+
     /* free special SVs */
 
     SvREFCNT(&PL_sv_yes) = 0;
diff --git a/sv.c b/sv.c
index 31a90e7174..40fa5caaf6 100644
--- a/sv.c
+++ b/sv.c
@@ -7700,6 +7700,51 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
     }
 }
 
+void
+Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl)
+{
+    register PTR_TBL_ENT_t **array;
+    register PTR_TBL_ENT_t *entry;
+    register PTR_TBL_ENT_t *oentry = Null(PTR_TBL_ENT_t*);
+    UV riter = 0;
+    UV max;
+
+    if (!tbl || !tbl->tbl_items) {
+        return;
+    }
+
+    array = tbl->tbl_ary;
+    entry = array[0];
+    max = tbl->tbl_max;
+
+    for (;;) {
+        if (entry) {
+            oentry = entry;
+            entry = entry->next;
+            Safefree(oentry);
+        }
+        if (!entry) {
+            if (++riter > max) {
+                break;
+            }
+            entry = array[riter];
+        }
+    }
+
+    tbl->tbl_items = 0;
+}
+
+void
+Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl)
+{
+    if (!tbl) {
+        return;
+    }
+    ptr_table_clear(tbl);
+    Safefree(tbl->tbl_ary);
+    Safefree(tbl);
+}
+
 #ifdef DEBUGGING
 char *PL_watch_pvx;
 #endif
@@ -8910,7 +8955,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* thrdvar.h stuff */
 
-    if (flags & 1) {
+    if (flags & CLONEf_COPY_STACKS) {
 	/* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
 	PL_tmps_ix		= proto_perl->Ttmps_ix;
 	PL_tmps_max		= proto_perl->Ttmps_max;
@@ -9096,6 +9141,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reginterp_cnt	= 0;
     PL_reg_starttry	= 0;
 
+    if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
+        ptr_table_free(PL_ptr_table);
+        PL_ptr_table = NULL;
+    }
+
 #ifdef PERL_OBJECT
     return (PerlInterpreter*)pPerl;
 #else
diff --git a/sv.h b/sv.h
index 0ab87e91e3..2785f14595 100644
--- a/sv.h
+++ b/sv.h
@@ -1107,3 +1107,7 @@ Returns a pointer to the character buffer.
 #define Sv_Grow sv_grow
 
 #define SV_IMMEDIATE_UNREF	1
+
+#define CLONEf_COPY_STACKS 1
+#define CLONEf_KEEP_PTR_TABLE 2
+