This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allocate GV bodies from arenas
authorNicholas Clark <nick@ccl4.org>
Fri, 13 May 2005 11:09:03 +0000 (11:09 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 13 May 2005 11:09:03 +0000 (11:09 +0000)
p4raw-id: //depot/perl@24459

embed.fnc
embed.h
embedvar.h
intrpvar.h
perlapi.h
proto.h
sv.c

index 498304a..1260bad 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1191,6 +1191,7 @@ s |void   |more_xpvcv
 s      |void   |more_xpvav
 s      |void   |more_xpvhv
 s      |void   |more_xpvmg
+s      |void   |more_xpvgv
 s      |void   |more_xpvlv
 s      |void   |more_xpvbm
 s      |void   |more_xrv
@@ -1203,6 +1204,7 @@ s |XPVCV* |new_xpvcv
 s      |XPVAV* |new_xpvav
 s      |XPVHV* |new_xpvhv
 s      |XPVMG* |new_xpvmg
+s      |XPVGV* |new_xpvgv
 s      |XPVLV* |new_xpvlv
 s      |XPVBM* |new_xpvbm
 s      |XRV*   |new_xrv
@@ -1215,6 +1217,7 @@ s |void   |del_xpvcv      |XPVCV* p
 s      |void   |del_xpvav      |XPVAV* p
 s      |void   |del_xpvhv      |XPVHV* p
 s      |void   |del_xpvmg      |XPVMG* p
+s      |void   |del_xpvgv      |XPVGV* p
 s      |void   |del_xpvlv      |XPVLV* p
 s      |void   |del_xpvbm      |XPVBM* p
 s      |void   |del_xrv        |XRV* p
diff --git a/embed.h b/embed.h
index f2102c3..b7ae6da 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define more_xpvav             S_more_xpvav
 #define more_xpvhv             S_more_xpvhv
 #define more_xpvmg             S_more_xpvmg
+#define more_xpvgv             S_more_xpvgv
 #define more_xpvlv             S_more_xpvlv
 #define more_xpvbm             S_more_xpvbm
 #define more_xrv               S_more_xrv
 #define new_xpvav              S_new_xpvav
 #define new_xpvhv              S_new_xpvhv
 #define new_xpvmg              S_new_xpvmg
+#define new_xpvgv              S_new_xpvgv
 #define new_xpvlv              S_new_xpvlv
 #define new_xpvbm              S_new_xpvbm
 #define new_xrv                        S_new_xrv
 #define del_xpvav              S_del_xpvav
 #define del_xpvhv              S_del_xpvhv
 #define del_xpvmg              S_del_xpvmg
+#define del_xpvgv              S_del_xpvgv
 #define del_xpvlv              S_del_xpvlv
 #define del_xpvbm              S_del_xpvbm
 #define del_xrv                        S_del_xrv
 #define more_xpvav()           S_more_xpvav(aTHX)
 #define more_xpvhv()           S_more_xpvhv(aTHX)
 #define more_xpvmg()           S_more_xpvmg(aTHX)
+#define more_xpvgv()           S_more_xpvgv(aTHX)
 #define more_xpvlv()           S_more_xpvlv(aTHX)
 #define more_xpvbm()           S_more_xpvbm(aTHX)
 #define more_xrv()             S_more_xrv(aTHX)
 #define new_xpvav()            S_new_xpvav(aTHX)
 #define new_xpvhv()            S_new_xpvhv(aTHX)
 #define new_xpvmg()            S_new_xpvmg(aTHX)
+#define new_xpvgv()            S_new_xpvgv(aTHX)
 #define new_xpvlv()            S_new_xpvlv(aTHX)
 #define new_xpvbm()            S_new_xpvbm(aTHX)
 #define new_xrv()              S_new_xrv(aTHX)
 #define del_xpvav(a)           S_del_xpvav(aTHX_ a)
 #define del_xpvhv(a)           S_del_xpvhv(aTHX_ a)
 #define del_xpvmg(a)           S_del_xpvmg(aTHX_ a)
+#define del_xpvgv(a)           S_del_xpvgv(aTHX_ a)
 #define del_xpvlv(a)           S_del_xpvlv(aTHX_ a)
 #define del_xpvbm(a)           S_del_xpvbm(aTHX_ a)
 #define del_xrv(a)             S_del_xrv(aTHX_ a)
index 631a245..60c5d27 100644 (file)
 #define PL_xpvbm_root          (vTHX->Ixpvbm_root)
 #define PL_xpvcv_arenaroot     (vTHX->Ixpvcv_arenaroot)
 #define PL_xpvcv_root          (vTHX->Ixpvcv_root)
+#define PL_xpvgv_arenaroot     (vTHX->Ixpvgv_arenaroot)
+#define PL_xpvgv_root          (vTHX->Ixpvgv_root)
 #define PL_xpvhv_arenaroot     (vTHX->Ixpvhv_arenaroot)
 #define PL_xpvhv_root          (vTHX->Ixpvhv_root)
 #define PL_xpviv_arenaroot     (vTHX->Ixpviv_arenaroot)
 #define PL_Ixpvbm_root         PL_xpvbm_root
 #define PL_Ixpvcv_arenaroot    PL_xpvcv_arenaroot
 #define PL_Ixpvcv_root         PL_xpvcv_root
+#define PL_Ixpvgv_arenaroot    PL_xpvgv_arenaroot
+#define PL_Ixpvgv_root         PL_xpvgv_root
 #define PL_Ixpvhv_arenaroot    PL_xpvhv_arenaroot
 #define PL_Ixpvhv_root         PL_xpvhv_root
 #define PL_Ixpviv_arenaroot    PL_xpviv_arenaroot
index bca17b0..ab08e05 100644 (file)
@@ -258,6 +258,7 @@ PERLVAR(Ixpvcv_root,        XPVCV *)        /* free xpvcv list */
 PERLVAR(Ixpvav_root,   XPVAV *)        /* free xpvav list */
 PERLVAR(Ixpvhv_root,   XPVHV *)        /* free xpvhv list */
 PERLVAR(Ixpvmg_root,   XPVMG *)        /* free xpvmg list */
+PERLVAR(Ixpvgv_root,   XPVGV *)        /* free xpvgv list */
 PERLVAR(Ixpvlv_root,   XPVLV *)        /* free xpvlv list */
 PERLVAR(Ixpvbm_root,   XPVBM *)        /* free xpvbm list */
 PERLVAR(Ihe_root,      HE *)           /* free he list */
@@ -437,6 +438,7 @@ PERLVAR(Ixpvcv_arenaroot,XPVCV*)    /* list of allocated xpvcv areas */
 PERLVAR(Ixpvav_arenaroot,XPVAV*)       /* list of allocated xpvav areas */
 PERLVAR(Ixpvhv_arenaroot,XPVHV*)       /* list of allocated xpvhv areas */
 PERLVAR(Ixpvmg_arenaroot,XPVMG*)       /* list of allocated xpvmg areas */
+PERLVAR(Ixpvgv_arenaroot,XPVGV*)       /* list of allocated xpvgv areas */
 PERLVAR(Ixpvlv_arenaroot,XPVLV*)       /* list of allocated xpvlv areas */
 PERLVAR(Ixpvbm_arenaroot,XPVBM*)       /* list of allocated xpvbm areas */
 PERLVAR(Ihe_arenaroot, HE *)           /* list of allocated he areas */
index 2ff02e5..6ae40a2 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -673,6 +673,10 @@ END_EXTERN_C
 #define PL_xpvcv_arenaroot     (*Perl_Ixpvcv_arenaroot_ptr(aTHX))
 #undef  PL_xpvcv_root
 #define PL_xpvcv_root          (*Perl_Ixpvcv_root_ptr(aTHX))
+#undef  PL_xpvgv_arenaroot
+#define PL_xpvgv_arenaroot     (*Perl_Ixpvgv_arenaroot_ptr(aTHX))
+#undef  PL_xpvgv_root
+#define PL_xpvgv_root          (*Perl_Ixpvgv_root_ptr(aTHX))
 #undef  PL_xpvhv_arenaroot
 #define PL_xpvhv_arenaroot     (*Perl_Ixpvhv_arenaroot_ptr(aTHX))
 #undef  PL_xpvhv_root
diff --git a/proto.h b/proto.h
index 766d27b..7b0764c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1851,6 +1851,7 @@ STATIC void       S_more_xpvcv(pTHX);
 STATIC void    S_more_xpvav(pTHX);
 STATIC void    S_more_xpvhv(pTHX);
 STATIC void    S_more_xpvmg(pTHX);
+STATIC void    S_more_xpvgv(pTHX);
 STATIC void    S_more_xpvlv(pTHX);
 STATIC void    S_more_xpvbm(pTHX);
 STATIC void    S_more_xrv(pTHX);
@@ -1863,6 +1864,7 @@ STATIC XPVCV*     S_new_xpvcv(pTHX);
 STATIC XPVAV*  S_new_xpvav(pTHX);
 STATIC XPVHV*  S_new_xpvhv(pTHX);
 STATIC XPVMG*  S_new_xpvmg(pTHX);
+STATIC XPVGV*  S_new_xpvgv(pTHX);
 STATIC XPVLV*  S_new_xpvlv(pTHX);
 STATIC XPVBM*  S_new_xpvbm(pTHX);
 STATIC XRV*    S_new_xrv(pTHX);
@@ -1875,6 +1877,7 @@ STATIC void       S_del_xpvcv(pTHX_ XPVCV* p);
 STATIC void    S_del_xpvav(pTHX_ XPVAV* p);
 STATIC void    S_del_xpvhv(pTHX_ XPVHV* p);
 STATIC void    S_del_xpvmg(pTHX_ XPVMG* p);
+STATIC void    S_del_xpvgv(pTHX_ XPVGV* p);
 STATIC void    S_del_xpvlv(pTHX_ XPVLV* p);
 STATIC void    S_del_xpvbm(pTHX_ XPVBM* p);
 STATIC void    S_del_xrv(pTHX_ XRV* p);
diff --git a/sv.c b/sv.c
index 568f81b..e80f7ca 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -609,6 +609,13 @@ Perl_sv_free_arenas(pTHX)
     PL_xpvmg_arenaroot = 0;
     PL_xpvmg_root = 0;
 
+    for (arena = (XPV*)PL_xpvgv_arenaroot; arena; arena = arenanext) {
+       arenanext = (XPV*)arena->xpv_pv;
+       Safefree(arena);
+    }
+    PL_xpvgv_arenaroot = 0;
+    PL_xpvgv_root = 0;
+
     for (arena = (XPV*)PL_xpvlv_arenaroot; arena; arena = arenanext) {
        arenanext = (XPV*)arena->xpv_pv;
        Safefree(arena);
@@ -1609,6 +1616,52 @@ S_more_xpvmg(pTHX)
     xpvmg->xpv_pv = 0;
 }
 
+/* allocate another arena's worth of struct xpvgv */
+
+STATIC void
+S_more_xpvgv(pTHX)
+{
+    XPVGV* xpvgv;
+    XPVGV* xpvgvend;
+    New(720, xpvgv, PERL_ARENA_SIZE/sizeof(XPVGV), XPVGV);
+    xpvgv->xpv_pv = (char*)PL_xpvgv_arenaroot;
+    PL_xpvgv_arenaroot = xpvgv;
+
+    xpvgvend = &xpvgv[PERL_ARENA_SIZE / sizeof(XPVGV) - 1];
+    PL_xpvgv_root = ++xpvgv;
+    while (xpvgv < xpvgvend) {
+       xpvgv->xpv_pv = (char*)(xpvgv + 1);
+       xpvgv++;
+    }
+    xpvgv->xpv_pv = 0;
+}
+
+/* grab a new struct xpvgv from the free list, allocating more if necessary */
+
+STATIC XPVGV*
+S_new_xpvgv(pTHX)
+{
+    XPVGV* xpvgv;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvgv_root)
+       more_xpvgv();
+    xpvgv = PL_xpvgv_root;
+    PL_xpvgv_root = (XPVGV*)xpvgv->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpvgv;
+}
+
+/* return a struct xpvgv to the free list */
+
+STATIC void
+S_del_xpvgv(pTHX_ XPVGV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpvgv_root;
+    PL_xpvgv_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
 /* grab a new struct xpvlv from the free list, allocating more if necessary */
 
 STATIC XPVLV*
@@ -1736,6 +1789,9 @@ S_more_xpvbm(pTHX)
 #define new_XPVMG()    my_safemalloc(sizeof(XPVMG))
 #define del_XPVMG(p)   my_safefree(p)
 
+#define new_XPVGV()    my_safemalloc(sizeof(XPVGV))
+#define del_XPVGV(p)   my_safefree(p)
+
 #define new_XPVLV()    my_safemalloc(sizeof(XPVLV))
 #define del_XPVLV(p)   my_safefree(p)
 
@@ -1774,6 +1830,9 @@ S_more_xpvbm(pTHX)
 #define new_XPVMG()    (void*)new_xpvmg()
 #define del_XPVMG(p)   del_xpvmg((XPVMG *)p)
 
+#define new_XPVGV()    (void*)new_xpvgv()
+#define del_XPVGV(p)   del_xpvgv((XPVGV *)p)
+
 #define new_XPVLV()    (void*)new_xpvlv()
 #define del_XPVLV(p)   del_xpvlv((XPVLV *)p)
 
@@ -1782,9 +1841,6 @@ S_more_xpvbm(pTHX)
 
 #endif /* PURIFY */
 
-#define new_XPVGV()    my_safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p)   my_safefree(p)
-
 #define new_XPVFM()    my_safemalloc(sizeof(XPVFM))
 #define del_XPVFM(p)   my_safefree(p)