cvs commit: ponie/perl/ext/Devel/Peek/t Peek.t
[email protected] (Nicholas Clark) 4 May 2004 16:36:52 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/05/04 09:36:52
Modified: perl cv.h embed.fnc embed.h global.sym proto.h sv.c
perl/ext/Devel/Peek/t Peek.t
Log:
CVs and FORMATs now hidden behind PMCs
Revision Changes Path
1.2 +22 -15 ponie/perl/cv.h
Index: cv.h
===================================================================
RCS file: /cvs/public/ponie/perl/cv.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- cv.h 9 Sep 2003 11:58:48 -0000 1.1
+++ cv.h 4 May 2004 16:36:52 -0000 1.2
@@ -1,7 +1,7 @@
/* cv.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 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.
@@ -11,6 +11,8 @@
/* This structure must match XPVCV in B/C.pm and the beginning of XPVFM
* in sv.h */
+typedef void (*xpvcv_xcv_xsub_t) (pTHX_ CV*);
+
struct xpvcv {
char * xpv_pv; /* pointer to malloced string (for prototype) */
STRLEN xpv_cur; /* length of xp_pv as a C string */
@@ -23,7 +25,7 @@
HV * xcv_stash;
OP * xcv_start;
OP * xcv_root;
- void (*xcv_xsub) (pTHX_ CV*);
+ xpvcv_xcv_xsub_t xcv_xsub;
ANY xcv_xsubany;
GV * xcv_gv;
char * xcv_file;
@@ -52,30 +54,35 @@
#define Nullcv Null(CV*)
-#define CvSTASH(sv) ((XPVCV*)SvANY(sv))->xcv_stash
-#define CvSTART(sv) ((XPVCV*)SvANY(sv))->xcv_start
-#define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root
-#define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_xsub
-#define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_xsubany
-#define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv
-#define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file
+#define SvIVX(sv) (* Perl_macro_SvIVX(aTHX_ (SV*) (sv)))
+
+#define CvSTASH(sv) (* Perl_macro_CvSTASH(aTHX_ (SV*) (sv)))
+#define CvSTART(sv) (* Perl_macro_CvSTART(aTHX_ (SV*) (sv)))
+#define CvROOT(sv) (* Perl_macro_CvROOT(aTHX_ (SV*) (sv)))
+#define CvXSUB(sv) (* Perl_macro_CvXSUB(aTHX_ (SV*) (sv)))
+#define CvXSUBANY(sv) (* Perl_macro_CvXSUBANY(aTHX_ (SV*) (sv)))
+#define CvGV(sv) (* Perl_macro_CvGV(aTHX_ (SV*) (sv)))
+#define CvFILE(sv) (* Perl_macro_CvFILE(aTHX_ (SV*) (sv)))
#ifdef USE_ITHREADS
# define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = savepv(CopFILE(cop)))
#else
# define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = CopFILE(cop))
#endif
#define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv)))
-#define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth
-#define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist
-#define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside
-#define CvFLAGS(sv) ((XPVCV*)SvANY(sv))->xcv_flags
-#define CvOUTSIDE_SEQ(sv) ((XPVCV*)SvANY(sv))->xcv_outside_seq
+#define CvDEPTH(sv) (* Perl_macro_CvDEPTH(aTHX_ (SV*) (sv)))
+#define CvPADLIST(sv) (* Perl_macro_CvPADLIST(aTHX_ (SV*) (sv)))
+#define CvOUTSIDE(sv) (* Perl_macro_CvOUTSIDE(aTHX_ (SV*) (sv)))
+#define CvFLAGS(sv) (* Perl_macro_CvFLAGS(aTHX_ (SV*) (sv)))
+#define CvOUTSIDE_SEQ(sv) (* Perl_macro_CvOUTSIDE_SEQ(aTHX_ (SV*) (sv)))
#define CVf_CLONE 0x0001 /* anon CV uses external lexicals */
#define CVf_CLONED 0x0002 /* a clone of one of those */
#define CVf_ANON 0x0004 /* CvGV() can't be trusted */
#define CVf_OLDSTYLE 0x0008
-#define CVf_UNIQUE 0x0010 /* can't be cloned */
+#define CVf_UNIQUE 0x0010 /* sub is only called once (eg PL_main_cv,
+ * require, eval). Not to be confused
+ * with the GVf_UNIQUE flag associated
+ * with the :unique attribute */
#define CVf_NODEBUG 0x0020 /* no DB::sub indirection for this CV
(esp. useful for special XSUBs) */
#define CVf_METHOD 0x0040 /* CV is explicitly marked as a method */
1.17 +18 -2 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- embed.fnc 4 May 2004 10:20:03 -0000 1.16
+++ embed.fnc 4 May 2004 16:36:52 -0000 1.17
@@ -1024,6 +1024,18 @@
Ap |STRLEN* |macro_GvNAMELEN |GV *
Ap |HV** |macro_GvSTASH |GV *
Ap |U8* |macro_GvFLAGS |GV *
+Ap |HV** |macro_CvSTASH |SV *
+Ap |OP** |macro_CvSTART |SV *
+Ap |OP** |macro_CvROOT |SV *
+Ap |xpvcv_xcv_xsub_t*|macro_CvXSUB |SV *
+Ap |ANY* |macro_CvXSUBANY |SV *
+Ap |GV** |macro_CvGV |SV *
+Ap |char** |macro_CvFILE |SV *
+Ap |long* |macro_CvDEPTH |SV *
+Ap |PADLIST** |macro_CvPADLIST |SV *
+Ap |CV** |macro_CvOUTSIDE |SV *
+Ap |cv_flags_t* |macro_CvFLAGS |SV *
+Ap |U32* |macro_CvOUTSIDE_SEQ |SV *
END_EXTERN_C
@@ -1257,10 +1269,11 @@
s |XPV* |new_xpv
s |XPVIV* |new_xpviv
s |XPVNV* |new_xpvnv
-s |XPVCV* |new_xpvcv
+s |Parrot_PMC |new_xpvcv
s |Parrot_PMC |new_xpvav
s |Parrot_PMC |new_xpvhv
s |Parrot_PMC |new_xpvio
+s |Parrot_PMC |new_xpvfm
s |XPVMG* |new_xpvmg
s |Parrot_PMC |new_xpvlv
s |XPVBM* |new_xpvbm
@@ -1270,14 +1283,17 @@
s |void |del_xpv |XPV* p
s |void |del_xpviv |XPVIV* p
s |void |del_xpvnv |XPVNV* p
-s |void |del_xpvcv |XPVCV* p
+s |void |del_xpvcv |Parrot_PMC p
s |void |del_xpvav |Parrot_PMC p
s |void |del_xpvhv |Parrot_PMC p
s |void |del_xpvio |Parrot_PMC p
+s |void |del_xpvfm |Parrot_PMC p
s |void |del_xpvmg |XPVMG* p
s |void |del_xpvlv |Parrot_PMC p
s |void |del_xpvbm |XPVBM* 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
s |void |sv_unglob |SV* sv
s |void |not_a_number |SV *sv
1.14 +48 -0 ponie/perl/embed.h
Index: embed.h
===================================================================
RCS file: /cvs/public/ponie/perl/embed.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- embed.h 4 May 2004 10:20:03 -0000 1.13
+++ embed.h 4 May 2004 16:36:52 -0000 1.14
@@ -1306,6 +1306,18 @@
#define macro_GvNAMELEN Perl_macro_GvNAMELEN
#define macro_GvSTASH Perl_macro_GvSTASH
#define macro_GvFLAGS Perl_macro_GvFLAGS
+#define macro_CvSTASH Perl_macro_CvSTASH
+#define macro_CvSTART Perl_macro_CvSTART
+#define macro_CvROOT Perl_macro_CvROOT
+#define macro_CvXSUB Perl_macro_CvXSUB
+#define macro_CvXSUBANY Perl_macro_CvXSUBANY
+#define macro_CvGV Perl_macro_CvGV
+#define macro_CvFILE Perl_macro_CvFILE
+#define macro_CvDEPTH Perl_macro_CvDEPTH
+#define macro_CvPADLIST Perl_macro_CvPADLIST
+#define macro_CvOUTSIDE Perl_macro_CvOUTSIDE
+#define macro_CvFLAGS Perl_macro_CvFLAGS
+#define macro_CvOUTSIDE_SEQ Perl_macro_CvOUTSIDE_SEQ
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple S_do_trans_simple
@@ -1853,6 +1865,9 @@
#define new_xpvio S_new_xpvio
#endif
#ifdef PERL_CORE
+#define new_xpvfm S_new_xpvfm
+#endif
+#ifdef PERL_CORE
#define new_xpvmg S_new_xpvmg
#endif
#ifdef PERL_CORE
@@ -1892,6 +1907,9 @@
#define del_xpvio S_del_xpvio
#endif
#ifdef PERL_CORE
+#define del_xpvfm S_del_xpvfm
+#endif
+#ifdef PERL_CORE
#define del_xpvmg S_del_xpvmg
#endif
#ifdef PERL_CORE
@@ -1904,6 +1922,12 @@
#define del_xrv S_del_xrv
#endif
#ifdef PERL_CORE
+#define zero_xpvfm S_zero_xpvfm
+#endif
+#ifdef PERL_CORE
+#define zero_xpvcv S_zero_xpvcv
+#endif
+#ifdef PERL_CORE
#define zero_xpvio S_zero_xpvio
#endif
#ifdef PERL_CORE
@@ -3862,6 +3886,18 @@
#define macro_GvNAMELEN(a) Perl_macro_GvNAMELEN(aTHX_ a)
#define macro_GvSTASH(a) Perl_macro_GvSTASH(aTHX_ a)
#define macro_GvFLAGS(a) Perl_macro_GvFLAGS(aTHX_ a)
+#define macro_CvSTASH(a) Perl_macro_CvSTASH(aTHX_ a)
+#define macro_CvSTART(a) Perl_macro_CvSTART(aTHX_ a)
+#define macro_CvROOT(a) Perl_macro_CvROOT(aTHX_ a)
+#define macro_CvXSUB(a) Perl_macro_CvXSUB(aTHX_ a)
+#define macro_CvXSUBANY(a) Perl_macro_CvXSUBANY(aTHX_ a)
+#define macro_CvGV(a) Perl_macro_CvGV(aTHX_ a)
+#define macro_CvFILE(a) Perl_macro_CvFILE(aTHX_ a)
+#define macro_CvDEPTH(a) Perl_macro_CvDEPTH(aTHX_ a)
+#define macro_CvPADLIST(a) Perl_macro_CvPADLIST(aTHX_ a)
+#define macro_CvOUTSIDE(a) Perl_macro_CvOUTSIDE(aTHX_ a)
+#define macro_CvFLAGS(a) Perl_macro_CvFLAGS(aTHX_ a)
+#define macro_CvOUTSIDE_SEQ(a) Perl_macro_CvOUTSIDE_SEQ(aTHX_ a)
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple(a) S_do_trans_simple(aTHX_ a)
@@ -4408,6 +4444,9 @@
#define new_xpvio() S_new_xpvio(aTHX)
#endif
#ifdef PERL_CORE
+#define new_xpvfm() S_new_xpvfm(aTHX)
+#endif
+#ifdef PERL_CORE
#define new_xpvmg() S_new_xpvmg(aTHX)
#endif
#ifdef PERL_CORE
@@ -4447,6 +4486,9 @@
#define del_xpvio(a) S_del_xpvio(aTHX_ a)
#endif
#ifdef PERL_CORE
+#define del_xpvfm(a) S_del_xpvfm(aTHX_ a)
+#endif
+#ifdef PERL_CORE
#define del_xpvmg(a) S_del_xpvmg(aTHX_ a)
#endif
#ifdef PERL_CORE
@@ -4457,6 +4499,12 @@
#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
+#define zero_xpvcv(a) S_zero_xpvcv(aTHX_ a)
#endif
#ifdef PERL_CORE
#define zero_xpvio(a) S_zero_xpvio(aTHX_ a)
1.13 +12 -0 ponie/perl/global.sym
Index: global.sym
===================================================================
RCS file: /cvs/public/ponie/perl/global.sym,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- global.sym 7 Apr 2004 10:37:27 -0000 1.12
+++ global.sym 4 May 2004 16:36:52 -0000 1.13
@@ -686,6 +686,18 @@
Perl_macro_GvNAMELEN
Perl_macro_GvSTASH
Perl_macro_GvFLAGS
+Perl_macro_CvSTASH
+Perl_macro_CvSTART
+Perl_macro_CvROOT
+Perl_macro_CvXSUB
+Perl_macro_CvXSUBANY
+Perl_macro_CvGV
+Perl_macro_CvFILE
+Perl_macro_CvDEPTH
+Perl_macro_CvPADLIST
+Perl_macro_CvOUTSIDE
+Perl_macro_CvFLAGS
+Perl_macro_CvOUTSIDE_SEQ
Perl_Slab_Alloc
Perl_Slab_Free
Perl_sv_setsv_flags
1.17 +18 -2 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- proto.h 4 May 2004 10:20:03 -0000 1.16
+++ proto.h 4 May 2004 16:36:52 -0000 1.17
@@ -982,6 +982,18 @@
PERL_CALLCONV STRLEN* Perl_macro_GvNAMELEN(pTHX_ GV *);
PERL_CALLCONV HV** Perl_macro_GvSTASH(pTHX_ GV *);
PERL_CALLCONV U8* Perl_macro_GvFLAGS(pTHX_ GV *);
+PERL_CALLCONV HV** Perl_macro_CvSTASH(pTHX_ SV *);
+PERL_CALLCONV OP** Perl_macro_CvSTART(pTHX_ SV *);
+PERL_CALLCONV OP** Perl_macro_CvROOT(pTHX_ SV *);
+PERL_CALLCONV xpvcv_xcv_xsub_t* Perl_macro_CvXSUB(pTHX_ SV *);
+PERL_CALLCONV ANY* Perl_macro_CvXSUBANY(pTHX_ SV *);
+PERL_CALLCONV GV** Perl_macro_CvGV(pTHX_ SV *);
+PERL_CALLCONV char** Perl_macro_CvFILE(pTHX_ SV *);
+PERL_CALLCONV long* Perl_macro_CvDEPTH(pTHX_ SV *);
+PERL_CALLCONV PADLIST** Perl_macro_CvPADLIST(pTHX_ SV *);
+PERL_CALLCONV CV** Perl_macro_CvOUTSIDE(pTHX_ SV *);
+PERL_CALLCONV cv_flags_t* Perl_macro_CvFLAGS(pTHX_ SV *);
+PERL_CALLCONV U32* Perl_macro_CvOUTSIDE_SEQ(pTHX_ SV *);
END_EXTERN_C
@@ -1209,10 +1221,11 @@
STATIC XPV* S_new_xpv(pTHX);
STATIC XPVIV* S_new_xpviv(pTHX);
STATIC XPVNV* S_new_xpvnv(pTHX);
-STATIC XPVCV* S_new_xpvcv(pTHX);
+STATIC Parrot_PMC S_new_xpvcv(pTHX);
STATIC Parrot_PMC S_new_xpvav(pTHX);
STATIC Parrot_PMC S_new_xpvhv(pTHX);
STATIC Parrot_PMC S_new_xpvio(pTHX);
+STATIC Parrot_PMC S_new_xpvfm(pTHX);
STATIC XPVMG* S_new_xpvmg(pTHX);
STATIC Parrot_PMC S_new_xpvlv(pTHX);
STATIC XPVBM* S_new_xpvbm(pTHX);
@@ -1222,14 +1235,17 @@
STATIC void S_del_xpv(pTHX_ XPV* p);
STATIC void S_del_xpviv(pTHX_ XPVIV* p);
STATIC void S_del_xpvnv(pTHX_ XPVNV* p);
-STATIC void S_del_xpvcv(pTHX_ XPVCV* p);
+STATIC void S_del_xpvcv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvav(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvhv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvio(pTHX_ Parrot_PMC p);
+STATIC void S_del_xpvfm(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvmg(pTHX_ XPVMG* p);
STATIC void S_del_xpvlv(pTHX_ Parrot_PMC p);
STATIC void S_del_xpvbm(pTHX_ XPVBM* 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);
STATIC void S_sv_unglob(pTHX_ SV* sv);
STATIC void S_not_a_number(pTHX_ SV *sv);
1.24 +137 -18 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- sv.c 4 May 2004 10:20:03 -0000 1.23
+++ sv.c 4 May 2004 16:36:52 -0000 1.24
@@ -903,28 +903,28 @@
/* grab a new struct xpvcv from the free list, allocating more if necessary */
-STATIC XPVCV*
+STATIC Parrot_PMC
S_new_xpvcv(pTHX)
{
- XPVCV* xpvcv;
- LOCK_SV_MUTEX;
- if (!PL_xpvcv_root)
- more_xpvcv();
- xpvcv = PL_xpvcv_root;
- PL_xpvcv_root = (XPVCV*)xpvcv->xpv_pv;
- UNLOCK_SV_MUTEX;
- return xpvcv;
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVCV");
+ Parrot_PMC cv = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, cv);
+ return MUMBLE(cv);
}
/* return a struct xpvcv to the free list */
STATIC void
-S_del_xpvcv(pTHX_ XPVCV *p)
+S_del_xpvcv(pTHX_ Parrot_PMC cv)
{
- LOCK_SV_MUTEX;
- p->xpv_pv = (char*)PL_xpvcv_root;
- PL_xpvcv_root = p;
- UNLOCK_SV_MUTEX;
+ Parrot_unregister_pmc(PL_Parrot, cv);
+}
+
+void
+S_zero_xpvcv(pTHX_ SV *fm)
+{
+ assert(SvPMC(fm));
+ Zero(Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(fm))), 1, XPVCV);
}
/* allocate another arena's worth of struct xpvcv */
@@ -1277,12 +1277,25 @@
#define new_XPVGV() my_safemalloc(sizeof(XPVGV))
#define del_XPVGV(p) my_safefree(p)
-#define new_XPVFM() my_safemalloc(sizeof(XPVFM))
-#define del_XPVFM(p) my_safefree(p)
+#define new_XPVFM() (void*)new_xpvfm()
+#define del_XPVFM(p) del_xpvfm((XPVFM *)p)
#define new_XPVIO() (void*)new_xpvio()
#define del_XPVIO(p) del_xpvio((XPVIO *)p)
+STATIC Parrot_PMC
+S_new_xpvfm(pTHX)
+{
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5PVFM");
+ Parrot_PMC fm = Parrot_PMC_new(PL_Parrot, type);
+ Parrot_register_pmc(PL_Parrot, fm);
+ return MUMBLE(fm);
+}
+STATIC void
+S_del_xpvfm(pTHX_ Parrot_PMC fm)
+{
+ Parrot_unregister_pmc(PL_Parrot, fm);
+}
STATIC Parrot_PMC
S_new_xpvio(pTHX)
@@ -1579,6 +1592,110 @@
return &((XPVIO*)SvANY(sv))->xio_flags;
}
+HV** Perl_macro_CvSTASH (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_stash);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_stash;
+}
+
+OP** Perl_macro_CvSTART (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_start);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_start;
+}
+
+OP** Perl_macro_CvROOT (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_root);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_root;
+}
+
+xpvcv_xcv_xsub_t * Perl_macro_CvXSUB (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_xsub);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_xsub;
+}
+
+ANY* Perl_macro_CvXSUBANY (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_xsubany);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_xsubany;
+}
+
+GV** Perl_macro_CvGV (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_gv);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_gv;
+}
+
+char** Perl_macro_CvFILE (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_file);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_file;
+}
+
+long* Perl_macro_CvDEPTH (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_depth);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_depth;
+}
+
+PADLIST** Perl_macro_CvPADLIST (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_padlist);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_padlist;
+}
+
+CV** Perl_macro_CvOUTSIDE (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_outside);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_outside;
+}
+
+cv_flags_t* Perl_macro_CvFLAGS (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_flags);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_flags;
+}
+
+U32* Perl_macro_CvOUTSIDE_SEQ (pTHX_ SV *sv) {
+ if(SvPMC(sv)) {
+ XPVCV* data = (XPVCV*) Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(sv)));
+ return &(data->xcv_outside_seq);
+ }
+ return &((XPVCV*)SvANY(sv))->xcv_outside_seq;
+}
+
+
+void
+S_zero_xpvfm(pTHX_ SV *fm)
+{
+ assert(SvPMC(fm));
+ Zero(Parrot_PMC_get_pointer(PL_Parrot, MUMBLE(SvANY(fm))), 1, XPVFM);
+}
+
void
S_zero_xpvio(pTHX_ SV *io)
{
@@ -1819,7 +1936,8 @@
break;
case SVt_PVCV:
SvANY(sv) = new_XPVCV();
- Zero(SvANY(sv), 1, XPVCV);
+ SvPMC_on(sv);
+ zero_xpvcv(sv);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
@@ -1858,7 +1976,8 @@
break;
case SVt_PVFM:
SvANY(sv) = new_XPVFM();
- Zero(SvANY(sv), 1, XPVFM);
+ SvPMC_on(sv);
+ zero_xpvfm(sv);
SvPVX(sv) = pv;
SvCUR(sv) = cur;
SvLEN(sv) = len;
1.4 +2 -2 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.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Peek.t 3 May 2004 22:21:56 -0000 1.3
+++ Peek.t 4 May 2004 16:36:52 -0000 1.4
@@ -207,7 +207,7 @@
RV = $ADDR
SV = PVCV\\($ADDR\\) at $ADDR
REFCNT = 2
- FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
+ FLAGS = \\(pmc,PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
IV = 0
NV = 0
PROTOTYPE = ""
@@ -235,7 +235,7 @@
RV = $ADDR
SV = PVCV\\($ADDR\\) at $ADDR
REFCNT = (3|4)
- FLAGS = \\(\\)
+ FLAGS = \\(pmc\\)
IV = 0
NV = 0
COMP_STASH = $ADDR\\t"main"