cvs commit: ponie/src/pmc perl5cargo_cult.pmc

cvsuser     05/05/04 08:08:57

  Modified:    perl     sv.c
               src/pmc  perl5cargo_cult.pmc
  Log:
  Move the guts of newSVrv (bugs and all) into the PMC
  
  Revision  Changes    Path
  1.86      +3 -38     ponie/perl/sv.c
  
  Index: sv.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/sv.c,v
  retrieving revision 1.85
  retrieving revision 1.86
  diff -u -r1.85 -r1.86
  --- sv.c	4 May 2005 14:09:48 -0000	1.85
  +++ sv.c	4 May 2005 15:08:56 -0000	1.86
  @@ -7289,44 +7289,9 @@
   SV*
   Perl_newSVrv(pTHX_ SV *rv, const char *classname)
   {
  -    SV *sv;
  -
  -    new_SV(sv);
  -
  -    SV_CHECK_THINKFIRST_COW_DROP(rv);
  -    SvAMAGIC_off(rv);
  -
  -    if (SvTYPE(rv) >= SVt_PVMG) {
  -	U32 refcnt = SvREFCNT(rv);
  -	SvREFCNT_set(rv, 0);
  -	/* FIXME. A downgrade upgrade.  */
  -	sv_clear(rv);
  -	SvANY_set(rv, 0);
  -	Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(rv), Ponie_P_NEWSVRV,
  -				      classname);
  -	SvFLAGS(rv) = 0;
  -	SvREFCNT_set(rv, refcnt);
  -    }
  -
  -    if (SvTYPE(rv) < SVt_RV)
  -	sv_upgrade(rv, SVt_RV);
  -    else if (SvTYPE(rv) > SVt_RV) {
  -	SvOOK_off(rv);
  -	if (SvPVX(rv) && SvLEN(rv))
  -	    Safefree(SvPVX(rv));
  -	SvCUR_set(rv, 0);
  -	SvLEN_set(rv, 0);
  -    }
  -
  -    SvOK_off(rv);
  -    SvRV_set(rv, sv);
  -    SvROK_on(rv);
  -
  -    if (classname) {
  -	HV* stash = gv_stashpv(classname, TRUE);
  -	(void)sv_bless(rv, stash);
  -    }
  -    return sv;
  +    Parrot_PMC_set_pointer_intkey(PL_Parrot, MUMBLE(rv), Ponie_P_NEWSVRV,
  +				  (void *)classname);
  +    return SvRV(rv);
   }
   
   /*
  
  
  
  1.64      +42 -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.63
  retrieving revision 1.64
  diff -u -r1.63 -r1.64
  --- perl5cargo_cult.pmc	4 May 2005 14:09:48 -0000	1.63
  +++ perl5cargo_cult.pmc	4 May 2005 15:08:56 -0000	1.64
  @@ -582,7 +582,47 @@
               }
               break;
           case Ponie_P_NEWSVRV:
  -            SELF->vtable = Parrot_base_vtables[PL_pmcname[SVt_NULL]];
  +            {
  +                /* value is the classname for gv_stashpv */
  +                SV *sv;
  +                SV *rv = MUMBLE(SELF);
  +
  +                SV_CHECK_THINKFIRST_COW_DROP(rv);
  +                SvAMAGIC_off(rv);
  +
  +                if (SvTYPE(rv) >= SVt_PVMG) {
  +                    U32 refcnt = SvREFCNT(rv);
  +                    SvREFCNT_set(rv, 0);
  +                    /* A downgrade upgrade.  */
  +                    sv_clear(rv);
  +                    SvANY_set(rv, 0);
  +                    SELF->vtable = Parrot_base_vtables[PL_pmcname[SVt_NULL]];
  +                    PERL5_FLAGS(SELF) = 0;
  +                    SvREFCNT_set(rv, refcnt);
  +                }
  +                
  +                if (SvTYPE(rv) < SVt_RV)
  +                    VTABLE_morph(interpreter, pmc, PL_pmcname[SVt_RV]);
  +                else if (SvTYPE(rv) > SVt_RV) {
  +                    /* Yes, this is buggy for all the reasons that core perl's
  +                       newSVrv is currently buggy.  */
  +                    SvOOK_off(rv);
  +                    if (SvPVX(rv) && SvLEN(rv))
  +                        Safefree(SvPVX(rv));
  +                    SvCUR_set(rv, 0);
  +                    SvLEN_set(rv, 0);
  +                }
  +
  +                SvOK_off(rv);
  +                SvRV_set(rv, MUMBLE(Parrot_PMC_new(PL_Parrot,
  +                                                   PL_pmcname[SVt_NULL])));
  +                SvROK_on(rv);
  +
  +                if (value) {
  +                    HV* stash = gv_stashpv(value, TRUE);
  +                    (void)sv_bless(rv, stash);
  +                }
  +            }
               break;
           case Ponie_P_REPLACE:
               {