cvs commit: ponie/src/pmc perl5cargo_cult.pmc
[email protected] (Nicholas Clark) 5 May 2004 16:10:25 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/05/05 09:10:25
Modified: . Configure.pl
perl embed.fnc proto.h sv.c sv.h
perl/ext/Devel/Peek/t Peek.t
src/pmc perl5cargo_cult.pmc
Log:
Generate all the perl 5 PMC types.
Implement PVIV and PVNV
Revision Changes Path
1.25 +2 -1 ponie/Configure.pl
Index: Configure.pl
===================================================================
RCS file: /cvs/public/ponie/Configure.pl,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- Configure.pl 4 May 2004 16:52:58 -0000 1.24
+++ Configure.pl 5 May 2004 16:10:23 -0000 1.25
@@ -47,7 +47,8 @@
my $template = do {local $/; <F>};
close F or die $!;
chdir('parrot') || die "You need to checkout parrot inside ponie";
- foreach (qw(rv pvlv pvav pvhv pvio pvcv pvfm)) {
+ foreach (qw(iv nv rv pv pviv pvnv pvmg pvbm pvgv pvlv pvav pvhv pvcv pvfm
+ pvio)) {
my $file = File::Spec->catfile('classes', "perl5$_.pmc");
if (-e $file) {
unlink $file or die "unlink '$file' failed: $!";
1.18 +4 -4 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- embed.fnc 4 May 2004 16:36:52 -0000 1.17
+++ embed.fnc 5 May 2004 16:10:23 -0000 1.18
@@ -1267,8 +1267,8 @@
s |XPVIV* |new_xiv
s |XPVNV* |new_xnv
s |XPV* |new_xpv
-s |XPVIV* |new_xpviv
-s |XPVNV* |new_xpvnv
+s |Parrot_PMC |new_xpviv
+s |Parrot_PMC |new_xpvnv
s |Parrot_PMC |new_xpvcv
s |Parrot_PMC |new_xpvav
s |Parrot_PMC |new_xpvhv
@@ -1281,8 +1281,8 @@
s |void |del_xiv |XPVIV* p
s |void |del_xnv |XPVNV* p
s |void |del_xpv |XPV* p
-s |void |del_xpviv |XPVIV* p
-s |void |del_xpvnv |XPVNV* p
+s |void |del_xpviv |Parrot_PMC p
+s |void |del_xpvnv |Parrot_PMC p
s |void |del_xpvcv |Parrot_PMC p
s |void |del_xpvav |Parrot_PMC p
s |void |del_xpvhv |Parrot_PMC p
1.18 +4 -4 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- proto.h 4 May 2004 16:36:52 -0000 1.17
+++ proto.h 5 May 2004 16:10:24 -0000 1.18
@@ -1219,8 +1219,8 @@
STATIC XPVIV* S_new_xiv(pTHX);
STATIC XPVNV* S_new_xnv(pTHX);
STATIC XPV* S_new_xpv(pTHX);
-STATIC XPVIV* S_new_xpviv(pTHX);
-STATIC XPVNV* S_new_xpvnv(pTHX);
+STATIC Parrot_PMC S_new_xpviv(pTHX);
+STATIC Parrot_PMC S_new_xpvnv(pTHX);
STATIC Parrot_PMC S_new_xpvcv(pTHX);
STATIC Parrot_PMC S_new_xpvav(pTHX);
STATIC Parrot_PMC S_new_xpvhv(pTHX);
@@ -1233,8 +1233,8 @@
STATIC void S_del_xiv(pTHX_ XPVIV* p);
STATIC void S_del_xnv(pTHX_ XPVNV* p);
STATIC void S_del_xpv(pTHX_ XPV* p);
-STATIC void S_del_xpviv(pTHX_ XPVIV* p);
-STATIC void S_del_xpvnv(pTHX_ XPVNV* p);
+STATIC void S_del_xpviv(pTHX_ Parrot_PMC p);
+STATIC void S_del_xpvnv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvcv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvav(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvhv(pTHX_ Parrot_PMC p);
1.25 +18 -28 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- sv.c 4 May 2004 16:36:52 -0000 1.24
+++ sv.c 5 May 2004 16:10:24 -0000 1.25
@@ -811,28 +811,21 @@
/* grab a new struct xpviv from the free list, allocating more if necessary */
-STATIC XPVIV*
+STATIC Parrot_PMC
S_new_xpviv(pTHX)
{
- XPVIV* xpviv;
- LOCK_SV_MUTEX;
- if (!PL_xpviv_root)
- more_xpviv();
- xpviv = PL_xpviv_root;
- PL_xpviv_root = (XPVIV*)xpviv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpviv;
+ 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 a struct xpviv to the free list */
STATIC void
-S_del_xpviv(pTHX_ XPVIV *p)
+S_del_xpviv(pTHX_ Parrot_PMC p)
{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpviv_root;
- PL_xpviv_root = p;
- UNLOCK_SV_MUTEX;
+ Parrot_unregister_pmc(PL_Parrot, p);
}
/* allocate another arena's worth of struct xpviv */
@@ -857,28 +850,21 @@
/* grab a new struct xpvnv from the free list, allocating more if necessary */
-STATIC XPVNV*
+STATIC Parrot_PMC
S_new_xpvnv(pTHX)
{
- XPVNV* xpvnv;
- LOCK_SV_MUTEX;
- if (!PL_xpvnv_root)
- more_xpvnv();
- xpvnv = PL_xpvnv_root;
- PL_xpvnv_root = (XPVNV*)xpvnv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvnv;
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVNV");
+ Parrot_PMC pvnv = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, pvnv);
+ return MUMBLE(pvnv);
}
/* return a struct xpvnv to the free list */
STATIC void
-S_del_xpvnv(pTHX_ XPVNV *p)
+S_del_xpvnv(pTHX_ Parrot_PMC p)
{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvnv_root;
- PL_xpvnv_root = p;
- UNLOCK_SV_MUTEX;
+ Parrot_unregister_pmc(PL_Parrot, p);
}
/* allocate another arena's worth of struct xpvnv */
@@ -1806,6 +1792,7 @@
magic = 0;
stash = 0;
del_XPVIV(SvANY(sv));
+ SvPMC_off(sv);
break;
case SVt_PVNV:
pv = SvPVX(sv);
@@ -1816,6 +1803,7 @@
magic = 0;
stash = 0;
del_XPVNV(SvANY(sv));
+ SvPMC_off(sv);
break;
case SVt_PVMG:
pv = SvPVX(sv);
@@ -1855,6 +1843,7 @@
break;
case SVt_PVIV:
SvANY(sv) = new_XPVIV();
+ SvPMC_on(sv);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
@@ -1865,6 +1854,7 @@
break;
case SVt_PVNV:
SvANY(sv) = new_XPVNV();
+ SvPMC_on(sv);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
1.16 +4 -4 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- sv.h 7 Apr 2004 13:51:58 -0000 1.15
+++ sv.h 5 May 2004 16:10:24 -0000 1.16
@@ -1057,10 +1057,10 @@
!sv \
? 0 \
: SvPOK(sv) \
- ? (({XPV *nxpv = (XPV*)SvANY(sv); \
- nxpv && \
- (nxpv->xpv_cur > 1 || \
- (nxpv->xpv_cur && *nxpv->xpv_pv != '0')); }) \
+ ? (({STRLEN _len; \
+ char *_p = SvPV(sv, _len); \
+ _p && \
+ (_len > 1 || (_len && *_p != '0')); }) \
? 1 \
: 0) \
: \
1.5 +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.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- Peek.t 4 May 2004 16:36:52 -0000 1.4
+++ Peek.t 5 May 2004 16:10:25 -0000 1.5
@@ -107,7 +107,7 @@
$d,
'SV = PVNV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(NOK,pNOK\\)
+ FLAGS = \\(pmc,NOK,pNOK\\)
IV = 0
NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
PV = $ADDR "789"\\\0
1.3 +10 -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.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- perl5cargo_cult.pmc 4 May 2004 10:19:44 -0000 1.2
+++ perl5cargo_cult.pmc 5 May 2004 16:10:25 -0000 1.3
@@ -1,7 +1,7 @@
/* Perl5QQQ.pmc -*- c -*-
* Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perl5cargo_cult.pmc,v 1.2 2004/05/04 10:19:44 nicholas Exp $
+ * $Id: perl5cargo_cult.pmc,v 1.3 2004/05/05 16:10:25 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5QQQ base class
* Data Structure and Algorithms:
@@ -16,6 +16,15 @@
#include "config.h"
#undef HAS_OFF64_T
#include "perl.h"
+
+/* Two hacks that make the cargo cult easier. */
+struct xiv {
+ IV xiv_iv; /* integer value or pv offset */
+};
+
+struct xnv {
+ NV xnv_nv; /* numeric value, if any */
+};
pmclass Perl5QQQ need_ext {