cvs commit: ponie/perl embedvar.h intrpvar.h perl.c perlapi.h perlvars.h
[email protected] (Nicholas Clark) 21 Jun 2004 12:09:23 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/06/21 05:09:23
Modified: perl embedvar.h intrpvar.h perl.c perlapi.h perlvars.h
Log:
PL_sv_undef, yes, no and placeholder were allocated as SV heads.
Change to be allocated via pointers got from parrot
Revision Changes Path
1.5 +8 -6 ponie/perl/embedvar.h
Index: embedvar.h
===================================================================
RCS file: /cvs/public/ponie/perl/embedvar.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- embedvar.h 19 Jun 2004 11:44:33 -0000 1.4
+++ embedvar.h 21 Jun 2004 12:09:22 -0000 1.5
@@ -396,11 +396,12 @@
#define PL_subname (vTHX->Isubname)
#define PL_sv_arenatable (vTHX->Isv_arenatable)
#define PL_sv_count (vTHX->Isv_count)
-#define PL_sv_no (vTHX->Isv_no)
+#define PL_sv_no_p (vTHX->Isv_no_p)
#define PL_sv_objcount (vTHX->Isv_objcount)
+#define PL_sv_placeholder_p (vTHX->Isv_placeholder_p)
#define PL_sv_root (vTHX->Isv_root)
-#define PL_sv_undef (vTHX->Isv_undef)
-#define PL_sv_yes (vTHX->Isv_yes)
+#define PL_sv_undef_p (vTHX->Isv_undef_p)
+#define PL_sv_yes_p (vTHX->Isv_yes_p)
#define PL_sys_intern (vTHX->Isys_intern)
#define PL_taint_warn (vTHX->Itaint_warn)
#define PL_tainting (vTHX->Itainting)
@@ -698,11 +699,12 @@
#define PL_Isubname PL_subname
#define PL_Isv_arenatable PL_sv_arenatable
#define PL_Isv_count PL_sv_count
-#define PL_Isv_no PL_sv_no
+#define PL_Isv_no_p PL_sv_no_p
#define PL_Isv_objcount PL_sv_objcount
+#define PL_Isv_placeholder_p PL_sv_placeholder_p
#define PL_Isv_root PL_sv_root
-#define PL_Isv_undef PL_sv_undef
-#define PL_Isv_yes PL_sv_yes
+#define PL_Isv_undef_p PL_sv_undef_p
+#define PL_Isv_yes_p PL_sv_yes_p
#define PL_Isys_intern PL_sys_intern
#define PL_Itaint_warn PL_taint_warn
#define PL_Itainting PL_tainting
1.7 +8 -4 ponie/perl/intrpvar.h
Index: intrpvar.h
===================================================================
RCS file: /cvs/public/ponie/perl/intrpvar.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- intrpvar.h 19 Jun 2004 11:44:33 -0000 1.6
+++ intrpvar.h 21 Jun 2004 12:09:22 -0000 1.7
@@ -283,10 +283,14 @@
=cut
*/
-PERLVAR(Isv_undef, SV)
-PERLVAR(Isv_no, SV)
-PERLVAR(Isv_yes, SV)
-
+PERLVAR(Isv_undef_p, SV *)
+PERLVAR(Isv_no_p, SV *)
+PERLVAR(Isv_yes_p, SV *)
+PERLVAR(Isv_placeholder_p, SV *)
+#define PL_sv_undef (*PL_sv_undef_p)
+#define PL_sv_no (*PL_sv_no_p)
+#define PL_sv_yes (*PL_sv_yes_p)
+#define PL_sv_placeholder (*PL_sv_placeholder_p)
#ifdef CSH
PERLVARI(Icshname, char *, CSH)
PERLVARI(Icshlen, I32, 0)
1.10 +45 -25 ponie/perl/perl.c
Index: perl.c
===================================================================
RCS file: /cvs/public/ponie/perl/perl.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- perl.c 19 Jun 2004 11:44:33 -0000 1.9
+++ perl.c 21 Jun 2004 12:09:22 -0000 1.10
@@ -175,23 +175,27 @@
PL_linestr = NEWSV(65,79);
sv_upgrade(PL_linestr,SVt_PVIV);
- if (!SvREADONLY(&PL_sv_undef)) {
+ if (!PL_sv_undef_p) {
/* set read-only and try to insure than we wont see REFCNT==0
very often */
+ PL_sv_undef_p = newSV(0);
SvREADONLY_on(&PL_sv_undef);
SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
+ PL_sv_no_p = newSV(0);
sv_setpv(&PL_sv_no,PL_No);
SvNV(&PL_sv_no);
SvREADONLY_on(&PL_sv_no);
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
+ PL_sv_yes_p = newSV(0);
sv_setpv(&PL_sv_yes,PL_Yes);
SvNV(&PL_sv_yes);
SvREADONLY_on(&PL_sv_yes);
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ PL_sv_placeholder_p = newSV(0);
SvREADONLY_on(&PL_sv_placeholder);
SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
}
@@ -719,8 +723,8 @@
}
}
- /* the 2 is for PL_fdpid and PL_strtab */
- while (PL_sv_count > 2 && sv_clean_all())
+ /* the 6 is for PL_fdpid and PL_strtab, the 3 immortals and placeholder */
+ while (PL_sv_count > 6 && sv_clean_all())
;
SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
@@ -773,17 +777,45 @@
PL_ptr_table = (PTR_TBL_t*)NULL;
#endif
+#if defined(PERLIO_LAYERS)
+ /* No more IO - including error messages ! */
+ PerlIO_cleanup(aTHX);
+#endif
+
+ /* sv_undef needs to stay immortal until after PerlIO_cleanup
+ as currently layers use it rather than Nullsv as a marker
+ for no arg - and will try and SvREFCNT_dec it.
+ */
+
/* free special SVs */
- SvREFCNT(&PL_sv_yes) = 0;
- sv_clear(&PL_sv_yes);
- SvANY(&PL_sv_yes) = NULL;
- SvFLAGS(&PL_sv_yes) = 0;
-
- SvREFCNT(&PL_sv_no) = 0;
- sv_clear(&PL_sv_no);
- SvANY(&PL_sv_no) = NULL;
- SvFLAGS(&PL_sv_no) = 0;
+ {
+ /* 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(temp) = 1;
+ sv_free(temp);
+
+ temp = PL_sv_yes_p;
+ PL_sv_yes_p = Nullsv;
+ SvREFCNT(temp) = 1;
+ sv_free(temp);
+
+ temp = PL_sv_no_p;
+ PL_sv_no_p = Nullsv;
+ SvREFCNT(temp) = 1;
+ sv_free(temp);
+
+ temp = PL_sv_undef_p;
+ PL_sv_undef_p = Nullsv;
+ SvREFCNT(temp) = 1;
+ sv_free(temp);
+ }
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
@@ -807,18 +839,6 @@
PL_sv_count = 0;
-#if defined(PERLIO_LAYERS)
- /* No more IO - including error messages ! */
- PerlIO_cleanup(aTHX);
-#endif
-
- /* sv_undef needs to stay immortal until after PerlIO_cleanup
- as currently layers use it rather than Nullsv as a marker
- for no arg - and will try and SvREFCNT_dec it.
- */
- SvREFCNT(&PL_sv_undef) = 0;
- SvREADONLY_off(&PL_sv_undef);
-
Safefree(PL_origfilename);
PL_origfilename = Nullch;
Safefree(PL_reg_start_tmp);
1.5 +8 -6 ponie/perl/perlapi.h
Index: perlapi.h
===================================================================
RCS file: /cvs/public/ponie/perl/perlapi.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- perlapi.h 19 Jun 2004 11:44:33 -0000 1.4
+++ perlapi.h 21 Jun 2004 12:09:22 -0000 1.5
@@ -550,16 +550,18 @@
#define PL_sv_arenatable (*Perl_Isv_arenatable_ptr(aTHX))
#undef PL_sv_count
#define PL_sv_count (*Perl_Isv_count_ptr(aTHX))
-#undef PL_sv_no
-#define PL_sv_no (*Perl_Isv_no_ptr(aTHX))
+#undef PL_sv_no_p
+#define PL_sv_no_p (*Perl_Isv_no_p_ptr(aTHX))
#undef PL_sv_objcount
#define PL_sv_objcount (*Perl_Isv_objcount_ptr(aTHX))
+#undef PL_sv_placeholder_p
+#define PL_sv_placeholder_p (*Perl_Isv_placeholder_p_ptr(aTHX))
#undef PL_sv_root
#define PL_sv_root (*Perl_Isv_root_ptr(aTHX))
-#undef PL_sv_undef
-#define PL_sv_undef (*Perl_Isv_undef_ptr(aTHX))
-#undef PL_sv_yes
-#define PL_sv_yes (*Perl_Isv_yes_ptr(aTHX))
+#undef PL_sv_undef_p
+#define PL_sv_undef_p (*Perl_Isv_undef_p_ptr(aTHX))
+#undef PL_sv_yes_p
+#define PL_sv_yes_p (*Perl_Isv_yes_p_ptr(aTHX))
#undef PL_sys_intern
#define PL_sys_intern (*Perl_Isys_intern_ptr(aTHX))
#undef PL_taint_warn
1.2 +0 -4 ponie/perl/perlvars.h
Index: perlvars.h
===================================================================
RCS file: /cvs/public/ponie/perl/perlvars.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- perlvars.h 9 Sep 2003 11:58:52 -0000 1.1
+++ perlvars.h 21 Jun 2004 12:09:22 -0000 1.2
@@ -61,10 +61,6 @@
PERLVAR(Gsigfpe_saved, Sighandler_t)
#endif
-/* Restricted hashes placeholder value.
- * The contents are never used, only the address. */
-PERLVAR(Gsv_placeholder, SV)
-
#ifndef PERL_MICRO
PERLVARI(Gcsighandlerp, Sighandler_t, &Perl_csighandler) /* Pointer to C-level sighandler */
#endif