cvs commit: ponie/perl embed.fnc embed.h global.sym proto.h sv.c
[email protected] (Nicholas Clark) 30 Apr 2005 19:28:03 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/04/30 12:28:03
Modified: perl embed.fnc embed.h global.sym proto.h sv.c
Log:
Move all the memory allocation code into the PMCs.
All memory management is now completely hidden from the perl core
Revision Changes Path
1.38 +0 -34 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- embed.fnc 30 Apr 2005 17:35:36 -0000 1.37
+++ embed.fnc 30 Apr 2005 19:28:02 -0000 1.38
@@ -1243,43 +1243,9 @@
s |SV* |save_scalar_at |SV **sptr
#endif
-Ap |XPV* |new_xpv
-Ap |XPVIV* |new_xpviv
-Ap |XPVNV* |new_xpvnv
-Ap |XPVCV* |new_xpvcv
-Ap |XPVAV* |new_xpvav
-Ap |XPVHV* |new_xpvhv
-Ap |XPVIO* |new_xpvio
-Ap |XPVFM* |new_xpvfm
-Ap |XPVMG* |new_xpvmg
-Ap |XPVLV* |new_xpvlv
-Ap |XPVBM* |new_xpvbm
-Ap |XPVGV* |new_xpvgv
-Ap |void |del_xpv |XPV* p
-Ap |void |del_xpviv |XPVIV* p
-Ap |void |del_xpvnv |XPVNV* p
-Ap |void |del_xpvcv |XPVCV* p
-Ap |void |del_xpvav |XPVAV* p
-Ap |void |del_xpvhv |XPVHV* p
-Ap |void |del_xpvio |XPVIO* p
-Ap |void |del_xpvfm |XPVFM* p
-Ap |void |del_xpvmg |XPVMG* p
-Ap |void |del_xpvlv |XPVLV* p
-Ap |void |del_xpvbm |XPVBM* p
-Ap |void |del_xpvgv |XPVGV* p
-
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
s |IV |asIV |SV* sv
s |UV |asUV |SV* sv
-s |void |more_xpv
-s |void |more_xpviv
-s |void |more_xpvnv
-s |void |more_xpvcv
-s |void |more_xpvav
-s |void |more_xpvhv
-s |void |more_xpvmg
-s |void |more_xpvlv
-s |void |more_xpvbm
s |void |sv_unglob |SV* sv
s |void |not_a_number |SV *sv
s |I32 |visit |SVFUNC_t f|U32 flags|U32 mask
1.28 +0 -102 ponie/perl/embed.h
Index: embed.h
===================================================================
RCS file: /cvs/public/ponie/perl/embed.h,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- embed.h 30 Apr 2005 17:35:36 -0000 1.27
+++ embed.h 30 Apr 2005 19:28:02 -0000 1.28
@@ -1768,30 +1768,6 @@
#define save_scalar_at S_save_scalar_at
#endif
#endif
-#define new_xpv Perl_new_xpv
-#define new_xpviv Perl_new_xpviv
-#define new_xpvnv Perl_new_xpvnv
-#define new_xpvcv Perl_new_xpvcv
-#define new_xpvav Perl_new_xpvav
-#define new_xpvhv Perl_new_xpvhv
-#define new_xpvio Perl_new_xpvio
-#define new_xpvfm Perl_new_xpvfm
-#define new_xpvmg Perl_new_xpvmg
-#define new_xpvlv Perl_new_xpvlv
-#define new_xpvbm Perl_new_xpvbm
-#define new_xpvgv Perl_new_xpvgv
-#define del_xpv Perl_del_xpv
-#define del_xpviv Perl_del_xpviv
-#define del_xpvnv Perl_del_xpvnv
-#define del_xpvcv Perl_del_xpvcv
-#define del_xpvav Perl_del_xpvav
-#define del_xpvhv Perl_del_xpvhv
-#define del_xpvio Perl_del_xpvio
-#define del_xpvfm Perl_del_xpvfm
-#define del_xpvmg Perl_del_xpvmg
-#define del_xpvlv Perl_del_xpvlv
-#define del_xpvbm Perl_del_xpvbm
-#define del_xpvgv Perl_del_xpvgv
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define asIV S_asIV
@@ -1800,33 +1776,6 @@
#define asUV S_asUV
#endif
#ifdef PERL_CORE
-#define more_xpv S_more_xpv
-#endif
-#ifdef PERL_CORE
-#define more_xpviv S_more_xpviv
-#endif
-#ifdef PERL_CORE
-#define more_xpvnv S_more_xpvnv
-#endif
-#ifdef PERL_CORE
-#define more_xpvcv S_more_xpvcv
-#endif
-#ifdef PERL_CORE
-#define more_xpvav S_more_xpvav
-#endif
-#ifdef PERL_CORE
-#define more_xpvhv S_more_xpvhv
-#endif
-#ifdef PERL_CORE
-#define more_xpvmg S_more_xpvmg
-#endif
-#ifdef PERL_CORE
-#define more_xpvlv S_more_xpvlv
-#endif
-#ifdef PERL_CORE
-#define more_xpvbm S_more_xpvbm
-#endif
-#ifdef PERL_CORE
#define sv_unglob S_sv_unglob
#endif
#ifdef PERL_CORE
@@ -4374,30 +4323,6 @@
#define save_scalar_at(a) S_save_scalar_at(aTHX_ a)
#endif
#endif
-#define new_xpv() Perl_new_xpv(aTHX)
-#define new_xpviv() Perl_new_xpviv(aTHX)
-#define new_xpvnv() Perl_new_xpvnv(aTHX)
-#define new_xpvcv() Perl_new_xpvcv(aTHX)
-#define new_xpvav() Perl_new_xpvav(aTHX)
-#define new_xpvhv() Perl_new_xpvhv(aTHX)
-#define new_xpvio() Perl_new_xpvio(aTHX)
-#define new_xpvfm() Perl_new_xpvfm(aTHX)
-#define new_xpvmg() Perl_new_xpvmg(aTHX)
-#define new_xpvlv() Perl_new_xpvlv(aTHX)
-#define new_xpvbm() Perl_new_xpvbm(aTHX)
-#define new_xpvgv() Perl_new_xpvgv(aTHX)
-#define del_xpv(a) Perl_del_xpv(aTHX_ a)
-#define del_xpviv(a) Perl_del_xpviv(aTHX_ a)
-#define del_xpvnv(a) Perl_del_xpvnv(aTHX_ a)
-#define del_xpvcv(a) Perl_del_xpvcv(aTHX_ a)
-#define del_xpvav(a) Perl_del_xpvav(aTHX_ a)
-#define del_xpvhv(a) Perl_del_xpvhv(aTHX_ a)
-#define del_xpvio(a) Perl_del_xpvio(aTHX_ a)
-#define del_xpvfm(a) Perl_del_xpvfm(aTHX_ a)
-#define del_xpvmg(a) Perl_del_xpvmg(aTHX_ a)
-#define del_xpvlv(a) Perl_del_xpvlv(aTHX_ a)
-#define del_xpvbm(a) Perl_del_xpvbm(aTHX_ a)
-#define del_xpvgv(a) Perl_del_xpvgv(aTHX_ a)
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define asIV(a) S_asIV(aTHX_ a)
@@ -4406,33 +4331,6 @@
#define asUV(a) S_asUV(aTHX_ a)
#endif
#ifdef PERL_CORE
-#define more_xpv() S_more_xpv(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpviv() S_more_xpviv(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvnv() S_more_xpvnv(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvcv() S_more_xpvcv(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvav() S_more_xpvav(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvhv() S_more_xpvhv(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvmg() S_more_xpvmg(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvlv() S_more_xpvlv(aTHX)
-#endif
-#ifdef PERL_CORE
-#define more_xpvbm() S_more_xpvbm(aTHX)
-#endif
-#ifdef PERL_CORE
#define sv_unglob(a) S_sv_unglob(aTHX_ a)
#endif
#ifdef PERL_CORE
1.21 +0 -24 ponie/perl/global.sym
Index: global.sym
===================================================================
RCS file: /cvs/public/ponie/perl/global.sym,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- global.sym 30 Apr 2005 09:12:44 -0000 1.20
+++ global.sym 30 Apr 2005 19:28:02 -0000 1.21
@@ -706,30 +706,6 @@
Perl_macro_CvOUTSIDE_SEQ
Perl_Slab_Alloc
Perl_Slab_Free
-Perl_new_xpv
-Perl_new_xpviv
-Perl_new_xpvnv
-Perl_new_xpvcv
-Perl_new_xpvav
-Perl_new_xpvhv
-Perl_new_xpvio
-Perl_new_xpvfm
-Perl_new_xpvmg
-Perl_new_xpvlv
-Perl_new_xpvbm
-Perl_new_xpvgv
-Perl_del_xpv
-Perl_del_xpviv
-Perl_del_xpvnv
-Perl_del_xpvcv
-Perl_del_xpvav
-Perl_del_xpvhv
-Perl_del_xpvio
-Perl_del_xpvfm
-Perl_del_xpvmg
-Perl_del_xpvlv
-Perl_del_xpvbm
-Perl_del_xpvgv
Perl_sv_setsv_flags
Perl_sv_catpvn_flags
Perl_sv_catsv_flags
1.38 +0 -34 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- proto.h 30 Apr 2005 17:35:36 -0000 1.37
+++ proto.h 30 Apr 2005 19:28:02 -0000 1.38
@@ -1195,43 +1195,9 @@
STATIC SV* S_save_scalar_at(pTHX_ SV **sptr);
#endif
-PERL_CALLCONV XPV* Perl_new_xpv(pTHX);
-PERL_CALLCONV XPVIV* Perl_new_xpviv(pTHX);
-PERL_CALLCONV XPVNV* Perl_new_xpvnv(pTHX);
-PERL_CALLCONV XPVCV* Perl_new_xpvcv(pTHX);
-PERL_CALLCONV XPVAV* Perl_new_xpvav(pTHX);
-PERL_CALLCONV XPVHV* Perl_new_xpvhv(pTHX);
-PERL_CALLCONV XPVIO* Perl_new_xpvio(pTHX);
-PERL_CALLCONV XPVFM* Perl_new_xpvfm(pTHX);
-PERL_CALLCONV XPVMG* Perl_new_xpvmg(pTHX);
-PERL_CALLCONV XPVLV* Perl_new_xpvlv(pTHX);
-PERL_CALLCONV XPVBM* Perl_new_xpvbm(pTHX);
-PERL_CALLCONV XPVGV* Perl_new_xpvgv(pTHX);
-PERL_CALLCONV void Perl_del_xpv(pTHX_ XPV* p);
-PERL_CALLCONV void Perl_del_xpviv(pTHX_ XPVIV* p);
-PERL_CALLCONV void Perl_del_xpvnv(pTHX_ XPVNV* p);
-PERL_CALLCONV void Perl_del_xpvcv(pTHX_ XPVCV* p);
-PERL_CALLCONV void Perl_del_xpvav(pTHX_ XPVAV* p);
-PERL_CALLCONV void Perl_del_xpvhv(pTHX_ XPVHV* p);
-PERL_CALLCONV void Perl_del_xpvio(pTHX_ XPVIO* p);
-PERL_CALLCONV void Perl_del_xpvfm(pTHX_ XPVFM* p);
-PERL_CALLCONV void Perl_del_xpvmg(pTHX_ XPVMG* p);
-PERL_CALLCONV void Perl_del_xpvlv(pTHX_ XPVLV* p);
-PERL_CALLCONV void Perl_del_xpvbm(pTHX_ XPVBM* p);
-PERL_CALLCONV void Perl_del_xpvgv(pTHX_ XPVGV* p);
-
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
STATIC IV S_asIV(pTHX_ SV* sv);
STATIC UV S_asUV(pTHX_ SV* sv);
-STATIC void S_more_xpv(pTHX);
-STATIC void S_more_xpviv(pTHX);
-STATIC void S_more_xpvnv(pTHX);
-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_xpvlv(pTHX);
-STATIC void S_more_xpvbm(pTHX);
STATIC void S_sv_unglob(pTHX_ SV* sv);
STATIC void S_not_a_number(pTHX_ SV *sv);
STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask);
1.71 +0 -519 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- sv.c 30 Apr 2005 17:35:36 -0000 1.70
+++ sv.c 30 Apr 2005 19:28:02 -0000 1.71
@@ -1062,525 +1062,6 @@
"", "", "");
}
-/* grab a new struct xpv from the free list, allocating more if necessary */
-
-XPV*
-Perl_new_xpv(pTHX)
-{
- XPV* xpv;
- LOCK_SV_MUTEX;
- if (!PL_xpv_root)
- more_xpv();
- xpv = PL_xpv_root;
- PL_xpv_root = (XPV*)xpv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpv;
-}
-
-/* return a struct xpv to the free list */
-
-void
-Perl_del_xpv(pTHX_ XPV *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpv_root;
- PL_xpv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpv */
-
-STATIC void
-S_more_xpv(pTHX)
-{
- register XPV* xpv;
- register XPV* xpvend;
- New(713, xpv, 1008/sizeof(XPV), XPV);
- xpv->xpv_pv = (char*)PL_xpv_arenaroot;
- PL_xpv_arenaroot = xpv;
-
- xpvend = &xpv[1008 / sizeof(XPV) - 1];
- PL_xpv_root = ++xpv;
- while (xpv < xpvend) {
- xpv->xpv_pv = (char*)(xpv + 1);
- xpv++;
- }
- xpv->xpv_pv = 0;
-}
-
-/* grab a new struct xpviv from the free list, allocating more if necessary */
-
-XPVIV*
-Perl_new_xpviv(pTHX)
-{
- XPVIV* xpviv;
- LOCK_SV_MUTEX;
- if (!PL_xpviv_root)
- more_xpviv();
- xpviv = PL_xpviv_root;
- PL_xpviv_root = (XPVIV*)xpviv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpviv;
-}
-
-/* return a struct xpviv to the free list */
-
-void
-Perl_del_xpviv(pTHX_ XPVIV *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpviv_root;
- PL_xpviv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpviv */
-
-STATIC void
-S_more_xpviv(pTHX)
-{
- register XPVIV* xpviv;
- register XPVIV* xpvivend;
- New(714, xpviv, 1008/sizeof(XPVIV), XPVIV);
- xpviv->xpv_pv = (char*)PL_xpviv_arenaroot;
- PL_xpviv_arenaroot = xpviv;
-
- xpvivend = &xpviv[1008 / sizeof(XPVIV) - 1];
- PL_xpviv_root = ++xpviv;
- while (xpviv < xpvivend) {
- xpviv->xpv_pv = (char*)(xpviv + 1);
- xpviv++;
- }
- xpviv->xpv_pv = 0;
-}
-
-/* grab a new struct xpvnv from the free list, allocating more if necessary */
-
-XPVNV*
-Perl_new_xpvnv(pTHX)
-{
- XPVNV* xpvnv;
- LOCK_SV_MUTEX;
- if (!PL_xpvnv_root)
- more_xpvnv();
- xpvnv = PL_xpvnv_root;
- PL_xpvnv_root = (XPVNV*)xpvnv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvnv;
-}
-
-/* return a struct xpvnv to the free list */
-
-void
-Perl_del_xpvnv(pTHX_ XPVNV *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvnv_root;
- PL_xpvnv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvnv */
-
-STATIC void
-S_more_xpvnv(pTHX)
-{
- register XPVNV* xpvnv;
- register XPVNV* xpvnvend;
- New(715, xpvnv, 1008/sizeof(XPVNV), XPVNV);
- xpvnv->xpv_pv = (char*)PL_xpvnv_arenaroot;
- PL_xpvnv_arenaroot = xpvnv;
-
- xpvnvend = &xpvnv[1008 / sizeof(XPVNV) - 1];
- PL_xpvnv_root = ++xpvnv;
- while (xpvnv < xpvnvend) {
- xpvnv->xpv_pv = (char*)(xpvnv + 1);
- xpvnv++;
- }
- xpvnv->xpv_pv = 0;
-}
-
-/* grab a new struct xpvcv from the free list, allocating more if necessary */
-
-XPVCV*
-Perl_new_xpvcv(pTHX)
-{
- XPVCV* xpvcv;
- LOCK_SV_MUTEX;
- if (!PL_xpvcv_root)
- more_xpvcv();
- xpvcv = PL_xpvcv_root;
- PL_xpvcv_root = (XPVCV*)xpvcv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvcv;
-}
-
-/* return a struct xpvcv to the free list */
-
-void
-Perl_del_xpvcv(pTHX_ XPVCV *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvcv_root;
- PL_xpvcv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvcv */
-
-STATIC void
-S_more_xpvcv(pTHX)
-{
- register XPVCV* xpvcv;
- register XPVCV* xpvcvend;
- New(716, xpvcv, 1008/sizeof(XPVCV), XPVCV);
- xpvcv->xpv_pv = (char*)PL_xpvcv_arenaroot;
- PL_xpvcv_arenaroot = xpvcv;
-
- xpvcvend = &xpvcv[1008 / sizeof(XPVCV) - 1];
- PL_xpvcv_root = ++xpvcv;
- while (xpvcv < xpvcvend) {
- xpvcv->xpv_pv = (char*)(xpvcv + 1);
- xpvcv++;
- }
- xpvcv->xpv_pv = 0;
-}
-
-/* grab a new struct xpvav from the free list, allocating more if necessary */
-
-XPVAV*
-Perl_new_xpvav(pTHX)
-{
- XPVAV* xpvav;
- LOCK_SV_MUTEX;
- if (!PL_xpvav_root)
- more_xpvav();
- xpvav = PL_xpvav_root;
- PL_xpvav_root = (XPVAV*)xpvav->xav_array;
- UNLOCK_SV_MUTEX;
- return xpvav;
-}
-
-/* return a struct xpvav to the free list */
-
-void
-Perl_del_xpvav(pTHX_ XPVAV *p)
-{
- LOCK_SV_MUTEX;
- p->xav_array = (char*)PL_xpvav_root;
- PL_xpvav_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvav */
-
-STATIC void
-S_more_xpvav(pTHX)
-{
- register XPVAV* xpvav;
- register XPVAV* xpvavend;
- New(717, xpvav, 1008/sizeof(XPVAV), XPVAV);
- xpvav->xav_array = (char*)PL_xpvav_arenaroot;
- PL_xpvav_arenaroot = xpvav;
-
- xpvavend = &xpvav[1008 / sizeof(XPVAV) - 1];
- PL_xpvav_root = ++xpvav;
- while (xpvav < xpvavend) {
- xpvav->xav_array = (char*)(xpvav + 1);
- xpvav++;
- }
- xpvav->xav_array = 0;
-}
-
-/* grab a new struct xpvhv from the free list, allocating more if necessary */
-
-XPVHV*
-Perl_new_xpvhv(pTHX)
-{
- XPVHV* xpvhv;
- LOCK_SV_MUTEX;
- if (!PL_xpvhv_root)
- more_xpvhv();
- xpvhv = PL_xpvhv_root;
- PL_xpvhv_root = (XPVHV*)xpvhv->xhv_array;
- UNLOCK_SV_MUTEX;
- return xpvhv;
-}
-
-/* return a struct xpvhv to the free list */
-
-void
-Perl_del_xpvhv(pTHX_ XPVHV *p)
-{
- LOCK_SV_MUTEX;
- p->xhv_array = (char*)PL_xpvhv_root;
- PL_xpvhv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvhv */
-
-STATIC void
-S_more_xpvhv(pTHX)
-{
- register XPVHV* xpvhv;
- register XPVHV* xpvhvend;
- New(718, xpvhv, 1008/sizeof(XPVHV), XPVHV);
- xpvhv->xhv_array = (char*)PL_xpvhv_arenaroot;
- PL_xpvhv_arenaroot = xpvhv;
-
- xpvhvend = &xpvhv[1008 / sizeof(XPVHV) - 1];
- PL_xpvhv_root = ++xpvhv;
- while (xpvhv < xpvhvend) {
- xpvhv->xhv_array = (char*)(xpvhv + 1);
- xpvhv++;
- }
- xpvhv->xhv_array = 0;
-}
-
-/* grab a new struct xpvmg from the free list, allocating more if necessary */
-
-XPVMG*
-Perl_new_xpvmg(pTHX)
-{
- XPVMG* xpvmg;
- LOCK_SV_MUTEX;
- if (!PL_xpvmg_root)
- more_xpvmg();
- xpvmg = PL_xpvmg_root;
- PL_xpvmg_root = (XPVMG*)xpvmg->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvmg;
-}
-
-/* return a struct xpvmg to the free list */
-
-void
-Perl_del_xpvmg(pTHX_ XPVMG *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvmg_root;
- PL_xpvmg_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvmg */
-
-STATIC void
-S_more_xpvmg(pTHX)
-{
- register XPVMG* xpvmg;
- register XPVMG* xpvmgend;
- New(719, xpvmg, 1008/sizeof(XPVMG), XPVMG);
- xpvmg->xpv_pv = (char*)PL_xpvmg_arenaroot;
- PL_xpvmg_arenaroot = xpvmg;
-
- xpvmgend = &xpvmg[1008 / sizeof(XPVMG) - 1];
- PL_xpvmg_root = ++xpvmg;
- while (xpvmg < xpvmgend) {
- xpvmg->xpv_pv = (char*)(xpvmg + 1);
- xpvmg++;
- }
- xpvmg->xpv_pv = 0;
-}
-
-/* grab a new struct xpvlv from the free list, allocating more if necessary */
-
-XPVLV*
-Perl_new_xpvlv(pTHX)
-{
- XPVLV* xpvlv;
- LOCK_SV_MUTEX;
- if (!PL_xpvlv_root)
- more_xpvlv();
- xpvlv = PL_xpvlv_root;
- PL_xpvlv_root = (XPVLV*)xpvlv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvlv;
-}
-
-/* return a struct xpvlv to the free list */
-
-void
-Perl_del_xpvlv(pTHX_ XPVLV *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvlv_root;
- PL_xpvlv_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvlv */
-
-STATIC void
-S_more_xpvlv(pTHX)
-{
- register XPVLV* xpvlv;
- register XPVLV* xpvlvend;
- New(720, xpvlv, 1008/sizeof(XPVLV), XPVLV);
- xpvlv->xpv_pv = (char*)PL_xpvlv_arenaroot;
- PL_xpvlv_arenaroot = xpvlv;
-
- xpvlvend = &xpvlv[1008 / sizeof(XPVLV) - 1];
- PL_xpvlv_root = ++xpvlv;
- while (xpvlv < xpvlvend) {
- xpvlv->xpv_pv = (char*)(xpvlv + 1);
- xpvlv++;
- }
- xpvlv->xpv_pv = 0;
-}
-
-/* grab a new struct xpvbm from the free list, allocating more if necessary */
-
-XPVBM*
-Perl_new_xpvbm(pTHX)
-{
- XPVBM* xpvbm;
- LOCK_SV_MUTEX;
- if (!PL_xpvbm_root)
- more_xpvbm();
- xpvbm = PL_xpvbm_root;
- PL_xpvbm_root = (XPVBM*)xpvbm->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvbm;
-}
-
-/* return a struct xpvbm to the free list */
-
-void
-Perl_del_xpvbm(pTHX_ XPVBM *p)
-{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvbm_root;
- PL_xpvbm_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-/* allocate another arena's worth of struct xpvbm */
-
-STATIC void
-S_more_xpvbm(pTHX)
-{
- register XPVBM* xpvbm;
- register XPVBM* xpvbmend;
- New(721, xpvbm, 1008/sizeof(XPVBM), XPVBM);
- xpvbm->xpv_pv = (char*)PL_xpvbm_arenaroot;
- PL_xpvbm_arenaroot = xpvbm;
-
- xpvbmend = &xpvbm[1008 / sizeof(XPVBM) - 1];
- PL_xpvbm_root = ++xpvbm;
- while (xpvbm < xpvbmend) {
- xpvbm->xpv_pv = (char*)(xpvbm + 1);
- xpvbm++;
- }
- xpvbm->xpv_pv = 0;
-}
-
-#define my_safemalloc(s) (void*)safemalloc(s)
-#define my_safefree(p) safefree((char*)p)
-
-#ifdef PURIFY
-
-#define new_XPV() my_safemalloc(sizeof(XPV))
-#define del_XPV(p) my_safefree(p)
-
-#define new_XPVIV() my_safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) my_safefree(p)
-
-#define new_XPVNV() my_safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) my_safefree(p)
-
-#define new_XPVCV() my_safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) my_safefree(p)
-
-#define new_XPVAV() my_safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) my_safefree(p)
-
-#define new_XPVHV() my_safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) my_safefree(p)
-
-#define new_XPVMG() my_safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) my_safefree(p)
-
-#define new_XPVLV() my_safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) my_safefree(p)
-
-#define new_XPVBM() my_safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) my_safefree(p)
-
-#else /* !PURIFY */
-
-#define new_XPV() (void*)new_xpv()
-#define del_XPV(p) del_xpv((XPV *)p)
-
-#define new_XPVIV() (void*)new_xpviv()
-#define del_XPVIV(p) del_xpviv((XPVIV *)p)
-
-#define new_XPVNV() (void*)new_xpvnv()
-#define del_XPVNV(p) del_xpvnv((XPVNV *)p)
-
-#define new_XPVCV() (void*)new_xpvcv()
-#define del_XPVCV(p) del_xpvcv((XPVCV *)p)
-
-#define new_XPVAV() (void*)new_xpvav()
-#define del_XPVAV(p) del_xpvav((XPVAV *)p)
-
-#define new_XPVHV() (void*)new_xpvhv()
-#define del_XPVHV(p) del_xpvhv((XPVHV *)p)
-
-#define new_XPVMG() (void*)new_xpvmg()
-#define del_XPVMG(p) del_xpvmg((XPVMG *)p)
-
-#define new_XPVLV() (void*)new_xpvlv()
-#define del_XPVLV(p) del_xpvlv((XPVLV *)p)
-
-#define new_XPVBM() (void*)new_xpvbm()
-#define del_XPVBM(p) del_xpvbm((XPVBM *)p)
-
-#endif /* PURIFY */
-
-#define new_XPVGV() (void*)new_xpvgv()
-#define del_XPVGV(p) del_xpvgv((XPVGV *)p)
-
-#define new_XPVFM() (void*)new_xpvfm()
-#define del_XPVFM(p) del_xpvfm((XPVFM *)p)
-
-#define new_XPVIO() (void*)new_xpvio()
-#define del_XPVIO(p) del_xpvio((XPVIO *)p)
-
-XPVGV *
-Perl_new_xpvgv(pTHX)
-{
- return my_safemalloc(sizeof(XPVGV));
-}
-void
-Perl_del_xpvgv(pTHX_ XPVGV *fm)
-{
- my_safefree(fm);
-}
-
-XPVFM *
-Perl_new_xpvfm(pTHX)
-{
- return my_safemalloc(sizeof(XPVFM));
-}
-void
-Perl_del_xpvfm(pTHX_ XPVFM *fm)
-{
- my_safefree(fm);
-}
-
-XPVIO *
-Perl_new_xpvio(pTHX)
-{
- return my_safemalloc(sizeof(XPVIO));
-}
-void
-Perl_del_xpvio(pTHX_ XPVIO*io)
-{
- my_safefree(io);
-}
-
void**
Perl_macro_SvANY (pTHX_ SV *sv) {
return &(((struct STRUCT_SV*)Parrot_PMC_get_pointer(PL_Parrot,MUMBLE(sv)))