cvs commit: ponie/src/pmc perl5cargo_cult.pmc
[email protected] (Nicholas Clark) 25 Apr 2005 11:00:53 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/04/25 04:00:53
Modified: src/pmc perl5cargo_cult.pmc
Log:
Move sv_upgrade into the PMC. (missed a rather important bit)
Revision Changes Path
1.46 +412 -2 ponie/src/pmc/perl5cargo_cult.pmc
Index: perl5cargo_cult.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5cargo_cult.pmc,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- perl5cargo_cult.pmc 4 Nov 2004 12:35:32 -0000 1.45
+++ perl5cargo_cult.pmc 25 Apr 2005 11:00:53 -0000 1.46
@@ -36,6 +36,413 @@
& (SVs_GMG|SVs_SMG|SVs_RMG);
}
+/* 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)
+
+#define new_XPVAV() (void*)new_xpvav()
+#define del_XPVAV(p) del_xpvav((XPVAV *)p)
+
+#define new_XPVHV() (void*)new_xpvhv()
+#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)
+
+#define new_XPVBM() (void*)new_xpvbm()
+#define del_XPVBM(p) del_xpvbm((XPVBM *)p)
+
+#define new_XPVGV() (void*)new_xpvgv()
+#define del_XPVGV(p) del_xpvgv((XPVGV *)p)
+
+#define new_XPVFM() (void*)new_xpvfm()
+#define del_XPVFM(p) del_xpvfm((XPVFM *)p)
+
+#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;
+
+ 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;
+
+ switch (mt) {
+ case SVt_NULL:
+ Perl_croak(aTHX_ "Can't upgrade to undef");
+ case SVt_IV:
+ SvANY(sv) = 0;
+ SvPMC_on(sv);
+ SvIV_set(sv, iv);
+ break;
+ case SVt_NV:
+ SvANY(sv) = 0;
+ SvPMC_on(sv);
+ SvNV_set(sv, nv);
+ break;
+ case SVt_RV:
+ SvANY(sv) = 0;
+ SvPMC_on(sv);
+ SvRV_set(sv, rv);
+ break;
+ case SVt_PV:
+ SvANY(sv) = new_XPV();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ break;
+ case SVt_PVIV:
+ SvANY(sv) = new_XPVIV();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ if (SvNIOK(sv))
+ (void)SvIOK_on(sv);
+ SvNOK_off(sv);
+ break;
+ case SVt_PVNV:
+ SvANY(sv) = new_XPVNV();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ break;
+ case SVt_PVMG:
+ SvANY(sv) = new_XPVMG();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ break;
+ case SVt_PVLV:
+ SvANY(sv) = new_XPVLV();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ LvTARGOFF(sv) = 0;
+ LvTARGLEN(sv) = 0;
+ LvTARG(sv) = 0;
+ LvTYPE(sv) = 0;
+ GvGP(sv) = 0;
+ GvNAME(sv) = 0;
+ GvNAMELEN(sv) = 0;
+ GvSTASH(sv) = 0;
+ GvFLAGS(sv) = 0;
+ break;
+ case SVt_PVAV:
+ SvANY(sv) = new_XPVAV();
+ if (pv)
+ Safefree(pv);
+ if (sv_is_rv) {
+ /* XXX need more paranoia here? */
+ SvRV_set(sv, 0);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, (char*)0);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ AvMAX(sv) = -1;
+ AvFILLp(sv) = -1;
+ SvIV_set(sv, 0);
+ SvNV_set(sv, 0.0);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ AvALLOC(sv) = 0;
+ AvARYLEN(sv) = 0;
+ AvFLAGS(sv) = AVf_REAL;
+ break;
+ case SVt_PVHV:
+ SvANY(sv) = new_XPVHV();
+ if (pv)
+ Safefree(pv);
+ if (sv_is_rv) {
+ /* XXX need more paranoia here? */
+ SvRV_set(sv, 0);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, (char*)0);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ HvFILL(sv) = 0;
+ HvMAX(sv) = 0;
+ HvTOTALKEYS(sv) = 0;
+ HvPLACEHOLDERS(sv) = 0;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ HvRITER(sv) = 0;
+ HvEITER(sv) = 0;
+ HvPMROOT(sv) = 0;
+ HvNAME(sv) = 0;
+ break;
+ case SVt_PVCV:
+ SvANY(sv) = new_XPVCV();
+ SvPMC_on(sv);
+ zero_xpvcv(sv);
+ assert (!sv_is_rv);
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ break;
+ case SVt_PVGV:
+ SvANY(sv) = new_XPVGV();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ GvGP(sv) = 0;
+ GvNAME(sv) = 0;
+ GvNAMELEN(sv) = 0;
+ GvSTASH(sv) = 0;
+ GvFLAGS(sv) = 0;
+ break;
+ case SVt_PVBM:
+ SvANY(sv) = new_XPVBM();
+ SvPMC_on(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ BmRARE(sv) = 0;
+ BmUSEFUL(sv) = 0;
+ BmPREVIOUS(sv) = 0;
+ break;
+ case SVt_PVFM:
+ SvANY(sv) = new_XPVFM();
+ SvPMC_on(sv);
+ zero_xpvfm(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ break;
+ case SVt_PVIO:
+ SvANY(sv) = new_XPVIO();
+ SvPMC_on(sv);
+ zero_xpvio(sv);
+ if (sv_is_rv) {
+ SvRV_set(sv, rv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
+ } else {
+ SvPV_set(sv, pv);
+ Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
+ }
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
+ SvIV_set(sv, iv);
+ SvNV_set(sv, nv);
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
+ IoPAGE_LEN(sv) = 60;
+ break;
+ }
+}
+
pmclass Perl5QQQ dynpmc {
void init () {
@@ -697,7 +1104,10 @@
return;
case Ponie_I_SV_UPGRADE:
if ((((struct STRUCT_SV *)PMC_struct_val(SELF))->sv_flags & SVTYPEMASK) < value)
- sv_upgrade(MUMBLE(SELF), value);
+ do_upgrade(SELF, value);
+ return;
+ case Ponie_I_SV_UPGRADE_func:
+ do_upgrade(SELF, value);
return;
case Ponie_I_SVf_OK: