cvs commit: ponie/src/pmc perl5cargo_cult.pmc
[email protected] (Nicholas Clark) 3 Nov 2004 16:46:57 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/11/03 08:46:57
Modified: perl dump.c sv.c sv.h
perl/ext/Devel/Peek/t Peek.t
src/pmc perl5cargo_cult.pmc
Log:
Attempt to assert a distinction between the RV slot and the PV slot, and
segfault post cleanup accesses to SVs.
Revision Changes Path
1.4 +21 -10 ponie/perl/dump.c
Index: dump.c
===================================================================
RCS file: /cvs/public/ponie/perl/dump.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- dump.c 13 Jun 2004 20:38:53 -0000 1.3
+++ dump.c 3 Nov 2004 16:46:56 -0000 1.4
@@ -1289,19 +1289,30 @@
return;
}
if (type <= SVt_PVLV && type != SVt_PVGV) {
- if (SvPVX(sv)) {
- Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
- if (SvOOK(sv))
- PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
- PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
- if (SvUTF8(sv)) /* the 8? \x{....} */
- PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
- PerlIO_printf(file, "\n");
+ int more = 0;
+ if (SvROK(sv)) {
+ if (SvRV(sv)) {
+ more = 1;
+ }
+ } else {
+ if (SvPVX(sv)) {
+ Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
+ if (SvOOK(sv))
+ PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
+ PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+ if (SvUTF8(sv)) /* the 8? \x{....} */
+ PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ));
+ PerlIO_printf(file, "\n");
+ more = 1;
+ }
+ else
+ Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
+ }
+ if (more) {
+ /* These ought to be 0 for RVs but it's interesting to see... */
Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv));
Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv));
}
- else
- Perl_dump_indent(aTHX_ level, file, " PV = 0\n");
}
if (type >= SVt_PVMG) {
if (SvMAGIC(sv))
1.48 +107 -31 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- sv.c 26 Oct 2004 18:50:24 -0000 1.47
+++ sv.c 3 Nov 2004 16:46:56 -0000 1.48
@@ -1114,6 +1114,7 @@
char** Perl_macro_SvPVX (pTHX_ SV *sv) {
+ assert (!SvROK(sv));
if(SvPMC(sv)) {
XPV* data = (XPV*) /**/ SvANY(sv);
return &(data->xpv_pv);
@@ -1480,6 +1481,7 @@
NV nv = 0.0;
MAGIC* magic = NULL;
HV* stash = Nullhv;
+ int sv_is_rv;
if (mt != SVt_PV && SvIsCOW(sv)) {
sv_force_normal_flags(sv, 0);
@@ -1488,6 +1490,8 @@
if (SvTYPE(sv) == mt)
return TRUE;
+ sv_is_rv = SvROK(sv);
+
if (mt < SVt_PVIV)
(void)SvOOK_off(sv);
@@ -1542,8 +1546,11 @@
stash = 0;
break;
case SVt_PV:
- rv = SvRV(sv);
- pv = SvPVX(sv);
+ if (sv_is_rv) {
+ rv = SvRV(sv);
+ } else {
+ pv = SvPVX(sv);
+ }
cur = SvCUR(sv);
len = SvLEN(sv);
iv = 0;
@@ -1558,8 +1565,11 @@
mt = SVt_PVNV;
break;
case SVt_PVIV:
- rv = SvRV(sv);
- pv = SvPVX(sv);
+ if (sv_is_rv) {
+ rv = SvRV(sv);
+ } else {
+ pv = SvPVX(sv);
+ }
cur = SvCUR(sv);
len = SvLEN(sv);
iv = SvIVX(sv);
@@ -1570,8 +1580,11 @@
SvPMC_off(sv);
break;
case SVt_PVNV:
- rv = SvRV(sv);
- pv = SvPVX(sv);
+ if (sv_is_rv) {
+ rv = SvRV(sv);
+ } else {
+ pv = SvPVX(sv);
+ }
cur = SvCUR(sv);
len = SvLEN(sv);
iv = SvIVX(sv);
@@ -1582,8 +1595,11 @@
SvPMC_off(sv);
break;
case SVt_PVMG:
- rv = SvRV(sv);
- pv = SvPVX(sv);
+ if (sv_is_rv) {
+ rv = SvRV(sv);
+ } else {
+ pv = SvPVX(sv);
+ }
cur = SvCUR(sv);
len = SvLEN(sv);
iv = SvIVX(sv);
@@ -1618,16 +1634,26 @@
case SVt_PV:
SvANY(sv) = new_XPV();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
break;
case SVt_PVIV:
SvANY(sv) = new_XPVIV();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1638,8 +1664,13 @@
case SVt_PVNV:
SvANY(sv) = new_XPVNV();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1648,8 +1679,13 @@
case SVt_PVMG:
SvANY(sv) = new_XPVMG();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1660,8 +1696,13 @@
case SVt_PVLV:
SvANY(sv) = new_XPVLV();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1683,8 +1724,14 @@
SvPMC_on(sv);
if (pv)
Safefree(pv);
- SvRV(sv) = 0;
- SvPVX(sv) = 0;
+ if (sv_is_rv) {
+ /* XXX need more paranoia here? */
+ SvRV(sv) = 0;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = 0;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
AvMAX(sv) = -1;
AvFILLp(sv) = -1;
SvIVX(sv) = 0;
@@ -1700,8 +1747,14 @@
SvPMC_on(sv);
if (pv)
Safefree(pv);
- SvRV(sv) = 0;
- SvPVX(sv) = 0;
+ if (sv_is_rv) {
+ /* XXX need more paranoia here? */
+ SvRV(sv) = 0;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = 0;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
HvFILL(sv) = 0;
HvMAX(sv) = 0;
HvTOTALKEYS(sv) = 0;
@@ -1717,8 +1770,9 @@
SvANY(sv) = new_XPVCV();
SvPMC_on(sv);
zero_xpvcv(sv);
- SvRV(sv) = 0;
+ assert (!sv_is_rv);
SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1729,8 +1783,13 @@
case SVt_PVGV:
SvANY(sv) = new_XPVGV();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1746,8 +1805,13 @@
case SVt_PVBM:
SvANY(sv) = new_XPVBM();
SvPMC_on(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1762,8 +1826,13 @@
SvANY(sv) = new_XPVFM();
SvPMC_on(sv);
zero_xpvfm(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -1775,8 +1844,13 @@
SvANY(sv) = new_XPVIO();
SvPMC_on(sv);
zero_xpvio(sv);
- SvRV(sv) = rv;
- SvPVX(sv) = pv;
+ if (sv_is_rv) {
+ SvRV(sv) = rv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPVX(sv) = pv;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
SvCUR(sv) = cur;
SvLEN(sv) = len;
SvIVX(sv) = iv;
@@ -5840,6 +5914,7 @@
SVTYPEMASK);
SvBREAK_on(sv);
/* decrease refcount of the stash that owns this GV, if any */
+ SvANY(sv) = (void *) 0xDEAD;
if (stash)
SvREFCNT_dec(stash);
return; /* not break, SvFLAGS reset already happened */
@@ -5856,6 +5931,7 @@
Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv),
Ponie_I_SV_ZERO_FLAGS_SET_TYPE, SVTYPEMASK);
SvBREAK_on(sv);
+ SvANY(sv) = (void *) 0xDEAD;
}
/*
1.51 +2 -0 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- sv.h 26 Oct 2004 18:50:24 -0000 1.50
+++ sv.h 3 Nov 2004 16:46:56 -0000 1.51
@@ -198,6 +198,8 @@
Ponie_P_HVKEYS, /* SvIVX pointer */
Ponie_P_NVX, /* SvNVX pointer */
Ponie_P_HVPLACEHOLDERS, /* SvNVX pointer */
+ Ponie_P_RVX_0, /* Clear SvRVX pointer */
+ Ponie_P_PVX_0, /* Clear SvPVX pointer */
Ponie_P_MAX
} Ponie_pointers;
1.12 +2 -1 ponie/perl/ext/Devel/Peek/t/Peek.t
Index: Peek.t
===================================================================
RCS file: /cvs/public/ponie/perl/ext/Devel/Peek/t/Peek.t,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- Peek.t 23 Jun 2004 10:54:24 -0000 1.11
+++ Peek.t 3 Nov 2004 16:46:57 -0000 1.12
@@ -468,5 +468,6 @@
SV = NULL\\(0x0\\) at $ADDR
REFCNT = \d+
FLAGS = \\(READONLY\\)
- PV = 0
+ CUR = 0
+ LEN = 0
STASH = $ADDR\s+"Foobar"');
1.38 +29 -1 ponie/src/pmc/perl5cargo_cult.pmc
Index: perl5cargo_cult.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5cargo_cult.pmc,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- perl5cargo_cult.pmc 16 Oct 2004 19:04:22 -0000 1.37
+++ perl5cargo_cult.pmc 3 Nov 2004 16:46:57 -0000 1.38
@@ -1,7 +1,7 @@
/* Perl5QQQ.pmc -*- c -*-
* Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perl5cargo_cult.pmc,v 1.37 2004/10/16 19:04:22 nicholas Exp $
+ * $Id: perl5cargo_cult.pmc,v 1.38 2004/11/03 16:46:57 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5QQQ base class
* Data Structure and Algorithms:
@@ -61,6 +61,7 @@
case Ponie_P_ANY:
return PMC_struct_val(SELF);
case Ponie_P_RV:
+ assert (!(((struct STRUCT_SV *)PMC_struct_val(SELF))->sv_flags & SVp_POK));
return &(PMC_pmc_val(SELF));
/*return &(((struct xrv*)((struct STRUCT_SV *)PMC_struct_val(SELF))->sv_any)->xrv_rv);*/
case Ponie_P_IVX:
@@ -78,6 +79,33 @@
return 0;
}
+ void set_pointer_keyed_int(INTVAL key, void *value) {
+ switch (key) {
+ case Ponie_P_RVX_0:
+ assert (value == 0);
+ PMC_pmc_val(SELF) = NULL;
+ break;
+ case Ponie_P_PVX_0:
+ {
+ struct STRUCT_SV* sv;
+ XPV* data;
+
+ assert (value == 0);
+
+ sv = (struct STRUCT_SV *) PMC_struct_val(SELF);
+ assert (sv);
+ data = (XPV*) sv->sv_any;
+ assert (data);
+ data->xpv_pv = NULL;
+ }
+ break;
+ default:
+ croak ("Out of range or illegal key %d (max is %d), value %p"
+ " set_pointer_keyed_int", key, Ponie_P_MAX - 1, value);
+ }
+ return;
+ }
+
INTVAL get_integer_keyed_int(INTVAL key) {
switch (key) {
case Ponie_I_SV_TYPE: