cvs commit: ponie/src/pmc perl5pvmg_mess.pmc
[email protected] (Nicholas Clark) 2 May 2005 22:12:07 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/05/02 15:12:07
Modified: . write_makefile.pl
perl perl.c sv.h util.c
Added: src/pmc perl5pvmg_mess.pmc
Log:
Add a Perl5PVMG_mess PMC type for the special behaviour of PL_mess_sv
Revision Changes Path
1.12 +2 -2 ponie/write_makefile.pl
Index: write_makefile.pl
===================================================================
RCS file: /cvs/public/ponie/write_makefile.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- write_makefile.pl 2 May 2005 20:27:07 -0000 1.11
+++ write_makefile.pl 2 May 2005 22:12:06 -0000 1.12
@@ -10,7 +10,7 @@
my $top = $FindBin::Bin;
my @allPMCs
- = qw(cargo_cult base null pining
+ = qw(cargo_cult base null pining pvmg_mess
iv nv rv pv pviv pvnv pvmg pvbm pvgv pvlv pvav pvhv pvcv pvfm pvio);
my $parrotdir = "$top/parrot";
1.24 +5 -16 ponie/perl/perl.c
Index: perl.c
===================================================================
RCS file: /cvs/public/ponie/perl/perl.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- perl.c 2 May 2005 20:27:07 -0000 1.23
+++ perl.c 2 May 2005 22:12:06 -0000 1.24
@@ -254,6 +254,7 @@
PMC in the reverse mapping table as a distinct type. Should it
reverse map as SVt_NULL? */
{Ponie_PMC_Perl5Pining, "Perl5Pining"},
+ {Ponie_PMC_Perl5PVMG_mess, "Perl5PVMG_mess"},
{Ponie_PMC_Perl5_MAX, NULL}
};
const Ponie_pmc_init *i = s;
@@ -1006,22 +1007,10 @@
/* As the absolutely last thing, free the non-arena SV for mess() */
if (PL_mess_sv) {
- /* it could have accumulated taint magic */
- if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
- MAGIC* mg;
- MAGIC* moremagic;
- for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
- moremagic = mg->mg_moremagic;
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
- && mg->mg_len >= 0)
- Safefree(mg->mg_ptr);
- Safefree(mg);
- }
- }
- /* we know that type >= SVt_PV */
- (void)SvOOK_off(PL_mess_sv);
- Safefree(SvPVX(PL_mess_sv));
- Safefree(SvANY(PL_mess_sv));
+ /* Should I go the whole hog and instruct it to pine for the fjords,
+ rather than merely clearing itself? */
+ Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(PL_mess_sv),
+ Ponie_P_CLEAR, 0);
Parrot_unregister_pmc(PL_Parrot, MUMBLE(PL_mess_sv));
PL_mess_sv = Nullsv;
}
1.83 +1 -0 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -r1.82 -r1.83
--- sv.h 2 May 2005 20:27:07 -0000 1.82
+++ sv.h 2 May 2005 22:12:06 -0000 1.83
@@ -182,6 +182,7 @@
typedef enum {
Ponie_PMC_Perl5Pining = SVt_MAX,
+ Ponie_PMC_Perl5PVMG_mess,
Ponie_PMC_Perl5_MAX
} Ponie_pmcs;
1.16 +2 -12 ponie/perl/util.c
Index: util.c
===================================================================
RCS file: /cvs/public/ponie/perl/util.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- util.c 2 May 2005 20:27:07 -0000 1.15
+++ util.c 2 May 2005 22:12:06 -0000 1.16
@@ -855,9 +855,7 @@
STATIC SV *
S_mess_alloc(pTHX)
{
- SV *sv;
Parrot_PMC pvpvmg;
- XPVMG *any;
if (!PL_dirty)
return sv_2mortal(newSVpvn("",0));
@@ -867,18 +865,10 @@
/* Create as PVMG now, to avoid any upgrading later */
- pvpvmg = Parrot_PMC_new(PL_Parrot, PL_pmcname[SVt_PVMG]);
+ pvpvmg = Parrot_PMC_new(PL_Parrot, PL_pmcname[Ponie_PMC_Perl5PVMG_mess]);
Parrot_register_pmc(PL_Parrot, pvpvmg);
- sv = MUMBLE(pvpvmg);
-
- Newz(905, any, 1, XPVMG);
- Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv),
- Ponie_I_SV_ZERO_FLAGS_SET_TYPE, SVt_PVMG);
- SvANY_set(sv, any);
- SvREFCNT_set(sv, 1 << 30); /* practically infinite */
- PL_mess_sv = sv;
- return sv;
+ return PL_mess_sv = MUMBLE(pvpvmg);
}
#if defined(PERL_IMPLICIT_CONTEXT)
1.1 ponie/src/pmc/perl5pvmg_mess.pmc
Index: perl5pvmg_mess.pmc
===================================================================
/* Perl5PVMG.pmc -*- c -*-
* Copyright: 2005 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: perl5pvmg_mess.pmc,v 1.1 2005/05/02 22:12:06 nicholas Exp $
* Overview:
* Special case of Perl5PVMG for PL_mess_sv
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
#include "ponie.h"
pmclass Perl5PVMG_mess extends Perl5PVMG dynpmc group Perl5_group {
void init () {
struct STRUCT_SV* head = malloc(sizeof(struct STRUCT_SV));
XPVMG *any;
PObj_active_destroy_SET(SELF);
PMC_struct_val(SELF) = head;
PMC_pmc_val(SELF) = NULL;
head->sv_flags = SVt_PVMG;
head->sv_refcnt = 1 << 30; /* practically infinite */
Newz(905, any, 1, XPVMG);
head->sv_any = any;
}
void set_pointer_keyed_int(INTVAL key, void *value) {
switch (key) {
case Ponie_P_GET_UPGRADE:
croak ("Can't upgrade from Perl5PVMG_mess");
case Ponie_P_SET_UPGRADE:
croak ("Can't upgrade to Perl5PVMG_mess");
case Ponie_P_CLEAR:
{
SV *sv = MUMBLE(SELF);
MAGIC* mg;
MAGIC* moremagic;
/* it could have accumulated taint magic */
for (mg = SvMAGIC(sv); mg; mg = moremagic) {
moremagic = mg->mg_moremagic;
if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
&& mg->mg_len >= 0)
Safefree(mg->mg_ptr);
Safefree(mg);
}
/* we know that type >= SVt_PV */
(void)SvOOK_off(sv);
Safefree(SvPVX(sv));
Safefree(SvANY(sv));
Parrot_PMC_set_intval_intkey(PL_Parrot,SELF,
Ponie_I_SV_ZERO_FLAGS_SET_TYPEMASK_BREAK_DEAD,
0);
}
break;
default:
SUPER(key, value);
}
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/