cvs commit: ponie/perl sv.c sv.h perl.h

cvsuser     03/12/10 07:40:18

  Modified:    perl     sv.c sv.h perl.h
  Log:
  use a function instead of macro for SvPVX, do clever trick to allow it to be a lvalue and hope it works on other platforms
  
  Revision  Changes    Path
  1.3       +28 -17    ponie/perl/sv.c
  
  Index: sv.c
  ===================================================================
  RCS file: /cvs/public/ponie/perl/sv.c,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -w -r1.2 -r1.3
  --- sv.c	10 Dec 2003 10:25:21 -0000	1.2
  +++ sv.c	10 Dec 2003 15:40:18 -0000	1.3
  @@ -19,9 +19,9 @@
   
   #include "EXTERN.h"
   #define PERL_IN_SV_C
  +#include "parrot/extend.h"
   #include "perl.h"
   #include "regcomp.h"
  -#include "parrot/extend.h"
   #define FCALL *f
   
   #ifdef PERL_UTF8_CACHE_ASSERT
  @@ -1074,11 +1074,11 @@
   
   /* grab a new struct xpvlv from the free list, allocating more if necessary */
   
  -STATIC XPVLV*
  +STATIC Parrot_PMC
   S_new_xpvlv(pTHX)
   {
  -    XPVLV* xpvlv;
       Parrot_Int  type = Parrot_PMC_typenum(PL_Parrot, "Perl5LV");
  +    Parrot_PMC  lval;
       /*
         Instead of giving back a real XPVLV we give bakc a PMC
         
  @@ -1086,26 +1086,26 @@
       
       
       
  -    Parrot_PMC_new(PL_Parrot, type);
  +    lval = Parrot_PMC_new(PL_Parrot, type);
   
  -    LOCK_SV_MUTEX;
  -    if (!PL_xpvlv_root)
  -	more_xpvlv();
  -    xpvlv = PL_xpvlv_root;
  -    PL_xpvlv_root = (XPVLV*)xpvlv->xpv_pv;
  -    UNLOCK_SV_MUTEX;
  -    return xpvlv;
  +    /*    PerlIO_printf(Perl_debug_log,
  +		  "Create a new PMC %p\n",lval);
  +    */
  +
  +    return (Parrot_PMC) safemalloc(sizeof(XPVLV));
  +
  +    return lval;
   }
   
   /* return a struct xpvlv to the free list */
   
   STATIC void
  -S_del_xpvlv(pTHX_ XPVLV *p)
  +S_del_xpvlv(pTHX_ Parrot_PMC lval)
   {
  -    LOCK_SV_MUTEX;
  -    p->xpv_pv = (char*)PL_xpvlv_root;
  -    PL_xpvlv_root = p;
  -    UNLOCK_SV_MUTEX;
  +  /*
  +    PerlIO_printf(Perl_debug_log,
  +    "Dropped PMC %p\n", lval);
  +  */
   }
   
   /* allocate another arena's worth of struct xpvlv */
  @@ -1264,6 +1264,16 @@
   #define new_XPVIO()	my_safemalloc(sizeof(XPVIO))
   #define del_XPVIO(p)	my_safefree(p)
   
  +
  +char** Perl_macro_SvPVX (pTHX_ SV *sv) {
  +  if(SvPMC(sv)) {
  +    FIXME("SvPVX() not implemented yet\n");
  +  }
  +  return &((XPV*)SvANY(sv))->xpv_pv;
  +  
  +}
  +
  +
   /*
   =for apidoc sv_upgrade
   
  @@ -1441,6 +1451,7 @@
   	break;
       case SVt_PVLV:
   	SvANY(sv) = new_XPVLV();
  +	SvPMC_on(sv);
   	SvPVX(sv)	= pv;
   	SvCUR(sv)	= cur;
   	SvLEN(sv)	= len;
  
  
  
  1.3       +6 -1      ponie/perl/sv.h
  
  Index: sv.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/sv.h,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -w -r1.2 -r1.3
  --- sv.h	10 Sep 2003 16:27:27 -0000	1.2
  +++ sv.h	10 Dec 2003 15:40:18 -0000	1.3
  @@ -733,7 +733,12 @@
   #define SvUVXx(sv) SvUVX(sv)
   #define SvNVX(sv)  ((XPVNV*)SvANY(sv))->xnv_nv
   #define SvNVXx(sv) SvNVX(sv)
  -#define SvPVX(sv)  ((XPV*)  SvANY(sv))->xpv_pv
  +
  +#define SvPVX(sv)   (* Perl_macro_SvPVX(aTHX_ (SV*) sv))
  +//#define SvPVX(sv) (*(SvPMC((sv)) ?  &((XPV*)  SvANY(sv))->xpv_pv : &((XPV*)  SvANY(sv))->xpv_pv ))
  +//#define SvPVX(sv) (*(SvPMC((sv)) ?  Perl_macro_SvPVX(aTHX_ (SV*)sv) : &((XPV*)  SvANY(sv))->xpv_pv ))
  +//#define SvPVX(sv) ((SvPMC((sv)) ?  Perl_macro_SvPVX(aTHX_ (SV*)sv) : ((XPV*)  SvANY(sv))->xpv_pv ))
  +//Perl_macro_SvPVX(aTHX_ ((SV*)sv)))
   #define SvPVXx(sv) SvPVX(sv)
   #define SvCUR(sv) ((XPV*)  SvANY(sv))->xpv_cur
   #define SvLEN(sv) ((XPV*)  SvANY(sv))->xpv_len
  
  
  
  1.4       +1 -1      ponie/perl/perl.h
  
  Index: perl.h
  ===================================================================
  RCS file: /cvs/public/ponie/perl/perl.h,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -w -r1.3 -r1.4
  --- perl.h	10 Dec 2003 15:26:26 -0000	1.3
  +++ perl.h	10 Dec 2003 15:40:18 -0000	1.4
  @@ -13,7 +13,7 @@
   
   
   /* Here for Ponie to mark things that need to be done */
  -#define FIXME(x) ( (char*) 1)
  +#define FIXME(x) { PerlIO_printf(Perl_debug_log, x); abort(); }
   
   #ifdef PERL_FOR_X2P
   /*