summaryrefslogtreecommitdiff
path: root/gv.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2005-06-29 15:58:14 +0000
committerNicholas Clark <nick@ccl4.org>2005-06-29 15:58:14 +0000
commitc69033f2a629160559f680da8e4e5a7e3c4c3a0c (patch)
treed19b6ca86b0f5cbbbb1e078ab96eac111df03dfd /gv.c
parent9dc0b5dcb80b5128172acb8c4bd670aa72142821 (diff)
downloadperl-c69033f2a629160559f680da8e4e5a7e3c4c3a0c.tar.gz
First stab at not automatically creating an unused SV for GvSV
Enable it with -DPERL_DONT_CREATE_GVSV. Currently if enabled 22 test scripts have failures, so still some way to go. p4raw-id: //depot/perl@25009
Diffstat (limited to 'gv.c')
-rw-r--r--gv.c72
1 files changed, 55 insertions, 17 deletions
diff --git a/gv.c b/gv.c
index 5fac589698..e6993ad2d2 100644
--- a/gv.c
+++ b/gv.c
@@ -37,6 +37,19 @@ Perl stores its global variables.
static const char S_autoload[] = "AUTOLOAD";
static const STRLEN S_autolen = sizeof(S_autoload)-1;
+
+#ifdef PERL_DONT_CREATE_GVSV
+GV *
+Perl_gv_SVadd(pTHX_ GV *gv)
+{
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
+ Perl_croak(aTHX_ "Bad symbol for scalar");
+ if (!GvSV(gv))
+ GvSV(gv) = NEWSV(72,0);
+ return gv;
+}
+#endif
+
GV *
Perl_gv_AVadd(pTHX_ register GV *gv)
{
@@ -96,7 +109,11 @@ Perl_gv_fetchfile(pTHX_ const char *name)
gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
if (!isGV(gv)) {
gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
- sv_setpv(GvSV(gv), name);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(gv) = newSVpvn(name, tmplen - 2);
+#else
+ sv_setpvn(GvSV(gv), name, tmplen - 2);
+#endif
if (PERLDB_LINE)
hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile);
}
@@ -124,7 +141,11 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
}
Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(gv) = 0;
+#else
GvSV(gv) = NEWSV(72,0);
+#endif
GvLINE(gv) = CopLINE(PL_curcop);
/* XXX Ideally this cast would be replaced with a change to const char*
in the struct. */
@@ -171,6 +192,14 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
case SVt_PVHV:
(void)GvHVn(gv);
break;
+#ifdef PERL_DONT_CREATE_GVSV
+ case SVt_NULL:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ break;
+ default:
+ (void)GvSVn(gv);
+#endif
}
}
@@ -546,8 +575,12 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
vargv = *(GV**)hv_fetch(varstash, S_autoload, S_autolen, TRUE);
ENTER;
- if (!isGV(vargv))
+ if (!isGV(vargv)) {
gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(vargv) = NEWSV(72,0);
+#endif
+ }
LEAVE;
varsv = GvSV(vargv);
sv_setpvn(varsv, packname, packname_len);
@@ -1001,12 +1034,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
goto ro_magicalize;
case ':':
- sv_setpv(GvSV(gv),PL_chopset);
+ sv_setpv(GvSVn(gv),PL_chopset);
goto magicalize;
case '?':
#ifdef COMPLEX_STATUS
- SvUPGRADE(GvSV(gv), SVt_PVLV);
+ SvUPGRADE(GvSVn(gv), SVt_PVLV);
#endif
goto magicalize;
@@ -1018,7 +1051,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
now (rather than going to magicalize)
*/
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
if (sv_type == SVt_PVHV)
require_errno(gv);
@@ -1038,7 +1071,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
"$%c is no longer supported", *name);
break;
case '|':
- sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
+ sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
case '+':
@@ -1059,7 +1092,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
case '8':
case '9':
ro_magicalize:
- SvREADONLY_on(GvSV(gv));
+ SvREADONLY_on(GvSVn(gv));
/* FALL THROUGH */
case '[':
case '^':
@@ -1087,19 +1120,19 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
case '\024': /* $^T */
case '\027': /* $^W */
magicalize:
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
break;
case '\014': /* $^L */
- sv_setpvn(GvSV(gv),"\f",1);
- PL_formfeed = GvSV(gv);
+ sv_setpvn(GvSVn(gv),"\f",1);
+ PL_formfeed = GvSVn(gv);
break;
case ';':
- sv_setpvn(GvSV(gv),"\034",1);
+ sv_setpvn(GvSVn(gv),"\034",1);
break;
case ']':
{
- SV * const sv = GvSV(gv);
+ SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
(void *)upg_version(PL_patchlevel);
GvSV(gv) = vnumify(PL_patchlevel);
@@ -1109,7 +1142,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
break;
case '\026': /* $^V */
{
- SV * const sv = GvSV(gv);
+ SV * const sv = GvSVn(gv);
GvSV(gv) = new_version(PL_patchlevel);
SvREADONLY_on(GvSV(gv));
SvREFCNT_dec(sv);
@@ -1379,6 +1412,11 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
if (!gv)
lim = DESTROY_amg; /* Skip overloading entries. */
+#ifdef PERL_DONT_CREATE_GVSV
+ else if (!sv) {
+ /* Equivalent to !SvTRUE and !SvOK */
+ }
+#endif
else if (SvTRUE(sv))
amt.fallback=AMGfallYES;
else if (SvOK(sv))
@@ -1414,17 +1452,17 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
GV *ngv = Nullgv;
+ SV *gvsv = GvSV(gv);
DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
"\" for overloaded \"%s\" in package \"%.256s\"\n",
GvSV(gv), cp, hvname) );
- if (!SvPOK(GvSV(gv))
- || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(GvSV(gv)),
+ if (!gvsv || !SvPOK(gvsv)
+ || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv),
FALSE)))
{
/* Can be an import stub (created by "can"). */
- SV *gvsv = GvSV(gv);
- const char * const name = SvPOK(gvsv) ? SvPVX_const(gvsv) : "???";
+ const char * const name = (gvsv && SvPOK(gvsv)) ? SvPVX_const(gvsv) : "???";
Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\
"in package \"%.256s\"",
(GvCVGEN(gv) ? "Stub found while resolving"