cvs commit: ponie/src/pmc perl5pvgv.pmc
[email protected] (Nicholas Clark) 4 May 2005 16:44:30 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/05/04 09:44:30
Modified: perl embed.fnc embed.h proto.h sv.c sv.h
src/pmc perl5pvgv.pmc
Log:
sv_unglob is actually a constrained variant of sv_upgrade, so write it as such,
using the standard morph interface.
Revision Changes Path
1.45 +0 -1 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- embed.fnc 4 May 2005 09:44:01 -0000 1.44
+++ embed.fnc 4 May 2005 16:44:29 -0000 1.45
@@ -1171,7 +1171,6 @@
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
s |IV |asIV |SV* sv
s |UV |asUV |SV* sv
-s |void |sv_unglob |SV* sv
s |void |not_a_number |SV *sv
s |I32 |visit |SVFUNC_t f|U32 flags|U32 mask
s |void |sv_add_backref |SV *tsv|SV *sv
1.35 +0 -6 ponie/perl/embed.h
Index: embed.h
===================================================================
RCS file: /cvs/public/ponie/perl/embed.h,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- embed.h 4 May 2005 09:44:01 -0000 1.34
+++ embed.h 4 May 2005 16:44:29 -0000 1.35
@@ -1706,9 +1706,6 @@
#define asUV S_asUV
#endif
#ifdef PERL_CORE
-#define sv_unglob S_sv_unglob
-#endif
-#ifdef PERL_CORE
#define not_a_number S_not_a_number
#endif
#ifdef PERL_CORE
@@ -4191,9 +4188,6 @@
#define asUV(a) S_asUV(aTHX_ a)
#endif
#ifdef PERL_CORE
-#define sv_unglob(a) S_sv_unglob(aTHX_ a)
-#endif
-#ifdef PERL_CORE
#define not_a_number(a) S_not_a_number(aTHX_ a)
#endif
#ifdef PERL_CORE
1.45 +0 -1 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- proto.h 4 May 2005 09:44:01 -0000 1.44
+++ proto.h 4 May 2005 16:44:29 -0000 1.45
@@ -1123,7 +1123,6 @@
#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
STATIC IV S_asIV(pTHX_ SV* sv);
STATIC UV S_asUV(pTHX_ SV* sv);
-STATIC void S_sv_unglob(pTHX_ SV* sv);
STATIC void S_not_a_number(pTHX_ SV *sv);
STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask);
STATIC void S_sv_add_backref(pTHX_ SV *tsv, SV *sv);
1.87 +5 -70 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -r1.86 -r1.87
--- sv.c 4 May 2005 15:08:56 -0000 1.86
+++ sv.c 4 May 2005 16:44:29 -0000 1.87
@@ -4008,8 +4008,11 @@
#endif
if (SvROK(sv))
sv_unref_flags(sv, flags);
- else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
- sv_unglob(sv);
+ else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
+ /* classic sv_unglob is now a specialised upgrade. */
+ Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv),
+ Ponie_I_SV_UPGRADE_func, SVt_PVMG);
+ }
}
/*
@@ -7449,74 +7452,6 @@
return sv;
}
-/* Downgrades a PVGV to a PVMG.
- */
-
-/* FIXME. A downgrade upgrade. */
-
-STATIC void
-S_sv_unglob(pTHX_ SV *sv)
-{
- 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 (GvSTASH(sv)) {
- SvREFCNT_dec(GvSTASH(sv));
- GvSTASH(sv) = Nullhv;
- }
- sv_unmagic(sv, PERL_MAGIC_glob);
- GvMULTI_off(sv);
-
- /* need to keep SvANY(sv) in the right arena */
- sv_upgrade(new_mg, SVt_PVMG);
-
- /* Swap all the pointer related entries using the official API. */
- temp_pv = SvPVX(sv);
- SvPV_set(sv, SvPVX(new_mg));
- SvPV_set(new_mg, temp_pv);
- temp_len = SvCUR(sv);
- SvCUR_set(sv, SvCUR(new_mg));
- SvCUR_set(new_mg, temp_len);
- temp_len = SvLEN(sv);
- SvLEN_set(sv, SvLEN(new_mg));
- SvLEN_set(new_mg, temp_len);
- temp_magic = SvMAGIC(sv);
- SvMAGIC_set(sv, SvMAGIC(new_mg));
- SvMAGIC_set(new_mg, temp_magic);
- temp_stash = SvSTASH(sv);
- SvSTASH_set(sv, SvSTASH(new_mg));
- SvSTASH_set(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_set(sv, SvREFCNT(new_mg));
- SvREFCNT_set(new_mg, temp);
-
-
- /* Swap the bodies */
- temp_head
- = *(struct STRUCT_SV*)Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(sv));
- *(struct STRUCT_SV*)Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(sv))
- = *(struct STRUCT_SV*)Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(new_mg));
- *(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);
-}
-
/*
=for apidoc sv_unref_flags
1.85 +0 -1 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- sv.h 4 May 2005 11:06:44 -0000 1.84
+++ sv.h 4 May 2005 16:44:29 -0000 1.85
@@ -248,7 +248,6 @@
Ponie_P_SET_UPGRADE, /* Allocate SvANY and push data to it */
Ponie_P_CLEAR, /* Free SvANY and things hanging from it */
Ponie_P_FREESCALAR_COMMON, /* Common legacy code for freeing scalars */
- Ponie_P_UNGLOB, /* Special things for sv_unglob */
Ponie_P_NEWSVRV, /* newSVrv */
Ponie_P_REPLACE, /* Special things for sv_replace */
Ponie_P_PINE_FOR_FJORDS, /* Free all internal storage and play dead */
1.8 +40 -3 ponie/src/pmc/perl5pvgv.pmc
Index: perl5pvgv.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5pvgv.pmc,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- perl5pvgv.pmc 1 May 2005 21:00:49 -0000 1.7
+++ perl5pvgv.pmc 4 May 2005 16:44:30 -0000 1.8
@@ -61,9 +61,46 @@
GvFLAGS(sv) = 0;
break;
}
- case Ponie_P_UNGLOB:
+ case Ponie_P_GET_UPGRADE:
{
- SELF->vtable = Parrot_base_vtables[PL_pmcname[SVt_PVMG]];
+ struct Ponie_upgrade_info *info
+ = (struct Ponie_upgrade_info *)value;
+ SV *sv = MUMBLE(SELF);
+
+ if(info->p5_type != SVt_PVMG) {
+ croak("Can only unglob to SvPVMG (%u), not %u", SVt_PVMG,
+ info->p5_type);
+ }
+ if(!SvFAKE(sv)) {
+ croak("Can only unglob when SvFAKE is true");
+ }
+ if(SvROK(sv)) {
+ croak("Can't unglob a reference");
+ }
+
+ memset(&(info->value), 0, sizeof(struct Ponie_upgrade_value));
+
+ 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);
+
+ 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_XPVGV(SvANY(sv));
break;
}
case Ponie_P_CLEAR: