This is in preparation for making PADNAME a separate type.
#define AvREIFY_on(av) (SvFLAGS(av) |= SVpav_REIFY)
#define AvREIFY_off(av) (SvFLAGS(av) &= ~SVpav_REIFY)
#define AvREIFY_only(av) (AvREAL_off(av), SvFLAGS(av) |= SVpav_REIFY)
-#define AvPAD_NAMELIST(av) (SvFLAGS(av) & SVpad_NAMELIST)
-#define AvPAD_NAMELIST_on(av) (SvFLAGS(av) |= SVpad_NAMELIST)
#define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY))
if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
goto evaled_or_uv;
case SVt_PVAV:
- if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
break;
}
/* SVphv_SHAREKEYS is also 0x20000000 */
HV * const ost = SvOURSTASH(sv);
if (ost)
do_hv_dump(level, file, " OURSTASH", ost);
- } else if (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
- Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
- (UV)PadnamelistMAXNAMED(sv));
} else {
if (SvMAGIC(sv))
do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim);
PerlIO_putc(file, '\n');
Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv));
Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv));
- /* arylen is stored in magic, and padnamelists use SvMAGIC for
- something else. */
- if (!AvPAD_NAMELIST(sv))
- Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
+ Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n",
SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0);
sv_setpvs(d, "");
if (AvREAL(sv)) sv_catpv(d, ",REAL");
{
CV * const cv = deb_curcv(cxstack_ix);
SV *sv;
- PAD * comppad = NULL;
+ PADNAMELIST * comppad = NULL;
int i;
if (cv) {
PADLIST * const padlist = CvPADLIST(cv);
- comppad = *PadlistARRAY(padlist);
+ comppad = PadlistNAMES(padlist);
}
PerlIO_printf(Perl_debug_log, "(");
for (i = 0; i < count; i++) {
if (comppad &&
- (sv = *av_fetch(comppad, o->op_targ + i, FALSE)))
+ (sv = padnamelist_fetch(comppad, o->op_targ + i)))
PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
else
PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
ApaR |HV* |newHVhv |NULLOK HV *hv
Apabm |IO* |newIO
Apda |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
+AMpda |PADNAMELIST *|newPADNAMELIST|size_t max
#ifdef USE_ITHREADS
Apda |OP* |newPADOP |I32 type|I32 flags|NN SV* sv
#endif
pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv
pdX |void |pad_push |NN PADLIST *padlist|int depth
ApbdR |HV* |pad_compname_type|const PADOFFSET po
+AMpdR |PADNAME *|padnamelist_fetch|NN PADNAMELIST *pnl|SSize_t key
+Xop |void |padnamelist_free|NN PADNAMELIST *pnl
+AMpd |PADNAME **|padnamelist_store|NN PADNAMELIST *pnl|SSize_t key \
+ |NULLOK PADNAME *val
#if defined(USE_ITHREADS)
+pR |PADNAMELIST *|padnamelist_dup|NN PADNAMELIST *srcpad \
+ |NN CLONE_PARAMS *param
pdR |PADLIST *|padlist_dup |NN PADLIST *srcpad \
|NN CLONE_PARAMS *param
#endif
#define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e)
#define newNULLLIST() Perl_newNULLLIST(aTHX)
#define newOP(a,b) Perl_newOP(aTHX_ a,b)
+#define newPADNAMELIST(a) Perl_newPADNAMELIST(aTHX_ a)
#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)
#define pad_findmy_sv(a,b) Perl_pad_findmy_sv(aTHX_ a,b)
#define pad_new(a) Perl_pad_new(aTHX_ a)
#define pad_tidy(a) Perl_pad_tidy(aTHX_ a)
+#define padnamelist_fetch(a,b) Perl_padnamelist_fetch(aTHX_ a,b)
+#define padnamelist_store(a,b,c) Perl_padnamelist_store(aTHX_ a,b,c)
#define parse_arithexpr(a) Perl_parse_arithexpr(aTHX_ a)
#define parse_barestmt(a) Perl_parse_barestmt(aTHX_ a)
#define parse_block(a) Perl_parse_block(aTHX_ a)
# 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 padnamelist_dup(a,b) Perl_padnamelist_dup(aTHX_ a,b)
# endif
# if defined(USE_LOCALE) && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX))
#define stdize_locale(a) S_stdize_locale(aTHX_ a)
=back
-=head2 OTHER CLASSES
+=head2 PAD-RELATED CLASSES
-Perl 5.18 introduces a new class, B::PADLIST, returned by B::CV's
+Perl 5.18 introduced a new class, B::PADLIST, returned by B::CV's
C<PADLIST> method.
+Perl 5.22 introduced the B::PADNAMELIST and B::PADNAME classes.
+
=head2 B::PADLIST Methods
=over 4
=item ARRAY
-A list of pads. The first one contains the names. These are currently
-B::AV objects, but that is likely to change in future versions.
+A list of pads. The first one contains the names.
+
+The first one is a B::PADNAMELIST under Perl 5.22, and a B::AV under
+earlier versions. The rest are currently B::AV objects, but that could
+change in future versions.
=item ARRAYelt
Like C<ARRAY>, but takes an index as an argument to get only one element,
rather than a list of all of them.
+=item NAMES
+
+This method, introduced in 5.22, returns the B::PADNAMELIST. It is
+equivalent to C<ARRAYelt> with a 0 argument.
+
+=item REFCNT
+
+=back
+
+=head2 B::PADNAMELIST Methods
+
+=over 4
+
+=item MAX
+
+=item ARRAY
+
+=item ARRAYelt
+
=item REFCNT
=back
#ifdef PadlistARRAY
typedef PADLIST *B__PADLIST;
#endif
+typedef PADNAMELIST *B__PADNAMELIST;
+
#ifdef MULTIPLICITY
# define ASSIGN_COMMON_ALIAS(prefix, var) \
SSize_t
PadlistMAX(padlist)
B::PADLIST padlist
+ ALIAS: B::PADNAMELIST::MAX = 0
+ CODE:
+ PERL_UNUSED_VAR(ix);
+ RETVAL = PadlistMAX(padlist);
+ OUTPUT:
+ RETVAL
+
+B::PADNAMELIST
+PadlistNAMES(padlist)
+ B::PADLIST padlist
void
PadlistARRAY(padlist)
B::PADLIST padlist
PPCODE:
if (PadlistMAX(padlist) >= 0) {
+ dXSTARG;
PAD **padp = PadlistARRAY(padlist);
SSize_t i;
- for (i = 0; i <= PadlistMAX(padlist); i++)
+ sv_setiv(newSVrv(TARG, PadlistNAMES(padlist)
+ ? "B::PADNAMELIST"
+ : "B::NULL"),
+ PTR2IV(PadlistNAMES(padlist)));
+ XPUSHTARG;
+ for (i = 1; i <= PadlistMAX(padlist); i++)
XPUSHs(make_sv_object(aTHX_ (SV *)padp[i]));
}
B::PADLIST padlist
SSize_t idx
PPCODE:
- if (PadlistMAX(padlist) >= 0
- && idx <= PadlistMAX(padlist))
+ if (idx < 0 || idx > PadlistMAX(padlist))
+ XPUSHs(make_sv_object(aTHX_ NULL));
+ else if (!idx) {
+ PL_stack_sp--;
+ PUSHMARK(PL_stack_sp-1);
+ XS_B__PADLIST_NAMES(aTHX_ cv);
+ return;
+ }
+ else
XPUSHs(make_sv_object(aTHX_
(SV *)PadlistARRAY(padlist)[idx]));
- else
- XPUSHs(make_sv_object(aTHX_ NULL));
U32
PadlistREFCNT(padlist)
RETVAL
#endif
+
+MODULE = B PACKAGE = B::PADNAMELIST PREFIX = Padnamelist
+
+void
+PadnamelistARRAY(pnl)
+ B::PADNAMELIST pnl
+ PPCODE:
+ if (PadnamelistMAX(pnl) >= 0) {
+ PADNAME **padp = PadnamelistARRAY(pnl);
+ SSize_t i = 0;
+ for (; i <= PadnamelistMAX(pnl); i++)
+ XPUSHs(make_sv_object(aTHX_ padp[i]));
+ }
+
+void
+PadnamelistARRAYelt(pnl, idx)
+ B::PADNAMELIST pnl
+ SSize_t idx
+ PPCODE:
+ if (idx < 0 || idx > PadnamelistMAX(pnl))
+ XPUSHs(make_sv_object(aTHX_ NULL));
+ else
+ XPUSHs(make_sv_object(aTHX_
+ (SV *)PadnamelistARRAY(pnl)[idx]));
+
+U32
+PadnamelistREFCNT(pnl)
+ B::PADNAMELIST pnl
B::RHE T_RHE_OBJ
B::PADLIST T_PL_OBJ
+B::PADNAMELIST T_PNL_OBJ
INPUT
T_OP_OBJ
else
croak(\"$var is not a reference\")
+T_PNL_OBJ
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ croak(\"$var is not a reference\")
+
OUTPUT
T_MG_OBJ
sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var));
T_PL_OBJ
sv_setiv(newSVrv($arg, $var ? "B::PADLIST" : "B::NULL"),
PTR2IV($var));
+
+T_PNL_OBJ
+ sv_setiv(newSVrv($arg, $var ? "B::PADNAMELIST" : "B::NULL"),
+ PTR2IV($var));
if (sv) {
MAGIC *mg;
- assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
-
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
return mg;
check_fields =
rop
- && (lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE),
+ && (lexname = padnamelist_fetch(PL_comppad_name, rop->op_targ),
SvPAD_TYPED(lexname))
&& (fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE))
&& isGV(*fields) && GvHV(*fields);
The PADLIST has a C array where pads are stored.
-The 0th entry of the PADLIST is a PADNAMELIST (which is actually just an
-AV, but that may change) which represents the "names" or rather
+The 0th entry of the PADLIST is a PADNAMELIST
+which represents the "names" or rather
the "static type information" for lexicals. The individual elements of a
-PADNAMELIST are PADNAMEs (just SVs; but, again, that may change). Future
+PADNAMELIST are PADNAMEs. Future
refactorings might stop the PADNAMELIST from being stored in the PADLIST's
array, so don't rely on it. See L</PadlistNAMES>.
Perl_pad_new(pTHX_ int flags)
{
PADLIST *padlist;
- PAD *padname, *pad;
+ PADNAMELIST *padname;
+ PAD *pad;
PAD **ary;
ASSERT_CURPAD_LEGAL("pad_new");
av_store(pad, 0, MUTABLE_SV(a0));
AvREIFY_only(a0);
- padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name);
+ PadnamelistREFCNT(padname = PL_comppad_name)++;
}
else {
av_store(pad, 0, NULL);
- padname = newAV();
- AvPAD_NAMELIST_on(padname);
- av_store(padname, 0, &PL_sv_undef);
+ padname = newPADNAMELIST(0);
+ padnamelist_store(padname, 0, &PL_sv_undef);
}
/* Most subroutines never recurse, hence only need 2 entries in the padlist
Newx(ary, 2, PAD *);
PadlistMAX(padlist) = 1;
PadlistARRAY(padlist) = ary;
- ary[0] = padname;
+ ary[0] = (PAD *)padname;
ary[1] = pad;
/* ... then update state variables */
if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
CV * const outercv = CvOUTSIDE(&cvbody);
const U32 seq = CvOUTSIDE_SEQ(&cvbody);
- PAD * const comppad_name = PadlistARRAY(padlist)[0];
- SV ** const namepad = AvARRAY(comppad_name);
+ PADNAMELIST * const comppad_name = PadlistNAMES(padlist);
+ SV ** const namepad = PadnamelistARRAY(comppad_name);
PAD * const comppad = PadlistARRAY(padlist)[1];
SV ** const curpad = AvARRAY(comppad);
- for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+ for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) {
SV * const namesv = namepad[ix];
if (namesv && namesv != &PL_sv_undef
&& *SvPVX_const(namesv) == '&')
}
}
{
- PAD * const sv = PadlistARRAY(padlist)[0];
- if (sv == PL_comppad_name && SvREFCNT(sv) == 1)
+ PADNAMELIST * const names = PadlistNAMES(padlist);
+ if (names == PL_comppad_name && PadnamelistREFCNT(names) == 1)
PL_comppad_name = NULL;
- SvREFCNT_dec(sv);
+ PadnamelistREFCNT_dec(names);
}
if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist));
Safefree(padlist);
SvPAD_STATE_on(name);
}
- av_store(PL_comppad_name, offset, (SV *)name);
+ padnamelist_store(PL_comppad_name, offset, (SV *)name);
PadnamelistMAXNAMED(PL_comppad_name) = offset;
return offset;
}
* for a slot which has no name and no active value.
* For a constant, likewise, but use PL_constpadix.
*/
- SV * const * const names = AvARRAY(PL_comppad_name);
- const SSize_t names_fill = AvFILLp(PL_comppad_name);
+ PADNAME * const * const names = PadnamelistARRAY(PL_comppad_name);
+ const SSize_t names_fill = PadnamelistMAX(PL_comppad_name);
const bool konst = cBOOL(tmptype & SVf_READONLY);
retval = konst ? PL_constpadix : PL_padix;
for (;;) {
break;
}
if (konst) {
- av_store(PL_comppad_name, retval, &PL_sv_no);
+ padnamelist_store(PL_comppad_name, retval, &PL_sv_no);
tmptype &= ~SVf_READONLY;
tmptype |= SVs_PADTMP;
}
COP_SEQ_RANGE_LOW_set(name, 0);
COP_SEQ_RANGE_HIGH_set(name, 0);
ix = pad_alloc(optype, SVs_PADMY);
- av_store(PL_comppad_name, ix, name);
+ padnamelist_store(PL_comppad_name, ix, name);
/* XXX DAPM use PL_curpad[] ? */
if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func))
av_store(PL_comppad, ix, (SV*)func);
assert((flags & ~padadd_OUR) == 0);
- if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
+ if (PadnamelistMAX(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
return; /* nothing to check */
- svp = AvARRAY(PL_comppad_name);
- top = AvFILLp(PL_comppad_name);
+ svp = PadnamelistARRAY(PL_comppad_name);
+ top = PadnamelistMAX(PL_comppad_name);
/* check the current scope */
/* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
* type ? */
PADNAME *out_pn;
int out_flags;
I32 offset;
- const AV *nameav;
+ const PADNAMELIST *namelist;
PADNAME **name_p;
PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
* our $foo = 0 unless defined $foo;
* to not give a warning. (Yes, this is a hack) */
- nameav = PadlistARRAY(CvPADLIST(PL_compcv))[0];
- name_p = PadnamelistARRAY(nameav);
- for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
+ namelist = PadlistNAMES(CvPADLIST(PL_compcv));
+ name_p = PadnamelistARRAY(namelist);
+ for (offset = PadnamelistMAXNAMED(namelist); offset > 0; offset--) {
const PADNAME * const name = name_p[offset];
if (name && PadnameLEN(name) == namelen
&& !PadnameOUTER(name)
if (padlist) { /* not an undef CV */
I32 fake_offset = 0;
- const AV * const nameav = PadlistARRAY(padlist)[0];
- PADNAME * const * const name_p = PadnamelistARRAY(nameav);
+ const PADNAMELIST * const names = PadlistNAMES(padlist);
+ PADNAME * const * const name_p = PadnamelistARRAY(names);
- for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
+ for (offset = PadnamelistMAXNAMED(names); offset > 0; offset--) {
const PADNAME * const name = name_p[offset];
if (name && PadnameLEN(name) == namelen
&& padname_eq_pvn_flags(aTHX_ name, namepv, namelen,
"good" and only copying flag bits and pointers that it understands.
*/
PADNAME *new_name = (PADNAME *)newSVsv((SV *)*out_name);
- AV * const ocomppad_name = PL_comppad_name;
+ PADNAMELIST * const ocomppad_name = PL_comppad_name;
PAD * const ocomppad = PL_comppad;
- PL_comppad_name = PadlistARRAY(padlist)[0];
+ PL_comppad_name = PadlistNAMES(padlist);
PL_comppad = PadlistARRAY(padlist)[1];
PL_curpad = AvARRAY(PL_comppad);
{
ASSERT_CURPAD_ACTIVE("pad_block_start");
SAVEI32(PL_comppad_name_floor);
- PL_comppad_name_floor = AvFILLp(PL_comppad_name);
+ PL_comppad_name_floor = PadnamelistMAX(PL_comppad_name);
if (full)
PL_comppad_name_fill = PL_comppad_name_floor;
if (PL_comppad_name_floor < 0)
if (! PL_min_intro_pending)
return seq;
- svp = AvARRAY(PL_comppad_name);
+ svp = PadnamelistARRAY(PL_comppad_name);
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
SV * const sv = svp[i];
{
I32 off;
OP *o = NULL;
- SV * const * const svp = AvARRAY(PL_comppad_name);
+ PADNAME * const * const svp = PadnamelistARRAY(PL_comppad_name);
PL_pad_reset_pending = FALSE;
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
- for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
+ for (off = PadnamelistMAX(PL_comppad_name);
+ off > PL_comppad_name_fill; off--) {
SV * const sv = svp[off];
if (sv && PadnameLEN(sv) && !SvFAKE(sv)
&& COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
}
/* extend namepad to match curpad */
- if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
- av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
+ if (PadnamelistMAX(PL_comppad_name) < AvFILLp(PL_comppad))
+ padnamelist_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
if (type == padtidy_SUBCLONE) {
- SV ** const namep = AvARRAY(PL_comppad_name);
+ PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name);
PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
}
if (type == padtidy_SUB || type == padtidy_FORMAT) {
- SV ** const namep = AvARRAY(PL_comppad_name);
+ 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;
void
Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
{
- const AV *pad_name;
+ const PADNAMELIST *pad_name;
const AV *pad;
SV **pname;
SV **ppad;
if (!padlist) {
return;
}
- pad_name = *PadlistARRAY(padlist);
+ pad_name = PadlistNAMES(padlist);
pad = PadlistARRAY(padlist)[1];
- pname = AvARRAY(pad_name);
+ pname = PadnamelistARRAY(pad_name);
ppad = AvARRAY(pad);
Perl_dump_indent(aTHX_ level, file,
"PADNAME = 0x%"UVxf"(0x%"UVxf") PAD = 0x%"UVxf"(0x%"UVxf")\n",
PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad)
);
- for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
+ for (ix = 1; ix <= PadnamelistMAX(pad_name); ix++) {
const SV *namesv = pname[ix];
if (namesv && !PadnameLEN(namesv)) {
namesv = NULL;
{
I32 ix;
PADLIST* const protopadlist = CvPADLIST(proto);
- PAD *const protopad_name = *PadlistARRAY(protopadlist);
+ PADNAMELIST *const protopad_name = PadlistNAMES(protopadlist);
const PAD *const protopad = PadlistARRAY(protopadlist)[1];
- SV** const pname = AvARRAY(protopad_name);
+ SV** const pname = PadnamelistARRAY(protopad_name);
SV** const ppad = AvARRAY(protopad);
- const I32 fname = AvFILLp(protopad_name);
+ const I32 fname = PadnamelistMAX(protopad_name);
const I32 fpad = AvFILLp(protopad);
SV** outpad;
long depth;
Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
{
I32 ix;
- AV * const comppad_name = PadlistARRAY(padlist)[0];
+ PADNAMELIST * const comppad_name = PadlistNAMES(padlist);
AV * const comppad = PadlistARRAY(padlist)[1];
- SV ** const namepad = AvARRAY(comppad_name);
+ SV ** const namepad = PadnamelistARRAY(comppad_name);
SV ** const curpad = AvARRAY(comppad);
PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
PERL_UNUSED_ARG(old_cv);
- for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+ 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) == '&')
AV* const newpad = newAV();
SV** const oldpad = AvARRAY(svp[depth-1]);
I32 ix = AvFILLp((const AV *)svp[1]);
- const I32 names_fill = AvFILLp((const AV *)svp[0]);
- SV** const names = AvARRAY(svp[0]);
+ const I32 names_fill = PadnamelistMAX((PADNAMELIST *)svp[0]);
+ SV** const names = PadnamelistARRAY((PADNAMELIST *)svp[0]);
AV *av;
for ( ;ix > 0; ix--) {
PadlistMAX(dstpad) = max;
Newx(PadlistARRAY(dstpad), max + 1, PAD *);
+ PadlistARRAY(dstpad)[0] = (PAD *)
+ padnamelist_dup(PadlistNAMES(srcpad), param);
+ PadnamelistREFCNT(PadlistNAMES(dstpad))++;
if (cloneall) {
PADOFFSET depth;
- for (depth = 0; depth <= max; ++depth)
+ for (depth = 1; depth <= max; ++depth)
PadlistARRAY(dstpad)[depth] =
av_dup_inc(PadlistARRAY(srcpad)[depth], param);
} else {
to build anything other than the first level of pads. */
I32 ix = AvFILLp(PadlistARRAY(srcpad)[1]);
AV *pad1;
- const I32 names_fill = AvFILLp(PadlistARRAY(srcpad)[0]);
+ const I32 names_fill = PadnamelistMAX(PadlistNAMES(srcpad));
const PAD *const srcpad1 = PadlistARRAY(srcpad)[1];
SV **oldpad = AvARRAY(srcpad1);
- SV **names;
+ SV ** const names = PadnamelistARRAY(PadlistNAMES(dstpad));
SV **pad1a;
AV *args;
- PadlistARRAY(dstpad)[0] =
- av_dup_inc(PadlistARRAY(srcpad)[0], param);
- names = AvARRAY(PadlistARRAY(dstpad)[0]);
-
pad1 = newAV();
av_extend(pad1, ix);
}
/*
+=for apidoc newPADNAMELIST
+
+Creates a new pad name list. C<max> is the highest index for which space
+is allocated.
+
+=cut
+*/
+
+PADNAMELIST *
+Perl_newPADNAMELIST(pTHX_ size_t max)
+{
+ PADNAMELIST *pnl;
+ Newx(pnl, 1, PADNAMELIST);
+ Newxz(PadnamelistARRAY(pnl), max+1, PADNAME *);
+ PadnamelistMAX(pnl) = -1;
+ PadnamelistREFCNT(pnl) = 1;
+ PadnamelistMAXNAMED(pnl) = 0;
+ pnl->xpadnl_max = max;
+ return pnl;
+}
+
+/*
+=for apidoc padnamelist_store
+
+Stores the pad name (which may be null) at the given index, freeing any
+existing pad name in that slot.
+
+=cut
+*/
+
+PADNAME **
+Perl_padnamelist_store(pTHX_ PADNAMELIST *pnl, SSize_t key, PADNAME *val)
+{
+ PADNAME **ary;
+
+ PERL_ARGS_ASSERT_PADNAMELIST_STORE;
+
+ assert(key >= 0);
+
+ if (key > pnl->xpadnl_max)
+ av_extend_guts(NULL,key,&pnl->xpadnl_max,
+ (SV ***)&PadnamelistARRAY(pnl),
+ (SV ***)&PadnamelistARRAY(pnl));
+ if (PadnamelistMAX(pnl) < key) {
+ Zero(PadnamelistARRAY(pnl)+PadnamelistMAX(pnl)+1,
+ key-PadnamelistMAX(pnl), PADNAME *);
+ PadnamelistMAX(pnl) = key;
+ }
+ ary = PadnamelistARRAY(pnl);
+ SvREFCNT_dec(ary[key]);
+ ary[key] = val;
+ return &ary[key];
+}
+
+/*
+=for apidoc padnamelist_fetch
+
+Fetches the pad name from the given index.
+
+=cut
+*/
+
+PADNAME *
+Perl_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, SSize_t key)
+{
+ PERL_ARGS_ASSERT_PADNAMELIST_FETCH;
+ ASSUME(key >= 0);
+
+ return key > PadnamelistMAX(pnl) ? NULL : PadnamelistARRAY(pnl)[key];
+}
+
+void
+Perl_padnamelist_free(pTHX_ PADNAMELIST *pnl)
+{
+ PERL_ARGS_ASSERT_PADNAMELIST_FREE;
+ if (!--PadnamelistREFCNT(pnl)) {
+ while(PadnamelistMAX(pnl) >= 0)
+ SvREFCNT_dec(PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--]);
+ Safefree(PadnamelistARRAY(pnl));
+ Safefree(pnl);
+ }
+}
+
+#if defined(USE_ITHREADS)
+
+/*
+=for apidoc padnamelist_dup
+
+Duplicates a pad name list.
+
+=cut
+*/
+
+PADNAMELIST *
+Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param)
+{
+ PADNAMELIST *dstpad;
+ SSize_t max = PadnamelistMAX(srcpad);
+
+ PERL_ARGS_ASSERT_PADNAMELIST_DUP;
+
+ /* look for it in the table first */
+ dstpad = (PADNAMELIST *)ptr_table_fetch(PL_ptr_table, srcpad);
+ if (dstpad)
+ return dstpad;
+
+ dstpad = newPADNAMELIST(max);
+ PadnamelistREFCNT(dstpad) = 0; /* The caller will increment it. */
+ PadnamelistMAXNAMED(dstpad) = PadnamelistMAXNAMED(srcpad);
+ PadnamelistMAX(dstpad) = max;
+
+ ptr_table_store(PL_ptr_table, srcpad, dstpad);
+ for (; max >= 0; max--)
+ PadnamelistARRAY(dstpad)[max] =
+ sv_dup_inc(PadnamelistARRAY(srcpad)[max], param);
+
+ return dstpad;
+}
+
+#endif /* USE_ITHREADS */
+
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
#endif
#define NOT_IN_PAD ((PADOFFSET) -1)
+/* B.xs expects the first members of these two structs to line up
+ (xpadl_max with xpadnl_fill).
+ */
struct padlist {
SSize_t xpadl_max; /* max index for which array has space */
PADNAMELIST*xpadl_outid; /* Padnamelist of outer pad; used as ID */
};
+struct padnamelist {
+ SSize_t xpadnl_fill; /* max index in use */
+ PADNAME ** xpadnl_alloc; /* pointer to beginning of array */
+ SSize_t xpadnl_max; /* max index for which array has space */
+ PADOFFSET xpadnl_max_named; /* highest index with len > 0 */
+ U32 xpadnl_refcnt;
+};
+
/* a value that PL_cop_seqmax is guaranteed never to be,
* flagging that a lexical is being introduced, or has not yet left scope
=for apidoc Amx|SSize_t|PadnamelistMAX|PADNAMELIST pnl
The index of the last pad name.
+=for apidoc Amx|SSize_t|PadnamelistREFCNT|PADNAMELIST pnl
+The reference count of the pad name list.
+
+=for apidoc Amx|void|PadnamelistREFCNT_dec|PADNAMELIST pnl
+Lowers the reference count of the pad name list.
+
=for apidoc Amx|SV **|PadARRAY|PAD pad
The C array of pad entries.
#define PadlistARRAY(pl) (pl)->xpadl_alloc
#define PadlistMAX(pl) (pl)->xpadl_max
-#define PadlistNAMES(pl) (*PadlistARRAY(pl))
+#define PadlistNAMES(pl) ((PADNAMELIST *)*PadlistARRAY(pl))
#define PadlistNAMESARRAY(pl) PadnamelistARRAY(PadlistNAMES(pl))
#define PadlistNAMESMAX(pl) PadnamelistMAX(PadlistNAMES(pl))
#define PadlistREFCNT(pl) 1 /* reserved for future use */
-#define PadnamelistARRAY(pnl) ((PADNAME **)AvARRAY(pnl))
-#define PadnamelistMAX(pnl) AvFILLp(pnl)
-#define PadnamelistMAXNAMED(pnl) \
- ((XPVAV*) SvANY(pnl))->xmg_u.xmg_hash_index
+#define PadnamelistARRAY(pnl) (pnl)->xpadnl_alloc
+#define PadnamelistMAX(pnl) (pnl)->xpadnl_fill
+#define PadnamelistMAXNAMED(pnl) (pnl)->xpadnl_max_named
+#define PadnamelistREFCNT(pnl) (pnl)->xpadnl_refcnt
+#define PadnamelistREFCNT_dec(pnl) Perl_padnamelist_free(aTHX_ pnl)
#define PadARRAY(pad) AvARRAY(pad)
#define PadMAX(pad) AvFILLp(pad)
*/
#define PAD_COMPNAME(po) PAD_COMPNAME_SV(po)
-#define PAD_COMPNAME_SV(po) ((PADNAME *)AvARRAY(PL_comppad_name)[(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_isOUR(po) SvPAD_OUR(PAD_COMPNAME_SV(po))
#define PAD_COMPNAME_PV(po) PadnamePV(PAD_COMPNAME(po))
#define PAD_COMPNAME_OURSTASH(po) \
(SvOURSTASH(PAD_COMPNAME_SV(po)))
-#define PAD_COMPNAME_GEN(po) ((STRLEN)SvUVX(AvARRAY(PL_comppad_name)[po]))
+#define PAD_COMPNAME_GEN(po) \
+ ((STRLEN)SvUVX(PadnamelistARRAY(PL_comppad_name)[po]))
-#define PAD_COMPNAME_GEN_set(po, gen) SvUV_set(AvARRAY(PL_comppad_name)[po], (UV)(gen))
+#define PAD_COMPNAME_GEN_set(po, gen) \
+ SvUV_set(PadnamelistARRAY(PL_comppad_name)[po], (UV)(gen))
/*
#define PAD_CLONE_VARS(proto_perl, param) \
PL_comppad = av_dup(proto_perl->Icomppad, param); \
PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \
- PL_comppad_name = av_dup(proto_perl->Icomppad_name, param); \
+ PL_comppad_name = \
+ padnamelist_dup(proto_perl->Icomppad_name, param); \
PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \
PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \
PL_min_intro_pending = proto_perl->Imin_intro_pending; \
* so hide the type. */
typedef struct padlist PADLIST;
typedef AV PAD;
-typedef AV PADNAMELIST;
+typedef struct padnamelist PADNAMELIST;
typedef SV PADNAME;
/* enable PERL_NEW_COPY_ON_WRITE by default */
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV PADNAMELIST * Perl_newPADNAMELIST(pTHX_ size_t max)
+ __attribute__malloc__
+ __attribute__warn_unused_result__;
+
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 PADNAME * Perl_padnamelist_fetch(pTHX_ PADNAMELIST *pnl, SSize_t key)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PADNAMELIST_FETCH \
+ assert(pnl)
+
+PERL_CALLCONV void Perl_padnamelist_free(pTHX_ PADNAMELIST *pnl)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PADNAMELIST_FREE \
+ assert(pnl)
+
+PERL_CALLCONV PADNAME ** Perl_padnamelist_store(pTHX_ PADNAMELIST *pnl, SSize_t key, PADNAME *val)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PADNAMELIST_STORE \
+ assert(pnl)
+
PERL_CALLCONV OP* Perl_parse_arithexpr(pTHX_ U32 flags);
PERL_CALLCONV OP* Perl_parse_barestmt(pTHX_ U32 flags);
PERL_CALLCONV OP* Perl_parse_block(pTHX_ U32 flags);
#define PERL_ARGS_ASSERT_PADLIST_DUP \
assert(srcpad); assert(param)
+PERL_CALLCONV PADNAMELIST * Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_PADNAMELIST_DUP \
+ assert(srcpad); assert(param)
+
PERL_CALLCONV yy_parser* Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_PARSER_DUP \
PERL_ARGS_ASSERT_SV_MAGICEXT;
- if (SvTYPE(sv)==SVt_PVAV) { assert (!AvPAD_NAMELIST(sv)); }
-
SvUPGRADE(sv, SVt_PVMG);
Newxz(mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
}
else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
SvREFCNT_dec(SvOURSTASH(sv));
- }
- else if (type == SVt_PVAV && AvPAD_NAMELIST(sv)) {
- assert(!SvMAGICAL(sv));
} else if (SvMAGIC(sv)) {
/* Free back-references before other types of magic. */
sv_unmagic(sv, PERL_MAGIC_backref);
if (sv_type >= SVt_PVMG) {
if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
- } else if (sv_type == SVt_PVAV && AvPAD_NAMELIST(dstr)) {
- NOOP;
} else if (SvMAGIC(dstr))
SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
if (SvOBJECT(dstr) && !SvPAD_NAME(dstr) && SvSTASH(dstr))
else {
CV * const cv = gv ? ((CV *)gv) : find_runcv(NULL);
SV *sv;
- AV *av;
assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
if (!cv || !CvPADLIST(cv))
return NULL;
- av = *PadlistARRAY(CvPADLIST(cv));
- sv = *av_fetch(av, targ, FALSE);
+ sv = padnamelist_fetch(PadlistNAMES(CvPADLIST(cv)), targ);
sv_setsv_flags(name, sv, 0);
}
subroutine in another package. Set the
GvIMPORTED_CV_on() if it needs to be
expanded to a real GV */
-#define SVpad_NAMELIST SVp_SCREAM /* AV is a padnamelist */
#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 */
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 */
-}; /* also used by PadnamelistMAXNAMED */
+};
struct xpv {
_XPV_HEAD;
https://perl5.git.perl.org / perl5.git / commitdiff