cvs commit: ponie/src/pmc perl5cargo_cult.pmc

[email protected] (Nicholas Clark) 23 Jun 2004 10:54:25 -0000
Newsgroups perl.ponie.changes
Message-ID <[email protected]>
cvsuser     04/06/23 03:54:25

  Modified:    perl     embed.fnc embed.h embedvar.h intrpvar.h perlapi.h
                        pp.c pp_hot.c proto.h sv.c
               perl/ext/Devel/Peek/t Peek.t
               perl/ext/Storable Storable.xs
               src/pmc  perl5cargo_cult.pmc
  Log:
  RVs are now stored in the PMC's PMC slot. (but still refcounted.)
  
  Revision  Changes    Path
  1.28      +0 -3      ponie/perl/embed.fnc
  
  Index: embed.fnc
  ===================================================================
  RCS file: /cvs/public/ponie/perl/embed.fnc,v
  retrieving revision 1.27
  retrieving revision 1.28
  diff -u -w -r1.27 -r1.28
  --- embed.fnc	19 Jun 2004 11:44:33 -0000	1.27
  +++ embed.fnc	23 Jun 2004 10:54:24 -0000	1.28
  @@ -1266,7 +1266,6 @@
   s	|void	|more_xpvmg
   s	|void	|more_xpvlv
   s	|void	|more_xpvbm
  -s	|void	|more_xrv
   s	|XPVIV*	|new_xiv
   s	|XPVNV*	|new_xnv
   s	|XPV*	|new_xpv
  @@ -1281,7 +1280,6 @@
   s	|XPVLV*	|new_xpvlv
   s	|XPVBM*	|new_xpvbm
   s	|XPVGV*	|new_xpvgv
  -s	|XRV*	|new_xrv
   s	|void	|del_xiv	|XPVIV* p
   s	|void	|del_xnv	|XPVNV* p
   s	|void	|del_xpv	|XPV* p
  @@ -1296,7 +1294,6 @@
   s	|void	|del_xpvlv	|XPVLV* p
   s	|void	|del_xpvbm	|XPVBM* p
   s	|void	|del_xpvgv	|XPVGV* p
  -s	|void	|del_xrv	|XRV* p
   s	|void	|zero_xpvfm	|SV *fm
   s	|void	|zero_xpvcv	|SV *cv
   s	|void	|zero_xpvio	|SV *io
  
  
  
  1.18      +0 -18     ponie/perl/embed.h
  
  Index: embed.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/embed.h,v
  retrieving revision 1.17
  retrieving revision 1.18
  diff -u -w -r1.17 -r1.18
  --- embed.h	19 Jun 2004 11:44:33 -0000	1.17
  +++ embed.h	23 Jun 2004 10:54:24 -0000	1.18
  @@ -1835,9 +1835,6 @@
   #define more_xpvbm		S_more_xpvbm
   #endif
   #ifdef PERL_CORE
  -#define more_xrv		S_more_xrv
  -#endif
  -#ifdef PERL_CORE
   #define new_xiv			S_new_xiv
   #endif
   #ifdef PERL_CORE
  @@ -1880,9 +1877,6 @@
   #define new_xpvgv		S_new_xpvgv
   #endif
   #ifdef PERL_CORE
  -#define new_xrv			S_new_xrv
  -#endif
  -#ifdef PERL_CORE
   #define del_xiv			S_del_xiv
   #endif
   #ifdef PERL_CORE
  @@ -1925,9 +1919,6 @@
   #define del_xpvgv		S_del_xpvgv
   #endif
   #ifdef PERL_CORE
  -#define del_xrv			S_del_xrv
  -#endif
  -#ifdef PERL_CORE
   #define zero_xpvfm		S_zero_xpvfm
   #endif
   #ifdef PERL_CORE
  @@ -4415,9 +4406,6 @@
   #define more_xpvbm()		S_more_xpvbm(aTHX)
   #endif
   #ifdef PERL_CORE
  -#define more_xrv()		S_more_xrv(aTHX)
  -#endif
  -#ifdef PERL_CORE
   #define new_xiv()		S_new_xiv(aTHX)
   #endif
   #ifdef PERL_CORE
  @@ -4460,9 +4448,6 @@
   #define new_xpvgv()		S_new_xpvgv(aTHX)
   #endif
   #ifdef PERL_CORE
  -#define new_xrv()		S_new_xrv(aTHX)
  -#endif
  -#ifdef PERL_CORE
   #define del_xiv(a)		S_del_xiv(aTHX_ a)
   #endif
   #ifdef PERL_CORE
  @@ -4505,9 +4490,6 @@
   #define del_xpvgv(a)		S_del_xpvgv(aTHX_ a)
   #endif
   #ifdef PERL_CORE
  -#define del_xrv(a)		S_del_xrv(aTHX_ a)
  -#endif
  -#ifdef PERL_CORE
   #define zero_xpvfm(a)		S_zero_xpvfm(aTHX_ a)
   #endif
   #ifdef PERL_CORE
  
  
  
  1.7       +0 -4      ponie/perl/embedvar.h
  
  Index: embedvar.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/embedvar.h,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -w -r1.6 -r1.7
  --- embedvar.h	21 Jun 2004 12:28:35 -0000	1.6
  +++ embedvar.h	23 Jun 2004 10:54:24 -0000	1.7
  @@ -457,8 +457,6 @@
   #define PL_xpvmg_root		(vTHX->Ixpvmg_root)
   #define PL_xpvnv_arenaroot	(vTHX->Ixpvnv_arenaroot)
   #define PL_xpvnv_root		(vTHX->Ixpvnv_root)
  -#define PL_xrv_arenaroot	(vTHX->Ixrv_arenaroot)
  -#define PL_xrv_root		(vTHX->Ixrv_root)
   #define PL_yycharp		(vTHX->Iyycharp)
   #define PL_yylvalp		(vTHX->Iyylvalp)
   
  @@ -760,8 +758,6 @@
   #define PL_Ixpvmg_root		PL_xpvmg_root
   #define PL_Ixpvnv_arenaroot	PL_xpvnv_arenaroot
   #define PL_Ixpvnv_root		PL_xpvnv_root
  -#define PL_Ixrv_arenaroot	PL_xrv_arenaroot
  -#define PL_Ixrv_root		PL_xrv_root
   #define PL_Iyycharp		PL_yycharp
   #define PL_Iyylvalp		PL_yylvalp
   
  
  
  
  1.8       +0 -2      ponie/perl/intrpvar.h
  
  Index: intrpvar.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/intrpvar.h,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -w -r1.7 -r1.8
  --- intrpvar.h	21 Jun 2004 12:09:22 -0000	1.7
  +++ intrpvar.h	23 Jun 2004 10:54:24 -0000	1.8
  @@ -250,7 +250,6 @@
   PERLVAR(Ixiv_arenaroot,	XPV*)		/* list of allocated xiv areas */
   PERLVAR(Ixiv_root,	IV *)		/* free xiv list */
   PERLVAR(Ixnv_root,	NV *)		/* free xnv list */
  -PERLVAR(Ixrv_root,	XRV *)		/* free xrv list */
   PERLVAR(Ixpv_root,	XPV *)		/* free xpv list */
   PERLVAR(Ixpviv_root,	XPVIV *)	/* free xpviv list */
   PERLVAR(Ixpvnv_root,	XPVNV *)	/* free xpvnv list */
  @@ -430,7 +429,6 @@
   PERLVARI(Ibeginav_save, AV*, Nullav)	/* save BEGIN{}s when compiling */
   
   PERLVAR(Ixnv_arenaroot,	XPV*)		/* list of allocated xnv areas */
  -PERLVAR(Ixrv_arenaroot,	XPV*)		/* list of allocated xrv areas */
   PERLVAR(Ixpv_arenaroot,	XPV*)		/* list of allocated xpv areas */
   PERLVAR(Ixpviv_arenaroot,XPVIV*)	/* list of allocated xpviv areas */
   PERLVAR(Ixpvnv_arenaroot,XPVNV*)	/* list of allocated xpvnv areas */
  
  
  
  1.7       +0 -4      ponie/perl/perlapi.h
  
  Index: perlapi.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/perlapi.h,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -w -r1.6 -r1.7
  --- perlapi.h	21 Jun 2004 12:28:35 -0000	1.6
  +++ perlapi.h	23 Jun 2004 10:54:24 -0000	1.7
  @@ -672,10 +672,6 @@
   #define PL_xpvnv_arenaroot	(*Perl_Ixpvnv_arenaroot_ptr(aTHX))
   #undef  PL_xpvnv_root
   #define PL_xpvnv_root		(*Perl_Ixpvnv_root_ptr(aTHX))
  -#undef  PL_xrv_arenaroot
  -#define PL_xrv_arenaroot	(*Perl_Ixrv_arenaroot_ptr(aTHX))
  -#undef  PL_xrv_root
  -#define PL_xrv_root		(*Perl_Ixrv_root_ptr(aTHX))
   #undef  PL_yycharp
   #define PL_yycharp		(*Perl_Iyycharp_ptr(aTHX))
   #undef  PL_yylvalp
  
  
  
  1.2       +27 -25    ponie/perl/pp.c
  
  Index: pp.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/pp.c,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -w -r1.1 -r1.2
  --- pp.c	9 Sep 2003 11:58:52 -0000	1.1
  +++ pp.c	23 Jun 2004 10:54:24 -0000	1.2
  @@ -1,7 +1,7 @@
   /*    pp.c
    *
    *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  - *    2000, 2001, 2002, 2003, by Larry Wall and others
  + *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
    *
    *    You may distribute under the terms of either the GNU General Public
    *    License or the Artistic License, as specified in the README file.
  @@ -106,15 +106,7 @@
   	RETURNOP(do_kv());
       }
       else if (gimme == G_SCALAR) {
  -	SV* sv = sv_newmortal();
  -        if (SvRMAGICAL(TARG) && mg_find(TARG, PERL_MAGIC_tied))
  -	     Perl_croak(aTHX_ "Can't provide tied hash usage; "
  -			"use keys(%%hash) to test if empty");
  -	if (HvFILL((HV*)TARG))
  -	    Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
  -		      (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
  -	else
  -	    sv_setiv(sv, 0);
  +	SV* sv = Perl_hv_scalar(aTHX_ (HV*)TARG);
   	SETs(sv);
       }
       RETURN;
  @@ -688,6 +680,8 @@
   
       if (PL_op->op_flags & OPf_STACKED)
   	sv = POPs;
  +    else if (PL_op->op_private & OPpTARGET_MY)
  +	sv = GETTARGET;
       else {
   	sv = DEFSV;
   	EXTEND(SP,1);
  @@ -741,7 +735,7 @@
       register SV* sv;
   
       sv = POPs;
  -    if (!sv || !SvANY(sv))
  +    if (!sv)
   	RETPUSHNO;
       switch (SvTYPE(sv)) {
       case SVt_PVAV:
  @@ -836,7 +830,7 @@
   PP(pp_predec)
   {
       dSP;
  -    if (SvTYPE(TOPs) > SVt_PVLV)
  +    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
   	DIE(aTHX_ PL_no_modify);
       if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
           && SvIVX(TOPs) != IV_MIN)
  @@ -853,7 +847,7 @@
   PP(pp_postinc)
   {
       dSP; dTARGET;
  -    if (SvTYPE(TOPs) > SVt_PVLV)
  +    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
   	DIE(aTHX_ PL_no_modify);
       sv_setsv(TARG, TOPs);
       if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
  @@ -875,7 +869,7 @@
   PP(pp_postdec)
   {
       dSP; dTARGET;
  -    if (SvTYPE(TOPs) > SVt_PVLV)
  +    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
   	DIE(aTHX_ PL_no_modify);
       sv_setsv(TARG, TOPs);
       if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
  @@ -2208,13 +2202,15 @@
       dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
       {
         dPOPTOPssrl;
  +      if (SvGMAGICAL(left)) mg_get(left);
  +      if (SvGMAGICAL(right)) mg_get(right);
         if (SvNIOKp(left) || SvNIOKp(right)) {
   	if (PL_op->op_private & HINT_INTEGER) {
  -	  IV i = SvIV(left) & SvIV(right);
  +	  IV i = SvIV_nomg(left) & SvIV_nomg(right);
   	  SETi(i);
   	}
   	else {
  -	  UV u = SvUV(left) & SvUV(right);
  +	  UV u = SvUV_nomg(left) & SvUV_nomg(right);
   	  SETu(u);
   	}
         }
  @@ -2231,13 +2227,15 @@
       dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
       {
         dPOPTOPssrl;
  +      if (SvGMAGICAL(left)) mg_get(left);
  +      if (SvGMAGICAL(right)) mg_get(right);
         if (SvNIOKp(left) || SvNIOKp(right)) {
   	if (PL_op->op_private & HINT_INTEGER) {
  -	  IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
  +	  IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
   	  SETi(i);
   	}
   	else {
  -	  UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
  +	  UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
   	  SETu(u);
   	}
         }
  @@ -2254,13 +2252,15 @@
       dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
       {
         dPOPTOPssrl;
  +      if (SvGMAGICAL(left)) mg_get(left);
  +      if (SvGMAGICAL(right)) mg_get(right);
         if (SvNIOKp(left) || SvNIOKp(right)) {
   	if (PL_op->op_private & HINT_INTEGER) {
  -	  IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
  +	  IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
   	  SETi(i);
   	}
   	else {
  -	  UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
  +	  UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
   	  SETu(u);
   	}
         }
  @@ -2355,13 +2355,15 @@
       dSP; dTARGET; tryAMAGICun(compl);
       {
         dTOPss;
  +      if (SvGMAGICAL(sv))
  +	  mg_get(sv);
         if (SvNIOKp(sv)) {
   	if (PL_op->op_private & HINT_INTEGER) {
  -	  IV i = ~SvIV(sv);
  +	  IV i = ~SvIV_nomg(sv);
   	  SETi(i);
   	}
   	else {
  -	  UV u = ~SvUV(sv);
  +	  UV u = ~SvUV_nomg(sv);
   	  SETu(u);
   	}
         }
  @@ -2370,7 +2372,7 @@
   	register I32 anum;
   	STRLEN len;
   
  -	SvSetSV(TARG, sv);
  +	sv_setsv_nomg(TARG, sv);
   	tmps = (U8*)SvPV_force(TARG, len);
   	anum = len;
   	if (SvUTF8(TARG)) {
  @@ -2417,6 +2419,7 @@
   	      *result = '\0';
   	      result -= nchar;
   	      sv_setpvn(TARG, (char*)result, nchar);
  +	      SvUTF8_off(TARG);
   	  }
   	  Safefree(result);
   	  SETs(TARG);
  @@ -2802,8 +2805,7 @@
   	      if (value > (NV)IV_MIN - 0.5) {
   		  SETi(I_V(value));
   	      } else {
  -		/* This is maint, and we don't have Perl_ceil in perl.h  */
  -		  SETn(-Perl_floor(-value));
  +		  SETn(Perl_ceil(value));
   	      }
   	  }
         }
  
  
  
  1.5       +1 -1      ponie/perl/pp_hot.c
  
  Index: pp_hot.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/pp_hot.c,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -w -r1.4 -r1.5
  --- pp_hot.c	7 Apr 2004 10:37:27 -0000	1.4
  +++ pp_hot.c	23 Jun 2004 10:54:24 -0000	1.5
  @@ -329,7 +329,7 @@
       register SV* sv;
   
       sv = TOPs;
  -    if (!sv || !SvANY(sv)) {
  +    if (!sv) {
   	--SP;
   	RETURNOP(cLOGOP->op_other);
       }
  
  
  
  1.28      +0 -3      ponie/perl/proto.h
  
  Index: proto.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/proto.h,v
  retrieving revision 1.27
  retrieving revision 1.28
  diff -u -w -r1.27 -r1.28
  --- proto.h	19 Jun 2004 11:44:33 -0000	1.27
  +++ proto.h	23 Jun 2004 10:54:24 -0000	1.28
  @@ -1218,7 +1218,6 @@
   STATIC void	S_more_xpvmg(pTHX);
   STATIC void	S_more_xpvlv(pTHX);
   STATIC void	S_more_xpvbm(pTHX);
  -STATIC void	S_more_xrv(pTHX);
   STATIC XPVIV*	S_new_xiv(pTHX);
   STATIC XPVNV*	S_new_xnv(pTHX);
   STATIC XPV*	S_new_xpv(pTHX);
  @@ -1233,7 +1232,6 @@
   STATIC XPVLV*	S_new_xpvlv(pTHX);
   STATIC XPVBM*	S_new_xpvbm(pTHX);
   STATIC XPVGV*	S_new_xpvgv(pTHX);
  -STATIC XRV*	S_new_xrv(pTHX);
   STATIC void	S_del_xiv(pTHX_ XPVIV* p);
   STATIC void	S_del_xnv(pTHX_ XPVNV* p);
   STATIC void	S_del_xpv(pTHX_ XPV* p);
  @@ -1248,7 +1246,6 @@
   STATIC void	S_del_xpvlv(pTHX_ XPVLV* p);
   STATIC void	S_del_xpvbm(pTHX_ XPVBM* p);
   STATIC void	S_del_xpvgv(pTHX_ XPVGV* p);
  -STATIC void	S_del_xrv(pTHX_ XRV* p);
   STATIC void	S_zero_xpvfm(pTHX_ SV *fm);
   STATIC void	S_zero_xpvcv(pTHX_ SV *cv);
   STATIC void	S_zero_xpvio(pTHX_ SV *io);
  
  
  
  1.41      +35 -77    ponie/perl/sv.c
  
  Index: sv.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/sv.c,v
  retrieving revision 1.40
  retrieving revision 1.41
  diff -u -w -r1.40 -r1.41
  --- sv.c	22 Jun 2004 16:20:18 -0000	1.40
  +++ sv.c	23 Jun 2004 10:54:24 -0000	1.41
  @@ -443,13 +443,6 @@
       PL_xnv_arenaroot = 0;
       PL_xnv_root = 0;
   
  -    for (arena = PL_xrv_arenaroot; arena; arena = arenanext) {
  -	arenanext = (XPV*)arena->xpv_pv;
  -	Safefree(arena);
  -    }
  -    PL_xrv_arenaroot = 0;
  -    PL_xrv_root = 0;
  -
       for (arena = PL_xpv_arenaroot; arena; arena = arenanext) {
   	arenanext = (XPV*)arena->xpv_pv;
   	Safefree(arena);
  @@ -648,55 +641,6 @@
       *(NV**)xnv = 0;
   }
   
  -/* grab a new struct xrv from the free list, allocating more if necessary */
  -
  -STATIC XRV*
  -S_new_xrv(pTHX)
  -{
  -    XRV* xrv;
  -    LOCK_SV_MUTEX;
  -    if (!PL_xrv_root)
  -	more_xrv();
  -    xrv = PL_xrv_root;
  -    PL_xrv_root = (XRV*)xrv->xrv_rv;
  -    UNLOCK_SV_MUTEX;
  -    return xrv;
  -}
  -
  -/* return a struct xrv to the free list */
  -
  -STATIC void
  -S_del_xrv(pTHX_ XRV *p)
  -{
  -    LOCK_SV_MUTEX;
  -    p->xrv_rv = (SV*)PL_xrv_root;
  -    PL_xrv_root = p;
  -    UNLOCK_SV_MUTEX;
  -}
  -
  -/* allocate another arena's worth of struct xrv */
  -
  -STATIC void
  -S_more_xrv(pTHX)
  -{
  -    register XRV* xrv;
  -    register XRV* xrvend;
  -    XPV *ptr;
  -    New(712, ptr, 1008/sizeof(XPV), XPV);
  -    ptr->xpv_pv = (char*)PL_xrv_arenaroot;
  -    PL_xrv_arenaroot = ptr;
  -
  -    xrv = (XRV*) ptr;
  -    xrvend = &xrv[1008 / sizeof(XRV) - 1];
  -    xrv += (sizeof(XPV) - 1) / sizeof(XRV) + 1;
  -    PL_xrv_root = xrv;
  -    while (xrv < xrvend) {
  -	xrv->xrv_rv = (SV*)(xrv + 1);
  -	xrv++;
  -    }
  -    xrv->xrv_rv = 0;
  -}
  -
   /* grab a new struct xpv from the free list, allocating more if necessary */
   
   STATIC XPV*
  @@ -1122,9 +1066,6 @@
   #define new_XNV()	my_safemalloc(sizeof(XPVNV))
   #define del_XNV(p)	my_safefree(p)
   
  -#define new_XRV()	my_safemalloc(sizeof(XRV))
  -#define del_XRV(p)	my_safefree(p)
  -
   #define new_XPV()	my_safemalloc(sizeof(XPV))
   #define del_XPV(p)	my_safefree(p)
   
  @@ -1160,9 +1101,6 @@
   #define new_XNV()	(void*)new_xnv()
   #define del_XNV(p)	del_xnv((XPVNV*) p)
   
  -#define new_XRV()	(void*)new_xrv()
  -#define del_XRV(p)	del_xrv((XRV*) p)
  -
   #define new_XPV()	(void*)new_xpv()
   #define del_XPV(p)	del_xpv((XPV *)p)
   
  @@ -1661,6 +1599,7 @@
   Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
   {
       char*	pv = NULL;
  +    SV*		rv = NULL;
       U32		cur = 0;
       U32		len = 0;
       IV		iv = 0;
  @@ -1718,17 +1657,18 @@
   	    mt = SVt_PVNV;
   	break;
       case SVt_RV:
  -	pv	= (char*)SvRV(sv);
  +	rv	= SvRV(sv);
   	cur	= 0;
   	len	= 0;
  -	iv	= PTR2IV(pv);
  -	nv	= PTR2NV(pv);
  -	del_XRV(SvANY(sv));
  +	iv	= PTR2IV(rv);
  +	nv	= PTR2NV(rv);
  +	assert(SvANY(sv) == 0);
   	SvPMC_off(sv);
   	magic	= 0;
   	stash	= 0;
   	break;
       case SVt_PV:
  +	rv	= SvRV(sv);
   	pv	= SvPVX(sv);
   	cur	= SvCUR(sv);
   	len	= SvLEN(sv);
  @@ -1744,6 +1684,7 @@
   	    mt = SVt_PVNV;
   	break;
       case SVt_PVIV:
  +	rv	= SvRV(sv);
   	pv	= SvPVX(sv);
   	cur	= SvCUR(sv);
   	len	= SvLEN(sv);
  @@ -1755,6 +1696,7 @@
   	SvPMC_off(sv);
   	break;
       case SVt_PVNV:
  +	rv	= SvRV(sv);
   	pv	= SvPVX(sv);
   	cur	= SvCUR(sv);
   	len	= SvLEN(sv);
  @@ -1766,6 +1708,7 @@
   	SvPMC_off(sv);
   	break;
       case SVt_PVMG:
  +	rv	= SvRV(sv);
   	pv	= SvPVX(sv);
   	cur	= SvCUR(sv);
   	len	= SvLEN(sv);
  @@ -1794,13 +1737,14 @@
   	SvNVX(sv)	= nv;
   	break;
       case SVt_RV:
  -	SvANY(sv) = new_XRV();
  +	SvANY(sv) = 0;
   	SvPMC_on(sv);
  -	SvRV(sv) = (SV*)pv;
  +	SvRV(sv)	= rv;
   	break;
       case SVt_PV:
   	SvANY(sv) = new_XPV();
   	SvPMC_on(sv);
  +	SvRV(sv) = rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1808,6 +1752,7 @@
       case SVt_PVIV:
   	SvANY(sv) = new_XPVIV();
   	SvPMC_on(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1819,6 +1764,7 @@
       case SVt_PVNV:
   	SvANY(sv) = new_XPVNV();
   	SvPMC_on(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1828,6 +1774,7 @@
       case SVt_PVMG:
   	SvANY(sv) = new_XPVMG();
   	SvPMC_on(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1839,6 +1786,7 @@
       case SVt_PVLV:
   	SvANY(sv)       = new_XPVLV();
   	SvPMC_on(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1861,6 +1809,7 @@
   	SvPMC_on(sv);
   	if (pv)
   	    Safefree(pv);
  +	SvRV(sv)	=  0;
   	SvPVX(sv)       =  0;
   	AvMAX(sv)	= -1;
   	AvFILLp(sv)	= -1;
  @@ -1877,6 +1826,7 @@
   	SvPMC_on(sv);
   	if (pv)
   	    Safefree(pv);
  +	SvRV(sv)	= 0;
   	SvPVX(sv)	= 0;
   	HvFILL(sv)	= 0;
   	HvMAX(sv)	= 0;
  @@ -1893,6 +1843,7 @@
   	SvANY(sv) = new_XPVCV();
   	SvPMC_on(sv);
   	zero_xpvcv(sv);
  +	SvRV(sv)	=  0;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1904,6 +1855,7 @@
       case SVt_PVGV:
   	SvANY(sv) = new_XPVGV();
   	SvPMC_on(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1920,6 +1872,7 @@
       case SVt_PVBM:
   	SvANY(sv) = new_XPVBM();
   	SvPMC_on(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1935,6 +1888,7 @@
   	SvANY(sv) = new_XPVFM();
   	SvPMC_on(sv);
   	zero_xpvfm(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -1947,6 +1901,7 @@
   	SvANY(sv) = new_XPVIO();
   	SvPMC_on(sv);
   	zero_xpvio(sv);
  +	SvRV(sv)	= rv;
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  @@ -5941,7 +5896,8 @@
               }
   	}
   #else
  -	else if (SvPVX(sv) && SvLEN(sv))
  +	else if (SvANY(sv)) {
  +	    if (SvPVX(sv) && SvLEN(sv))
   	    Safefree(SvPVX(sv));
   	else if (SvPVX(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
   	    unsharepvn(SvPVX(sv),
  @@ -5949,6 +5905,7 @@
   		       SvUVX(sv));
   	    SvFAKE_off(sv);
   	}
  +	}
   #endif
   	break;
   /*
  @@ -5969,7 +5926,7 @@
   	del_XNV(SvANY(sv));
   	break;
       case SVt_RV:
  -	del_XRV(SvANY(sv));
  +	assert(SvANY(sv) == 0);
   	break;
       case SVt_PV:
   	del_XPV(SvANY(sv));
  @@ -8188,7 +8145,8 @@
   	}
   	else
   	    s = sv_2pv_flags(sv, lp, flags);
  -	if (s != SvPVX(sv)) {	/* Almost, but not quite, sv_setpvn() */
  +	if (SvROK(sv) || s != SvPVX(sv)) {
  +	    /* Almost, but not quite, sv_setpvn() */
   	    STRLEN len = *lp;
   	
   	    if (SvROK(sv))
  
  
  
  1.11      +1 -3      ponie/perl/ext/Devel/Peek/t/Peek.t
  
  Index: Peek.t
  ===================================================================
  RCS file: /cvs/public/ponie/perl/ext/Devel/Peek/t/Peek.t,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -w -r1.10 -r1.11
  --- Peek.t	13 Jun 2004 20:38:53 -0000	1.10
  +++ Peek.t	23 Jun 2004 10:54:24 -0000	1.11
  @@ -468,7 +468,5 @@
       SV = NULL\\(0x0\\) at $ADDR
         REFCNT = \d+
         FLAGS = \\(READONLY\\)
  -    PV = $ADDR ""
  -    CUR = 0
  -    LEN = 0
  +    PV = 0
       STASH = $ADDR\s+"Foobar"');
  
  
  
  1.2       +163 -56   ponie/perl/ext/Storable/Storable.xs
  
  Index: Storable.xs
  ===================================================================
  RCS file: /cvs/public/ponie/perl/ext/Storable/Storable.xs,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -w -r1.1 -r1.2
  --- Storable.xs	9 Sep 2003 11:59:16 -0000	1.1
  +++ Storable.xs	23 Jun 2004 10:54:24 -0000	1.2
  @@ -288,6 +288,7 @@
   	HV *hseen;			/* which objects have been seen, store time */
   	AV *hook_seen;		/* which SVs were returned by STORABLE_freeze() */
   	AV *aseen;			/* which objects have been seen, retrieve time */
  +	IV where_is_undef;		/* index in aseen of PL_sv_undef */
   	HV *hclass;			/* which classnames have been seen, store time */
   	AV *aclass;			/* which classnames have been seen, retrieve time */
   	HV *hook;			/* cache for hook methods per class name */
  @@ -791,6 +792,13 @@
    * Useful store shortcuts...
    */
   
  +/*
  + * Note that if you put more than one mark for storing a particular
  + * type of thing, *and* in the retrieve_foo() function you mark both
  + * the thingy's you get off with SEEN(), you *must* increase the
  + * tagnum with cxt->tagnum++ along with this macro!
  + *     - samv 20Jan04
  + */
   #define PUTMARK(x) 							\
     STMT_START {								\
   	if (!cxt->fio)							\
  @@ -937,12 +945,14 @@
    * To achieve that, the class name of the last retrieved object is passed down
    * recursively, and the first SEEN() call for which the class name is not NULL
    * will bless the object.
  + *
  + * i should be true iff sv is immortal (ie PL_sv_yes, PL_sv_no or PL_sv_undef)
    */
  -#define SEEN(y,c) 							\
  +#define SEEN(y,c,i) 							\
     STMT_START {								\
   	if (!y)									\
   		return (SV *) 0;					\
  -	if (av_store(cxt->aseen, cxt->tagnum++, SvREFCNT_inc(y)) == 0) \
  +	if (av_store(cxt->aseen, cxt->tagnum++, i ? (SV*)(y) : SvREFCNT_inc(y)) == 0) \
   		return (SV *) 0;					\
   	TRACEME(("aseen(#%d) = 0x%"UVxf" (refcnt=%d)", cxt->tagnum-1, \
   		 PTR2UV(y), SvREFCNT(y)-1));		\
  @@ -1330,6 +1340,7 @@
   		      ? newHV() : 0);
   
   	cxt->aseen = newAV();			/* Where retrieved objects are kept */
  +	cxt->where_is_undef = -1;		/* Special case for PL_sv_undef */
   	cxt->aclass = newAV();			/* Where seen classnames are kept */
   	cxt->tagnum = 0;				/* Have to count objects... */
   	cxt->classnum = 0;				/* ...and class names as well */
  @@ -1362,6 +1373,7 @@
   		av_undef(aseen);
   		sv_free((SV *) aseen);
   	}
  +	cxt->where_is_undef = -1;
   
   	if (cxt->aclass) {
   		AV *aclass = cxt->aclass;
  @@ -2179,15 +2191,44 @@
   		qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp);
   
   		for (i = 0; i < len; i++) {
  -                        unsigned char flags;
  +#ifdef HAS_RESTRICTED_HASHES
  +			int placeholders = HvPLACEHOLDERS(hv);
  +#endif
  +                        unsigned char flags = 0;
   			char *keyval;
   			STRLEN keylen_tmp;
                           I32 keylen;
   			SV *key = av_shift(av);
  +			/* This will fail if key is a placeholder.
  +			   Track how many placeholders we have, and error if we
  +			   "see" too many.  */
   			HE *he  = hv_fetch_ent(hv, key, 0, 0);
  -			SV *val = HeVAL(he);
  -			if (val == 0)
  -				return 1;		/* Internal error, not I/O error */
  +			SV *val;
  +
  +			if (he) {
  +				if (!(val =  HeVAL(he))) {
  +					/* Internal error, not I/O error */
  +					return 1;
  +				}
  +			} else {
  +#ifdef HAS_RESTRICTED_HASHES
  +				/* Should be a placeholder.  */
  +				if (placeholders-- < 0) {
  +					/* This should not happen - number of
  +					   retrieves should be identical to
  +					   number of placeholders.  */
  +			  		return 1;
  +				}
  +				/* Value is never needed, and PL_sv_undef is
  +				   more space efficient to store.  */
  +				val = &PL_sv_undef;
  +				ASSERT (flags == 0,
  +					("Flags not 0 but %d", flags));
  +				flags = SHV_K_PLACEHOLDER;
  +#else
  +				return 1;
  +#endif
  +			}
   			
   			/*
   			 * Store value first.
  @@ -2208,12 +2249,9 @@
   			 
                           /* Implementation of restricted hashes isn't nicely
                              abstracted:  */
  -                        flags
  -                            = (((hash_flags & SHV_RESTRICTED)
  -                                && SvREADONLY(val))
  -                               ? SHV_K_LOCKED : 0);
  -                        if (val == &PL_sv_placeholder)
  -                            flags |= SHV_K_PLACEHOLDER;
  +			if ((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) {
  +				flags |= SHV_K_LOCKED;
  +			}
   
   			keyval = SvPV(key, keylen_tmp);
                           keylen = keylen_tmp;
  @@ -2299,6 +2337,18 @@
   			if (val == 0)
   				return 1;		/* Internal error, not I/O error */
   
  +                        /* Implementation of restricted hashes isn't nicely
  +                           abstracted:  */
  +                        flags
  +                            = (((hash_flags & SHV_RESTRICTED)
  +                                && SvREADONLY(val))
  +                                             ? SHV_K_LOCKED : 0);
  +
  +                        if (val == &PL_sv_placeholder) {
  +                            flags |= SHV_K_PLACEHOLDER;
  +			    val = &PL_sv_undef;
  +			}
  +
   			/*
   			 * Store value first.
   			 */
  @@ -2308,14 +2358,6 @@
   			if ((ret = store(cxt, val)))	/* Extra () for -Wall, grr... */
   				goto out;
   
  -                        /* Implementation of restricted hashes isn't nicely
  -                           abstracted:  */
  -                        flags
  -                            = (((hash_flags & SHV_RESTRICTED)
  -                                && SvREADONLY(val))
  -                                             ? SHV_K_LOCKED : 0);
  -                        if (val == &PL_sv_placeholder)
  -                            flags |= SHV_K_PLACEHOLDER;
   
                           hek = HeKEY_hek(he);
                           len = HEK_LEN(hek);
  @@ -2463,6 +2505,7 @@
   	 */
   
   	PUTMARK(SX_CODE);
  +	cxt->tagnum++;   /* necessary, as SX_CODE is a SEEN() candidate */
   	TRACEME(("size = %d", len));
   	TRACEME(("code = %s", SvPV_nolen(text)));
   
  @@ -3259,7 +3302,39 @@
   
   	svh = hv_fetch(hseen, (char *) &sv, sizeof(sv), FALSE);
   	if (svh) {
  -		I32 tagval = htonl(LOW_32BITS(*svh));
  +		I32 tagval;
  +
  +		if (sv == &PL_sv_undef) {
  +			/* We have seen PL_sv_undef before, but fake it as
  +			   if we have not.
  +
  +			   Not the simplest solution to making restricted
  +			   hashes work on 5.8.0, but it does mean that
  +			   repeated references to the one true undef will
  +			   take up less space in the output file.
  +			*/
  +			/* Need to jump past the next hv_store, because on the
  +			   second store of undef the old hash value will be
  +			   SV_REFCNT_DEC()ed, and as Storable cheats horribly
  +			   by storing non-SVs in the hash a SEGV will ensure.
  +			   Need to increase the tag number so that the
  +			   receiver has no idea what games we're up to.  This
  +			   special casing doesn't affect hooks that store
  +			   undef, as the hook routine does its own lookup into
  +			   hseen.  Also this means that any references back
  +			   to PL_sv_undef (from the pathological case of hooks
  +			   storing references to it) will find the seen hash
  +			   entry for the first time, as if we didn't have this
  +			   hackery here. (That hseen lookup works even on 5.8.0
  +			   because it's a key of &PL_sv_undef and a value
  +			   which is a tag number, not a value which is
  +			   PL_sv_undef.)  */
  +			cxt->tagnum++;
  +			type = svis_SCALAR;
  +			goto undef_special_case;
  +		}
  +		
  +		tagval = htonl(LOW_32BITS(*svh));
   
   		TRACEME(("object 0x%"UVxf" seen as #%d", PTR2UV(sv), ntohl(tagval)));
   
  @@ -3291,6 +3366,7 @@
   
   	type = sv_type(sv);
   
  +undef_special_case:
   	TRACEME(("storing 0x%"UVxf" tag #%d, type %d...",
   		 PTR2UV(sv), cxt->tagnum, type));
   
  @@ -3816,7 +3892,7 @@
   	default:
   		return retrieve_other(cxt, 0);		/* Let it croak */
   	}
  -	SEEN(sv, 0);							/* Don't bless yet */
  +	SEEN(sv, 0, 0);							/* Don't bless yet */
   
   	/*
   	 * Whilst flags tell us to recurse, do so.
  @@ -3957,9 +4033,17 @@
   			READ_I32(tag);
   			tag = ntohl(tag);
   			svh = av_fetch(cxt->aseen, tag, FALSE);
  -			if (!svh)
  +			if (!svh) {
  +				if (tag == cxt->where_is_undef) {
  +					/* av_fetch uses PL_sv_undef internally, hence this
  +					   somewhat gruesome hack. */
  +					xsv = &PL_sv_undef;
  +					svh = &xsv;
  +				} else {
   				CROAK(("Object #%"IVdf" should have been retrieved already",
   					(IV) tag));
  +				}
  +			}
   			xsv = *svh;
   			ary[i] = SvREFCNT_inc(xsv);
   		}
  @@ -4129,7 +4213,7 @@
   	 */
   
   	rv = NEWSV(10002, 0);
  -	SEEN(rv, cname);		/* Will return if rv is null */
  +	SEEN(rv, cname, 0);		/* Will return if rv is null */
   	sv = retrieve(cxt, 0);	/* Retrieve <object> */
   	if (!sv)
   		return (SV *) 0;	/* Failed */
  @@ -4152,9 +4236,8 @@
   	 */
   
   	if (cname) {
  -		/* Do not use sv_upgrade to preserve STASH */
  -		SvFLAGS(rv) &= ~SVTYPEMASK;
  -		SvFLAGS(rv) |= SVt_RV;
  +		/* No need to do anything, as rv will already be PVMG.  */
  +		assert (SvTYPE(rv) >= SVt_RV);
   	} else {
   		sv_upgrade(rv, SVt_RV);
   	}
  @@ -4186,7 +4269,7 @@
   	 */
   
   	rv = NEWSV(10002, 0);
  -	SEEN(rv, cname);		/* Will return if rv is null */
  +	SEEN(rv, cname, 0);		/* Will return if rv is null */
   	sv = retrieve(cxt, 0);	/* Retrieve <object> */
   	if (!sv)
   		return (SV *) 0;	/* Failed */
  @@ -4202,10 +4285,11 @@
   	/*
   	 * Restore overloading magic.
   	 */
  -
  -	stash = (HV *) SvSTASH (sv);
  -	if (!stash || !Gv_AMG(stash))
  -		CROAK(("Cannot restore overloading on %s(0x%"UVxf") (package %s)",
  +	if (!SvTYPE(sv)
  +	    || !(stash = (HV *) SvSTASH (sv))
  +	    || !Gv_AMG(stash))
  +		CROAK(("Cannot restore overloading on %s(0x%"UVxf
  +		       ") (package %s)",
   		       sv_reftype(sv, FALSE),
   		       PTR2UV(sv),
   			   stash ? HvNAME(stash) : "<unknown>"));
  @@ -4231,7 +4315,7 @@
   	TRACEME(("retrieve_tied_array (#%d)", cxt->tagnum));
   
   	tv = NEWSV(10002, 0);
  -	SEEN(tv, cname);			/* Will return if tv is null */
  +	SEEN(tv, cname, 0);			/* Will return if tv is null */
   	sv = retrieve(cxt, 0);		/* Retrieve <object> */
   	if (!sv)
   		return (SV *) 0;		/* Failed */
  @@ -4260,7 +4344,7 @@
   	TRACEME(("retrieve_tied_hash (#%d)", cxt->tagnum));
   
   	tv = NEWSV(10002, 0);
  -	SEEN(tv, cname);			/* Will return if tv is null */
  +	SEEN(tv, cname, 0);			/* Will return if tv is null */
   	sv = retrieve(cxt, 0);		/* Retrieve <object> */
   	if (!sv)
   		return (SV *) 0;		/* Failed */
  @@ -4288,7 +4372,7 @@
   	TRACEME(("retrieve_tied_scalar (#%d)", cxt->tagnum));
   
   	tv = NEWSV(10002, 0);
  -	SEEN(tv, cname);			/* Will return if rv is null */
  +	SEEN(tv, cname, 0);			/* Will return if rv is null */
   	sv = retrieve(cxt, 0);		/* Retrieve <object> */
   	if (!sv) {
   		return (SV *) 0;		/* Failed */
  @@ -4325,7 +4409,7 @@
   	TRACEME(("retrieve_tied_key (#%d)", cxt->tagnum));
   
   	tv = NEWSV(10002, 0);
  -	SEEN(tv, cname);			/* Will return if tv is null */
  +	SEEN(tv, cname, 0);			/* Will return if tv is null */
   	sv = retrieve(cxt, 0);		/* Retrieve <object> */
   	if (!sv)
   		return (SV *) 0;		/* Failed */
  @@ -4357,7 +4441,7 @@
   	TRACEME(("retrieve_tied_idx (#%d)", cxt->tagnum));
   
   	tv = NEWSV(10002, 0);
  -	SEEN(tv, cname);			/* Will return if tv is null */
  +	SEEN(tv, cname, 0);			/* Will return if tv is null */
   	sv = retrieve(cxt, 0);		/* Retrieve <object> */
   	if (!sv)
   		return (SV *) 0;		/* Failed */
  @@ -4394,7 +4478,7 @@
   	 */
   
   	sv = NEWSV(10002, len);
  -	SEEN(sv, cname);	/* Associate this new scalar with tag "tagnum" */
  +	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
   
   	/*
   	 * WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
  @@ -4440,7 +4524,7 @@
   	 */
   
   	sv = NEWSV(10002, len);
  -	SEEN(sv, cname);	/* Associate this new scalar with tag "tagnum" */
  +	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
   
   	/*
   	 * WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
  @@ -4552,7 +4636,7 @@
   
   	READ(&iv, sizeof(iv));
   	sv = newSViv(iv);
  -	SEEN(sv, cname);	/* Associate this new scalar with tag "tagnum" */
  +	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
   
   	TRACEME(("integer %"IVdf, iv));
   	TRACEME(("ok (retrieve_integer at 0x%"UVxf")", PTR2UV(sv)));
  @@ -4581,7 +4665,7 @@
   	sv = newSViv(iv);
   	TRACEME(("network integer (as-is) %d", iv));
   #endif
  -	SEEN(sv, cname);	/* Associate this new scalar with tag "tagnum" */
  +	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
   
   	TRACEME(("ok (retrieve_netint at 0x%"UVxf")", PTR2UV(sv)));
   
  @@ -4603,7 +4687,7 @@
   
   	READ(&nv, sizeof(nv));
   	sv = newSVnv(nv);
  -	SEEN(sv, cname);	/* Associate this new scalar with tag "tagnum" */
  +	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
   
   	TRACEME(("double %"NVff, nv));
   	TRACEME(("ok (retrieve_double at 0x%"UVxf")", PTR2UV(sv)));
  @@ -4629,7 +4713,7 @@
   	TRACEME(("small integer read as %d", (unsigned char) siv));
   	tmp = (unsigned char) siv - 128;
   	sv = newSViv(tmp);
  -	SEEN(sv, cname);	/* Associate this new scalar with tag "tagnum" */
  +	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
   
   	TRACEME(("byte %d", tmp));
   	TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv)));
  @@ -4649,7 +4733,7 @@
   	TRACEME(("retrieve_undef"));
   
   	sv = newSV(0);
  -	SEEN(sv, cname);
  +	SEEN(sv, cname, 0);
   
   	return sv;
   }
  @@ -4665,7 +4749,13 @@
   
   	TRACEME(("retrieve_sv_undef"));
   
  -	SEEN(sv, cname);
  +	/* Special case PL_sv_undef, as av_fetch uses it internally to mark
  +	   deleted elements, and will return NULL (fetch failed) whenever it
  +	   is fetched.  */
  +	if (cxt->where_is_undef == -1) {
  +		cxt->where_is_undef = cxt->tagnum;
  +	}
  +	SEEN(sv, cname, 1);
   	return sv;
   }
   
  @@ -4680,7 +4770,7 @@
   
   	TRACEME(("retrieve_sv_yes"));
   
  -	SEEN(sv, cname);
  +	SEEN(sv, cname, 1);
   	return sv;
   }
   
  @@ -4695,7 +4785,7 @@
   
   	TRACEME(("retrieve_sv_no"));
   
  -	SEEN(sv, cname);
  +	SEEN(sv, cname, 1);
   	return sv;
   }
   
  @@ -4724,7 +4814,7 @@
   	RLEN(len);
   	TRACEME(("size = %d", len));
   	av = newAV();
  -	SEEN(av, cname);			/* Will return if array not allocated nicely */
  +	SEEN(av, cname, 0);			/* Will return if array not allocated nicely */
   	if (len)
   		av_extend(av, len);
   	else
  @@ -4776,7 +4866,7 @@
   	RLEN(len);
   	TRACEME(("size = %d", len));
   	hv = newHV();
  -	SEEN(hv, cname);		/* Will return if table not allocated properly */
  +	SEEN(hv, cname, 0);		/* Will return if table not allocated properly */
   	if (len == 0)
   		return (SV *) hv;	/* No data follow if table empty */
   	hv_ksplit(hv, len);		/* pre-extend hash to save multiple splits */
  @@ -4862,7 +4952,7 @@
       RLEN(len);
       TRACEME(("size = %d, flags = %d", len, hash_flags));
       hv = newHV();
  -    SEEN(hv, cname);		/* Will return if table not allocated properly */
  +    SEEN(hv, cname, 0);		/* Will return if table not allocated properly */
       if (len == 0)
           return (SV *) hv;	/* No data follow if table empty */
       hv_ksplit(hv, len);		/* pre-extend hash to save multiple splits */
  @@ -4975,13 +5065,24 @@
       CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
   #else
   	dSP;
  -	int type, count;
  +	int type, count, tagnum;
   	SV *cv;
   	SV *sv, *text, *sub;
   
   	TRACEME(("retrieve_code (#%d)", cxt->tagnum));
   
   	/*
  +	 *  Insert dummy SV in the aseen array so that we don't screw
  +	 *  up the tag numbers.  We would just make the internal
  +	 *  scalar an untagged item in the stream, but
  +	 *  retrieve_scalar() calls SEEN().  So we just increase the
  +	 *  tag number.
  +	 */
  +	tagnum = cxt->tagnum;
  +	sv = newSViv(0);
  +	SEEN(sv, cname, 0);
  +
  +	/*
   	 * Retrieve the source of the code reference
   	 * as a small or large scalar
   	 */
  @@ -5023,6 +5124,8 @@
   			CROAK(("Can't eval, please set $Storable::Eval to a true value"));
   		} else {
   			sv = newSVsv(sub);
  +			/* fix up the dummy entry... */
  +			av_store(cxt->aseen, tagnum, SvREFCNT_inc(sv));
   			return sv;
   		}
   	}
  @@ -5060,8 +5163,9 @@
   
   	FREETMPS;
   	LEAVE;
  +	/* fix up the dummy entry... */
  +	av_store(cxt->aseen, tagnum, SvREFCNT_inc(sv));
   
  -	SEEN(sv, cname);
   	return sv;
   #endif
   }
  @@ -5093,7 +5197,7 @@
   	RLEN(len);
   	TRACEME(("size = %d", len));
   	av = newAV();
  -	SEEN(av, 0);				/* Will return if array not allocated nicely */
  +	SEEN(av, 0, 0);				/* Will return if array not allocated nicely */
   	if (len)
   		av_extend(av, len);
   	else
  @@ -5155,7 +5259,7 @@
   	RLEN(len);
   	TRACEME(("size = %d", len));
   	hv = newHV();
  -	SEEN(hv, 0);			/* Will return if table not allocated properly */
  +	SEEN(hv, 0, 0);			/* Will return if table not allocated properly */
   	if (len == 0)
   		return (SV *) hv;	/* No data follow if table empty */
   	hv_ksplit(hv, len);		/* pre-extend hash to save multiple splits */
  @@ -5901,6 +6005,9 @@
       gv_fetchpv("Storable::interwork_56_64bit",   GV_ADDMULTI, SVt_PV);
   #endif
   
  +void
  +init_perinterp()
  +
   int
   pstore(f,obj)
   OutputStream	f
  
  
  
  1.10      +3 -3      ponie/src/pmc/perl5cargo_cult.pmc
  
  Index: perl5cargo_cult.pmc
  ===================================================================
  RCS file: /cvs/public/ponie/src/pmc/perl5cargo_cult.pmc,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -w -r1.9 -r1.10
  --- perl5cargo_cult.pmc	22 Jun 2004 16:19:48 -0000	1.9
  +++ perl5cargo_cult.pmc	23 Jun 2004 10:54:25 -0000	1.10
  @@ -1,7 +1,7 @@
   /* Perl5QQQ.pmc -*- c -*-
    *  Copyright: 2001-2004 The Perl Foundation.  All Rights Reserved.
    *  CVS Info
  - *     $Id: perl5cargo_cult.pmc,v 1.9 2004/06/22 16:19:48 nicholas Exp $
  + *     $Id: perl5cargo_cult.pmc,v 1.10 2004/06/23 10:54:25 nicholas Exp $
    *  Overview:
    *     These are the vtable functions for the Perl5QQQ base class
    *  Data Structure and Algorithms:
  @@ -42,8 +42,8 @@
   	case Ponie_P_ANY:
   	    return PMC_struct_val(SELF);
   	case Ponie_P_RV:
  -	    /*return &(PMC_pmc_val(SELF));*/
  -	    return &(((struct xrv*)((struct STRUCT_SV *)PMC_struct_val(SELF))->sv_any)->xrv_rv);
  +	    return &(PMC_pmc_val(SELF));
  +	    /*return &(((struct xrv*)((struct STRUCT_SV *)PMC_struct_val(SELF))->sv_any)->xrv_rv);*/
   	    /*default:
   	      Can't easily croak.  */
   	    /*croak ("Out of range key %d (max is %d)", key, Ponie_P_MAX - 1);*/