cvs commit: ponie/perl embed.fnc embed.h global.sym mg.c pp_hot.c proto.h sv.c sv.h
[email protected] (Arthur Bergman) 7 Jan 2004 14:13:59 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/01/07 06:13:59
Modified: perl embed.fnc embed.h global.sym mg.c pp_hot.c proto.h
sv.c sv.h
Log:
add some more nifty LVALUE macro wrappers
Revision Changes Path
1.4 +1 -1 ponie/perl/embed.fnc
Index: embed.fnc
===================================================================
RCS file: /cvs/public/ponie/perl/embed.fnc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- embed.fnc 15 Dec 2003 13:55:14 -0000 1.3
+++ embed.fnc 7 Jan 2004 14:13:58 -0000 1.4
@@ -970,7 +970,7 @@
Ap |char** |macro_SvPVX |SV *
Ap |char** |macro_LvTYPE |SV *
-
+Ap |SV** |macro_LvTARG |SV *
END_EXTERN_C
1.4 +2 -0 ponie/perl/embed.h
Index: embed.h
===================================================================
RCS file: /cvs/public/ponie/perl/embed.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- embed.h 15 Dec 2003 13:55:14 -0000 1.3
+++ embed.h 7 Jan 2004 14:13:58 -0000 1.4
@@ -1257,6 +1257,7 @@
#define nothreadhook Perl_nothreadhook
#define macro_SvPVX Perl_macro_SvPVX
#define macro_LvTYPE Perl_macro_LvTYPE
+#define macro_LvTARG Perl_macro_LvTARG
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple S_do_trans_simple
@@ -3741,6 +3742,7 @@
#define nothreadhook() Perl_nothreadhook(aTHX)
#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)
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple(a) S_do_trans_simple(aTHX_ a)
1.4 +1 -0 ponie/perl/global.sym
Index: global.sym
===================================================================
RCS file: /cvs/public/ponie/perl/global.sym,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- global.sym 15 Dec 2003 13:55:15 -0000 1.3
+++ global.sym 7 Jan 2004 14:13:58 -0000 1.4
@@ -630,6 +630,7 @@
Perl_nothreadhook
Perl_macro_SvPVX
Perl_macro_LvTYPE
+Perl_macro_LvTARG
Perl_Slab_Alloc
Perl_Slab_Free
Perl_sv_setsv_flags
1.2 +41 -32 ponie/perl/mg.c
Index: mg.c
===================================================================
RCS file: /cvs/public/ponie/perl/mg.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- mg.c 9 Sep 2003 11:58:50 -0000 1.1
+++ mg.c 7 Jan 2004 14:13:58 -0000 1.2
@@ -122,6 +122,11 @@
MAGIC *newmg, *head, *cur, *mg;
I32 mgs_ix = SSNEW(sizeof(MGS));
+ if(SvPMC(sv)) {
+
+
+ } else {
+
save_magic(mgs_ix, sv);
/* We must call svt_get(sv, mg) for each valid entry in the linked
@@ -170,6 +175,7 @@
}
restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix));
+ }
return 0;
}
@@ -370,6 +376,9 @@
{
MAGIC* mg;
MAGIC* moremagic;
+ if(SvPMC(sv)) {
+ return 0;
+ }
for (mg = SvMAGIC(sv); mg; mg = moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
moremagic = mg->mg_moremagic;
1.2 +3 -1 ponie/perl/pp_hot.c
Index: pp_hot.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp_hot.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- pp_hot.c 9 Sep 2003 11:58:53 -0000 1.1
+++ pp_hot.c 7 Jan 2004 14:13:58 -0000 1.2
@@ -1718,8 +1718,10 @@
* and thus the later pp_sassign() will fail to mg_get() the
* old value. This should also cure problems with delayed
* mg_get()s. GSAR 98-07-03 */
- if (!lval && SvGMAGICAL(sv))
+ if (!lval && SvGMAGICAL(sv)) {
sv = sv_mortalcopy(sv);
+ sv_dump(sv);
+ }
PUSHs(sv);
RETURN;
}
1.4 +1 -1 ponie/perl/proto.h
Index: proto.h
===================================================================
RCS file: /cvs/public/ponie/perl/proto.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- proto.h 15 Dec 2003 13:55:15 -0000 1.3
+++ proto.h 7 Jan 2004 14:13:58 -0000 1.4
@@ -928,7 +928,7 @@
PERL_CALLCONV char** Perl_macro_SvPVX(pTHX_ SV *);
PERL_CALLCONV char** Perl_macro_LvTYPE(pTHX_ SV *);
-
+PERL_CALLCONV SV** Perl_macro_LvTARG(pTHX_ SV *);
END_EXTERN_C
1.5 +36 -1 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- sv.c 15 Dec 2003 13:55:15 -0000 1.4
+++ sv.c 7 Jan 2004 14:13:58 -0000 1.5
@@ -1092,7 +1092,6 @@
"Create a new PMC %p\n",lval);
*/
- return (Parrot_PMC) safemalloc(sizeof(XPVLV));
return lval;
}
@@ -1281,6 +1280,15 @@
return &(data->xlv_type);
}
+SV** Perl_macro_LvTARG (pTHX_ SV* sv) {
+ perl5lv_pmc_data* data;
+ if(!SvPMC(sv))
+ abort();
+ data = (perl5lv_pmc_data*) Parrot_PMC_get_pointer(PL_Parrot, SvANY(sv));
+ return &(data->xlv_targ);
+}
+
+
/*
=for apidoc sv_upgrade
@@ -3666,6 +3674,17 @@
SvRMAGICAL_off(dstr);
}
+
+ if(SvPMC(sstr)) {
+ (void)SvUPGRADE(dstr, SVt_PVNV);
+ PerlIO_printf(Perl_debug_log, "FOO: %s\n", Parrot_PMC_get_cstring(PL_Parrot, SvANY(sstr)));
+ sv_setpv(dstr, Parrot_PMC_get_cstring(PL_Parrot, SvANY(sstr)));
+ sv_dump(dstr);
+ return;
+
+ }
+
+
/* There's a lot of redundancy below but we're going for speed here */
switch (stype) {
@@ -5416,6 +5435,12 @@
--PL_sv_objcount; /* XXX Might want something more general */
}
}
+
+ if(SvPMC(sv)) {
+ return;
+ }
+
+
if (SvTYPE(sv) >= SVt_PVMG) {
if (SvMAGIC(sv))
mg_free(sv);
@@ -8262,6 +8287,9 @@
void
Perl_sv_taint(pTHX_ SV *sv)
{
+ if(SvPMC(sv)) {
+ return;
+ }
sv_magic((sv), Nullsv, PERL_MAGIC_taint, Nullch, 0);
}
@@ -8275,6 +8303,9 @@
void
Perl_sv_untaint(pTHX_ SV *sv)
{
+ if(SvPMC(sv)) {
+ return;
+ }
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, PERL_MAGIC_taint);
if (mg)
@@ -8292,6 +8323,10 @@
bool
Perl_sv_tainted(pTHX_ SV *sv)
{
+ if(SvPMC(sv)) {
+ return FALSE;
+ }
+
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
MAGIC *mg = mg_find(sv, PERL_MAGIC_taint);
if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
1.5 +2 -1 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- sv.h 15 Dec 2003 13:55:15 -0000 1.4
+++ sv.h 7 Jan 2004 14:13:59 -0000 1.5
@@ -791,7 +791,8 @@
#define LvTYPE(sv) ((char*)*Perl_macro_LvTYPE(aTHX_ (SV*)sv))
//#define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type
-#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ
+#define LvTARG(sv) ((SV*)*Perl_macro_LvTARG(aTHX_ (SV*)sv))
+//#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ
#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff
#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen