develooper Front page | perl.perl5.porters | Postings from February 2010

Re: [patch 0/3] rework sv.c body-inventory mechanics

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
February 7, 2010 05:45
Subject:
Re: [patch 0/3] rework sv.c body-inventory mechanics
Message ID:
20100207122142.GZ49893@plum.flirble.org
On Mon, Feb 01, 2010 at 02:42:24PM +0000, Nicholas Clark wrote:

> This analysis makes me think that actually, yes, the PTE allocation code *is*
> sub-optimal. But not in the way that you're proposing to fix it.
> 
> Instead, I think that the following would improve performance, *and* return
> more memory to malloc()
> 
> * Remove PTEs from the common arena code/data structures
> * Give each ptr_table its own arena chain
> * Don't bother with creating the linked list - use two pointers to operate a
>   slab allocator for the arena
> * Don't bother with deleting PTEs - just walk and free() the arena chain in
>   ptr_table_clear

Something like the appended.

$ git diff --stat
 perl.h |    6 +++---
 sv.c   |   57 +++++++++++++++++++++++++++++++--------------------------
 sv.h   |    5 +----
 3 files changed, 35 insertions(+), 33 deletions(-)

If we got rid of ptr_table_clear, which I don't think that anyone else uses,
then the code would be smaller still, and more efficient, because we could
avoid Zero()ing the array.

Nicholas Clark

diff --git a/perl.h b/perl.h
index 5988e78..b2ad719 100644
--- a/perl.h
+++ b/perl.h
@@ -3453,9 +3453,6 @@ typedef struct magic_state MGS;	/* struct magic_state defined in mg.c */
 struct scan_data_t;		/* Used in S_* functions in regcomp.c */
 struct regnode_charclass_class;	/* Used in S_* functions in regcomp.c */
 
-/* Keep next first in this structure, because sv_free_arenas take
-   advantage of this to share code between the pte arenas and the SV
-   body arenas  */
 struct ptr_tbl_ent {
     struct ptr_tbl_ent*		next;
     const void*			oldval;
@@ -3466,6 +3463,9 @@ struct ptr_tbl {
     struct ptr_tbl_ent**	tbl_ary;
     UV				tbl_max;
     UV				tbl_items;
+    struct ptr_tbl_arena	*tbl_arena;
+    struct ptr_tbl_ent		*tbl_arena_next;
+    struct ptr_tbl_ent		*tbl_arena_end;
 };
 
 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
diff --git a/sv.c b/sv.c
index 3b16d7d..4712e34 100644
--- a/sv.c
+++ b/sv.c
@@ -852,13 +852,6 @@ PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the
 bodies_by_type[SVt_NULL] slot is not used, as the table is not
 available in hv.c.
 
-PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless,
-they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can
-just use the same allocation semantics.  At first, PTEs were also
-overloaded to a non-body sv-type, but this yielded hard-to-find malloc
-bugs, so was simplified by claiming a new slot.  This choice has no
-consequence at this time.
-
 */
 
 struct body_details {
@@ -10654,6 +10647,11 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *const param)
 
 #endif /* USE_ITHREADS */
 
+struct ptr_tbl_arena {
+    struct ptr_tbl_arena *next;
+    struct ptr_tbl_ent array[1023/3]; /* as ptr_tbl_ent has 3 pointers.  */
+};
+
 /* create a new pointer-mapping table */
 
 PTR_TBL_t *
@@ -10665,6 +10663,9 @@ Perl_ptr_table_new(pTHX)
     Newx(tbl, 1, PTR_TBL_t);
     tbl->tbl_max	= 511;
     tbl->tbl_items	= 0;
+    tbl->tbl_arena	= NULL;
+    tbl->tbl_arena_next	= NULL;
+    tbl->tbl_arena_end	= NULL;
     Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
     return tbl;
 }
@@ -10672,14 +10673,6 @@ Perl_ptr_table_new(pTHX)
 #define PTR_TABLE_HASH(ptr) \
   ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
 
-/* 
-   we use the PTE_SVSLOT 'reservation' made above, both here (in the
-   following define) and at call to new_body_inline made below in 
-   Perl_ptr_table_store()
- */
-
-#define del_pte(p)     del_body_type(p, PTE_SVSLOT)
-
 /* map an existing pointer using a table */
 
 STATIC PTR_TBL_ENT_t *
@@ -10724,7 +10717,18 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *const tbl, const void *const oldsv, void *
     } else {
 	const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;
 
-	new_body_inline(tblent, PTE_SVSLOT);
+	if (tbl->tbl_arena_next == tbl->tbl_arena_end) {
+	    struct ptr_tbl_arena *new_arena;
+
+	    Newx(new_arena, 1, struct ptr_tbl_arena);
+	    new_arena->next = tbl->tbl_arena;
+	    tbl->tbl_arena = new_arena;
+	    tbl->tbl_arena_next = new_arena->array;
+	    tbl->tbl_arena_end = new_arena->array
+		+ sizeof(new_arena->array) / sizeof(new_arena->array[0]);
+	}
+
+	tblent = tbl->tbl_arena_next++;
 
 	tblent->oldval = oldsv;
 	tblent->newval = newsv;
@@ -10777,20 +10781,21 @@ void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
 {
     if (tbl && tbl->tbl_items) {
-	register PTR_TBL_ENT_t * const * const array = tbl->tbl_ary;
-	UV riter = tbl->tbl_max;
+	struct ptr_tbl_arena *arena = tbl->tbl_arena;
 
-	do {
-	    PTR_TBL_ENT_t *entry = array[riter];
+	Zero(tbl->tbl_ary, tbl->tbl_max + 1, struct ptr_tbl_ent **);
 
-	    while (entry) {
-		PTR_TBL_ENT_t * const oentry = entry;
-		entry = entry->next;
-		del_pte(oentry);
-	    }
-	} while (riter--);
+	while (arena) {
+	    struct ptr_tbl_arena *next = arena->next;
+
+	    Safefree(arena);
+	    arena = next;
+	};
 
 	tbl->tbl_items = 0;
+	tbl->tbl_arena = NULL;
+	tbl->tbl_arena_next = NULL;
+	tbl->tbl_arena_end = NULL;
     }
 }
 
diff --git a/sv.h b/sv.h
index fc1b475..33d4fb9 100644
--- a/sv.h
+++ b/sv.h
@@ -78,11 +78,8 @@ typedef enum {
 /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL
    and SVt_IV, so never reaches the clause at the end that uses
    sv_type_details->body_size to determine whether to call safefree(). Hence
-   body_size can be set no-zero to record the size of PTEs and HEs, without
+   body_size can be set no-zero to record the size of HEs, without
    fear of bogus frees.  */
-#ifdef PERL_IN_SV_C
-#define PTE_SVSLOT	SVt_IV
-#endif
 #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
 #define HE_SVSLOT	SVt_NULL
 #endif

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About