(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
(int)(PL_dumpindent*level), "");
- if (!((flags & SVpad_NAME) == SVpad_NAME
- && (type == SVt_PVMG || type == SVt_PVNV))) {
- if ((flags & SVs_PADSTALE))
+ if ((flags & SVs_PADSTALE))
sv_catpv(d, "PADSTALE,");
- }
- if (!((flags & SVpad_NAME) == SVpad_NAME && type == SVt_PVMG)) {
- if ((flags & SVs_PADTMP))
+ if ((flags & SVs_PADTMP))
sv_catpv(d, "PADTMP,");
- }
append_flags(d, flags, first_sv_flags_names);
if (flags & SVf_ROK) {
sv_catpv(d, "ROK,");
case SVt_PVMG:
if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
if (SvVALID(sv)) sv_catpv(d, "VALID,");
- if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
- if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
/* FALLTHROUGH */
- case SVt_PVNV:
- if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
goto evaled_or_uv;
case SVt_PVAV:
break;
PerlIO_putc(file, '\n');
}
- if ((type == SVt_PVNV || type == SVt_PVMG)
- && (SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME) {
- Perl_dump_indent(aTHX_ level, file, " COP_LOW = %"UVuf"\n",
- (UV) COP_SEQ_RANGE_LOW(sv));
- Perl_dump_indent(aTHX_ level, file, " COP_HIGH = %"UVuf"\n",
- (UV) COP_SEQ_RANGE_HIGH(sv));
- } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
+ if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
|| type == SVt_NV) {
}
if (type >= SVt_PVMG) {
- if (type == SVt_PVMG && SvPAD_OUR(sv)) {
- HV * const ost = SvOURSTASH(sv);
- if (ost)
- do_hv_dump(level, file, " OURSTASH", ost);
- } else {
- if (SvMAGIC(sv))
+ if (SvMAGIC(sv))
do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
- }
if (SvSTASH(sv))
do_hv_dump(level, file, " STASH", SvSTASH(sv));
ApaR |HV* |newHVhv |NULLOK HV *hv
Apabm |IO* |newIO
Apda |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
+AMpda |PADNAME *|newPADNAMEouter|NN PADNAME *outer
+AMpda |PADNAME *|newPADNAMEpvn|NN const char *s|STRLEN len
AMpda |PADNAMELIST *|newPADNAMELIST|size_t max
#ifdef USE_ITHREADS
Apda |OP* |newPADOP |I32 type|I32 flags|NN SV* sv
Xop |void |padnamelist_free|NN PADNAMELIST *pnl
AMpd |PADNAME **|padnamelist_store|NN PADNAMELIST *pnl|SSize_t key \
|NULLOK PADNAME *val
+Xop |void |padname_free |NN PADNAME *pn
#if defined(USE_ITHREADS)
+pdR |PADNAME *|padname_dup |NN PADNAME *src|NN CLONE_PARAMS *param
pR |PADNAMELIST *|padnamelist_dup|NN PADNAMELIST *srcpad \
|NN CLONE_PARAMS *param
pdR |PADLIST *|padlist_dup |NN PADLIST *srcpad \
#define newNULLLIST() Perl_newNULLLIST(aTHX)
#define newOP(a,b) Perl_newOP(aTHX_ a,b)
#define newPADNAMELIST(a) Perl_newPADNAMELIST(aTHX_ a)
+#define newPADNAMEouter(a) Perl_newPADNAMEouter(aTHX_ a)
+#define newPADNAMEpvn(a,b) Perl_newPADNAMEpvn(aTHX_ a,b)
#define newPMOP(a,b) Perl_newPMOP(aTHX_ a,b)
#define newPROG(a) Perl_newPROG(aTHX_ a)
#define newPVOP(a,b,c) Perl_newPVOP(aTHX_ a,b,c)
# if defined(USE_ITHREADS)
#define mro_meta_dup(a,b) Perl_mro_meta_dup(aTHX_ a,b)
#define padlist_dup(a,b) Perl_padlist_dup(aTHX_ a,b)
+#define padname_dup(a,b) Perl_padname_dup(aTHX_ a,b)
#define padnamelist_dup(a,b) Perl_padnamelist_dup(aTHX_ a,b)
# endif
# if defined(USE_LOCALE) && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX))
typedef PADLIST *B__PADLIST;
#endif
typedef PADNAMELIST *B__PADNAMELIST;
+typedef PADNAME *B__PADNAME;
#ifdef MULTIPLICITY
#define IV_uvx_ix sv_UVp | STRUCT_OFFSET(struct xpvuv, xuv_uv)
#define NV_nvx_ix sv_NVp | STRUCT_OFFSET(struct xpvnv, xnv_u.xnv_nv)
-#define NV_cop_seq_range_low_ix \
- sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
-#define NV_cop_seq_range_high_ix \
- sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
-#define NV_parent_pad_index_ix \
- sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
-#define NV_parent_fakelex_flags_ix \
- sv_U32p | STRUCT_OFFSET(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
-
#define PV_cur_ix sv_STRLENp | STRUCT_OFFSET(struct xpv, xpv_cur)
#define PV_len_ix sv_STRLENp | STRUCT_OFFSET(struct xpv, xpv_len)
B::IV::IVX = IV_ivx_ix
B::IV::UVX = IV_uvx_ix
B::NV::NVX = NV_nvx_ix
- B::NV::COP_SEQ_RANGE_LOW = NV_cop_seq_range_low_ix
- B::NV::COP_SEQ_RANGE_HIGH = NV_cop_seq_range_high_ix
- B::NV::PARENT_PAD_INDEX = NV_parent_pad_index_ix
- B::NV::PARENT_FAKELEX_FLAGS = NV_parent_fakelex_flags_ix
B::PV::CUR = PV_cur_ix
B::PV::LEN = PV_len_ix
B::PVMG::SvSTASH = PVMG_stash_ix
PADNAME **padp = PadnamelistARRAY(pnl);
SSize_t i = 0;
for (; i <= PadnamelistMAX(pnl); i++)
- XPUSHs(make_sv_object(aTHX_ padp[i]));
+ {
+ SV *rv = sv_newmortal();
+ sv_setiv(newSVrv(rv,padp[i] ? "B::PADNAME" : "B::SPECIAL"),
+ PTR2IV(padp[i]));
+ XPUSHs(rv);
+ }
}
-void
+B::PADNAME
PadnamelistARRAYelt(pnl, idx)
B::PADNAMELIST pnl
SSize_t idx
- PPCODE:
+ CODE:
if (idx < 0 || idx > PadnamelistMAX(pnl))
- XPUSHs(make_sv_object(aTHX_ NULL));
+ RETVAL = NULL;
else
- XPUSHs(make_sv_object(aTHX_
- (SV *)PadnamelistARRAY(pnl)[idx]));
+ RETVAL = PadnamelistARRAY(pnl)[idx];
+ OUTPUT:
+ RETVAL
U32
PadnamelistREFCNT(pnl)
B::PADNAMELIST pnl
+
+MODULE = B PACKAGE = B::PADNAME PREFIX = Padname
+
+#define PN_type_ix \
+ sv_SVp | STRUCT_OFFSET(struct padname,xpadn_type_u.xpadn_typestash)
+#define PN_ourstash_ix \
+ sv_SVp | STRUCT_OFFSET(struct padname,xpadn_ourstash)
+#define PN_len_ix \
+ sv_U8p | STRUCT_OFFSET(struct padname,xpadn_len)
+#define PN_refcnt_ix \
+ sv_U32p | STRUCT_OFFSET(struct padname, xpadn_refcnt)
+#define PN_cop_seq_range_low_ix \
+ sv_U32p | STRUCT_OFFSET(struct padname, xpadn_low)
+#define PN_cop_seq_range_high_ix \
+ sv_U32p | STRUCT_OFFSET(struct padname, xpadn_high)
+#define PN_parent_pad_index_ix \
+ sv_U32p | STRUCT_OFFSET(struct padname, xpadn_low)
+#define PN_parent_fakelex_flags_ix \
+ sv_U32p | STRUCT_OFFSET(struct padname, xpadn_high)
+
+void
+PadnameTYPE(pn)
+ B::PADNAME pn
+ ALIAS:
+ B::PADNAME::TYPE = PN_type_ix
+ B::PADNAME::OURSTASH = PN_ourstash_ix
+ B::PADNAME::LEN = PN_len_ix
+ B::PADNAME::REFCNT = PN_refcnt_ix
+ B::PADNAME::COP_SEQ_RANGE_LOW = PN_cop_seq_range_low_ix
+ B::PADNAME::COP_SEQ_RANGE_HIGH = PN_cop_seq_range_high_ix
+ B::PADNAME::PARENT_PAD_INDEX = PN_parent_pad_index_ix
+ B::PADNAME::PARENT_FAKELEX_FLAGS = PN_parent_fakelex_flags_ix
+ PREINIT:
+ char *ptr;
+ SV *ret;
+ PPCODE:
+ ptr = (ix & 0xFFFF) + (char *)pn;
+ switch ((U8)(ix >> 16)) {
+ case (U8)(sv_SVp >> 16):
+ ret = make_sv_object(aTHX_ *((SV **)ptr));
+ break;
+ case (U8)(sv_U32p >> 16):
+ ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
+ break;
+ case (U8)(sv_U8p >> 16):
+ ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
+ break;
+ default:
+ NOT_REACHED;
+ }
+ ST(0) = ret;
+ XSRETURN(1);
+
+SV *
+PadnamePV(pn)
+ B::PADNAME pn
+ PREINIT:
+ dXSTARG;
+ PPCODE:
+ PERL_UNUSED_ARG(RETVAL);
+ sv_setpvn(TARG, PadnamePV(pn), PadnameLEN(pn));
+ SvUTF8_on(TARG);
+ XPUSHTARG;
+
+BOOT:
+{
+ /* Uses less memory than an ALIAS. */
+ GV *gv = gv_fetchpvs("B::PADNAME::TYPE", 1, SVt_PVGV);
+ sv_setsv((SV *)gv_fetchpvs("B::PADNAME::SvSTASH",1,SVt_PVGV),(SV *)gv);
+ sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PROTOCV",1,SVt_PVGV),(SV *)gv);
+ sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PVX",1,SVt_PVGV),
+ (SV *)gv_fetchpvs("B::PADNAME::PV" ,1,SVt_PVGV));
+}
+
+U32
+PadnameFLAGS(pn)
+ B::PADNAME pn
+ CODE:
+ RETVAL = PadnameFLAGS(pn);
+ /* backward-compatibility hack, which should be removed if the
+ flags field becomes large enough to hold SVf_FAKE (and
+ PADNAMEt_OUTER should be renumbered to match SVf_FAKE) */
+ assert(SVf_FAKE >= 1<<(sizeof(PadnameFLAGS(pn)) * 8));
+ if (PadnameOUTER(pn))
+ RETVAL |= SVf_FAKE;
+ OUTPUT:
+ RETVAL
for ($i = 0; $i < $count; $i++) {
my $sv = $els[$i];
if (class($sv) ne "SPECIAL") {
- printf $walkHandle "$i: %s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX;
+ printf $walkHandle "$i: (0x%lx) %s\n",
+ $$sv, $sv->PVX // "undef" || "const";
} else {
printf $walkHandle "$i: %s\n", $sv->terse;
#printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv);
my ($newlex, $nosp1); # rendering state vars
+sub padname_terse {
+ my $name = shift;
+ return $name->terse if class($name) eq 'SPECIAL';
+ my $str = $name->PVX;
+ return sprintf "(0x%lx) %s",
+ $$name,
+ length $str ? qq'"$str"' : defined $str ? "const" : 'undef';
+}
+
sub newlex { # drop-in for showlex
my ($objname, $names, $vals) = @_;
my @names = $names->ARRAY;
my @vals = $vals->ARRAY;
my $count = @names;
print $walkHandle "$objname Pad has $count entries\n";
- printf $walkHandle "0: %s\n", $names[0]->terse unless $nosp1;
+ printf $walkHandle "0: %s\n", padname_terse($names[0]) unless $nosp1;
for (my $i = 1; $i < $count; $i++) {
- printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse
- unless $nosp1 and $names[$i]->terse =~ /SPECIAL/;
+ printf $walkHandle "$i: %s = %s\n", padname_terse($names[$i]),
+ $vals[$i]->terse,
+ unless $nosp1
+ and class($names[$i]) eq 'SPECIAL' || !$names[$i]->LEN;
}
}
}
my @names = ({ name => 'HEf_SVKEY', macro => 1, type => "IV" },
- qw(SVTYPEMASK SVt_PVGV SVt_PVHV PAD_FAKELEX_ANON PAD_FAKELEX_MULTI));
+ qw(SVTYPEMASK SVt_PVGV SVt_PVHV PAD_FAKELEX_ANON
+ PAD_FAKELEX_MULTI SVpad_STATE SVpad_TYPED SVpad_OUR));
my @depend;
['op.h'],
['opcode.h', 'OPp'],
['op_reg_common.h','(?:(?:RXf_)?PMf_)'],
+ ['pad.h','PADNAMEt_'],
['regexp.h','RXf_'],
['sv.h', 'SV(?:[fps]|pad)_'],
) {
ok "# use5005threads: test skipped\n";
} else {
$a = `$^X $path "-MO=Showlex" -e "my \@one" 2>&1`;
- like ($a, qr/sv_undef.*PVNV.*\@one.*Nullsv.*AV/s,
+ like ($a, qr/undef.*: \([^)]*\) \@one.*Nullsv.*AV/s,
"canonical usage works");
}
sub padrep {
my ($varname,$newlex) = @_;
return ($newlex)
- ? 'PVNV \(0x[0-9a-fA-F]+\) "\\'.$varname.'" = '
- : "PVNV \\\(0x[0-9a-fA-F]+\\\) \\$varname\n";
+ ? '\(0x[0-9a-fA-F]+\) "\\'.$varname.'" = '
+ : "\\\(0x[0-9a-fA-F]+\\\) \\$varname\n";
}
for $newlex ('', '-newlex') {
SAVEFREESV(sv);
}
else if (allow_lex && type == OP_PADSV) {
- if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE)
+ if (PAD_COMPNAME_FLAGS(o->op_targ) & PADNAMEt_OUTER)
{
sv = &PL_sv_undef; /* an arbitrary non-null value */
padsv = TRUE;
else if (PadnameIsSTATE(name) || CvDEPTH(outcv))
cv = *spot;
else {
- MAGIC *mg;
- SvUPGRADE((SV *)name, SVt_PVMG);
- mg = mg_find((SV *)name, PERL_MAGIC_proto);
assert (SvTYPE(*spot) == SVt_PVCV);
if (CvNAMED(*spot))
hek = CvNAME_HEK(*spot);
);
CvLEXICAL_on(*spot);
}
- if (mg) {
- assert(mg->mg_obj);
- cv = (CV *)mg->mg_obj;
- }
- else {
- sv_magic((SV *)name, &PL_sv_undef, PERL_MAGIC_proto, NULL, 0);
- mg = mg_find((SV *)name, PERL_MAGIC_proto);
- }
- spot = (CV **)(svspot = &mg->mg_obj);
+ cv = PadnamePROTOCV(name);
+ svspot = (SV **)(spot = &PadnamePROTOCV(name));
}
if (block) {
[off = PARENT_PAD_INDEX(name)];
}
assert(!PadnameIsOUR(name));
- if (!PadnameIsSTATE(name) && SvMAGICAL(name)) {
- MAGIC * mg = mg_find((SV *)name, PERL_MAGIC_proto);
- assert(mg);
- assert(mg->mg_obj);
- return (CV *)mg->mg_obj;
+ if (!PadnameIsSTATE(name) && PadnamePROTOCV(name)) {
+ return PadnamePROTOCV(name);
}
return (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off];
}
#include "keywords.h"
#define COP_SEQ_RANGE_LOW_set(sv,val) \
- STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
+ STMT_START { (sv)->xpadn_low = (val); } STMT_END
#define COP_SEQ_RANGE_HIGH_set(sv,val) \
- STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
+ STMT_START { (sv)->xpadn_high = (val); } STMT_END
-#define PARENT_PAD_INDEX_set(sv,val) \
- STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
-#define PARENT_FAKELEX_FLAGS_set(sv,val) \
- STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
+#define PARENT_PAD_INDEX_set COP_SEQ_RANGE_LOW_set
+#define PARENT_FAKELEX_FLAGS_set COP_SEQ_RANGE_HIGH_set
#ifdef DEBUGGING
void
else {
av_store(pad, 0, NULL);
padname = newPADNAMELIST(0);
- padnamelist_store(padname, 0, &PL_sv_undef);
+ padnamelist_store(padname, 0, &PL_padname_undef);
}
/* Most subroutines never recurse, hence only need 2 entries in the padlist
ASSERT_CURPAD_ACTIVE("pad_alloc_name");
if (typestash) {
- assert(SvTYPE(name) == SVt_PVMG);
SvPAD_TYPED_on(name);
- SvSTASH_set(name, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+ PadnameTYPE(name) =
+ MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash)));
}
if (ourstash) {
SvPAD_OUR_on(name);
SvPAD_STATE_on(name);
}
- padnamelist_store(PL_comppad_name, offset, (SV *)name);
+ padnamelist_store(PL_comppad_name, offset, name);
PadnamelistMAXNAMED(PL_comppad_name) = offset;
return offset;
}
Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
- name = (PADNAME *)
- newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
-
- sv_setpvn((SV *)name, namepv, namelen);
- SvUTF8_on(name);
+ name = newPADNAMEpvn(namepv, namelen);
if ((flags & padadd_NO_DUP_CHECK) == 0) {
ENTER;
- SAVEFREESV(name); /* in case of fatal warnings */
+ SAVEFREEPADNAME(name); /* in case of fatal warnings */
/* check for duplicate declaration */
pad_check_dup(name, flags & padadd_OUR, ourstash);
- SvREFCNT_inc_simple_void_NN(name);
+ PadnameREFCNT(name)++;
LEAVE;
}
break;
}
if (konst) {
- padnamelist_store(PL_comppad_name, retval, &PL_sv_no);
+ padnamelist_store(PL_comppad_name, retval, &PL_padname_const);
tmptype &= ~SVf_READONLY;
tmptype |= SVs_PADTMP;
}
Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
{
PADOFFSET ix;
- SV* const name = newSV_type(SVt_PVNV);
+ PADNAME * const name = newPADNAMEpvn("&", 1);
PERL_ARGS_ASSERT_PAD_ADD_ANON;
pad_peg("add_anon");
- sv_setpvs(name, "&");
/* These two aren't used; just make sure they're not equal to
- * PERL_PADSEQ_INTRO */
- COP_SEQ_RANGE_LOW_set(name, 0);
- COP_SEQ_RANGE_HIGH_set(name, 0);
+ * PERL_PADSEQ_INTRO. They should be 0 by default. */
+ assert(COP_SEQ_RANGE_LOW (name) != PERL_PADSEQ_INTRO);
+ assert(COP_SEQ_RANGE_HIGH(name) != PERL_PADSEQ_INTRO);
ix = pad_alloc(optype, SVs_PADMY);
padnamelist_store(PL_comppad_name, ix, name);
/* XXX DAPM use PL_curpad[] ? */
type as the source, independent of the flags set, and on it being
"good" and only copying flag bits and pointers that it understands.
*/
- PADNAME *new_name = (PADNAME *)newSVsv((SV *)*out_name);
+ PADNAME *new_name = newPADNAMEouter(*out_name);
PADNAMELIST * const ocomppad_name = PL_comppad_name;
PAD * const ocomppad = PL_comppad;
PL_comppad_name = PadlistNAMES(padlist);
PadnameOURSTASH(*out_name)
);
- SvFAKE_on(new_name);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad addname: %ld \"%.*s\" FAKE\n",
(long)new_offset,
if (PadnamelistARRAY(PL_comppad_name)[po]) {
assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
}
- PadnamelistARRAY(PL_comppad_name)[po] = (PADNAME *)&PL_sv_undef;
+ PadnamelistARRAY(PL_comppad_name)[po] = &PL_padname_undef;
}
/* Use PL_constpadix here, not PL_padix. The latter may have been
reset by pad_reset. We don’t want pad_alloc to have to scan the
PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name);
PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
- if (!namep[ix]) namep[ix] = &PL_sv_undef;
+ if (!namep[ix]) namep[ix] = &PL_padname_undef;
if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix]))
continue;
- if (SvPADMY(PL_curpad[ix]) && !SvFAKE(namep[ix])) {
+ if (SvPADMY(PL_curpad[ix]) && !PadnameOUTER(namep[ix])) {
/* This is a work around for how the current implementation of
?{ } blocks in regexps interacts with lexicals.
I32 ix;
PADNAMELIST * const comppad_name = PadlistNAMES(padlist);
AV * const comppad = PadlistARRAY(padlist)[1];
- SV ** const namepad = PadnamelistARRAY(comppad_name);
+ PADNAME ** const namepad = PadnamelistARRAY(comppad_name);
SV ** const curpad = AvARRAY(comppad);
PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
PERL_UNUSED_ARG(old_cv);
for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) {
- const SV * const namesv = namepad[ix];
- if (namesv && namesv != &PL_sv_undef && !SvPAD_STATE(namesv)
- && *SvPVX_const(namesv) == '&')
+ const PADNAME * const name = namepad[ix];
+ if (name && name != &PL_padname_undef && !PadnameIsSTATE(name)
+ && *PadnamePV(name) == '&')
{
if (SvTYPE(curpad[ix]) == SVt_PVCV) {
- MAGIC * const mg =
- SvMAGICAL(curpad[ix])
- ? mg_find(curpad[ix], PERL_MAGIC_proto)
- : NULL;
- CV * const innercv = MUTABLE_CV(mg ? mg->mg_obj : curpad[ix]);
+ /* XXX 0afba48f added code here to check for a proto CV
+ attached to the pad entry by magic. But shortly there-
+ after 81df9f6f95 moved the magic to the pad name. The
+ code here was never updated, so it wasn’t doing anything
+ and got deleted when PADNAME became a distinct type. Is
+ there any bug as a result? */
+ CV * const innercv = MUTABLE_CV(curpad[ix]);
if (CvOUTSIDE(innercv) == old_cv) {
if (!CvWEAKOUTSIDE(innercv)) {
SvREFCNT_dec(old_cv);
PadnamelistMAX(pnl) = key;
}
ary = PadnamelistARRAY(pnl);
- SvREFCNT_dec(ary[key]);
+ if (ary[key])
+ PadnameREFCNT_dec(ary[key]);
ary[key] = val;
return &ary[key];
}
PERL_ARGS_ASSERT_PADNAMELIST_FREE;
if (!--PadnamelistREFCNT(pnl)) {
while(PadnamelistMAX(pnl) >= 0)
- SvREFCNT_dec(PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--]);
+ {
+ PADNAME * const pn =
+ PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--];
+ if (pn)
+ PadnameREFCNT_dec(pn);
+ }
Safefree(PadnamelistARRAY(pnl));
Safefree(pnl);
}
ptr_table_store(PL_ptr_table, srcpad, dstpad);
for (; max >= 0; max--)
+ if (PadnamelistARRAY(srcpad)[max]) {
PadnamelistARRAY(dstpad)[max] =
- sv_dup_inc(PadnamelistARRAY(srcpad)[max], param);
+ padname_dup(PadnamelistARRAY(srcpad)[max], param);
+ PadnameREFCNT(PadnamelistARRAY(dstpad)[max])++;
+ }
return dstpad;
}
#endif /* USE_ITHREADS */
+/*
+=for apidoc newPADNAMEpvn
+
+Constructs and returns a new pad name. I<s> must be a UTF8 string. Do not
+use this for pad names that point to outer lexicals. See
+L</newPADNAMEouter>.
+
+=cut
+*/
+
+PADNAME *
+Perl_newPADNAMEpvn(pTHX_ const char *s, STRLEN len)
+{
+ struct padname_with_str *alloc;
+ char *alloc2; /* for Newxz */
+ PADNAME *pn;
+ PERL_ARGS_ASSERT_NEWPADNAMEPVN;
+ Newxz(alloc2,
+ STRUCT_OFFSET(struct padname_with_str, xpadn_str[0]) + len + 1,
+ char);
+ alloc = (struct padname_with_str *)alloc2;
+ pn = (PADNAME *)alloc;
+ PadnameREFCNT(pn) = 1;
+ PadnamePV(pn) = alloc->xpadn_str;
+ Copy(s, PadnamePV(pn), len, char);
+ *(PadnamePV(pn) + len) = '\0';
+ PadnameLEN(pn) = len;
+ return pn;
+}
+
+/*
+=for apidoc newPADNAMEouter
+
+Constructs and returns a new pad name. Only use this function for names
+that refer to outer lexicals. (See also L</newPADNAMEpvn>.) I<outer> is
+the outer pad name that this one mirrors. The returned pad name has the
+PADNAMEt_OUTER flag already set.
+
+=cut
+*/
+
+PADNAME *
+Perl_newPADNAMEouter(pTHX_ PADNAME *outer)
+{
+ PADNAME *pn;
+ PERL_ARGS_ASSERT_NEWPADNAMEOUTER;
+ Newxz(pn, 1, PADNAME);
+ PadnameREFCNT(pn) = 1;
+ PadnamePV(pn) = PadnamePV(outer);
+ /* Not PadnameREFCNT(outer), because ‘outer’ may itself close over
+ another entry. The original pad name owns the buffer. */
+ PadnameREFCNT(PADNAME_FROM_PV(PadnamePV(outer)))++;
+ PadnameFLAGS(pn) = PADNAMEt_OUTER;
+ PadnameLEN(pn) = PadnameLEN(outer);
+ return pn;
+}
+
+void
+Perl_padname_free(pTHX_ PADNAME *pn)
+{
+ PERL_ARGS_ASSERT_PADNAME_FREE;
+ if (!--PadnameREFCNT(pn)) {
+ if (UNLIKELY(pn == &PL_padname_undef || pn == &PL_padname_const)) {
+ PadnameREFCNT(pn) = SvREFCNT_IMMORTAL;
+ return;
+ }
+ SvREFCNT_dec(PadnameTYPE(pn)); /* Takes care of protocv, too. */
+ SvREFCNT_dec(PadnameOURSTASH(pn));
+ if (PadnameOUTER(pn))
+ PadnameREFCNT_dec(PADNAME_FROM_PV(PadnamePV(pn)));
+ Safefree(pn);
+ }
+}
+
+#if defined(USE_ITHREADS)
+
+/*
+=for apidoc padname_dup
+
+Duplicates a pad name.
+
+=cut
+*/
+
+PADNAME *
+Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param)
+{
+ PADNAME *dst;
+
+ PERL_ARGS_ASSERT_PADNAME_DUP;
+
+ /* look for it in the table first */
+ dst = (PADNAME *)ptr_table_fetch(PL_ptr_table, src);
+ if (dst)
+ return dst;
+
+ if (!PadnamePV(src)) {
+ dst = &PL_padname_undef;
+ ptr_table_store(PL_ptr_table, src, dst);
+ return dst;
+ }
+
+ dst = PadnameOUTER(src)
+ ? newPADNAMEouter(padname_dup(PADNAME_FROM_PV(PadnamePV(src)), param))
+ : newPADNAMEpvn(PadnamePV(src), PadnameLEN(src));
+ ptr_table_store(PL_ptr_table, src, dst);
+ PadnameLEN(dst) = PadnameLEN(src);
+ PadnameFLAGS(dst) = PadnameFLAGS(src);
+ PadnameREFCNT(dst) = 0; /* The caller will increment it. */
+ PadnameTYPE (dst) = (HV *)sv_dup_inc((SV *)PadnameTYPE(src), param);
+ PadnameOURSTASH(dst) = (HV *)sv_dup_inc((SV *)PadnameOURSTASH(src),
+ param);
+ dst->xpadn_low = src->xpadn_low;
+ dst->xpadn_high = src->xpadn_high;
+ dst->xpadn_gen = src->xpadn_gen;
+ return dst;
+}
+
+#endif /* USE_ITHREADS */
/*
* Local variables:
U32 xpadnl_refcnt;
};
+struct padname {
+ char * xpadn_pv;
+ HV * xpadn_ourstash;
+ union {
+ HV * xpadn_typestash;
+ CV * xpadn_protocv;
+ } xpadn_type_u;
+ U32 xpadn_low;
+ U32 xpadn_high;
+ U32 xpadn_refcnt;
+ int xpadn_gen;
+ U8 xpadn_len;
+ U8 xpadn_flags;
+};
+
+struct padname_with_str {
+ struct padname xpadn_padname;
+ char xpadn_str[1];
+};
+
+#define PADNAME_FROM_PV(s) \
+ ((PADNAME *)((s) - STRUCT_OFFSET(struct padname_with_str, xpadn_str)))
+
/* a value that PL_cop_seqmax is guaranteed never to be,
* flagging that a lexical is being introduced, or has not yet left scope
/* Low range end is exclusive (valid from the cop seq after this one) */
/* High range end is inclusive (valid up to this cop seq) */
-#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define COP_SEQ_RANGE_LOW(sv) \
- (({ const SV *const _sv_cop_seq_range_low = (const SV *) (sv); \
- assert(SvTYPE(_sv_cop_seq_range_low) == SVt_NV \
- || SvTYPE(_sv_cop_seq_range_low) >= SVt_PVNV); \
- assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVAV); \
- assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVHV); \
- assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVCV); \
- assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVFM); \
- assert(!isGV_with_GP(_sv_cop_seq_range_low)); \
- ((XPVNV*) MUTABLE_PTR(SvANY(_sv_cop_seq_range_low)))->xnv_u.xpad_cop_seq.xlow; \
- }))
-# define COP_SEQ_RANGE_HIGH(sv) \
- (({ const SV *const _sv_cop_seq_range_high = (const SV *) (sv); \
- assert(SvTYPE(_sv_cop_seq_range_high) == SVt_NV \
- || SvTYPE(_sv_cop_seq_range_high) >= SVt_PVNV); \
- assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVAV); \
- assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVHV); \
- assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVCV); \
- assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVFM); \
- assert(!isGV_with_GP(_sv_cop_seq_range_high)); \
- ((XPVNV*) MUTABLE_PTR(SvANY(_sv_cop_seq_range_high)))->xnv_u.xpad_cop_seq.xhigh; \
- }))
-# define PARENT_PAD_INDEX(sv) \
- (({ const SV *const _sv_parent_pad_index = (const SV *) (sv); \
- assert(SvTYPE(_sv_parent_pad_index) == SVt_NV \
- || SvTYPE(_sv_parent_pad_index) >= SVt_PVNV); \
- assert(SvTYPE(_sv_parent_pad_index) != SVt_PVAV); \
- assert(SvTYPE(_sv_parent_pad_index) != SVt_PVHV); \
- assert(SvTYPE(_sv_parent_pad_index) != SVt_PVCV); \
- assert(SvTYPE(_sv_parent_pad_index) != SVt_PVFM); \
- assert(!isGV_with_GP(_sv_parent_pad_index)); \
- ((XPVNV*) MUTABLE_PTR(SvANY(_sv_parent_pad_index)))->xnv_u.xpad_cop_seq.xlow; \
- }))
-# define PARENT_FAKELEX_FLAGS(sv) \
- (({ const SV *const _sv_parent_fakelex_flags = (const SV *) (sv); \
- assert(SvTYPE(_sv_parent_fakelex_flags) == SVt_NV \
- || SvTYPE(_sv_parent_fakelex_flags) >= SVt_PVNV); \
- assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVAV); \
- assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVHV); \
- assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVCV); \
- assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVFM); \
- assert(!isGV_with_GP(_sv_parent_fakelex_flags)); \
- ((XPVNV*) MUTABLE_PTR(SvANY(_sv_parent_fakelex_flags)))->xnv_u.xpad_cop_seq.xhigh; \
- }))
-#else
-# define COP_SEQ_RANGE_LOW(sv) \
- (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow))
-# define COP_SEQ_RANGE_HIGH(sv) \
- (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh))
-
-
-# define PARENT_PAD_INDEX(sv) \
- (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow))
-# define PARENT_FAKELEX_FLAGS(sv) \
- (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh))
-#endif
+#define COP_SEQ_RANGE_LOW(pn) (pn)->xpadn_low
+#define COP_SEQ_RANGE_HIGH(pn) (pn)->xpadn_high
+#define PARENT_PAD_INDEX(pn) (pn)->xpadn_low
+#define PARENT_FAKELEX_FLAGS(pn) (pn)->xpadn_high
/* Flags set in the SvIVX field of FAKE namesvs */
Whether PadnamePV is in UTF8. Currently, this is always true.
=for apidoc Amx|SV *|PadnameSV|PADNAME pn
-Returns the pad name as an SV. This is currently just C<pn>. It will
-begin returning a new mortal SV if pad names ever stop being SVs.
+Returns the pad name as a mortal SV.
=for apidoc m|bool|PadnameIsOUR|PADNAME pn
Whether this is an "our" variable.
The stash associated with a typed lexical. This returns the %Foo:: hash
for C<my Foo $bar>.
+=for apidoc Amx|SSize_t|PadnameREFCNT|PADNAME pn
+The reference count of the pad name.
+
+=for apidoc Amx|void|PadnameREFCNT_dec|PADNAME pn
+Lowers the reference count of the pad name.
+
=for apidoc m|SV *|PAD_SETSV |PADOFFSET po|SV* sv
Set the slot at offset C<po> in the current pad to C<sv>
#define PadARRAY(pad) AvARRAY(pad)
#define PadMAX(pad) AvFILLp(pad)
-#define PadnamePV(pn) (SvPOKp(pn) ? SvPVX_const(pn) : NULL)
-#define PadnameLEN(pn) ((SV*)(pn) == &PL_sv_undef ? 0 : SvCUR(pn))
-#define PadnameUTF8(pn) (assert_(SvUTF8(pn)) 1)
-#define PadnameSV(pn) pn
-#define PadnameIsOUR(pn) !!SvPAD_OUR(pn)
-#define PadnameOURSTASH(pn) SvOURSTASH(pn)
-#define PadnameOUTER(pn) !!SvFAKE(pn)
-#define PadnameIsSTATE(pn) !!SvPAD_STATE(pn)
-#define PadnameTYPE(pn) (SvPAD_TYPED(pn) ? SvSTASH(pn) : NULL)
-#define PadnameLVALUE(pn) \
- ((SvFLAGS(pn) & (SVpad_NAME|SVpad_LVALUE))==(SVpad_NAME|SVpad_LVALUE))
-
-#define PadnameLVALUE_on(pn) (SvFLAGS(pn) |= SVpad_NAME|SVpad_LVALUE)
+#define PadnamePV(pn) (pn)->xpadn_pv
+#define PadnameLEN(pn) (pn)->xpadn_len
+#define PadnameUTF8(pn) 1
+#define PadnameSV(pn) \
+ newSVpvn_flags(PadnamePV(pn), PadnameLEN(pn), SVs_TEMP|SVf_UTF8)
+#define PadnameFLAGS(pn) (pn)->xpadn_flags
+#define PadnameIsOUR(pn) (!!(pn)->xpadn_ourstash)
+#define PadnameOURSTASH(pn) (pn)->xpadn_ourstash
+#define PadnameTYPE(pn) (pn)->xpadn_type_u.xpadn_typestash
+#define PadnamePROTOCV(pn) (pn)->xpadn_type_u.xpadn_protocv
+#define PadnameREFCNT(pn) (pn)->xpadn_refcnt
+#define PadnameREFCNT_dec(pn) Perl_padname_free(aTHX_ pn)
+#define PadnameOURSTASH_set(pn,s) (PadnameOURSTASH(pn) = (s))
+#define PadnameTYPE_set(pn,s) (PadnameTYPE(pn) = (s))
+#define PadnameOUTER(pn) (PadnameFLAGS(pn) & PADNAMEt_OUTER)
+#define PadnameIsSTATE(pn) (PadnameFLAGS(pn) & PADNAMEt_STATE)
+#define PadnameLVALUE(pn) (PadnameFLAGS(pn) & PADNAMEt_LVALUE)
+
+#define PadnameLVALUE_on(pn) (PadnameFLAGS(pn) |= PADNAMEt_LVALUE)
+#define PadnameIsSTATE_on(pn) (PadnameFLAGS(pn) |= PADNAMEt_STATE)
+
+#define PADNAMEt_OUTER 1 /* outer lexical var */
+#define PADNAMEt_STATE 2 /* state var */
+#define PADNAMEt_LVALUE 4 /* used as lvalue */
+#define PADNAMEt_TYPED 8 /* for B; unused by core */
+#define PADNAMEt_OUR 16 /* for B; unused by core */
+
+/* backward compatibility */
+#define SvPAD_STATE PadnameIsSTATE
+#define SvPAD_TYPED(pn) (!!PadnameTYPE(pn))
+#define SvPAD_OUR(pn) (!!PadnameOURSTASH(pn))
+#define SvPAD_STATE_on PadnameIsSTATE_on
+#define SvPAD_TYPED_on(pn) (PadnameFLAGS(pn) |= PADNAMEt_TYPED)
+#define SvPAD_OUR_on(pn) (PadnameFLAGS(pn) |= PADNAMEt_OUR)
+#define SvOURSTASH PadnameOURSTASH
+#define SvOURSTASH_set PadnameOURSTASH_set
+#define SVpad_STATE PADNAMEt_STATE
+#define SVpad_TYPED PADNAMEt_TYPED
+#define SVpad_OUR PADNAMEt_OUR
#ifdef DEBUGGING
# define PAD_SV(po) pad_sv(po)
#define PAD_COMPNAME(po) PAD_COMPNAME_SV(po)
#define PAD_COMPNAME_SV(po) (PadnamelistARRAY(PL_comppad_name)[(po)])
-#define PAD_COMPNAME_FLAGS(po) SvFLAGS(PAD_COMPNAME_SV(po))
+#define PAD_COMPNAME_FLAGS(po) PadnameFLAGS(PAD_COMPNAME(po))
#define PAD_COMPNAME_FLAGS_isOUR(po) SvPAD_OUR(PAD_COMPNAME_SV(po))
#define PAD_COMPNAME_PV(po) PadnamePV(PAD_COMPNAME(po))
(SvOURSTASH(PAD_COMPNAME_SV(po)))
#define PAD_COMPNAME_GEN(po) \
- ((STRLEN)SvUVX(PadnamelistARRAY(PL_comppad_name)[po]))
+ ((STRLEN)PadnamelistARRAY(PL_comppad_name)[po]->xpadn_gen)
#define PAD_COMPNAME_GEN_set(po, gen) \
- SvUV_set(PadnamelistARRAY(PL_comppad_name)[po], (UV)(gen))
+ (PadnamelistARRAY(PL_comppad_name)[po]->xpadn_gen = (gen))
/*
typedef struct ptr_tbl PTR_TBL_t;
typedef struct clone_params CLONE_PARAMS;
-/* a pad or name pad is currently just an AV; but that might change,
+/* a pad is currently just an AV; but that might change,
* so hide the type. */
typedef struct padlist PADLIST;
typedef AV PAD;
typedef struct padnamelist PADNAMELIST;
-typedef SV PADNAME;
+typedef struct padname PADNAME;
/* enable PERL_NEW_COPY_ON_WRITE by default */
#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
#endif
#define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
-#define PNf SVf
-#define PNfARG SVfARG
+#define PNf UTF8f
+#define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn)
#ifdef PERL_CORE
/* not used; but needed for backward compatibility with XS code? - RMB */
PP(pp_clonecv)
{
dTARGET;
- MAGIC * const mg =
- mg_find(PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG],
- PERL_MAGIC_proto);
+ CV * const protocv = PadnamePROTOCV(
+ PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG]
+ );
assert(SvTYPE(TARG) == SVt_PVCV);
- assert(mg);
- assert(mg->mg_obj);
- if (CvISXSUB(mg->mg_obj)) { /* constant */
+ assert(protocv);
+ if (CvISXSUB(protocv)) { /* constant */
/* XXX Should we clone it here? */
/* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV
to introcv and remove the SvPADSTALE_off. */
SAVEPADSVANDMORTALIZE(ARGTARG);
- PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(mg->mg_obj);
+ PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(protocv);
}
else {
- if (CvROOT(mg->mg_obj)) {
- assert(CvCLONE(mg->mg_obj));
- assert(!CvCLONED(mg->mg_obj));
+ if (CvROOT(protocv)) {
+ assert(CvCLONE(protocv));
+ assert(!CvCLONED(protocv));
}
- cv_clone_into((CV *)mg->mg_obj,(CV *)TARG);
+ cv_clone_into(protocv,(CV *)TARG);
SAVECLEARSV(PAD_SVl(ARGTARG));
}
return NORMAL;
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV PADNAME * Perl_newPADNAMEouter(pTHX_ PADNAME *outer)
+ __attribute__malloc__
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_NEWPADNAMEOUTER \
+ assert(outer)
+
+PERL_CALLCONV PADNAME * Perl_newPADNAMEpvn(pTHX_ const char *s, STRLEN len)
+ __attribute__malloc__
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_NEWPADNAMEPVN \
+ assert(s)
+
PERL_CALLCONV OP* Perl_newPMOP(pTHX_ I32 type, I32 flags)
__attribute__malloc__
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_PADLIST_STORE \
assert(padlist)
+PERL_CALLCONV void Perl_padname_free(pTHX_ PADNAME *pn)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PADNAME_FREE \
+ assert(pn)
+
PERL_CALLCONV PADNAME * Perl_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, SSize_t key)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_PADLIST_DUP \
assert(srcpad); assert(param)
+PERL_CALLCONV PADNAME * Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_PADNAME_DUP \
+ assert(src); assert(param)
+
PERL_CALLCONV PADNAMELIST * Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1)
case SAVEt_FREESV:
SvREFCNT_dec(ARG0_SV);
break;
+ case SAVEt_FREEPADNAME:
+ PadnameREFCNT_dec((PADNAME *)ARG0_PTR);
+ break;
case SAVEt_FREECOPHH:
cophh_free((COPHH *)ARG0_PTR);
break;
#define SAVEt_PARSER 19
#define SAVEt_STACK_POS 20
#define SAVEt_READONLY_OFF 21
+#define SAVEt_FREEPADNAME 22
-#define SAVEt_ARG1_MAX 21
+#define SAVEt_ARG1_MAX 22
/* two args */
-#define SAVEt_APTR 22
#define SAVEt_AV 23
#define SAVEt_DESTRUCTOR 24
#define SAVEt_DESTRUCTOR_X 25
#define SAVEt_SVREF 44
#define SAVEt_VPTR 45
#define SAVEt_ADELETE 46
+#define SAVEt_APTR 47
-#define SAVEt_ARG2_MAX 46
+#define SAVEt_ARG2_MAX 47
/* three args */
-#define SAVEt_DELETE 47
#define SAVEt_HELEM 48
#define SAVEt_PADSV_AND_MORTALIZE 49
#define SAVEt_SET_SVFLAGS 50
#define SAVEt_GVSLOT 51
#define SAVEt_AELEM 52
+#define SAVEt_DELETE 53
+
#define SAVEf_SETMAGIC 1
#define SAVEf_KEEPOLDELEM 2
#define SAVEVPTR(s) save_vptr((void*)&(s))
#define SAVEPADSVANDMORTALIZE(s) save_padsv_and_mortalize(s)
#define SAVEFREESV(s) save_freesv(MUTABLE_SV(s))
+#define SAVEFREEPADNAME(s) save_pushptr((void *)(s), SAVEt_FREEPADNAME)
#define SAVEMORTALIZESV(s) save_mortalizesv(MUTABLE_SV(s))
#define SAVEFREEOP(o) save_freeop((OP*)(o))
#define SAVEFREEPV(p) save_freepv((char*)(p))
if ((PL_stderrgv && GvGP(PL_stderrgv) && (SV*)GvIO(PL_stderrgv) == sv)
|| (PL_defoutgv && GvGP(PL_defoutgv) && (SV*)GvIO(PL_defoutgv) == sv))
return;
- if (SvPAD_NAME(sv))
- return;
(void)curse(sv, 0);
}
there's no way that it can be safely upgraded, because perl.c
expects to Safefree(SvANY(PL_mess_sv)) */
assert(sv != PL_mess_sv);
- /* This flag bit is used to mean other things in other scalar types.
- Given that it only has meaning inside the pad, it shouldn't be set
- on anything that can get upgraded. */
- assert(!SvPAD_TYPED(sv));
break;
default:
if (UNLIKELY(old_type_details->cant_upgrade))
/* objs are always >= MG, but pad names use the SVs_OBJECT flag
for another purpose */
- assert(!SvOBJECT(sv) || type >= SVt_PVMG || SvPAD_NAME(sv));
+ assert(!SvOBJECT(sv) || type >= SVt_PVMG);
if (type >= SVt_PVMG) {
- if (SvOBJECT(sv) && !SvPAD_NAME(sv)) {
+ if (SvOBJECT(sv)) {
if (!curse(sv, 1)) goto get_next_sv;
type = SvTYPE(sv); /* destructor may have changed it */
}
if (SvMAGIC(sv))
mg_free(sv);
}
- else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
- SvREFCNT_dec(SvOURSTASH(sv));
- } else if (SvMAGIC(sv)) {
+ else if (SvMAGIC(sv)) {
/* Free back-references before other types of magic. */
sv_unmagic(sv, PERL_MAGIC_backref);
mg_free(sv);
}
SvMAGICAL_off(sv);
- if (type == SVt_PVMG && SvPAD_TYPED(sv))
- SvREFCNT_dec(SvSTASH(sv));
}
switch (type) {
/* case SVt_INVLIST: */
#endif
/* don't clone objects whose class has asked us not to */
- if (SvOBJECT(sstr) && !SvPAD_NAME(sstr)
+ if (SvOBJECT(sstr)
&& ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE))
{
SvFLAGS(dstr) = 0;
missing by always going for the destination.
FIXME - instrument and check that assumption */
if (sv_type >= SVt_PVMG) {
- if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
- SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
- } else if (SvMAGIC(dstr))
+ if (SvMAGIC(dstr))
SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
- if (SvOBJECT(dstr) && !SvPAD_NAME(dstr) && SvSTASH(dstr))
+ if (SvOBJECT(dstr) && SvSTASH(dstr))
SvSTASH_set(dstr, hv_dup_inc(SvSTASH(dstr), param));
else SvSTASH_set(dstr, 0); /* don't copy DESTROY cache */
}
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
break;
+ case SAVEt_FREEPADNAME:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = padname_dup((PADNAME *)ptr, param);
+ PadnameREFCNT((PADNAME *)TOPPTR(nss,ix))++;
+ break;
case SAVEt_SHARED_PVREF: /* char* in shared space */
c = (char*)POPPTR(ss,ix);
TOPPTR(nss,ix) = savesharedpv(c);
PL_sig_pending = 0;
PL_parser = NULL;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
+ Zero(&PL_padname_undef, 1, PADNAME);
+ Zero(&PL_padname_const, 1, PADNAME);
# ifdef DEBUG_LEAKING_SCALARS
PL_sv_serial = (((UV)my_perl >> 2) & 0xfff) * 1000000;
# endif
ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
+ ptr_table_store(PL_ptr_table, &proto_perl->Ipadname_const,
+ &PL_padname_const);
/* create (a non-shared!) shared string table */
PL_strtab = newHV();
SvLEN_set(&PL_sv_yes, 0);
SvIV_set(&PL_sv_yes, 1);
SvNV_set(&PL_sv_yes, 1);
+
+ PadnamePV(&PL_padname_const) = (char *)PL_No;
}
/*
}
else {
CV * const cv = gv ? ((CV *)gv) : find_runcv(NULL);
- SV *sv;
+ PADNAME *sv;
assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
if (!cv || !CvPADLIST(cv))
return NULL;
sv = padnamelist_fetch(PadlistNAMES(CvPADLIST(cv)), targ);
- sv_setsv_flags(name, sv, 0);
+ sv_setpvn(name, PadnamePV(sv), PadnameLEN(sv));
+ SvUTF8_on(name);
}
if (subscript_type == FUV_SUBSCRIPT_HASH) {
expanded to a real GV */
#define SVf_PROTECT 0x00010000 /* very read-only */
#define SVs_PADTMP 0x00020000 /* in use as tmp */
-#define SVpad_TYPED 0x00020000 /* pad name is a Typed Lexical */
#define SVs_PADSTALE 0x00040000 /* lexical has gone out of scope;
only used when !PADTMP */
-#define SVpad_OUR 0x00040000 /* pad name is "our" instead of "my" */
#define SVs_TEMP 0x00080000 /* mortal (implies string is stealable) */
#define SVs_OBJECT 0x00100000 /* is "blessed" */
-#define SVpad_LVALUE 0x00100000 /* pad name is used as lvalue */
#define SVs_GMG 0x00200000 /* has magical get method */
#define SVs_SMG 0x00400000 /* has magical set method */
#define SVs_RMG 0x00800000 /* has random magical methods */
2: For PVCV, whether CvUNIQUE(cv)
refers to an eval or once only
[CvEVAL(cv), CvSPECIAL(cv)]
- 3: On a pad name SV, that slot in the
- frame AV is a REFCNT'ed reference
- to a lexical from "outside".
- 4: HV: informally reserved by DAPM
+ 3: HV: informally reserved by DAPM
for vtables */
#define SVf_OOK 0x02000000 /* has valid offset value. For a PVHV this
means that a hv_aux struct is present
/* Some private flags. */
-/* PVNV, PVMG only, and only used in pads. Should be safe to test on any scalar
- SV, as the core is careful to avoid setting both.
+/* The SVp_SCREAM|SVpbm_VALID (0x40008000) combination is up for grabs.
+ Formerly it was used for pad names, but now it is available. The core
+ is careful to avoid setting both flags.
SVf_POK, SVp_POK also set:
0x00004400 Normal
0x0000C400 method name for DOES (SvSCREAM)
0x40004400 FBM compiled (SvVALID)
- 0x4000C400 pad name.
+ 0x4000C400 *** Formerly used for pad names ***
0x00008000 GV with GP
0x00008800 RV with PCS imported
*/
-#define SVpad_NAME (SVp_SCREAM|SVpbm_VALID)
- /* This SV is a name in the PAD, so
- SVpad_TYPED, SVpad_OUR and SVpad_STATE
- apply */
/* PVAV */
#define SVpav_REAL 0x40000000 /* free old entries */
/* PVHV */
/* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */
#define SVprv_WEAKREF 0x80000000 /* Weak reference */
/* pad name vars only */
-#define SVpad_STATE 0x80000000 /* pad name is a "state" var */
#define _XPV_HEAD \
HV* xmg_stash; /* class package */ \
union _xmgu {
MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
STRLEN xmg_hash_index; /* used while freeing hash entries */
};
#define SvTAIL_on(sv) (SvFLAGS(sv) |= SVpbm_TAIL)
#define SvTAIL_off(sv) (SvFLAGS(sv) &= ~SVpbm_TAIL)
-#define SvPAD_NAME(sv) ((SvFLAGS(sv) & SVpad_NAME) == SVpad_NAME)
-
-#define SvPAD_TYPED(sv) \
- ((SvFLAGS(sv) & (SVpad_NAME|SVpad_TYPED)) == (SVpad_NAME|SVpad_TYPED))
-
-#define SvPAD_OUR(sv) \
- ((SvFLAGS(sv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
-
-#define SvPAD_STATE(sv) \
- ((SvFLAGS(sv) & (SVpad_NAME|SVpad_STATE)) == (SVpad_NAME|SVpad_STATE))
-
-#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvPAD_TYPED_on(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(SvTYPE(_svpad) == SVt_PVMG); \
- (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_TYPED); \
- })
-#define SvPAD_OUR_on(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(SvTYPE(_svpad) == SVt_PVMG); \
- (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_OUR); \
- })
-#define SvPAD_STATE_on(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(SvTYPE(_svpad) == SVt_PVNV || SvTYPE(_svpad) == SVt_PVMG); \
- (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_STATE); \
- })
-#else
-# define SvPAD_TYPED_on(sv) (SvFLAGS(sv) |= SVpad_NAME|SVpad_TYPED)
-# define SvPAD_OUR_on(sv) (SvFLAGS(sv) |= SVpad_NAME|SVpad_OUR)
-# define SvPAD_STATE_on(sv) (SvFLAGS(sv) |= SVpad_NAME|SVpad_STATE)
-#endif
-
-#define SvOURSTASH(sv) \
- (SvPAD_OUR(sv) ? ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash : NULL)
-#define SvOURSTASH_set(sv, st) \
- STMT_START { \
- assert(SvTYPE(sv) == SVt_PVMG); \
- ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash = st; \
- } STMT_END
-
#define SvRVx(sv) SvRV(sv)
#ifdef PERL_DEBUG_COW
# define SvMAGIC(sv) \
(*({ const SV *const _svmagic = (const SV *)(sv); \
assert(SvTYPE(_svmagic) >= SVt_PVMG); \
- if(SvTYPE(_svmagic) == SVt_PVMG) \
- assert(!SvPAD_OUR(_svmagic)); \
&(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \
}))
# define SvSTASH(sv) \
/*
=for apidoc Amx|SV*|newSVpadname|PADNAME *pn
-Creates a new SV containing the pad name. This is currently identical
-to C<newSVsv>, but pad names may cease being SVs at some point, so
-C<newSVpadname> is preferable.
+Creates a new SV containing the pad name.
=cut
*/
-#define newSVpadname(pn) newSVsv((SV *)(pn))
+#define newSVpadname(pn) newSVpvn_utf8(PadnamePV(pn), PadnameLEN(pn), TRUE)
/*
=for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len
https://perl5.git.perl.org / perl5.git / commitdiff