[svn:ponie] r345 - in trunk: . perl src/pmc
[email protected] 29 Aug 2005 11:37:22 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: nicholas
Date: Mon Aug 29 04:37:21 2005
New Revision: 345
Modified:
trunk/ (props changed)
trunk/perl/embed.fnc
trunk/perl/embed.h
trunk/perl/global.sym
trunk/perl/perl.c
trunk/perl/proto.h
trunk/perl/sv.c
trunk/perl/sv.h
trunk/src/pmc/perl5cargo_cult.pmc
Log:
r26038@ship-in-a-bottle: nick | 2005-08-27 23:56:47 +0100
Add sv_free_immortal() to free the 3.5 immortal scalars (without needing
to drop their reference counts first)
Add Ponie_P_JOIN_CHOIR_INVISIBLE as a variant of Ponie_P_PINE_FOR_FJORDS,
which doesn't assert that the reference count is zero first. (For immortals)
Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc (original)
+++ trunk/perl/embed.fnc Mon Aug 29 04:37:21 2005
@@ -750,6 +750,7 @@ Apd |bool |sv_derived_from|SV* sv|const
Apd |I32 |sv_eq |SV* sv1|SV* sv2
Apd |void |sv_free |SV* sv
poMX |void |sv_free2 |SV* sv
+poMX |void |sv_free_immortal|SV* sv
pd |void |sv_free_arenas
Apd |char* |sv_gets |SV* sv|PerlIO* fp|I32 append
Apd |char* |sv_grow |SV* sv|STRLEN newlen
Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h (original)
+++ trunk/perl/embed.h Mon Aug 29 04:37:21 2005
@@ -3511,6 +3511,8 @@
#ifdef PERL_CORE
#endif
#ifdef PERL_CORE
+#endif
+#ifdef PERL_CORE
#define sv_free_arenas() Perl_sv_free_arenas(aTHX)
#endif
#define sv_gets(a,b,c) Perl_sv_gets(aTHX_ a,b,c)
Modified: trunk/perl/global.sym
==============================================================================
--- trunk/perl/global.sym (original)
+++ trunk/perl/global.sym Mon Aug 29 04:37:21 2005
@@ -467,6 +467,7 @@ Perl_sv_derived_from
Perl_sv_eq
Perl_sv_free
Perl_sv_free2
+Perl_sv_free_immortal
Perl_sv_gets
Perl_sv_grow
Perl_sv_inc
Modified: trunk/perl/perl.c
==============================================================================
--- trunk/perl/perl.c (original)
+++ trunk/perl/perl.c Mon Aug 29 04:37:21 2005
@@ -1195,33 +1195,14 @@ perl_destruct(pTHXx)
/* free special SVs */
- {
- /* The definition of IMMORTAL is that the pointer is one of the 3,
- so to actually clear any of them we need to ensure that the pointer
- in question is no longer pointing the PMC we actually now need to
- free. */
- SV *temp;
-
- temp = PL_sv_placeholder_p;
- PL_sv_placeholder_p = Nullsv;
- SvREFCNT_set(temp, 1);
- sv_free(temp);
-
- temp = PL_sv_yes_p;
- PL_sv_yes_p = Nullsv;
- SvREFCNT_set(temp, 1);
- sv_free(temp);
-
- temp = PL_sv_no_p;
- PL_sv_no_p = Nullsv;
- SvREFCNT_set(temp, 1);
- sv_free(temp);
-
- temp = PL_sv_undef_p;
- PL_sv_undef_p = Nullsv;
- SvREFCNT_set(temp, 1);
- sv_free(temp);
- }
+ Perl_sv_free_immortal(aTHX_ PL_sv_placeholder_p);
+ PL_sv_placeholder_p = Nullsv;
+ Perl_sv_free_immortal(aTHX_ PL_sv_yes_p);
+ PL_sv_yes_p = Nullsv;
+ Perl_sv_free_immortal(aTHX_ PL_sv_no_p);
+ PL_sv_no_p = Nullsv;
+ Perl_sv_free_immortal(aTHX_ PL_sv_undef_p);
+ PL_sv_undef_p = Nullsv;
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
Modified: trunk/perl/proto.h
==============================================================================
--- trunk/perl/proto.h (original)
+++ trunk/perl/proto.h Mon Aug 29 04:37:21 2005
@@ -719,6 +719,7 @@ PERL_CALLCONV bool Perl_sv_derived_from(
PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV* sv1, SV* sv2);
PERL_CALLCONV void Perl_sv_free(pTHX_ SV* sv);
PERL_CALLCONV void Perl_sv_free2(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_free_immortal(pTHX_ SV* sv);
PERL_CALLCONV void Perl_sv_free_arenas(pTHX);
PERL_CALLCONV char* Perl_sv_gets(pTHX_ SV* sv, PerlIO* fp, I32 append);
PERL_CALLCONV char* Perl_sv_grow(pTHX_ SV* sv, STRLEN newlen);
Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c (original)
+++ trunk/perl/sv.c Mon Aug 29 04:37:21 2005
@@ -175,6 +175,8 @@ Public API:
#define new_SV(p) (p)=MUMBLE(Parrot_PMC_new(PL_Parrot, PL_pmcname[SVt_NULL]))
#define del_SV(p) Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(p), \
Ponie_P_PINE_FOR_FJORDS, 0)
+#define del_immortal_SV(p) Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(p),\
+ Ponie_P_JOIN_CHOIR_INVISIBLE, 0)
STATIC void S_ptr_table_cleanup(pTHX_ PTR_TBL_t *tbl);
@@ -5036,6 +5038,18 @@ Perl_sv_free2(pTHX_ SV *sv)
del_SV(sv);
}
+
+void
+Perl_sv_free_immortal(pTHX_ SV *sv)
+{
+ /* This routine is called outside of PL_in_clean_all, SvBREAK shouldn't be
+ set, and immportals will always report a non-zero reference count, so we
+ don't want all the usual checks. We also need to call the backend
+ directly, as sv_clear asserts a zero reference count. */
+ sv_clear_backend(sv, 0);
+ del_immortal_SV(sv);
+}
+
/*
=for apidoc sv_len
Modified: trunk/perl/sv.h
==============================================================================
--- trunk/perl/sv.h (original)
+++ trunk/perl/sv.h Mon Aug 29 04:37:21 2005
@@ -251,6 +251,7 @@ typedef enum {
Ponie_P_NEWSVRV, /* newSVrv */
Ponie_P_REPLACE, /* Special things for sv_replace */
Ponie_P_PINE_FOR_FJORDS, /* Free all internal storage and play dead */
+ Ponie_P_JOIN_CHOIR_INVISIBLE, /* special version of pining for immortals */
Ponie_P_SV_2PV, /* Get the pvx and len. */
Ponie_P_SV_2PV_NO_GMAGIC, /* Get the pvx and len, but don't call GMAGIC */
Ponie_P_SV_PVN, /* Set the pvx and len. */
Modified: trunk/src/pmc/perl5cargo_cult.pmc
==============================================================================
--- trunk/src/pmc/perl5cargo_cult.pmc (original)
+++ trunk/src/pmc/perl5cargo_cult.pmc Mon Aug 29 04:37:21 2005
@@ -726,6 +726,8 @@ pmclass Perl5cargo_cult dynpmc {
input->len, 0);
}
break;
+ case Ponie_P_JOIN_CHOIR_INVISIBLE:
+ /* Special version for immortals. */
case Ponie_P_PINE_FOR_FJORDS:
{
--PL_sv_count;
@@ -737,7 +739,11 @@ pmclass Perl5cargo_cult dynpmc {
}
assert(PMC_struct_val(SELF));
- assert(!PERL5_REFCNT(SELF));
+ if (key != Ponie_P_JOIN_CHOIR_INVISIBLE) {
+ /* Immortals will always report a non-zero reference count.
+ */
+ assert(!PERL5_REFCNT(SELF));
+ }
free(PMC_struct_val(SELF));
PMC_struct_val(SELF) = 0;