cvs commit: ponie/src/pmc perl5cargo_cult.pmc
[email protected] (Nicholas Clark) 5 May 2004 19:44:35 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/05/05 12:44:35
Modified: perl embed.fnc proto.h sv.c
perl/ext/Devel/Peek/t Peek.t
src/pmc perl5cargo_cult.pmc
Log:
and now IVs get the PMC treatment
Revision Changes Path
1.20 +2 -2 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- embed.fnc 5 May 2004 18:23:18 -0000 1.19
+++ embed.fnc 5 May 2004 19:44:34 -0000 1.20
@@ -1264,7 +1264,7 @@
s |void |more_xpvlv
s |void |more_xpvbm
s |void |more_xrv
-s |XPVIV* |new_xiv
+s |Parrot_PMC |new_xiv
s |XPVNV* |new_xnv
s |Parrot_PMC |new_xpv
s |Parrot_PMC |new_xpviv
@@ -1278,7 +1278,7 @@
s |Parrot_PMC |new_xpvlv
s |XPVBM* |new_xpvbm
s |Parrot_PMC |new_xrv
-s |void |del_xiv |XPVIV* p
+s |void |del_xiv |Parrot_PMC p
s |void |del_xnv |XPVNV* p
s |void |del_xpv |Parrot_PMC p
s |void |del_xpviv |Parrot_PMC p
1.20 +2 -2 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- proto.h 5 May 2004 18:23:18 -0000 1.19
+++ proto.h 5 May 2004 19:44:34 -0000 1.20
@@ -1216,7 +1216,7 @@
STATIC void S_more_xpvlv(pTHX);
STATIC void S_more_xpvbm(pTHX);
STATIC void S_more_xrv(pTHX);
-STATIC XPVIV* S_new_xiv(pTHX);
+STATIC Parrot_PMC S_new_xiv(pTHX);
STATIC XPVNV* S_new_xnv(pTHX);
STATIC Parrot_PMC S_new_xpv(pTHX);
STATIC Parrot_PMC S_new_xpviv(pTHX);
@@ -1230,7 +1230,7 @@
STATIC Parrot_PMC S_new_xpvlv(pTHX);
STATIC XPVBM* S_new_xpvbm(pTHX);
STATIC Parrot_PMC S_new_xrv(pTHX);
-STATIC void S_del_xiv(pTHX_ XPVIV* p);
+STATIC void S_del_xiv(pTHX_ Parrot_PMC p);
STATIC void S_del_xnv(pTHX_ XPVNV* p);
STATIC void S_del_xpv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpviv(pTHX_ Parrot_PMC p);
1.27 +9 -18 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- sv.c 5 May 2004 18:23:18 -0000 1.26
+++ sv.c 5 May 2004 19:44:34 -0000 1.27
@@ -615,32 +615,21 @@
/* grab a new IV body from the free list, allocating more if necessary */
-STATIC XPVIV*
+STATIC Parrot_PMC
S_new_xiv(pTHX)
{
- IV* xiv;
- LOCK_SV_MUTEX;
- if (!PL_xiv_root)
- more_xiv();
- xiv = PL_xiv_root;
- /*
- * See comment in more_xiv() -- RAM.
- */
- PL_xiv_root = *(IV**)xiv;
- UNLOCK_SV_MUTEX;
- return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVIV");
+ Parrot_PMC pviv = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, pviv);
+ return MUMBLE(pviv);
}
/* return an IV body to the free list */
STATIC void
-S_del_xiv(pTHX_ XPVIV *p)
+S_del_xiv(pTHX_ Parrot_PMC p)
{
- IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
- LOCK_SV_MUTEX;
- *(IV**)xiv = PL_xiv_root;
- PL_xiv_root = xiv;
- UNLOCK_SV_MUTEX;
+ Parrot_unregister_pmc(PL_Parrot, p);
}
/* allocate another arena's worth of IV bodies */
@@ -1736,6 +1725,7 @@
iv = SvIVX(sv);
nv = (NV)SvIVX(sv);
del_XIV(SvANY(sv));
+ SvPMC_off(sv);
magic = 0;
stash = 0;
if (mt == SVt_NV)
@@ -1823,6 +1813,7 @@
Perl_croak(aTHX_ "Can't upgrade to undef");
case SVt_IV:
SvANY(sv) = new_XIV();
+ SvPMC_on(sv);
SvIVX(sv) = iv;
break;
case SVt_NV:
1.7 +6 -6 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.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- Peek.t 5 May 2004 18:23:19 -0000 1.6
+++ Peek.t 5 May 2004 19:44:35 -0000 1.7
@@ -72,7 +72,7 @@
$b = 123,
'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,pIOK\\)
+ FLAGS = \\(pmc,IOK,pIOK\\)
IV = 123');
do_test( 4,
@@ -86,7 +86,7 @@
$c = 456,
'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(PADMY,IOK,pIOK\\)
+ FLAGS = \\(pmc,PADMY,IOK,pIOK\\)
IV = 456');
# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
@@ -98,7 +98,7 @@
$c + $d,
'SV = ([NI])V\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(PADTMP,\1OK,p\1OK\\)
+ FLAGS = \\(pmc,PADTMP,\1OK,p\1OK\\)
\1V = 456');
($d = "789") += 0.1;
@@ -145,7 +145,7 @@
$c_pattern = '
SV = PVNV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
+ FLAGS = \\(pmc,IOK,NOK,pIOK,pNOK\\)
IV = 456
NV = 456
PV = 0';
@@ -153,7 +153,7 @@
$c_pattern = '
SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,pIOK\\)
+ FLAGS = \\(pmc,IOK,pIOK\\)
IV = 456';
}
do_test(11,
@@ -175,7 +175,7 @@
Elt No. 0
SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,pIOK\\)
+ FLAGS = \\(pmc,IOK,pIOK\\)
IV = 123
Elt No. 1' . $c_pattern);
1.4 +8 -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.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- perl5cargo_cult.pmc 5 May 2004 16:10:25 -0000 1.3
+++ perl5cargo_cult.pmc 5 May 2004 19:44:35 -0000 1.4
@@ -1,7 +1,7 @@
/* Perl5QQQ.pmc -*- c -*-
* Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perl5cargo_cult.pmc,v 1.3 2004/05/05 16:10:25 nicholas Exp $
+ * $Id: perl5cargo_cult.pmc,v 1.4 2004/05/05 19:44:35 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5QQQ base class
* Data Structure and Algorithms:
@@ -19,10 +19,17 @@
/* Two hacks that make the cargo cult easier. */
struct xiv {
+ char * xpv_pv; /* pointer to malloced string */
+ STRLEN xpv_cur; /* length of xpv_pv as a C string */
+ STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
};
struct xnv {
+ char * xpv_pv; /* pointer to malloced string */
+ STRLEN xpv_cur; /* length of xpv_pv as a C string */
+ STRLEN xpv_len; /* allocated size */
+ IV xiv_iv; /* integer value or pv offset */
NV xnv_nv; /* numeric value, if any */
};