This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove offer_nice_chunk(), PL_nice_chunk and PL_nice_chunk_size.
authorNicholas Clark <nick@ccl4.org>
Wed, 8 Sep 2010 09:24:04 +0000 (10:24 +0100)
committerNicholas Clark <nick@ccl4.org>
Wed, 8 Sep 2010 09:24:04 +0000 (10:24 +0100)
These provided a non-public API for the hash and array code to donate free
memory direct to the SV head allocation routines, instead of returning it
to the malloc system with free().

I assume that on some older mallocs this could offer significant benefits.
However, my benchmarking on a modern malloc couldn't detect any significant
effect (positive or negative) on removing the code. Its (continued) presence,
however, has downsides

a: slightly more code complexity
b: slightly larger interpreter structure
c: in the steady state, if net creation of SVs is zero, 1 chunk of allocated
   but unused memory will exist (per thread)

So I think it best to remove it.

Porting/findvars
av.c
embed.fnc
embed.h
embedvar.h
hv.c
intrpvar.h
perlapi.h
proto.h
sv.c

index b2914f5..173175e 100644 (file)
@@ -204,8 +204,6 @@ na
 nexttoke
 nexttype
 nextval
-nice_chunk
-nice_chunk_size
 ninterps
 nomemok
 numeric_local
diff --git a/av.c b/av.c
index 86aaae0..b061828 100644 (file)
--- a/av.c
+++ b/av.c
@@ -150,11 +150,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
                assert(newmax >= AvMAX(av));
                Newx(ary, newmax+1, SV*);
                Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
-               if (AvMAX(av) > 64)
-                   offer_nice_chunk(AvALLOC(av),
-                                    (AvMAX(av)+1) * sizeof(const SV *));
-               else
-                   Safefree(AvALLOC(av));
+               Safefree(AvALLOC(av));
                AvALLOC(av) = ary;
 #endif
 #ifdef Perl_safesysmalloc_size
index 8d6758e..a4382a3 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2273,9 +2273,6 @@ Apo       |bool   |ckwarn_d       |U32 w
 XEopMa |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \
                                |NN const char *const bits|STRLEN size
 
-: Used in av.c, hv.c
-p      |void   |offer_nice_chunk       |NN void *const chunk|const U32 chunk_size
-
 #ifndef SPRINTF_RETURNS_STRLEN
 Apnod  |int    |my_sprintf     |NN char *buffer|NN const char *pat|...
 #endif
diff --git a/embed.h b/embed.h
index 2812c92..b4e419c 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define ckwarn_common          S_ckwarn_common
 #endif
 #endif
-#ifdef PERL_CORE
-#define offer_nice_chunk       Perl_offer_nice_chunk
-#endif
 #ifndef SPRINTF_RETURNS_STRLEN
 #endif
 #ifdef PERL_CORE
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #endif
-#ifdef PERL_CORE
-#define offer_nice_chunk(a,b)  Perl_offer_nice_chunk(aTHX_ a,b)
-#endif
 #ifndef SPRINTF_RETURNS_STRLEN
 #endif
 #ifdef PERL_CORE
index e57eed9..3a9bccc 100644 (file)
 #define PL_my_cxt_list         (vTHX->Imy_cxt_list)
 #define PL_my_cxt_size         (vTHX->Imy_cxt_size)
 #define PL_na                  (vTHX->Ina)
-#define PL_nice_chunk          (vTHX->Inice_chunk)
-#define PL_nice_chunk_size     (vTHX->Inice_chunk_size)
 #define PL_nomemok             (vTHX->Inomemok)
 #define PL_numeric_local       (vTHX->Inumeric_local)
 #define PL_numeric_name                (vTHX->Inumeric_name)
 #define PL_Imy_cxt_list                PL_my_cxt_list
 #define PL_Imy_cxt_size                PL_my_cxt_size
 #define PL_Ina                 PL_na
-#define PL_Inice_chunk         PL_nice_chunk
-#define PL_Inice_chunk_size    PL_nice_chunk_size
 #define PL_Inomemok            PL_nomemok
 #define PL_Inumeric_local      PL_numeric_local
 #define PL_Inumeric_name       PL_numeric_name
diff --git a/hv.c b/hv.c
index 9d7606a..9aa1466 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1105,13 +1105,7 @@ S_hsplit(pTHX_ HV *hv)
     if (SvOOK(hv)) {
        Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
     }
-    if (oldsize >= 64) {
-       offer_nice_chunk(HvARRAY(hv),
-                        PERL_HV_ARRAY_ALLOC_BYTES(oldsize)
-                        + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0));
-    }
-    else
-       Safefree(HvARRAY(hv));
+    Safefree(HvARRAY(hv));
 #endif
 
     PL_nomemok = FALSE;
@@ -1270,13 +1264,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        if (SvOOK(hv)) {
            Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
        }
-       if (oldsize >= 64) {
-           offer_nice_chunk(HvARRAY(hv),
-                            PERL_HV_ARRAY_ALLOC_BYTES(oldsize)
-                            + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0));
-       }
-       else
-           Safefree(HvARRAY(hv));
+       Safefree(HvARRAY(hv));
 #endif
        PL_nomemok = FALSE;
        Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
index 503d9d6..749be42 100644 (file)
@@ -445,8 +445,7 @@ PERLVAR(Isighandlerp,       Sighandler_t)
 
 PERLVARA(Ibody_roots,  PERL_ARENA_ROOTS_SIZE, void*) /* array of body roots */
 
-PERLVAR(Inice_chunk,   char *)         /* a nice chunk of memory to reuse */
-PERLVAR(Inice_chunk_size,      U32)    /* how nice the chunk of memory is */
+/* Space for an int */
 
 PERLVARI(Imaxo,        int,    MAXO)           /* maximum number of ops */
 
index cb0aa05..f41a31e 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -448,10 +448,6 @@ END_EXTERN_C
 #define PL_my_cxt_size         (*Perl_Imy_cxt_size_ptr(aTHX))
 #undef  PL_na
 #define PL_na                  (*Perl_Ina_ptr(aTHX))
-#undef  PL_nice_chunk
-#define PL_nice_chunk          (*Perl_Inice_chunk_ptr(aTHX))
-#undef  PL_nice_chunk_size
-#define PL_nice_chunk_size     (*Perl_Inice_chunk_size_ptr(aTHX))
 #undef  PL_nomemok
 #define PL_nomemok             (*Perl_Inomemok_ptr(aTHX))
 #undef  PL_numeric_local
diff --git a/proto.h b/proto.h
index b915db2..a29bdc0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6691,12 +6691,6 @@ PERL_CALLCONV STRLEN *   Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const ch
        assert(bits)
 
 
-PERL_CALLCONV void     Perl_offer_nice_chunk(pTHX_ void *const chunk, const U32 chunk_size)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_OFFER_NICE_CHUNK      \
-       assert(chunk)
-
-
 #ifndef SPRINTF_RETURNS_STRLEN
 PERL_CALLCONV int      Perl_my_sprintf(char *buffer, const char *pat, ...)
                        __attribute__nonnull__(1)
diff --git a/sv.c b/sv.c
index 136c65b..d6af5ce 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -162,26 +162,6 @@ Public API:
  * "A time to plant, and a time to uproot what was planted..."
  */
 
-void
-Perl_offer_nice_chunk(pTHX_ void *const chunk, const U32 chunk_size)
-{
-    dVAR;
-    void *new_chunk;
-    U32 new_chunk_size;
-
-    PERL_ARGS_ASSERT_OFFER_NICE_CHUNK;
-
-    new_chunk = (void *)(chunk);
-    new_chunk_size = (chunk_size);
-    if (new_chunk_size > PL_nice_chunk_size) {
-       Safefree(PL_nice_chunk);
-       PL_nice_chunk = (char *) new_chunk;
-       PL_nice_chunk_size = new_chunk_size;
-    } else {
-       Safefree(chunk);
-    }
-}
-
 #ifdef PERL_MEM_LOG
 #  define MEM_LOG_NEW_SV(sv, file, line, func) \
            Perl_mem_log_new_sv(sv, file, line, func)
@@ -254,17 +234,9 @@ S_more_sv(pTHX)
 {
     dVAR;
     SV* sv;
-
-    if (PL_nice_chunk) {
-       sv_add_arena(PL_nice_chunk, PL_nice_chunk_size, 0);
-       PL_nice_chunk = NULL;
-        PL_nice_chunk_size = 0;
-    }
-    else {
-       char *chunk;                /* must use New here to match call to */
-       Newx(chunk,PERL_ARENA_SIZE,char);  /* Safefree() in sv_free_arenas() */
-       sv_add_arena(chunk, PERL_ARENA_SIZE, 0);
-    }
+    char *chunk;                /* must use New here to match call to */
+    Newx(chunk,PERL_ARENA_SIZE,char);  /* Safefree() in sv_free_arenas() */
+    sv_add_arena(chunk, PERL_ARENA_SIZE, 0);
     uproot_SV(sv);
     return sv;
 }
@@ -673,9 +645,6 @@ Perl_sv_free_arenas(pTHX)
     while (i--)
        PL_body_roots[i] = 0;
 
-    Safefree(PL_nice_chunk);
-    PL_nice_chunk = NULL;
-    PL_nice_chunk_size = 0;
     PL_sv_arenaroot = 0;
     PL_sv_root = 0;
 }
@@ -12296,8 +12265,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_body_arenas = NULL;
     Zero(&PL_body_roots, 1, PL_body_roots);
     
-    PL_nice_chunk      = NULL;
-    PL_nice_chunk_size = 0;
     PL_sv_count                = 0;
     PL_sv_objcount     = 0;
     PL_sv_root         = NULL;