cvs commit: ponie/perl av.c av.h embed.fnc embed.h global.sym proto.h sv.c
[email protected] (Arthur Bergman) 20 Feb 2004 09:45:57 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/02/20 01:45:57
Modified: . Configure.pl
perl av.c av.h embed.fnc embed.h global.sym proto.h sv.c
Log:
Switch arrays to user perl5av.pmc and wrap the Av* macros around, unforutnatly for quite some time the perl5av.pmc will just use perl5 array code wrapped in pmc code, and cut directly to inner slots in the structure, but at least using functions. The amount of code that assumes that it can poke inside an array is impressive
Revision Changes Path
1.10 +2 -0 ponie/Configure.pl
Index: Configure.pl
===================================================================
RCS file: /cvs/public/ponie/Configure.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- Configure.pl 19 Dec 2003 14:37:51 -0000 1.9
+++ Configure.pl 20 Feb 2004 09:45:56 -0000 1.10
@@ -37,6 +37,8 @@
chdir('classes') || die;
system('rm -f perl5lv.pmc') && die "Error";
system('ln','-s','../../src/pmc/perl5lv.pmc') && die "error";
+ system('rm -f perl5av.pmc') && die "Error";
+ system('ln','-s','../../src/pmc/perl5av.pmc') && die "error";
chdir('..') || die;
system($^X,'Configure.pl',"--ccflags= :add{ -I$dir/perl}") && die "error";
system('make') && die "error";
1.2 +29 -1 ponie/perl/av.c
Index: av.c
===================================================================
RCS file: /cvs/public/ponie/perl/av.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- av.c 9 Sep 2003 11:58:34 -0000 1.1
+++ av.c 20 Feb 2004 09:45:56 -0000 1.2
@@ -20,6 +20,35 @@
#include "EXTERN.h"
#define PERL_IN_AV_C
#include "perl.h"
+#include "parrot/extend.h"
+
+
+
+U8* Perl_macro_AvFLAGS (pTHX_ AV *av) {
+ XPVAV* data = (XPV*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(av));
+ return &(data->xav_flags);
+}
+
+SSize_t* Perl_macro_AvMAX (pTHX_ AV *av) {
+ XPVAV* data = (XPV*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(av));
+ return &(data->xav_max);
+}
+
+SV*** Perl_macro_AvALLOC (pTHX_ AV *av) {
+ XPVAV* data = (XPV*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(av));
+ return &(data->xav_alloc);
+}
+
+SV** Perl_macro_AvARYLEN (pTHX_ AV *av) {
+ XPVAV* data = (XPV*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(av));
+ return &(data->xav_arylen);
+}
+
+SSize_t* Perl_macro_AvFILLp (pTHX_ AV *av) {
+ XPVAV* data = (XPV*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(av));
+ return &(data->xav_fill);
+}
+
void
Perl_av_reify(pTHX_ AV *av)
@@ -354,7 +383,6 @@
sv_upgrade((SV *)av, SVt_PVAV);
AvREAL_on(av);
AvALLOC(av) = 0;
- SvPVX(av) = 0;
AvMAX(av) = AvFILLp(av) = -1;
return av;
}
1.2 +6 -6 ponie/perl/av.h
Index: av.h
===================================================================
RCS file: /cvs/public/ponie/perl/av.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- av.h 9 Sep 2003 11:58:34 -0000 1.1
+++ av.h 20 Feb 2004 09:45:56 -0000 1.2
@@ -22,7 +22,6 @@
U8 xav_flags;
};
-
/* AVf_REAL is set for all AVs whose xav_array contents are refcounted.
* Some things like "@_" and the scratchpad list do not set this, to
* indicate that they are cheating (for efficiency) by not refcounting
@@ -63,11 +62,12 @@
#define Nullav Null(AV*)
#define AvARRAY(av) ((SV**)((XPVAV*) SvANY(av))->xav_array)
-#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc
-#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max
-#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill
-#define AvARYLEN(av) ((XPVAV*) SvANY(av))->xav_arylen
-#define AvFLAGS(av) ((XPVAV*) SvANY(av))->xav_flags
+#define AvALLOC(av) ( * Perl_macro_AvALLOC(aTHX_ (AV*)av) )
+#define AvMAX(av) ( * Perl_macro_AvMAX(aTHX_ (AV*)av) )
+#define AvFILLp(av) ( * Perl_macro_AvFILLp(aTHX_ (AV*)av) )
+#define AvARYLEN(av) ( * Perl_macro_AvARYLEN(aTHX_ (AV*)av) )
+#define AvFLAGS(av) ( * Perl_macro_AvFLAGS(aTHX_ (AV*)av) )
+
#define AvREAL(av) (AvFLAGS(av) & AVf_REAL)
#define AvREAL_on(av) (AvFLAGS(av) |= AVf_REAL)
1.5 +7 -1 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- embed.fnc 7 Jan 2004 14:13:58 -0000 1.4
+++ embed.fnc 20 Feb 2004 09:45:56 -0000 1.5
@@ -968,6 +968,12 @@
Adp |int |nothreadhook
+
+Ap |U8*|macro_AvFLAGS |AV *
+Ap |SV***|macro_AvALLOC |AV *
+Ap |SV**|macro_AvARYLEN |AV *
+Ap |SSize_t*|macro_AvFILLp |AV *
+Ap |SSize_t*|macro_AvMAX |AV *
Ap |char** |macro_SvPVX |SV *
Ap |char** |macro_LvTYPE |SV *
Ap |SV** |macro_LvTARG |SV *
@@ -1205,7 +1211,7 @@
s |XPVIV* |new_xpviv
s |XPVNV* |new_xpvnv
s |XPVCV* |new_xpvcv
-s |XPVAV* |new_xpvav
+s |Parrot_PMC |new_xpvav
s |XPVHV* |new_xpvhv
s |XPVMG* |new_xpvmg
s |Parrot_PMC |new_xpvlv
1.5 +10 -0 ponie/perl/embed.h
Index: embed.h
===================================================================
RCS file: /cvs/public/ponie/perl/embed.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- embed.h 7 Jan 2004 14:13:58 -0000 1.4
+++ embed.h 20 Feb 2004 09:45:56 -0000 1.5
@@ -1255,6 +1255,11 @@
#define sv_nolocking Perl_sv_nolocking
#define sv_nounlocking Perl_sv_nounlocking
#define nothreadhook Perl_nothreadhook
+#define macro_AvFLAGS Perl_macro_AvFLAGS
+#define macro_AvALLOC Perl_macro_AvALLOC
+#define macro_AvARYLEN Perl_macro_AvARYLEN
+#define macro_AvFILLp Perl_macro_AvFILLp
+#define macro_AvMAX Perl_macro_AvMAX
#define macro_SvPVX Perl_macro_SvPVX
#define macro_LvTYPE Perl_macro_LvTYPE
#define macro_LvTARG Perl_macro_LvTARG
@@ -3740,6 +3745,11 @@
#define sv_nolocking(a) Perl_sv_nolocking(aTHX_ a)
#define sv_nounlocking(a) Perl_sv_nounlocking(aTHX_ a)
#define nothreadhook() Perl_nothreadhook(aTHX)
+#define macro_AvFLAGS(a) Perl_macro_AvFLAGS(aTHX_ a)
+#define macro_AvALLOC(a) Perl_macro_AvALLOC(aTHX_ a)
+#define macro_AvARYLEN(a) Perl_macro_AvARYLEN(aTHX_ a)
+#define macro_AvFILLp(a) Perl_macro_AvFILLp(aTHX_ a)
+#define macro_AvMAX(a) Perl_macro_AvMAX(aTHX_ a)
#define macro_SvPVX(a) Perl_macro_SvPVX(aTHX_ a)
#define macro_LvTYPE(a) Perl_macro_LvTYPE(aTHX_ a)
#define macro_LvTARG(a) Perl_macro_LvTARG(aTHX_ a)
1.5 +5 -0 ponie/perl/global.sym
Index: global.sym
===================================================================
RCS file: /cvs/public/ponie/perl/global.sym,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- global.sym 7 Jan 2004 14:13:58 -0000 1.4
+++ global.sym 20 Feb 2004 09:45:56 -0000 1.5
@@ -628,6 +628,11 @@
Perl_sv_nolocking
Perl_sv_nounlocking
Perl_nothreadhook
+Perl_macro_AvFLAGS
+Perl_macro_AvALLOC
+Perl_macro_AvARYLEN
+Perl_macro_AvFILLp
+Perl_macro_AvMAX
Perl_macro_SvPVX
Perl_macro_LvTYPE
Perl_macro_LvTARG
1.5 +7 -1 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- proto.h 7 Jan 2004 14:13:58 -0000 1.4
+++ proto.h 20 Feb 2004 09:45:56 -0000 1.5
@@ -926,6 +926,12 @@
PERL_CALLCONV int Perl_nothreadhook(pTHX);
+
+PERL_CALLCONV U8* Perl_macro_AvFLAGS(pTHX_ AV *);
+PERL_CALLCONV SV*** Perl_macro_AvALLOC(pTHX_ AV *);
+PERL_CALLCONV SV** Perl_macro_AvARYLEN(pTHX_ AV *);
+PERL_CALLCONV SSize_t* Perl_macro_AvFILLp(pTHX_ AV *);
+PERL_CALLCONV SSize_t* Perl_macro_AvMAX(pTHX_ AV *);
PERL_CALLCONV char** Perl_macro_SvPVX(pTHX_ SV *);
PERL_CALLCONV char** Perl_macro_LvTYPE(pTHX_ SV *);
PERL_CALLCONV SV** Perl_macro_LvTARG(pTHX_ SV *);
@@ -1156,7 +1162,7 @@
STATIC XPVIV* S_new_xpviv(pTHX);
STATIC XPVNV* S_new_xpvnv(pTHX);
STATIC XPVCV* S_new_xpvcv(pTHX);
-STATIC XPVAV* S_new_xpvav(pTHX);
+STATIC Parrot_PMC S_new_xpvav(pTHX);
STATIC XPVHV* S_new_xpvhv(pTHX);
STATIC XPVMG* S_new_xpvmg(pTHX);
STATIC Parrot_PMC S_new_xpvlv(pTHX);
1.6 +24 -23 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- sv.c 7 Jan 2004 14:13:58 -0000 1.5
+++ sv.c 20 Feb 2004 09:45:56 -0000 1.6
@@ -936,28 +936,13 @@
/* grab a new struct xpvav from the free list, allocating more if necessary */
-STATIC XPVAV*
-S_new_xpvav(pTHX)
-{
- XPVAV* xpvav;
- LOCK_SV_MUTEX;
- if (!PL_xpvav_root)
- more_xpvav();
- xpvav = PL_xpvav_root;
- PL_xpvav_root = (XPVAV*)xpvav->xav_array;
- UNLOCK_SV_MUTEX;
- return xpvav;
-}
/* return a struct xpvav to the free list */
STATIC void
S_del_xpvav(pTHX_ XPVAV *p)
{
- LOCK_SV_MUTEX;
- p->xav_array = (char*)PL_xpvav_root;
- PL_xpvav_root = p;
- UNLOCK_SV_MUTEX;
+
}
/* allocate another arena's worth of struct xpvav */
@@ -1075,6 +1060,21 @@
/* grab a new struct xpvlv from the free list, allocating more if necessary */
STATIC Parrot_PMC
+S_new_xpvav(pTHX)
+{
+ Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5AV");
+ Parrot_PMC av;
+ /*
+ Instead of giving back a real XPVLV we give bakc a PMC
+ */
+
+
+ av = Parrot_PMC_new(PL_Parrot, type);
+ return av;
+}
+
+
+STATIC Parrot_PMC
S_new_xpvlv(pTHX)
{
Parrot_Int type = Parrot_PMC_typenum(PL_Parrot, "Perl5LV");
@@ -1266,7 +1266,8 @@
char** Perl_macro_SvPVX (pTHX_ SV *sv) {
if(SvPMC(sv)) {
- FIXME("SvPVX() not implemented yet");
+ XPV* data = (XPV*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(sv));
+ return &(data->xpv_pv);
}
return &((XPV*)SvANY(sv))->xpv_pv;
@@ -1277,7 +1278,7 @@
if(!SvPMC(sv))
abort();
data = (perl5lv_pmc_data*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(sv));
- return &(data->xlv_type);
+ return (char**) &(data->xlv_type);
}
SV** Perl_macro_LvTARG (pTHX_ SV* sv) {
@@ -1483,15 +1484,15 @@
break;
case SVt_PVAV:
SvANY(sv) = new_XPVAV();
+ SvPMC_on(sv);
if (pv)
Safefree(pv);
- SvPVX(sv) = 0;
AvMAX(sv) = -1;
AvFILLp(sv) = -1;
- SvIVX(sv) = 0;
+ /* SvIVX(sv) = 0;
SvNVX(sv) = 0.0;
SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvSTASH(sv) = stash; */
AvALLOC(sv) = 0;
AvARYLEN(sv) = 0;
AvFLAGS(sv) = 0;