diff options
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | embed.h | 6 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | gv.c | 72 | ||||
| -rw-r--r-- | gv.h | 8 | ||||
| -rw-r--r-- | makedef.pl | 5 | ||||
| -rw-r--r-- | perl.c | 7 | ||||
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | sv.c | 6 |
10 files changed, 97 insertions, 22 deletions
@@ -1521,6 +1521,10 @@ ApR |bool |stashpv_hvname_match|NN const COP *cop|NN const HV *hv p |void |dump_sv_child |SV *sv #endif +#ifdef PERL_DONT_CREATE_GVSV +Ap |GV* |gv_SVadd |NN GV* gv +#endif + END_EXTERN_C /* * ex: set ts=8 sts=4 sw=4 noet: @@ -1637,6 +1637,9 @@ #define dump_sv_child Perl_dump_sv_child #endif #endif +#ifdef PERL_DONT_CREATE_GVSV +#define gv_SVadd Perl_gv_SVadd +#endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -3609,6 +3612,9 @@ #define dump_sv_child(a) Perl_dump_sv_child(aTHX_ a) #endif #endif +#ifdef PERL_DONT_CREATE_GVSV +#define gv_SVadd(a) Perl_gv_SVadd(aTHX_ a) +#endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/global.sym b/global.sym index bb974dd3a6..17d16b76bc 100644 --- a/global.sym +++ b/global.sym @@ -691,4 +691,5 @@ Perl_hv_placeholders_set Perl_gv_fetchpvn_flags Perl_gv_fetchsv Perl_stashpv_hvname_match +Perl_gv_SVadd # ex: set ro: @@ -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" @@ -42,6 +42,14 @@ Return the SV from the GV. */ #define GvSV(gv) (GvGP(gv)->gp_sv) +#ifdef PERL_DONT_CREATE_GVSV +#define GvSVn(gv) (GvGP(gv)->gp_sv ? \ + GvGP(gv)->gp_sv : \ + GvGP(gv_SVadd(gv))->gp_sv) +#else +#define GvSVn(gv) GvSV(gv) +#endif + #define GvREFCNT(gv) (GvGP(gv)->gp_refcnt) #define GvIO(gv) ((gv) && SvTYPE((SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : 0) #define GvIOp(gv) (GvGP(gv)->gp_io) diff --git a/makedef.pl b/makedef.pl index 9753100d64..bc47833ea2 100644 --- a/makedef.pl +++ b/makedef.pl @@ -789,6 +789,11 @@ unless ($define{'DEBUG_LEAKING_SCALARS_FORK_DUMP'}) { PL_dumper_fd )]; } +unless ($define{'PERL_DONT_CREATE_GVSV'}) { + skip_symbols [qw( + Perl_gv_SVadd + )]; +} unless ($define{'d_mmap'}) { skip_symbols [qw( @@ -1371,9 +1371,9 @@ S_set_caret_X(pTHX) { S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]); #else #ifdef OS2 - sv_setpv(GvSV(tmpgv), os2_execname(aTHX)); + sv_setpv(GvSVn(tmpgv), os2_execname(aTHX)); #else - sv_setpv(GvSV(tmpgv),PL_origargv[0]); + sv_setpv(GvSVn(tmpgv),PL_origargv[0]); #endif #endif } @@ -3381,6 +3381,9 @@ S_init_main_stash(pTHX) PL_replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */ GvMULTI_on(PL_replgv); (void)Perl_form(aTHX_ "%240s",""); /* Preallocate temp - for immediate signals. */ +#ifdef PERL_DONT_CREATE_GVSV + gv_SVadd(PL_errgv); +#endif sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */ sv_setpvn(ERRSV, "", 0); PL_curstash = PL_defstash; @@ -58,7 +58,7 @@ PP(pp_gvsv) if (PL_op->op_private & OPpLVAL_INTRO) PUSHs(save_scalar(cGVOP_gv)); else - PUSHs(GvSV(cGVOP_gv)); + PUSHs(GvSVn(cGVOP_gv)); RETURN; } @@ -1473,7 +1473,7 @@ Perl_do_readline(pTHX) if (av_len(GvAVn(PL_last_in_gv)) < 0) { IoFLAGS(io) &= ~IOf_START; do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp); - sv_setpvn(GvSV(PL_last_in_gv), "-", 1); + sv_setpvn(GvSVn(PL_last_in_gv), "-", 1); SvSETMAGIC(GvSV(PL_last_in_gv)); fp = IoIFP(io); goto have_fp; @@ -2991,6 +2991,12 @@ PERL_CALLCONV bool Perl_stashpv_hvname_match(pTHX_ const COP *cop, const HV *hv) PERL_CALLCONV void Perl_dump_sv_child(pTHX_ SV *sv); #endif +#ifdef PERL_DONT_CREATE_GVSV +PERL_CALLCONV GV* Perl_gv_SVadd(pTHX_ GV* gv) + __attribute__nonnull__(pTHX_1); + +#endif + END_EXTERN_C /* * ex: set ts=8 sts=4 sw=4 noet: @@ -441,7 +441,11 @@ static void do_clean_named_objs(pTHX_ SV *sv) { if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) { - if ( SvOBJECT(GvSV(sv)) || + if (( +#ifdef PERL_DONT_CREATE_GVSV + GvSV(sv) && +#endif + SvOBJECT(GvSV(sv))) || (GvAV(sv) && SvOBJECT(GvAV(sv))) || (GvHV(sv) && SvOBJECT(GvHV(sv))) || (GvIO(sv) && SvOBJECT(GvIO(sv))) || |