cvs commit: ponie/perl/ext/Devel/Peek/t Peek.t
[email protected] (Nicholas Clark) 13 Jun 2004 16:40:06 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/06/13 09:40:06
Modified: perl embed.fnc embed.h perl.c proto.h sv.c sv.h util.c
perl/ext/Devel/Peek/t Peek.t
Log:
Oops. It seemed that we didn't have have PVMG as PMCs.
Everything now is a PMC. (with an asseriton to check this)
Revision Changes Path
1.24 +2 -0 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- embed.fnc 6 May 2004 14:13:16 -0000 1.23
+++ embed.fnc 13 Jun 2004 16:40:05 -0000 1.24
@@ -1277,6 +1277,7 @@
s |Parrot_PMC |new_xpvmg
s |Parrot_PMC |new_xpvlv
s |Parrot_PMC |new_xpvbm
+s |Parrot_PMC |new_xpvgv
s |Parrot_PMC |new_xrv
s |void |del_xiv |Parrot_PMC p
s |void |del_xnv |Parrot_PMC p
@@ -1291,6 +1292,7 @@
s |void |del_xpvmg |Parrot_PMC p
s |void |del_xpvlv |Parrot_PMC p
s |void |del_xpvbm |Parrot_PMC p
+s |void |del_xpvgv |Parrot_PMC p
s |void |del_xrv |XRV* p
s |void |zero_xpvfm |SV *fm
s |void |zero_xpvcv |SV *cv
1.15 +12 -0 ponie/perl/embed.h
Index: embed.h
===================================================================
RCS file: /cvs/public/ponie/perl/embed.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- embed.h 4 May 2004 16:36:52 -0000 1.14
+++ embed.h 13 Jun 2004 16:40:05 -0000 1.15
@@ -1877,6 +1877,9 @@
#define new_xpvbm S_new_xpvbm
#endif
#ifdef PERL_CORE
+#define new_xpvgv S_new_xpvgv
+#endif
+#ifdef PERL_CORE
#define new_xrv S_new_xrv
#endif
#ifdef PERL_CORE
@@ -1919,6 +1922,9 @@
#define del_xpvbm S_del_xpvbm
#endif
#ifdef PERL_CORE
+#define del_xpvgv S_del_xpvgv
+#endif
+#ifdef PERL_CORE
#define del_xrv S_del_xrv
#endif
#ifdef PERL_CORE
@@ -4456,6 +4462,9 @@
#define new_xpvbm() S_new_xpvbm(aTHX)
#endif
#ifdef PERL_CORE
+#define new_xpvgv() S_new_xpvgv(aTHX)
+#endif
+#ifdef PERL_CORE
#define new_xrv() S_new_xrv(aTHX)
#endif
#ifdef PERL_CORE
@@ -4498,6 +4507,9 @@
#define del_xpvbm(a) S_del_xpvbm(aTHX_ a)
#endif
#ifdef PERL_CORE
+#define del_xpvgv(a) S_del_xpvgv(aTHX_ a)
+#endif
+#ifdef PERL_CORE
#define del_xrv(a) S_del_xrv(aTHX_ a)
#endif
#ifdef PERL_CORE
1.7 +5 -4 ponie/perl/perl.c
Index: perl.c
===================================================================
RCS file: /cvs/public/ponie/perl/perl.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- perl.c 7 Apr 2004 10:37:27 -0000 1.6
+++ perl.c 13 Jun 2004 16:40:05 -0000 1.7
@@ -15,6 +15,7 @@
#include "EXTERN.h"
#define PERL_IN_PERL_C
#include "perl.h"
+#include "parrot/extend.h"
#include "patchlevel.h" /* for local_patches */
#ifdef NETWARE
@@ -853,8 +854,6 @@
Perl_reentrant_free(aTHX);
#endif
- Parrot_destroy(PL_Parrot);
-
sv_free_arenas();
/* As the absolutely last thing, free the non-arena SV for mess() */
@@ -874,11 +873,13 @@
}
/* we know that type >= SVt_PV */
(void)SvOOK_off(PL_mess_sv);
- Safefree(SvPVX(PL_mess_sv));
- Safefree(SvANY(PL_mess_sv));
+ Parrot_unregister_pmc(PL_Parrot, MUMBLE(SvANY(PL_mess_sv)));
Safefree(PL_mess_sv);
PL_mess_sv = Nullsv;
}
+
+ Parrot_destroy(PL_Parrot);
+
return STATUS_NATIVE_EXPORT;
}
1.24 +2 -0 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- proto.h 6 May 2004 14:13:16 -0000 1.23
+++ proto.h 13 Jun 2004 16:40:05 -0000 1.24
@@ -1229,6 +1229,7 @@
STATIC Parrot_PMC S_new_xpvmg(pTHX);
STATIC Parrot_PMC S_new_xpvlv(pTHX);
STATIC Parrot_PMC S_new_xpvbm(pTHX);
+STATIC Parrot_PMC S_new_xpvgv(pTHX);
STATIC Parrot_PMC S_new_xrv(pTHX);
STATIC void S_del_xiv(pTHX_ Parrot_PMC p);
STATIC void S_del_xnv(pTHX_ Parrot_PMC p);
@@ -1243,6 +1244,7 @@
STATIC void S_del_xpvmg(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvlv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvbm(pTHX_ Parrot_PMC p);
+STATIC void S_del_xpvgv(pTHX_ Parrot_PMC p);
STATIC void S_del_xrv(pTHX_ XRV* p);
STATIC void S_zero_xpvfm(pTHX_ SV *fm);
STATIC void S_zero_xpvcv(pTHX_ SV *cv);
1.32 +20 -2 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- sv.c 8 May 2004 10:16:11 -0000 1.31
+++ sv.c 13 Jun 2004 16:40:05 -0000 1.32
@@ -1144,6 +1144,23 @@
xpvbm->xpv_pv = 0;
}
+STATIC Parrot_PMC
+S_new_xpvgv(pTHX)
+{
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVGV");
+ Parrot_PMC pvgv = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, pvgv);
+ return MUMBLE(pvgv);
+}
+
+/* return a struct xpvgv to the free list */
+
+STATIC void
+S_del_xpvgv(pTHX_ Parrot_PMC p)
+{
+ Parrot_unregister_pmc(PL_Parrot, MUMBLE(p));
+}
+
#define my_safemalloc(s) (void*)safemalloc(s)
#define my_safefree(p) safefree((char*)p)
@@ -1225,8 +1242,8 @@
#endif /* PURIFY */
-#define new_XPVGV() my_safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p) my_safefree(p)
+#define new_XPVGV() (void*)new_xpvgv()
+#define del_XPVGV(p) del_xpvfm((XPVGV *)p)
#define new_XPVFM() (void*)new_xpvfm()
#define del_XPVFM(p) del_xpvfm((XPVFM *)p)
@@ -1911,6 +1928,7 @@
break;
case SVt_PVGV:
SvANY(sv) = new_XPVGV();
+ SvPMC_on(sv);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
1.18 +1 -1 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- sv.h 6 May 2004 14:13:16 -0000 1.17
+++ sv.h 13 Jun 2004 16:40:05 -0000 1.18
@@ -131,7 +131,7 @@
#define SvANY(sv) (sv)->sv_any
#define SvFLAGS(sv) (sv)->sv_flags
#define SvREFCNT(sv) (sv)->sv_refcnt
-#define SvPMC(sv) (sv)->sv_is_pmc
+#define SvPMC(sv) (STMT_START {assert(SvANY(sv) ? (sv)->sv_is_pmc : 1)} STMT_END, (sv)->sv_is_pmc)
#define SvPMC_on(sv) ((sv)->sv_is_pmc = 1);
#define SvPMC_off(sv) ((sv)->sv_is_pmc = 0);
1.4 +11 -4 ponie/perl/util.c
Index: util.c
===================================================================
RCS file: /cvs/public/ponie/perl/util.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- util.c 7 Apr 2004 10:37:28 -0000 1.3
+++ util.c 13 Jun 2004 16:40:05 -0000 1.4
@@ -16,6 +16,7 @@
#include "EXTERN.h"
#define PERL_IN_UTIL_C
#include "perl.h"
+#include "parrot/extend.h"
#ifndef PERL_MICRO
#include <signal.h>
@@ -816,7 +817,8 @@
S_mess_alloc(pTHX)
{
SV *sv;
- XPVMG *any;
+ Parrot_Int type;
+ Parrot_PMC pvpvmg;
if (!PL_dirty)
return sv_2mortal(newSVpvn("",0));
@@ -825,12 +827,17 @@
return PL_mess_sv;
/* Create as PVMG now, to avoid any upgrading later */
+
+ type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVMG");
+ pvpvmg = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, pvpvmg);
+ Zero(Parrot_PMC_get_pointer(PL_Parrot, pvpvmg), 1, XPVMG);
+
New(905, sv, 1, SV);
- Newz(905, any, 1, XPVMG);
SvFLAGS(sv) = SVt_PVMG;
- SvANY(sv) = (void*)any;
+ SvANY(sv) = (void*)MUMBLE(pvpvmg);
SvREFCNT(sv) = 1 << 30; /* practically infinite */
- SvPMC_off(sv);
+ SvPMC_on(sv);
PL_mess_sv = sv;
return sv;
}
1.9 +1 -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.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- Peek.t 6 May 2004 14:13:17 -0000 1.8
+++ Peek.t 13 Jun 2004 16:40:06 -0000 1.9
@@ -298,7 +298,7 @@
*a,
'SV = PVGV\\($ADDR\\) at $ADDR
REFCNT = 5
- FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
+ FLAGS = \\(pmc,GMG,SMG,MULTI(?:,IN_PAD)?\\)
IV = 0
NV = 0
MAGIC = $ADDR