cvs commit: ponie/src/pmc perl5iv.pmc perl5null.pmc perl5nv.pmc perl5pv.pmc perl5rv.pmc ponie.h perl5cargo_cult.pmc perl5pvgv.pmc perl5pviv.pmc perl5pvmg.pmc perl5pvnv.pmc
[email protected] (Nicholas Clark) 29 Apr 2005 22:11:31 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/04/29 15:11:31
Modified: . write_makefile.pl
perl sv.c sv.h
src/pmc perl5cargo_cult.pmc perl5pvgv.pmc perl5pviv.pmc
perl5pvmg.pmc perl5pvnv.pmc
Added: src/pmc perl5iv.pmc perl5null.pmc perl5nv.pmc perl5pv.pmc
perl5rv.pmc ponie.h
Removed: . fake_pmcs.pl
Log:
Morphing part 1 - read the value out of the old PMC with a vtable call
Revision Changes Path
1.10 +2 -18 ponie/write_makefile.pl
Index: write_makefile.pl
===================================================================
RCS file: /cvs/public/ponie/write_makefile.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- write_makefile.pl 27 Apr 2005 16:17:23 -0000 1.9
+++ write_makefile.pl 29 Apr 2005 22:11:31 -0000 1.10
@@ -12,14 +12,6 @@
my @allPMCs
= qw(cargo_cult base null
iv nv rv pv pviv pvnv pvmg pvbm pvgv pvlv pvav pvhv pvcv pvfm pvio);
-my @real
- = qw(cargo_cult base pviv pvnv pvmg pvbm pvgv pvlv pvav pvhv pvcv pvfm pvio);
-my %fakes;
-@fakes{@allPMCs} = ();
-delete $fakes{$_} foreach @real;
-
-system $^X, 'fake_pmcs.pl', "src/pmc/perl5QQQ.pmc", keys %fakes
- and die "Error";
my $parrotdir = "$top/parrot";
@@ -37,7 +29,7 @@
PERL=$^X -I$parrotdir/lib
CC=$Config{cc}
-CFLAGS=$Config{ccflags} -g -I$parrotdir/classes -I$parrotdir/include -I$top/perl
+CFLAGS=$Config{ccflags} -DPONIE_CORE -g -I$parrotdir/classes -I$parrotdir/include -I$top/perl
libponie$Config{_a}: $allobjs
ar -r \$\@ \$\?
@@ -51,14 +43,6 @@
EOM
foreach (@allPMCs) {
- if (exists $fakes{$_}) {
- print <<"EOSNIP";
-
-perl5$_.pmc: perl5QQQ.pmc
- \$(PERL) $top/fake_pmcs.pl perl5QQQ.pmc $_
-EOSNIP
- }
-
print <<"EOSNIP";
perl5$_.dump: perl5$_.pmc
1.66 +8 -0 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- sv.c 28 Apr 2005 22:52:11 -0000 1.65
+++ sv.c 29 Apr 2005 22:11:31 -0000 1.66
@@ -5641,6 +5641,7 @@
SvIV_set(sv, SvIVX(nsv));
if (type == SVt_NV || type >= SVt_PVNV)
SvNV_set(sv, SvNVX(nsv));
+ Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(sv), Ponie_P_REPLACE, nsv);
#ifdef PERL_COPY_ON_WRITE
if (SvIsCOW_normal(nsv)) {
@@ -8337,7 +8338,11 @@
if (SvTYPE(rv) >= SVt_PVMG) {
U32 refcnt = SvREFCNT(rv);
SvREFCNT(rv) = 0;
+ /* FIXME. A downgrade upgrade. */
sv_clear(rv);
+ SvANY(rv) = 0;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(rv), Ponie_P_NEWRV_HACK,
+ 0);
SvFLAGS(rv) = 0;
SvREFCNT(rv) = refcnt;
}
@@ -8521,6 +8526,8 @@
/* Downgrades a PVGV to a PVMG.
*/
+/* FIXME. A downgrade upgrade. */
+
STATIC void
S_sv_unglob(pTHX_ SV *sv)
{
@@ -8579,6 +8586,7 @@
*(struct STRUCT_SV*)Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(new_mg))
= temp_head;
+ Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(sv), Ponie_P_UNGLOB, 0);
/* And the plan is that now sv is a PVMG */
SvREFCNT_dec(new_mg);
}
1.70 +5 -0 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- sv.h 29 Apr 2005 21:11:39 -0000 1.69
+++ sv.h 29 Apr 2005 22:11:31 -0000 1.70
@@ -253,6 +253,11 @@
Ponie_P_CVOUTSIDE_SEQ, /* &CvOUTSIDE_SEQ pointer */
Ponie_P_RVX_0, /* Clear SvRVX pointer */
Ponie_P_PVX_0, /* Clear SvPVX pointer */
+ Ponie_P_GET_UPGRADE, /* Pull data from SvANY and free it */
+ Ponie_P_SET_UPGRADE, /* Allocate SvANY and push data to it */
+ Ponie_P_UNGLOB, /* Special things for sv_unglob */
+ Ponie_P_NEWRV_HACK, /* Special things for newSVrv */
+ Ponie_P_REPLACE, /* Special things for sv_replace */
Ponie_P_MAX
} Ponie_pointers;
1.50 +33 -129 ponie/src/pmc/perl5cargo_cult.pmc
Index: perl5cargo_cult.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5cargo_cult.pmc,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- perl5cargo_cult.pmc 29 Apr 2005 21:11:39 -0000 1.49
+++ perl5cargo_cult.pmc 29 Apr 2005 22:11:31 -0000 1.50
@@ -12,12 +12,7 @@
* References:
*/
-#include "parrot/parrot.h"
-
-#include "EXTERN.h"
-#include "config.h"
-#undef HAS_OFF64_T
-#include "perl.h"
+#include "ponie.h"
static void S_SvOK_off(PMC *pmc) {
assert_not_ROK(MUMBLE(pmc)) 0;
@@ -40,13 +35,10 @@
/* Refactor this when it gets chopped into morph code. */
#define new_XPV() (void*)new_xpv()
-#define del_XPV(p) del_xpv((XPV *)p)
#define new_XPVIV() (void*)new_xpviv()
-#define del_XPVIV(p) del_xpviv((XPVIV *)p)
#define new_XPVNV() (void*)new_xpvnv()
-#define del_XPVNV(p) del_xpvnv((XPVNV *)p)
#define new_XPVCV() (void*)new_xpvcv()
#define del_XPVCV(p) del_xpvcv((XPVCV *)p)
@@ -58,7 +50,6 @@
#define del_XPVHV(p) del_xpvhv((XPVHV *)p)
#define new_XPVMG() (void*)new_xpvmg()
-#define del_XPVMG(p) del_xpvmg((XPVMG *)p)
#define new_XPVLV() (void*)new_xpvlv()
#define del_XPVLV(p) del_xpvlv((XPVLV *)p)
@@ -75,125 +66,20 @@
#define new_XPVIO() (void*)new_xpvio()
#define del_XPVIO(p) del_xpvio((XPVIO *)p)
-static void do_upgrade(PMC *pmc, U32 mt) {
- char* pv;
- SV* rv;
- U32 cur;
- U32 len;
- IV iv;
- NV nv;
- MAGIC* magic;
- HV* stash;
- int sv_is_rv;
+static void do_upgrade(PMC *pmc, struct Ponie_upgrade_info *info) {
+ char* pv = info->value.pv;
+ SV* rv = info->value.rv;
+ U32 cur = info->value.cur;
+ U32 len = info->value.len;
+ IV iv = info->value.iv;
+ NV nv = info->value.nv;
+ MAGIC* magic = info->value.magic;
+ HV* stash = info->value.stash;
+ int sv_is_rv = info->value.sv_is_rv;
+ U32 mt = info->p5_type;
SV *sv = MUMBLE(pmc);
- if (mt != SVt_PV && SvIsCOW(sv)) {
- sv_force_normal_flags(sv, 0);
- }
-
- if (SvTYPE(sv) == mt)
- return;
-
- sv_is_rv = SvROK(sv);
-
- if (mt < SVt_PVIV)
- (void)SvOOK_off(sv);
-
- pv = NULL;
- rv = NULL;
- cur = 0;
- len = 0;
- iv = 0;
- nv = 0.0;
- magic = NULL;
- stash = Nullhv;
-
- switch (SvTYPE(sv)) {
- case SVt_NULL:
- break;
- case SVt_IV:
- iv = SvIVX(sv);
- assert(SvANY(sv) == 0);
- SvPMC_off(sv);
- if (mt == SVt_NV)
- mt = SVt_PVNV;
- else if (mt < SVt_PVIV)
- mt = SVt_PVIV;
- break;
- case SVt_NV:
- nv = SvNVX(sv);
- magic = 0;
- stash = 0;
- assert(SvANY(sv) == 0);
- SvPMC_off(sv);
- if (mt < SVt_PVNV)
- mt = SVt_PVNV;
- break;
- case SVt_RV:
- rv = SvRV(sv);
- assert(SvANY(sv) == 0);
- SvPMC_off(sv);
- break;
- case SVt_PV:
- if (sv_is_rv) {
- rv = SvRV(sv);
- } else {
- pv = SvPVX(sv);
- }
- cur = SvCUR(sv);
- len = SvLEN(sv);
- del_XPV(SvANY(sv));
- SvPMC_off(sv);
- if (mt <= SVt_IV)
- mt = SVt_PVIV;
- else if (mt == SVt_NV)
- mt = SVt_PVNV;
- break;
- case SVt_PVIV:
- if (sv_is_rv) {
- rv = SvRV(sv);
- } else {
- pv = SvPVX(sv);
- }
- cur = SvCUR(sv);
- len = SvLEN(sv);
- iv = SvIVX(sv);
- del_XPVIV(SvANY(sv));
- SvPMC_off(sv);
- break;
- case SVt_PVNV:
- if (sv_is_rv) {
- rv = SvRV(sv);
- } else {
- pv = SvPVX(sv);
- }
- cur = SvCUR(sv);
- len = SvLEN(sv);
- iv = SvIVX(sv);
- nv = SvNVX(sv);
- del_XPVNV(SvANY(sv));
- SvPMC_off(sv);
- break;
- case SVt_PVMG:
- if (sv_is_rv) {
- rv = SvRV(sv);
- } else {
- pv = SvPVX(sv);
- }
- cur = SvCUR(sv);
- len = SvLEN(sv);
- iv = SvIVX(sv);
- nv = SvNVX(sv);
- 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");
- }
-
/* This is SvTYPE_set(sv, mt): */
((struct STRUCT_SV *)PMC_struct_val(pmc))->sv_flags &= ~SVTYPEMASK;
((struct STRUCT_SV *)PMC_struct_val(pmc))->sv_flags |= mt;
@@ -928,6 +814,18 @@
data->xpv_pv = NULL;
}
break;
+ case Ponie_P_NEWRV_HACK:
+ SELF->vtable = Parrot_base_vtables[PL_pmcname[SVt_NULL]];
+ break;
+ case Ponie_P_REPLACE:
+ {
+ /* FIXME. Loads more to migrate to here from sv_replace. */
+ SELF->vtable = ((PMC *)MUMBLE(value))->vtable;
+ }
+ break;
+ case Ponie_P_GET_UPGRADE:
+ Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
+ 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);
@@ -1117,8 +1015,14 @@
croak ("Out of range or illegal type %d (max is %d) "
"for sv upgrade", value, Ponie_PMC_Perl5_MAX - 1);
}
- DYNSELF.morph(PL_pmcname[value]);
- do_upgrade(SELF, value);
+ {
+ struct Ponie_upgrade_info info;
+
+ info.p5_type = value;
+ DYNSELF.set_pointer_keyed_int(Ponie_P_GET_UPGRADE, &info);
+ DYNSELF.morph(PL_pmcname[info.p5_type]);
+ do_upgrade(SELF, &info);
+ }
return;
case Ponie_I_SVf_OK:
1.2 +25 -1 ponie/src/pmc/perl5pvgv.pmc
Index: perl5pvgv.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5pvgv.pmc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl5pvgv.pmc 27 Apr 2005 14:32:22 -0000 1.1
+++ perl5pvgv.pmc 29 Apr 2005 22:11:31 -0000 1.2
@@ -10,5 +10,29 @@
* References:
*/
+#include "ponie.h"
+
pmclass Perl5PVGV extends Perl5PVMG dynpmc group Perl5_group {
+
+ void set_pointer_keyed_int(INTVAL key, void *value) {
+ switch (key) {
+ case Ponie_P_UNGLOB:
+ {
+ SELF->vtable = Parrot_base_vtables[PL_pmcname[SVt_PVMG]];
+ break;
+ default:
+ SUPER(key, value);
+ }
+ }
+ }
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
1.2 +43 -1 ponie/src/pmc/perl5pviv.pmc
Index: perl5pviv.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5pviv.pmc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl5pviv.pmc 27 Apr 2005 14:32:22 -0000 1.1
+++ perl5pviv.pmc 29 Apr 2005 22:11:31 -0000 1.2
@@ -10,5 +10,47 @@
* References:
*/
+#include "ponie.h"
+
+#define del_XPVIV(p) del_xpviv((XPVIV *)p)
+
pmclass Perl5PVIV extends Perl5PV extends Perl5IV dynpmc group Perl5_group {
+ void set_pointer_keyed_int(INTVAL key, void *value) {
+ switch (key) {
+ case Ponie_P_GET_UPGRADE:
+ {
+ struct Ponie_upgrade_info *info
+ = (struct Ponie_upgrade_info *)value;
+ SV *sv = MUMBLE(SELF);
+
+ memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
+
+ if (SvROK(sv)) {
+ info->value.rv = SvRV(sv);
+ info->value.sv_is_rv = 1;
+ } else {
+ info->value.pv = SvPVX(sv);
+ }
+ info->value.cur = SvCUR(sv);
+ info->value.len = SvLEN(sv);
+ info->value.iv = SvIVX(sv);
+
+ del_XPVIV(SvANY(sv));
+
+ break;
+ default:
+ SUPER(key, value);
+ }
+ }
+ }
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
1.2 +47 -1 ponie/src/pmc/perl5pvmg.pmc
Index: perl5pvmg.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5pvmg.pmc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl5pvmg.pmc 27 Apr 2005 14:32:22 -0000 1.1
+++ perl5pvmg.pmc 29 Apr 2005 22:11:31 -0000 1.2
@@ -10,5 +10,51 @@
* References:
*/
+#include "ponie.h"
+
+#define del_XPVMG(p) del_xpvmg((XPVMG *)p)
+
pmclass Perl5PVMG extends Perl5PVNV dynpmc group Perl5_group {
+
+ void set_pointer_keyed_int(INTVAL key, void *value) {
+ switch (key) {
+ case Ponie_P_GET_UPGRADE:
+ {
+ struct Ponie_upgrade_info *info
+ = (struct Ponie_upgrade_info *)value;
+ SV *sv = MUMBLE(SELF);
+
+ memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
+
+ if (SvROK(sv)) {
+ info->value.rv = SvRV(sv);
+ info->value.sv_is_rv = 1;
+ } else {
+ info->value.pv = SvPVX(sv);
+ }
+ info->value.cur = SvCUR(sv);
+ info->value.len = SvLEN(sv);
+ info->value.iv = SvIVX(sv);
+ info->value.nv = SvNVX(sv);
+ info->value.magic = SvMAGIC(sv);
+ info->value.stash = SvSTASH(sv);
+
+ del_XPVMG(SvANY(sv));
+
+ break;
+ default:
+ SUPER(key, value);
+ }
+ }
+ }
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
1.2 +44 -1 ponie/src/pmc/perl5pvnv.pmc
Index: perl5pvnv.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5pvnv.pmc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl5pvnv.pmc 27 Apr 2005 14:32:22 -0000 1.1
+++ perl5pvnv.pmc 29 Apr 2005 22:11:31 -0000 1.2
@@ -10,5 +10,48 @@
* References:
*/
+#include "ponie.h"
+
+#define del_XPVNV(p) del_xpvnv((XPVNV *)p)
+
pmclass Perl5PVNV extends Perl5PVIV extends Perl5NV dynpmc group Perl5_group {
+ void set_pointer_keyed_int(INTVAL key, void *value) {
+ switch (key) {
+ case Ponie_P_GET_UPGRADE:
+ {
+ struct Ponie_upgrade_info *info
+ = (struct Ponie_upgrade_info *)value;
+ SV *sv = MUMBLE(SELF);
+
+ memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
+
+ if (SvROK(sv)) {
+ info->value.rv = SvRV(sv);
+ info->value.sv_is_rv = 1;
+ } else {
+ info->value.pv = SvPVX(sv);
+ }
+ info->value.cur = SvCUR(sv);
+ info->value.len = SvLEN(sv);
+ info->value.iv = SvIVX(sv);
+ info->value.nv = SvNVX(sv);
+
+ del_XPVNV(SvANY(sv));
+
+ break;
+ default:
+ SUPER(key, value);
+ }
+ }
+ }
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
1.1 ponie/src/pmc/perl5iv.pmc
Index: perl5iv.pmc
===================================================================
/* Perl5IV.pmc -*- c -*-
* Copyright: 2005 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: perl5iv.pmc,v 1.1 2005/04/29 22:11:31 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5IV class
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
#include "ponie.h"
pmclass Perl5IV extends Perl5base dynpmc group Perl5_group {
void set_pointer_keyed_int(INTVAL key, void *value) {
switch (key) {
case Ponie_P_GET_UPGRADE:
{
struct Ponie_upgrade_info *info
= (struct Ponie_upgrade_info *)value;
U32 mt = info->p5_type;
/* The assertion will have to go once we're using the union
to store the IV */
assert(!SvANY(MUMBLE(SELF)));
memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
info->value.iv = SvIVX(MUMBLE(SELF));
if (mt == SVt_NV)
info->p5_type = SVt_PVNV;
else if (mt < SVt_PVIV)
info->p5_type = SVt_PVIV;
break;
default:
SUPER(key, value);
}
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 ponie/src/pmc/perl5null.pmc
Index: perl5null.pmc
===================================================================
/* Perl5NULL.pmc -*- c -*-
* Copyright: 2005 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: perl5null.pmc,v 1.1 2005/04/29 22:11:31 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5NULL class
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
#include "ponie.h"
pmclass Perl5NULL extends Perl5base dynpmc group Perl5_group {
void set_pointer_keyed_int(INTVAL key, void *value) {
switch (key) {
case Ponie_P_GET_UPGRADE:
assert(!SvANY(MUMBLE(SELF)));
memset(&((struct Ponie_upgrade_info *)value)->value, 0,
sizeof(struct Ponie_upgrade_value));
break;
default:
SUPER(key, value);
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 ponie/src/pmc/perl5nv.pmc
Index: perl5nv.pmc
===================================================================
/* Perl5NV.pmc -*- c -*-
* Copyright: 2005 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: perl5nv.pmc,v 1.1 2005/04/29 22:11:31 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5NV class
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
#include "ponie.h"
pmclass Perl5NV extends Perl5base dynpmc group Perl5_group {
void set_pointer_keyed_int(INTVAL key, void *value) {
switch (key) {
case Ponie_P_GET_UPGRADE:
{
struct Ponie_upgrade_info *info
= (struct Ponie_upgrade_info *)value;
U32 mt = info->p5_type;
/* The assertion will have to go once we're using the union
to store the NV */
assert(!SvANY(MUMBLE(SELF)));
memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
info->value.nv = SvNVX(MUMBLE(SELF));
if (mt < SVt_PVNV)
info->p5_type = SVt_PVNV;
break;
default:
SUPER(key, value);
}
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 ponie/src/pmc/perl5pv.pmc
Index: perl5pv.pmc
===================================================================
/* Perl5PV.pmc -*- c -*-
* Copyright: 2005 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: perl5pv.pmc,v 1.1 2005/04/29 22:11:31 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5PV class
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
#include "ponie.h"
#define del_XPV(p) del_xpv((XPV *)p)
pmclass Perl5PV extends Perl5base dynpmc group Perl5_group {
void set_pointer_keyed_int(INTVAL key, void *value) {
switch (key) {
case Ponie_P_GET_UPGRADE:
{
struct Ponie_upgrade_info *info
= (struct Ponie_upgrade_info *)value;
U32 mt = info->p5_type;
SV *sv = MUMBLE(SELF);
memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
if (SvROK(sv)) {
info->value.rv = SvRV(sv);
info->value.sv_is_rv = 1;
} else {
info->value.pv = SvPVX(sv);
}
info->value.cur = SvCUR(sv);
info->value.len = SvLEN(sv);
del_XPV(SvANY(sv));
if (mt < SVt_PVIV)
info->p5_type = SVt_PVIV;
else if (mt == SVt_NV)
info->p5_type = SVt_PVNV;
break;
default:
SUPER(key, value);
}
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 ponie/src/pmc/perl5rv.pmc
Index: perl5rv.pmc
===================================================================
/* Perl5RV.pmc -*- c -*-
* Copyright: 2005 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: perl5rv.pmc,v 1.1 2005/04/29 22:11:31 nicholas Exp $
* Overview:
* These are the vtable functions for the Perl5RV class
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
#include "ponie.h"
pmclass Perl5RV extends Perl5base dynpmc group Perl5_group {
void set_pointer_keyed_int(INTVAL key, void *value) {
switch (key) {
case Ponie_P_GET_UPGRADE:
{
struct Ponie_upgrade_info *info
= (struct Ponie_upgrade_info *)value;
assert(!SvANY(MUMBLE(SELF)));
memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
info->value.rv = SvRV(MUMBLE(SELF));
info->value.sv_is_rv = 1;
break;
default:
SUPER(key, value);
}
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 ponie/src/pmc/ponie.h
Index: ponie.h
===================================================================
#include "parrot/parrot.h"
/*#include "parrot/embed.h"
#include "parrot/extend.h"*/
#include "EXTERN.h"
#include "config.h"
#undef HAS_OFF64_T
#include "perl.h"
struct Ponie_upgrade_value {
char* pv;
SV* rv;
U32 cur;
U32 len;
IV iv;
NV nv;
MAGIC* magic;
HV* stash;
int sv_is_rv;
};
struct Ponie_upgrade_info {
U32 p5_type;
struct Ponie_upgrade_value value;
};