cvs commit: ponie/perl/ext/Devel/Peek/t Peek.t
[email protected] (Nicholas Clark) 6 May 2004 14:13:18 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/05/06 07:13:17
Modified: perl embed.fnc proto.h sv.c sv.h
perl/ext/Devel/Peek/t Peek.t
Log:
And finally PVMG is a PMC
(after much fun with sv_unglob)
Revision Changes Path
1.23 +2 -2 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -w -r1.22 -r1.23
--- embed.fnc 5 May 2004 21:57:52 -0000 1.22
+++ embed.fnc 6 May 2004 14:13:16 -0000 1.23
@@ -1274,7 +1274,7 @@
s |Parrot_PMC |new_xpvhv
s |Parrot_PMC |new_xpvio
s |Parrot_PMC |new_xpvfm
-s |XPVMG* |new_xpvmg
+s |Parrot_PMC |new_xpvmg
s |Parrot_PMC |new_xpvlv
s |Parrot_PMC |new_xpvbm
s |Parrot_PMC |new_xrv
@@ -1288,7 +1288,7 @@
s |void |del_xpvhv |Parrot_PMC p
s |void |del_xpvio |Parrot_PMC p
s |void |del_xpvfm |Parrot_PMC p
-s |void |del_xpvmg |XPVMG* p
+s |void |del_xpvmg |Parrot_PMC p
s |void |del_xpvlv |Parrot_PMC p
s |void |del_xpvbm |Parrot_PMC p
s |void |del_xrv |XRV* p
1.23 +2 -2 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -w -r1.22 -r1.23
--- proto.h 5 May 2004 21:57:52 -0000 1.22
+++ proto.h 6 May 2004 14:13:16 -0000 1.23
@@ -1226,7 +1226,7 @@
STATIC Parrot_PMC S_new_xpvhv(pTHX);
STATIC Parrot_PMC S_new_xpvio(pTHX);
STATIC Parrot_PMC S_new_xpvfm(pTHX);
-STATIC XPVMG* S_new_xpvmg(pTHX);
+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_xrv(pTHX);
@@ -1240,7 +1240,7 @@
STATIC void S_del_xpvhv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvio(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvfm(pTHX_ Parrot_PMC p);
-STATIC void S_del_xpvmg(pTHX_ XPVMG* p);
+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_xrv(pTHX_ XRV* p);
1.30 +57 -30 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- sv.c 5 May 2004 21:57:52 -0000 1.29
+++ sv.c 6 May 2004 14:13:16 -0000 1.30
@@ -1001,28 +1001,21 @@
/* grab a new struct xpvmg from the free list, allocating more if necessary */
-STATIC XPVMG*
+STATIC Parrot_PMC
S_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;
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVMG");
+ Parrot_PMC pvpvmg = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, pvpvmg);
+ return MUMBLE(pvpvmg);
}
-/* return a struct xpvmg to the free list */
+/* return an PVMG body to the free list */
STATIC void
-S_del_xpvmg(pTHX_ XPVMG *p)
+S_del_xpvmg(pTHX_ Parrot_PMC p)
{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvmg_root;
- PL_xpvmg_root = p;
- UNLOCK_SV_MUTEX;
+ Parrot_unregister_pmc(PL_Parrot, p);
}
/* allocate another arena's worth of struct xpvmg */
@@ -1789,6 +1782,7 @@
magic = SvMAGIC(sv);
stash = SvSTASH(sv);
del_XPVMG(SvANY(sv));
+ SvPMC_off(sv);
break;
default:
Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
@@ -1841,6 +1835,7 @@
break;
case SVt_PVMG:
SvANY(sv) = new_XPVMG();
+ SvPMC_on(sv);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
@@ -3810,11 +3805,11 @@
return SvRV(sv) != 0;
}
if (SvPOKp(sv)) {
- register XPV* Xpvtmp;
- if ((Xpvtmp = (XPV*)SvANY(sv)) &&
- (*Xpvtmp->xpv_pv > '0' ||
- Xpvtmp->xpv_cur > 1 ||
- (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0')))
+ STRLEN len = SvCUR(sv);
+ char *p = SvPVX(sv);
+ if (p &&
+ (len > 1 ||
+ (len == 1 && *p != '0')))
return 1;
else
return 0;
@@ -8632,28 +8627,60 @@
STATIC void
S_sv_unglob(pTHX_ SV *sv)
{
- void *xpvmg;
+ SV *new_mg = NEWSV(0,0);
+ char *temp_pv;
+ STRLEN temp_len;
+ MAGIC *temp_magic;
+ HV *temp_stash;
+ U32 temp;
+ struct STRUCT_SV temp_head;
assert(SvTYPE(sv) == SVt_PVGV);
SvFAKE_off(sv);
- if (GvGP(sv))
- gp_free((GV*)sv);
if (GvSTASH(sv)) {
SvREFCNT_dec(GvSTASH(sv));
GvSTASH(sv) = Nullhv;
}
sv_unmagic(sv, PERL_MAGIC_glob);
- Safefree(GvNAME(sv));
GvMULTI_off(sv);
/* need to keep SvANY(sv) in the right arena */
- xpvmg = new_XPVMG();
- StructCopy(SvANY(sv), xpvmg, XPVMG);
- del_XPVGV(SvANY(sv));
- SvANY(sv) = xpvmg;
+ sv_upgrade(new_mg, SVt_PVMG);
- SvFLAGS(sv) &= ~SVTYPEMASK;
- SvFLAGS(sv) |= SVt_PVMG;
+ /* Swap all the pointer related entries using the official API. */
+ temp_pv = SvPVX(sv);
+ SvPVX(sv) = SvPVX(new_mg);
+ SvPVX(new_mg) = temp_pv;
+ temp_len = SvCUR(sv);
+ SvCUR(sv) = SvCUR(new_mg);
+ SvCUR(new_mg) = temp_len;
+ temp_len = SvLEN(sv);
+ SvLEN(sv) = SvLEN(new_mg);
+ SvLEN(new_mg) = temp_len;
+ temp_magic = SvMAGIC(sv);
+ SvMAGIC(sv) = SvMAGIC(new_mg);
+ SvMAGIC(new_mg) = temp_magic;
+ temp_stash = SvSTASH(sv);
+ SvSTASH(sv) = SvSTASH(new_mg);
+ SvSTASH(new_mg) = temp_stash;
+
+ temp = SvFLAGS(sv);
+ SvFLAGS(sv) = (SvFLAGS(sv) & SVTYPEMASK) | (SvFLAGS(new_mg) & ~SVTYPEMASK);
+ SvFLAGS(new_mg)
+ = (SvFLAGS(new_mg) & SVTYPEMASK) | (temp & ~SVTYPEMASK);
+
+ temp = SvREFCNT(sv);
+ SvREFCNT(sv) = SvREFCNT(new_mg);
+ SvREFCNT(new_mg) = temp;
+
+
+ /* Swap the bodies */
+ temp_head = *sv;
+ *sv = *new_mg;
+ *new_mg = temp_head;
+
+ /* And the plan is that now sv is a PVMG */
+ SvREFCNT_dec(new_mg);
}
/*
1.17 +2 -2 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- sv.h 5 May 2004 16:10:24 -0000 1.16
+++ sv.h 6 May 2004 14:13:16 -0000 1.17
@@ -1057,8 +1057,8 @@
!sv \
? 0 \
: SvPOK(sv) \
- ? (({STRLEN _len; \
- char *_p = SvPV(sv, _len); \
+ ? (({STRLEN _len = SvCUR(sv); \
+ char *_p = SvPVX(sv); \
_p && \
(_len > 1 || (_len && *_p != '0')); }) \
? 1 \
1.8 +4 -4 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.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- Peek.t 5 May 2004 19:44:35 -0000 1.7
+++ Peek.t 6 May 2004 14:13:17 -0000 1.8
@@ -265,7 +265,7 @@
RV = $ADDR
SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(OBJECT,SMG\\)
+ FLAGS = \\(pmc,OBJECT,SMG\\)
IV = 0
NV = 0
PV = 0
@@ -403,7 +403,7 @@
$x,
'SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(PADMY,SMG,POK,pPOK\\)
+ FLAGS = \\(pmc,PADMY,SMG,POK,pPOK\\)
IV = 0
NV = 0
PV = $ADDR ""\\\0
@@ -424,7 +424,7 @@
$ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
'SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
+ FLAGS = \\(pmc,GMG,SMG,RMG,pIOK,pPOK\\)
IV = 0
NV = 0
PV = $ADDR "0"\\\0
@@ -461,7 +461,7 @@
RV = $ADDR
SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 2
- FLAGS = \\(OBJECT,ROK\\)
+ FLAGS = \\(pmc,OBJECT,ROK\\)
IV = -?\d+
NV = $FLOAT
RV = $ADDR