cvs commit: ponie/src/pmc perl5cargo_cult_static_get.c perl5pining.pmc

cvsuser     05/05/07 05:45:27

  Modified:    perl     av.c pp_hot.c sv.h
               src/pmc  perl5cargo_cult_static_get.c perl5pining.pmc
  Log:
  Allow PMCs to be compiled to trap access to freed SVs (with special casing for
  the known accesses to freed elements of @_)
  
  Revision  Changes    Path
  1.12      +3 -1      ponie/perl/av.c
  
  Index: av.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/av.c,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -r1.11 -r1.12
  --- av.c	1 May 2005 17:13:13 -0000	1.11
  +++ av.c	7 May 2005 12:45:27 -0000	1.12
  @@ -247,7 +247,9 @@
       }
       else if (AvREIFY(av)
   	     && (!AvARRAY(av)[key]	/* eg. @_ could have freed elts */
  -		 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
  +		 || Parrot_PMC_get_intval_intkey(PL_Parrot,
  +						 MUMBLE(AvARRAY(av)[key]),
  +						 Ponie_I_SV_TYPE_IS_MASK_NO_ABORT))) {
   	AvARRAY(av)[key] = &PL_sv_undef;	/* 1/2 reify */
   	goto emptyness;
       }
  
  
  
  1.14      +2 -1      ponie/perl/pp_hot.c
  
  Index: pp_hot.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/pp_hot.c,v
  retrieving revision 1.13
  retrieving revision 1.14
  diff -u -r1.13 -r1.14
  --- pp_hot.c	19 Apr 2005 21:23:13 -0000	1.13
  +++ pp_hot.c	7 May 2005 12:45:27 -0000	1.14
  @@ -1917,7 +1917,8 @@
   	}
       }
   
  -    if (sv && SvREFCNT(sv) == 0) {
  +    if (sv && Parrot_PMC_get_intval_intkey(PL_Parrot, MUMBLE(sv),
  +					   Ponie_I_SV_REFCNT_NO_ABORT) == 0) {
   	*itersvp = Nullsv;
   	Perl_croak(aTHX_ "Use of freed value in iteration");
       }
  
  
  
  1.86      +2 -0      ponie/perl/sv.h
  
  Index: sv.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/sv.h,v
  retrieving revision 1.85
  retrieving revision 1.86
  diff -u -r1.85 -r1.86
  --- sv.h	4 May 2005 16:44:29 -0000	1.85
  +++ sv.h	7 May 2005 12:45:27 -0000	1.86
  @@ -324,6 +324,8 @@
     Ponie_I_HV_LAZYDEL,
     Ponie_I_HV_REHASH,
     Ponie_I_HV_AMAGIC,
  +  Ponie_I_SV_REFCNT_NO_ABORT,
  +  Ponie_I_SV_TYPE_IS_MASK_NO_ABORT,
     Ponie_I_MAX
   } Ponie_integers;
   
  
  
  
  1.2       +5 -1      ponie/src/pmc/perl5cargo_cult_static_get.c
  
  Index: perl5cargo_cult_static_get.c
  ===================================================================
  RCS file: /cvs/public/ponie/src/pmc/perl5cargo_cult_static_get.c,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- perl5cargo_cult_static_get.c	2 May 2005 20:27:07 -0000	1.1
  +++ perl5cargo_cult_static_get.c	7 May 2005 12:45:27 -0000	1.2
  @@ -22,6 +22,7 @@
       switch (key) {
       case Ponie_I_SV_FLAGS:
           return PERL5_FLAGS(pmc);
  +    case Ponie_I_SV_REFCNT_NO_ABORT:
       case Ponie_I_SV_REFCNT:
           return PERL5_REFCNT(pmc);
       case Ponie_I_SV_TYPE:
  @@ -126,6 +127,9 @@
       case Ponie_I_HV_REHASH:
           return PERL5_FLAGS(pmc) & SVphv_REHASH;
   
  +    case Ponie_I_SV_TYPE_IS_MASK_NO_ABORT:
  +        return (PERL5_FLAGS(pmc) & SVTYPEMASK) == SVTYPEMASK;
  +
       default:
           croak ("Out of range or illegal key %d (max is %d) "
                  "in get_integer_keyed_int", key, Ponie_I_MAX - 1);
  
  
  
  1.2       +11 -1     ponie/src/pmc/perl5pining.pmc
  
  Index: perl5pining.pmc
  ===================================================================
  RCS file: /cvs/public/ponie/src/pmc/perl5pining.pmc,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- perl5pining.pmc	2 May 2005 20:27:07 -0000	1.1
  +++ perl5pining.pmc	7 May 2005 12:45:27 -0000	1.2
  @@ -20,6 +20,16 @@
   
   pmclass Perl5Pining dynpmc group Perl5_group {
       INTVAL get_integer_keyed_int(INTVAL key) {
  +#ifdef PONIE_DEBUG_PINING
  +        if (key == Ponie_I_SV_REFCNT_NO_ABORT) {
  +            return 0;
  +        }
  +        if (key == Ponie_I_SV_TYPE_IS_MASK_NO_ABORT) {
  +            return 1;
  +        }
  +        PerlIO_printf(PerlIO_stderr(), "Pining for the fjords, key %d\n", key);
  +        abort();
  +#endif
           return S_get_integer_keyed_int(SELF, key);
       }