develooper Front page | perl.perl5.porters | Postings from August 2009

Re: [patch 3/3] - private arenas prep - cleanup macro middle layer

From:
Jim Cromie
Date:
August 26, 2009 17:26
Subject:
Re: [patch 3/3] - private arenas prep - cleanup macro middle layer
Message ID:
cfe85dfa0908261726t5420ca1bs4da0139c2b1bdf17@mail.gmail.com
  2   refactor more_bodies() to thread free bodies onto any root.

>   2b  clarify sv_type -> reqid mapping in (new|del)_body macros
>>>   2c  add (new|del)_body_private(void* reqid) macros
>>
>>
>>
>>
>> 0003-rework-new-del-_body-w-macros-clarify-mapping-sv.patch
>>
>>



[jimc@harpo perl]$
[jimc@harpo perl]$
[jimc@harpo perl]$
[jimc@harpo perl]$
[jimc@harpo perl]$
[jimc@harpo perl]$ more
0003-rework-new-del-_body-w-macros-clarify-mapping-sv.patch
From bd9e7b09aa003863a85706c449dd2911d3860716 Mon Sep 17 00:00:00 2001
From: Jim Cromie <jim.cromie@gmail.com>
Date: Tue, 9 Jun 2009 01:55:05 -0600
Subject: [PATCH 3/7] rework (new|del)_body\w* macros: clarify mapping:
sv_type --> reqid

pull this mapping out of S_more_bodies, and into callers:
   "void**const root = &PL_bodyroots[svtype]"

This lets us use S_more_bodies to thread free bodies onto any root,
untieing us from using only PL_bodyroots.

For the ~16 global sv-body customers, we just use their respective
body-root pointers; theyre void*, so they dont deref without casting,
and theyre unique (which we need for accurate cleanup).  This mapping
has mostly been in place for some time, we're merely cleaning it up
now (ahem;-)  We also do:

 -rename del_body --> del_body_private.  Its 2nd arg has always been
  root, this makes it clear/distinct from sv_type, which is (naturally)
  the global/public user.
 -comment on global/private distinction, and shuffle current new/del_*
  macro defs; del_*'s are simpler, and visual organization is easier.

Next patch, we will use the private alloc-path to privatize the
ptr-table-ents for a specific ptr-table.  PTEs are currently kept
globally, and in the wrong workload patterns, this can leave *gobs* of
memory hanging uselessly off the interpreter til process death.
---
 embed.fnc |    2 +-
 embed.h   |    2 +-
 proto.h   |    6 ++++-
 sv.c      |   63
+++++++++++++++++++++++++++++++++++-------------------------
 4 files changed, 44 insertions(+), 29 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 8799f31..7230b90 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1759,7 +1759,7 @@ sn    |char *    |F0convert    |NV nv|NN char *const
endbuf|NN STRLEN *const len
 sM    |void    |sv_release_COW    |NN SV *sv|NN const char *pvx|NN SV
*after
 #  endif
 s    |SV *    |more_sv
-s    |void *    |more_bodies    |const svtype sv_type
+s    |void *    |more_bodies    | const svtype sv_type | NN void ** const
broot
 s    |bool    |sv_2iuv_common    |NN SV *const sv
 s    |void    |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \
         |const int dtype
diff --git a/embed.h b/embed.h
index ba78d60..9d588e3 100644
--- a/embed.h
+++ b/embed.h
@@ -3887,7 +3887,7 @@
 #  endif
 #ifdef PERL_CORE
 #define more_sv()        S_more_sv(aTHX)
-#define more_bodies(a)        S_more_bodies(aTHX_ a)
+#define more_bodies(a,b)    S_more_bodies(aTHX_ a,b)
 #define sv_2iuv_common(a)    S_sv_2iuv_common(aTHX_ a)
 #define glob_assign_glob(a,b,c)    S_glob_assign_glob(aTHX_ a,b,c)
 #define glob_assign_ref(a,b)    S_glob_assign_ref(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index 528e5f8..4a1663c 100644
--- a/proto.h
+++ b/proto.h
@@ -5636,7 +5636,11 @@ STATIC void    S_sv_release_COW(pTHX_ SV *sv, const
char *pvx, SV *after)

 #  endif
 STATIC SV *    S_more_sv(pTHX);
-STATIC void *    S_more_bodies(pTHX_ const svtype sv_type);
+STATIC void *    S_more_bodies(pTHX_ const svtype sv_type, void ** const
broot)
+            __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_MORE_BODIES    \
+    assert(broot)
+
 STATIC bool    S_sv_2iuv_common(pTHX_ SV *const sv)
             __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_SV_2IUV_COMMON    \
diff --git a/sv.c b/sv.c
index 4ba2319..588dcef 100644
--- a/sv.c
+++ b/sv.c
@@ -762,7 +762,7 @@ Perl_get_arena(pTHX_ const size_t arena_size, const
svtype bodytype, void * cons

 /* return a thing to the free list */

-#define del_body(thing, root)            \
+#define del_body_private(thing, root)        \
     STMT_START {                \
     void ** const thing_copy = (void **)thing;\
     *thing_copy = *root;            \
@@ -1009,21 +1009,26 @@ static const struct body_details bodies_by_type[] =
{
       FIT_ARENA(24, sizeof(XPVIO) - STRUCT_OFFSET(XPVIO, xpv_cur)) },
 };

-#define new_body_type(sv_type)        \
-    (void *)((char *)S_new_body(aTHX_ sv_type))
+/* 2 kinds of sv-body allocations:
+   global: sv_type based, bodies to/from PL_bodyroots[]
+   private: private-root, bodies to/from it (just rename del_body! :-)
+   The following del_* macros map sv_type -> &PL_body_roots[sv_type]
+   new_* call-chain remains a bit wrinkled..
+ */
+#define del_body(p, root)    del_body_private(p, root) /* orig name */
+#define del_body_type(p, type)    del_body_private(p, &PL_body_roots[type])

-#define del_body_type(p, sv_type)    \
-    del_body(p, &PL_body_roots[sv_type])
+#define del_body_allocated(p, sv_type)    \
+    del_body_private(p + bodies_by_type[sv_type].offset, \
+             &PL_body_roots[sv_type])

+#define new_body_type(sv_type)        \
+    (void *)((char *)S_new_body(aTHX_ sv_type))

 #define new_body_allocated(sv_type)        \
     (void *)((char *)S_new_body(aTHX_ sv_type)    \
          - bodies_by_type[sv_type].offset)

-#define del_body_allocated(p, sv_type)        \
-    del_body(p + bodies_by_type[sv_type].offset, &PL_body_roots[sv_type])
-
-
 #define my_safemalloc(s)    (void*)safemalloc(s)
 #define my_safecalloc(s)    (void*)safecalloc(s, 1)
 #define my_safefree(p)    safefree((char*)p)
@@ -1078,10 +1083,11 @@ static const struct body_details bodies_by_type[] =
{
     my_safecalloc((details)->body_size + (details)->offset)

 STATIC void *
-S_more_bodies (pTHX_ const svtype sv_type)
+S_more_bodies (pTHX_ const svtype sv_type, void ** const broot)
 {
+    /* rely on caller to send correct
+       void ** const broot = &PL_body_roots[sv_type]; */
     dVAR;
-    void ** const root = &PL_body_roots[sv_type];
     const struct body_details * const bdp = &bodies_by_type[sv_type];
     const size_t body_size = bdp->body_size;
     char *start;
@@ -1104,7 +1110,7 @@ S_more_bodies (pTHX_ const svtype sv_type)

     assert(bdp->arena_size);

-    start = (char*) Perl_get_arena(aTHX_ arena_size, sv_type,
(void*)NULL+1);
+    start = (char*) Perl_get_arena(aTHX_ arena_size, sv_type, broot);

     end = start + arena_size - 2 * body_size;

@@ -1123,7 +1129,7 @@ S_more_bodies (pTHX_ const svtype sv_type)
               (int)bdp->arena_size, sv_type, (int)body_size,
               (int)bdp->arena_size / (int)body_size));
 #endif
-    *root = (void *)start;
+    *broot = (void *)start;

     while (start <= end) {
     char * const next = start + body_size;
@@ -1132,23 +1138,28 @@ S_more_bodies (pTHX_ const svtype sv_type)
     }
     *(void **)start = 0;

-    return *root;
+    return *broot;
 }

-/* grab a new thing from the free list, allocating more if necessary.
-   The inline version is used for speed in hot routines, and the
-   function using it serves the rest (unless PURIFY).
-*/
-#define new_body_inline(xpv, sv_type) \
-    STMT_START { \
-    void ** const r3wt = &PL_body_roots[sv_type]; \
+/* grab a new thing from the given (and possibly private) freelist,
+   allocating more as needed to the given freelist.  new_body_inline()
+   users get the global body-roots, ptr_tables can use a private
+   body-root they keep in tbl->free_ents */
+#define new_body_private(xpv, sv_type, theroot)    \
+    STMT_START {                    \
+    void ** const r3wt = theroot;            \
     xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt))      \
-      ? *((void **)(r3wt)) : more_bodies(sv_type)); \
-    *(r3wt) = *(void**)(xpv); \
+      ? *((void **)(r3wt)) : more_bodies(sv_type, r3wt)); \
+    *(r3wt) = *(void**)(xpv);            \
     } STMT_END

-#ifndef PURIFY
+#define new_body_inline(xpv, sv_type)        \
+    new_body_private(xpv, sv_type, &PL_body_roots[sv_type])

+#ifndef PURIFY
+/* The inline version is used for speed in hot routines, and the
+   function using it serves the rest (unless PURIFY).
+*/
 STATIC void *
 S_new_body(pTHX_ const svtype sv_type)
 {
@@ -10620,7 +10631,7 @@ Perl_ptr_table_new(pTHX)
    Perl_ptr_table_store()
  */

-#define del_pte(p)     del_body_type(p, PTE_SVSLOT)
+#define del_pte(p)  del_body_private(p, &PL_body_roots[PTE_SVSLOT])

 /* map an existing pointer using a table */

@@ -10666,7 +10677,7 @@ 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);
+    new_body_private(tblent, PTE_SVSLOT, &PL_body_roots[PTE_SVSLOT]);

     tblent->oldval = oldsv;
     tblent->newval = newsv;
-- 
1.6.2.5

[jimc@harpo perl]$



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