In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/d48603664228d505b0c33f97505c2766b85d74a2?hp=3bc8ec963e9657121e69386195faa61e46928dda>
- Log -----------------------------------------------------------------
commit d48603664228d505b0c33f97505c2766b85d74a2
Merge: 3bc8ec9 6623086
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Nov 30 11:49:11 2014 -0800
[Merge] Inflict PADNAMEs on everyone
This makes PADNAME into a separate type from SV. See
<https://rt.perl.org/rt3/Ticket/Display.html?id=123223> for the
reasoning.
commit 662308654967c8d237f3ee651bae9c27cd9feaa2
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 28 14:35:40 2014 -0800
Minimise the size of padname + string buffer
If we define the struct a little differently, we can begin the string
buffer two bytes into a pointer, rather than pointer-aligned. In case
some platforms can compare pointer-aligned string faster, I added a
#define to allow that. But on 64-bit darwin the speed is identical
either way:
$ time ./miniperl -e 'eval q|my$a;|x50000 . q|eval q<my $A>|'
I ran this three times in each mode, and the average of the user times
differed by less than 1%.
M pad.h
commit 93fa278758aa71f9c91078585c82898a9c7b8eb6
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:35:17 2014 -0800
Remove proto magic type
It is no longer in use, as of two commits ago.
M mg_names.c
M mg_raw.h
M mg_vtable.h
M pod/perlguts.pod
M regen/mg_vtable.pl
commit 307a54be0900ed9b37ec2967bff2a57d4874e280
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:33:20 2014 -0800
pad.c: Various doc updates
M pad.c
commit 0f94cb1fe27e58a59d3391214dab34037ab184db
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:30:54 2014 -0800
[perl #123223] Make PADNAME a separate type
distinct from SV. This should fix the CPAN modules that were failing
when the PadnameLVALUE flag was added, because it shared the same
bit as SVs_OBJECT and pad names were going through code paths not
designed to handle pad names.
Unfortunately, it will probably break other CPAN modules, but I think
this change is for the better, as it makes both pad names and SVs sim-
pler and makes pad names take less memory.
M dump.c
M embed.fnc
M embed.h
M ext/B/B.xs
M ext/B/B/Showlex.pm
M ext/B/Makefile.PL
M ext/B/t/showlex.t
M op.c
M pad.c
M pad.h
M perl.h
M pp.c
M proto.h
M scope.c
M scope.h
M sv.c
M sv.h
commit b19cb98db58c735b4237857f7f69fd857d61934a
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:20:47 2014 -0800
pad.h: Mention âfakeâ under PadnameOUTER
We refer to âfakeâ entries in various places in the documentation,
and we still have the word FAKE in PARENT_FAKELEX_FLAGS, so noting
this should be helpful.
M pad.h
commit 863f2221fb3e688e30e71fb86c1599bdc55d4a3f
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:18:31 2014 -0800
pad.h: Update PadnamePV description
GVs have been using âconstantâ pad names for a while now, since
v5.21.3-188-gc2bad63.
M pad.h
commit 3e020df5bba4b6ec0679d434d7a1d016fedd0150
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:14:39 2014 -0800
Use PADNAME rather than SV in pad.c:padlist_dup
M pad.c
commit a2ddd1d1c6155a3fca85c109c04d2c5bbedce836
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:14:08 2014 -0800
Use PADNAME rather than SV in pad.c:pad_push
M pad.c
commit 39899bf07e706fce4e1c299bbb3e0c5afd22d570
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:12:56 2014 -0800
Use PADNAME rather than SV in pad.c:cv_clone_pad
M pad.c
commit 013269332931e4eb162f49d6097358b1f62a7db6
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:12:11 2014 -0800
Use PADNAME rather than SV in pad.c:do_dump_pad
M pad.c
commit dbfcda05eb64bedf93e1561611c6e820e1c50ff1
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:11:29 2014 -0800
Use PADNAME rather than SV in pad.c:pad_tidy
M pad.c
commit 01b9977c9befe5459c20661a52da1e4310599b16
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:10:31 2014 -0800
Use PADNAME rather than SV in pad.c:pad_leavemy
M pad.c
commit 6a0435beea5b0c2006efb680eddbfae70c6e8489
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:09:38 2014 -0800
Use PADNAME rather than SV in pad.c:intro_my
M pad.c
commit f5658c36d8be338cf8de02053d2905f99f1eaabf
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:07:53 2014 -0800
pad.c: Donât mk temp SVs for unavailable warnings
We already have the name SVs available, not just the string and length.
M pad.c
commit e6df7a56063a4369e9942fa219dee1109f66a14a
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 22:04:56 2014 -0800
Use PADNAME rather than SV in pad.c:S_unavailable
M pad.c
commit 0aaff5a18f835ca5d9cbbbf6546aff21cc5a9e0e
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 19:30:06 2014 -0800
Use PADNAME rather than SV in pad.c:pad_check_dup
M pad.c
commit 5e6246a7a7423b3861d3df84462447b1f2032f9c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 19:28:44 2014 -0800
Use PADNAME rather than SV in pad.c:pad_alloc
M pad.c
commit cab74fcaebc3ae02d2be259329dee5091cecf045
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 19:26:14 2014 -0800
Use PADNAME rather than SV in pad.c:cv_undef_flags
M pad.c
commit c9956dca66cd54e6ae48aff4131b749304d77340
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 19:25:18 2014 -0800
pad.c apidocs: Note the separate state for state
M pad.c
commit ea7cbc5a3c6d450b4cef9c4243ab3e5d50f6ac16
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:58:49 2014 -0800
Teach diag.t about PNf
M t/porting/diag.t
commit 4d48c4e518df52b44e5fa6b805f27b2fc99d7181
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:38:36 2014 -0800
Use PadnameSV in op.c:newMYSUB
M op.c
commit ea9a9e77bcfd0235d72bd7b0fa9a2cdaba4fd790
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:36:54 2014 -0800
Use PNf rather than SVf in op.c:op_lvalue_flags
M op.c
commit a1c2aa4cbb260b9d9402596ee6b708060892204b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:36:26 2014 -0800
Use PADNAME rather than SV in op.c:finalize_op
M op.c
commit 12d375eaee7dd261460649b8148da4b92cf2d257
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:35:34 2014 -0800
Add âimmortalâ pad name intrp vars
These will replace the current use of &PL_sv_undef and &PL_sv_no as
pad names.
M embedvar.h
M intrpvar.h
commit f584841efdc63848bb22f17b92a260b129df52d6
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:07:44 2014 -0800
Prepare B typemap for upcoming pad name changes
M ext/B/typemap
commit 6e074f758b8f861728ac362110fa06417f4e8b5f
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:05:54 2014 -0800
Increase $B::Showlex::VERSION to 1.05
M ext/B/B/Showlex.pm
commit 53af8ccbd2539275a6da9742a1279817c92c8594
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 17:02:44 2014 -0800
Prepare B::Concise for upcoming pad name changes
When pad names become their own type, separate from SVs, the âimmor-
talâ pad names, &PL_padname_undef and &PL_padname_const (to replace
&PL_sv_undef and &PL_sv_no), will no longer be B::SPECIAL objects,
but B::PADNAMEs. The way to distinguish them is to check the
length. This method happens to work both before and after the pad
name changes.
M ext/B/B/Concise.pm
commit aa572f37468bc3a5a004bcb1ec555270d144d0bd
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 16:59:39 2014 -0800
B.pm: Clarify classes used for pad names
M ext/B/B.pm
commit dbac5ffee5158ed2dc8f92c7d7ea3432d5ae4575
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 16:57:39 2014 -0800
B.pm: Document upcoming PADLIST changes
M ext/B/B.pm
commit 95a55f11be5ebcdd3f9e743a92bae2ccdb4720ea
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 16:48:48 2014 -0800
Use PADNAME rather than SV in dump.c:debop
M dump.c
commit 0d1e9135a626ca23109d6ed25ddc71687b38615c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 27 16:48:03 2014 -0800
perl.h: Add PNf and PNfARG
for pad names. Currently equivalent to SVf(ARG), they will be changed
shortly when I make pad names a separate type.
M perl.h
commit 1648ed586e3dd9bbb7d59873272d3e15a21977d0
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Nov 24 00:42:20 2014 -0800
fetch_pad_names.t: Emit all test names
They were defined in the structure passed to the general_tests func-
tion, but not all of them were used.
M ext/XS-APItest/t/fetch_pad_names.t
commit 2a9203e94b669f45c3d0b2161702767b6a8ac237
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Nov 24 00:33:35 2014 -0800
âSubroutine (not var) "&x" will not stay sharedâ
Another âvariableâ warning about lexical subs that I missed.
M pad.c
M pod/perldiag.pod
M t/op/lexsub.t
commit 6ccbd5ffeda04f22f5ad352866c49d46b8ae84ac
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Nov 24 00:27:12 2014 -0800
diag.t: Allow multiline diag_listed_as
M t/porting/diag.t
commit 8d98b5bc31467e9874759490ec9cdd505a121d9e
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Nov 24 00:05:33 2014 -0800
pad.c: Use UTF8f for âwill not stay sharedâ
This is more efficient than creating a temporary SV.
M pad.c
commit 2502ffdfca07fac6972c9b2da7ae160d011c2877
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Nov 24 00:00:51 2014 -0800
Make pad names always UTF8
Prior to 5.16, pad names never used the UTF8 flag, and all non-ASCII
pad names were in UTF8. Because the latter was consistently true,
everything just worked anyway.
In 5.16, UTF8 handling was done âproperlyâ, so that non-ASCII UTF8
strings were always accompanied by the UTF8 flag.
Now, it is still the case that the only non-ASCII names to make their
way into pad name code are in UTF8. Since ASCII is a subset of UTF8,
we effectively *always* have UTF8 pad names. So the flag handling is
actually redundant.
If we just assume that all pad names are UTF8 (which is true), then
we donât need to bother with the flag checking. There is actually
no reason why we should have two different encodings for storing
pad names.
So this commit enforces what has always been the case and removes the
extra code for converting between Latin-1 and UTF8. Nothing on CPAN
is using the UTF8 flag with pads, so nothing should break. In fact,
we never documented padadd_UTF8_NAME.
M ext/XS-APItest/t/fetch_pad_names.t
M op.c
M pad.c
M pad.h
M toke.c
commit 09c676d973b724f9d8bc07dbb1b115dd8920d5f5
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Nov 23 14:51:21 2014 -0800
pad.c:padlist_dup: Remove refcnt check
This was added by 6de654a5, and the assert that makes sure the
reference count is exactly 1 was added in the same commit. After
several years, I think we can be sure now that the reference count
is indeed always 1. We donât need to âplay it safeâ for non-debug-
ging builds.
M pad.c
commit 9b7476d7a269a4d9bb24393ae5c8d75efe2fcab4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Nov 23 14:25:22 2014 -0800
Make PADNAMELIST a separate type
This is in preparation for making PADNAME a separate type.
M av.h
M dump.c
M embed.fnc
M embed.h
M ext/B/B.pm
M ext/B/B.xs
M ext/B/typemap
M mg.c
M op.c
M pad.c
M pad.h
M perl.h
M proto.h
M sv.c
M sv.h
commit 6bb83edb7efd3e3c04f6411141538655410c83a4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 21 14:54:50 2014 -0800
pad.c: Remove encoding handling
When encoding.pm affects variable names, it decodes them to UTF-8, and
when it doesnât non-ASCII lexical variable names are prohibited. So
this code is not necessary.
M pad.c
commit 09d7a3ba918e6e685992034f67fd84290a3df894
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 21 00:22:38 2014 -0800
Mathomise pad_compname_type
M embed.fnc
M mathoms.c
M pad.c
commit afb6e3f520f7e3ce2c0ed90f778ed45b48f9e43c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 21 00:19:27 2014 -0800
pad.h: Donât use pad_compname_type
We only use PAD_COMPNAME_TYPE in one place, so wrapping it in a func-
tion doesnât save us anything, and probably slows things down if
anything. Furthermore, PadnameTYPE will soon become even simpler
than before.
M pad.h
commit e1c02f8429b9931efc13e763746fa70a9acd3324
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 21 00:17:08 2014 -0800
Use PADNAME rather than SV in the source
This is in preparation for making PADNAME a separate type.
This commit is not perfect. What I did was temporarily make PADNAME a
separate struct identical to struct sv and make whatever changes were
necessary to avoid compiler warnings. In some cases I had to add tem-
porary SV casts.
M embed.fnc
M op.c
M pad.c
M pad.h
M proto.h
M sv.h
-----------------------------------------------------------------------
Summary of changes:
av.h | 2 -
dump.c | 48 +--
embed.fnc | 22 +-
embed.h | 7 +
embedvar.h | 2 +
ext/B/B.pm | 89 +++-
ext/B/B.xs | 168 +++++++-
ext/B/B/Concise.pm | 4 +-
ext/B/B/Showlex.pm | 22 +-
ext/B/Makefile.PL | 4 +-
ext/B/t/showlex.t | 6 +-
ext/B/typemap | 26 ++
ext/XS-APItest/t/fetch_pad_names.t | 30 +-
intrpvar.h | 2 +
mathoms.c | 16 +
mg.c | 2 -
mg_names.c | 1 -
mg_raw.h | 2 -
mg_vtable.h | 1 -
op.c | 75 ++--
pad.c | 858 ++++++++++++++++++++++---------------
pad.h | 220 ++++++----
perl.h | 9 +-
pod/perldiag.pod | 19 +
pod/perlguts.pod | 1 -
pp.c | 21 +-
proto.h | 63 ++-
regen/mg_vtable.pl | 1 -
scope.c | 3 +
scope.h | 11 +-
sv.c | 51 +--
sv.h | 73 +---
t/op/lexsub.t | 10 +-
t/porting/diag.t | 19 +-
toke.c | 10 +-
35 files changed, 1191 insertions(+), 707 deletions(-)
diff --git a/av.h b/av.h
index e15ebe6..dcd32cf 100644
--- a/av.h
+++ b/av.h
@@ -73,8 +73,6 @@ Same as C<av_top_index()>.
#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))
diff --git a/dump.c b/dump.c
index 9209d06..2781ada 100644
--- a/dump.c
+++ b/dump.c
@@ -1431,15 +1431,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv,
I32 nest, I32 maxnest, bo
(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,");
@@ -1489,14 +1484,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv,
I32 nest, I32 maxnest, bo
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:
- if (AvPAD_NAMELIST(sv)) sv_catpvs(d, "NAMELIST,");
break;
}
/* SVphv_SHAREKEYS is also 0x20000000 */
@@ -1563,13 +1553,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv,
I32 nest, I32 maxnest, bo
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) {
@@ -1639,17 +1623,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv,
I32 nest, I32 maxnest, bo
}
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 (SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)) {
- Perl_dump_indent(aTHX_ level, file, " MAXNAMED = %"UVuf"\n",
- (UV)PadnamelistMAXNAMED(sv));
- } 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));
@@ -1671,10 +1646,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv,
I32 nest, I32 maxnest, bo
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");
@@ -2302,19 +2274,19 @@ Perl_debop(pTHX_ const OP *o)
/* print the lexical's name */
{
CV * const cv = deb_curcv(cxstack_ix);
- SV *sv;
- PAD * comppad = NULL;
+ PADNAME *sv;
+ 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)))
- PerlIO_printf(Perl_debug_log, "%s", SvPV_nolen_const(sv));
+ (sv = padnamelist_fetch(comppad, o->op_targ + i)))
+ PerlIO_printf(Perl_debug_log, "%"PNf, PNfARG(sv));
else
PerlIO_printf(Perl_debug_log, "[%"UVuf"]",
(UV)o->op_targ+i);
diff --git a/embed.fnc b/embed.fnc
index 2b7b7c9..bc776e1 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1000,6 +1000,9 @@ AmdbR |HV* |newHV
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
#endif
@@ -2528,7 +2531,7 @@ Apda |PADLIST*|pad_new |int flags
pnX |void|set_padlist| NN CV * cv | NULLOK PADLIST * padlist
#endif
#if defined(PERL_IN_PAD_C)
-s |PADOFFSET|pad_alloc_name|NN SV *namesv|U32 flags \
+s |PADOFFSET|pad_alloc_name|NN PADNAME *name|U32 flags \
|NULLOK HV *typestash|NULLOK HV *ourstash
#endif
Apd |PADOFFSET|pad_add_name_pvn|NN const char *namepv|STRLEN namelen\
@@ -2543,7 +2546,8 @@ Apd |PADOFFSET|pad_add_name_sv|NN SV *name\
AMpd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype
Apd |PADOFFSET|pad_add_anon |NN CV* func|I32 optype
#if defined(PERL_IN_PAD_C)
-sd |void |pad_check_dup |NN SV *name|U32 flags|NULLOK const HV *ourstash
+sd |void |pad_check_dup |NN PADNAME *name|U32 flags \
+ |NULLOK const HV *ourstash
#endif
Apd |PADOFFSET|pad_findmy_pvn|NN const char* namepv|STRLEN namelen|U32 flags
Apd |PADOFFSET|pad_findmy_pv|NN const char* name|U32 flags
@@ -2555,8 +2559,8 @@ p |SV* |find_rundefsv2 |NN CV *cv|U32 seq
#if defined(PERL_IN_PAD_C)
sd |PADOFFSET|pad_findlex |NN const char *namepv|STRLEN namelen|U32 flags
\
|NN const CV* cv|U32 seq|int warn \
- |NULLOK SV** out_capture|NN SV** out_name_sv \
- |NN int *out_flags
+ |NULLOK SV** out_capture \
+ |NN PADNAME** out_name|NN int *out_flags
#endif
#ifdef DEBUGGING
Apd |SV* |pad_sv |PADOFFSET po
@@ -2581,8 +2585,16 @@ Apd |CV* |cv_clone |NN CV* proto
p |CV* |cv_clone_into |NN CV* proto|NN CV *target
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
-ApdR |HV* |pad_compname_type|const PADOFFSET po
+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
+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 \
|NN CLONE_PARAMS *param
#endif
diff --git a/embed.h b/embed.h
index c8dfde3..491daa4 100644
--- a/embed.h
+++ b/embed.h
@@ -384,6 +384,9 @@
#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 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)
@@ -449,6 +452,8 @@
#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)
@@ -1755,6 +1760,8 @@
# 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))
#define stdize_locale(a) S_stdize_locale(aTHX_ a)
diff --git a/embedvar.h b/embedvar.h
index 2a3ebdc..712c259 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -230,6 +230,8 @@
#define PL_pad_reset_pending (vTHX->Ipad_reset_pending)
#define PL_padix (vTHX->Ipadix)
#define PL_padix_floor (vTHX->Ipadix_floor)
+#define PL_padname_const (vTHX->Ipadname_const)
+#define PL_padname_undef (vTHX->Ipadname_undef)
#define PL_parser (vTHX->Iparser)
#define PL_patchlevel (vTHX->Ipatchlevel)
#define PL_peepp (vTHX->Ipeepp)
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 01db20d..038d83c 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -741,7 +741,9 @@ unsigned.
=item COP_SEQ_RANGE_HIGH
-These last two are only valid for pad name SVs.
+These last two are only valid for pad name SVs. They only existed in the
+B::NV class before Perl 5.22. In 5.22 they were moved to the B::PADNAME
+class.
=back
@@ -1296,11 +1298,13 @@ Since perl 5.17.1
=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
@@ -1309,18 +1313,93 @@ C<PADLIST> method.
=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
+
+These two methods return the pad names, using B::SPECIAL objects for null
+pointers and B::PADNAME objects otherwise.
+
+=item REFCNT
+
+=back
+
+=head2 B::PADNAME Methods
+
+=over 4
+
+=item PV
+
+=item PVX
+
+=item LEN
+
+=item REFCNT
+
+=item FLAGS
+
+For backward-compatibility, if the PADNAMEt_OUTER flag is set, the FLAGS
+method adds the SVf_FAKE flag, too.
+
+=item TYPE
+
+A B::HV object representing the stash for a typed lexical.
+
+=item SvSTASH
+
+A backward-compatibility alias for TYPE.
+
+=item OURSTASH
+
+A B::HV object representing the stash for 'our' variables.
+
+=item PROTOCV
+
+The prototype CV for a 'my' sub.
+
+=item COP_SEQ_RANGE_LOW
+
+=item COP_SEQ_RANGE_HIGH
+
+Sequence numbers representing the scope within which a lexical is visible.
+Meaningless if PADNAMEt_OUTER is set.
+
+=item PARENT_PAD_INDEX
+
+Only meaningful if PADNAMEt_OUTER is set.
+
+=item PARENT_FAKELEX_FLAGS
+
+Only meaningful if PADNAMEt_OUTER is set.
+
+=back
+
=head2 $B::overlay
Although the optree is read-only, there is an overlay facility that allows
diff --git a/ext/B/B.xs b/ext/B/B.xs
index a26c1c9..86bd09c 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -620,6 +620,9 @@ typedef struct refcounted_he *B__RHE;
#ifdef PadlistARRAY
typedef PADLIST *B__PADLIST;
#endif
+typedef PADNAMELIST *B__PADNAMELIST;
+typedef PADNAME *B__PADNAME;
+
#ifdef MULTIPLICITY
# define ASSIGN_COMMON_ALIAS(prefix, var) \
@@ -1338,15 +1341,6 @@ MODULE = B PACKAGE = B::IV
#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)
@@ -1412,10 +1406,6 @@ IVX(sv)
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
@@ -2059,15 +2049,31 @@ MODULE = B PACKAGE = B::PADLIST PREFIX = Padlist
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]));
}
@@ -2076,12 +2082,17 @@ PadlistARRAYelt(padlist, idx)
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)
@@ -2093,3 +2104,124 @@ 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++)
+ {
+ SV *rv = sv_newmortal();
+ sv_setiv(newSVrv(rv,padp[i] ? "B::PADNAME" : "B::SPECIAL"),
+ PTR2IV(padp[i]));
+ XPUSHs(rv);
+ }
+ }
+
+B::PADNAME
+PadnamelistARRAYelt(pnl, idx)
+ B::PADNAMELIST pnl
+ SSize_t idx
+ CODE:
+ if (idx < 0 || idx > PadnamelistMAX(pnl))
+ RETVAL = NULL;
+ else
+ 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
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 47082e8..dcca4af 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -789,7 +789,9 @@ sub concise_op {
for my $i (0..$count-1) {
my ($targarg, $targarglife);
my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i];
- if (defined $padname and class($padname) ne "SPECIAL") {
+ if (defined $padname and class($padname) ne "SPECIAL" and
+ $padname->LEN)
+ {
$targarg = $padname->PVX;
if ($padname->FLAGS & SVf_FAKE) {
# These changes relate to the jumbo closure fix.
diff --git a/ext/B/B/Showlex.pm b/ext/B/B/Showlex.pm
index ab68451..4ccb26d 100644
--- a/ext/B/B/Showlex.pm
+++ b/ext/B/B/Showlex.pm
@@ -1,6 +1,6 @@
package B::Showlex;
-our $VERSION = '1.04';
+our $VERSION = '1.05';
use strict;
use B qw(svref_2object comppadlist class);
@@ -36,7 +36,8 @@ sub shownamearray {
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);
@@ -64,16 +65,27 @@ sub showlex {
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;
}
}
diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
index cc16ad9..8708c0d 100644
--- a/ext/B/Makefile.PL
+++ b/ext/B/Makefile.PL
@@ -15,7 +15,8 @@ if ($core) {
}
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;
@@ -29,6 +30,7 @@ foreach my $tuple (['cop.h'],
['op.h'],
['opcode.h', 'OPp'],
['op_reg_common.h','(?:(?:RXf_)?PMf_)'],
+ ['pad.h','PADNAMEt_'],
['regexp.h','RXf_'],
['sv.h', 'SV(?:[fps]|pad)_'],
) {
diff --git a/ext/B/t/showlex.t b/ext/B/t/showlex.t
index 2871622..dd5cdb7 100644
--- a/ext/B/t/showlex.t
+++ b/ext/B/t/showlex.t
@@ -31,7 +31,7 @@ if ($is_thread) {
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");
}
@@ -43,8 +43,8 @@ my ($out, $newlex); # output, option-flag
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') {
diff --git a/ext/B/typemap b/ext/B/typemap
index e97fb76..045d6a0 100644
--- a/ext/B/typemap
+++ b/ext/B/typemap
@@ -37,6 +37,8 @@ B::HE T_HE_OBJ
B::RHE T_RHE_OBJ
B::PADLIST T_PL_OBJ
+B::PADNAMELIST T_PNL_OBJ
+B::PADNAME T_PN_OBJ
INPUT
T_OP_OBJ
@@ -87,6 +89,22 @@ T_PL_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\")
+
+T_PN_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));
@@ -100,3 +118,11 @@ T_RHE_OBJ
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));
+
+T_PN_OBJ
+ sv_setiv(newSVrv($arg, $var ? "B::PADNAME" : "B::SPECIAL"),
+ PTR2IV($var));
diff --git a/ext/XS-APItest/t/fetch_pad_names.t
b/ext/XS-APItest/t/fetch_pad_names.t
index 3d42280..9e95d1b 100644
--- a/ext/XS-APItest/t/fetch_pad_names.t
+++ b/ext/XS-APItest/t/fetch_pad_names.t
@@ -41,8 +41,8 @@ general_tests( $cv->(), $names_av, {
],
pad_size => {
total => { cmp => 2, msg => 'Sub has two lexicals.' },
- utf8 => { cmp => 0, msg => 'Sub has no UTF-8 encoded
vars.' },
- invariant => { cmp => 2, msg => 'Sub has two invariant
vars.' },
+ utf8 => { cmp => 2, msg => 'Sub has only UTF-8 vars.'
},
+ invariant => { cmp => 0, msg => 'Sub has no invariant
vars.' },
},
vars => [
{ name => '$zest', msg => 'Sub has [\$zest].', type => 'ok' },
@@ -79,8 +79,8 @@ general_tests( $cv->(), $names_av, {
],
pad_size => {
total => { cmp => 2, msg => 'Sub has two lexicals,
including those it closed over.' },
- utf8 => { cmp => 1, msg => 'UTF-8 in the pad.' },
- invariant => { cmp => 1, msg => '' },
+ utf8 => { cmp => 2, msg => 'UTF-8 in the pad.' },
+ invariant => { cmp => 0, msg => '' },
},
vars => [
{ name => '$ascii', msg => 'Sub has [$ascii].', type => 'ok' },
@@ -120,8 +120,8 @@ general_tests( $cv->(), $names_av, {
],
pad_size => {
total => { cmp => 2, msg => 'Sub has two lexicals' },
- utf8 => { cmp => 0, msg => 'Latin-1 not upgraded to
UTF-8.' },
- invariant => { cmp => 2, msg => '' },
+ utf8 => { cmp => 2, msg => 'Latin-1 got upgraded to
UTF-8.' },
+ invariant => { cmp => 0, msg => '' },
},
vars => [
{ name => '$Leon', msg => 'Sub has [$Leon].', type => 'ok' },
@@ -153,8 +153,8 @@ END_EVAL
results => [ ({ SKIP => 1 }) x 3 ],
pad_size => {
total => { cmp => 1, msg => 'Sub has one lexical, which it
closed over.' },
- utf8 => { cmp => 0, msg => '' },
- invariant => { cmp => 1, msg => '' },
+ utf8 => { cmp => 1, msg => '' },
+ invariant => { cmp => 0, msg => '' },
},
vars => [
{ name => '$Ceon', msg => "Sub doesn't have [\$Ceon].", type
=> 'not ok' },
@@ -189,8 +189,8 @@ general_tests( $cv->(), $names_av, {
],
pad_size => {
total => { cmp => 3, msg => 'Sub has three lexicals.'
},
- utf8 => { cmp => 1, msg => 'Japanese stored as
UTF-8.' },
- invariant => { cmp => 2, msg => '' },
+ utf8 => { cmp => 3, msg => 'Japanese stored as
UTF-8.' },
+ invariant => { cmp => 0, msg => '' },
},
vars => [
{ name => "\$\x{6226}\x{56fd}", msg => "Sub has
[\$\x{6226}\x{56fd}].", type => 'ok' },
@@ -236,8 +236,8 @@ general_tests( $cv->(), $names_av, {
],
pad_size => {
total => { cmp => 1, msg => 'Sub has one lexical.' },
- utf8 => { cmp => 0, msg => '' },
- invariant => { cmp => 1, msg => '' },
+ utf8 => { cmp => 1, msg => '' },
+ invariant => { cmp => 0, msg => '' },
},
vars => [],
});
@@ -307,8 +307,10 @@ sub general_tests {
}
is @$names_av, $tests->{pad_size}{total}{cmp},
$tests->{pad_size}{total}{msg};
- is grep( Encode::is_utf8($_), @$names_av), $tests->{pad_size}{utf8}{cmp};
- is grep( !Encode::is_utf8($_), @$names_av),
$tests->{pad_size}{invariant}{cmp};
+ is grep( Encode::is_utf8($_), @$names_av),
+ $tests->{pad_size}{utf8}{cmp}, $tests->{pad_size}{utf8}{msg};
+ is grep( !Encode::is_utf8($_), @$names_av),
$tests->{pad_size}{invariant}{cmp},
+ $tests->{pad_size}{invariant}{msg};
for my $var (@{$tests->{vars}}) {
no warnings 'experimental::smartmatch';
diff --git a/intrpvar.h b/intrpvar.h
index 56bb5c4..6397eb6 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -146,6 +146,8 @@ C<&PL_sv_yes>.
PERLVAR(I, sv_undef, SV)
PERLVAR(I, sv_no, SV)
PERLVAR(I, sv_yes, SV)
+PERLVAR(I, padname_undef, PADNAME)
+PERLVAR(I, padname_const, PADNAME)
PERLVAR(I, Sv, SV *) /* used to hold temporary values */
PERLVAR(I, parser, yy_parser *) /* current parser state */
diff --git a/mathoms.c b/mathoms.c
index fa60621..378c409 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -1773,6 +1773,22 @@ Perl_save_re_context(pTHX)
PERL_UNUSED_CONTEXT;
}
+/*
+=for apidoc Am|HV *|pad_compname_type|PADOFFSET po
+
+Looks up the type of the lexical variable at position I<po> in the
+currently-compiling pad. If the variable is typed, the stash of the
+class to which it is typed is returned. If not, C<NULL> is returned.
+
+=cut
+*/
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+ return PAD_COMPNAME_TYPE(po);
+}
+
END_EXTERN_C
diff --git a/mg.c b/mg.c
index be26512..77dd9c0 100644
--- a/mg.c
+++ b/mg.c
@@ -390,8 +390,6 @@ S_mg_findext_flags(const SV *sv, int type, const MGVTBL
*vtbl, U32 flags)
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;
diff --git a/mg_names.c b/mg_names.c
index 237dfc5..57d52db 100644
--- a/mg_names.c
+++ b/mg_names.c
@@ -9,7 +9,6 @@
{ PERL_MAGIC_sv, "sv(\\0)" },
{ PERL_MAGIC_arylen, "arylen(#)" },
{ PERL_MAGIC_rhash, "rhash(%)" },
- { PERL_MAGIC_proto, "proto(&)" },
{ PERL_MAGIC_debugvar, "debugvar(*)" },
{ PERL_MAGIC_pos, "pos(.)" },
{ PERL_MAGIC_symtab, "symtab(:)" },
diff --git a/mg_raw.h b/mg_raw.h
index fd4a826..b3e25d6 100644
--- a/mg_raw.h
+++ b/mg_raw.h
@@ -12,8 +12,6 @@
"/* arylen '#' Array length ($#ary) */" },
{ '%', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC",
"/* rhash '%' Extra data for restricted hashes */" },
- { '&', "magic_vtable_max",
- "/* proto '&' my sub prototype CV */" },
{ '*', "want_vtbl_debugvar",
"/* debugvar '*' $DB::single, signal, trace vars */" },
{ '.', "want_vtbl_pos | PERL_MAGIC_VALUE_MAGIC",
diff --git a/mg_vtable.h b/mg_vtable.h
index c0bb820..c71a988 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -15,7 +15,6 @@
#define PERL_MAGIC_sv '\0' /* Special scalar variable */
#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */
#define PERL_MAGIC_rhash '%' /* Extra data for restricted hashes */
-#define PERL_MAGIC_proto '&' /* my sub prototype CV */
#define PERL_MAGIC_debugvar '*' /* $DB::single, signal, trace vars */
#define PERL_MAGIC_pos '.' /* pos() lvalue */
#define PERL_MAGIC_symtab ':' /* Extra data for symbol tables */
diff --git a/op.c b/op.c
index d4927ae..fdf2a03 100644
--- a/op.c
+++ b/op.c
@@ -613,8 +613,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN
len, const U32 flags)
off = pad_add_name_pvn(name, len,
(is_our ? padadd_OUR :
- PL_parser->in_my == KEY_state ? padadd_STATE : 0)
- | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 ),
+ PL_parser->in_my == KEY_state ? padadd_STATE : 0),
PL_parser->in_my_stash,
(is_our
/* $_ is always in main::, even with our */
@@ -2241,7 +2240,7 @@ S_finalize_op(pTHX_ OP* o)
case OP_HELEM: {
UNOP *rop;
- SV *lexname;
+ PADNAME *lexname;
GV **fields;
SVOP *key_op;
OP *kid;
@@ -2295,9 +2294,10 @@ S_finalize_op(pTHX_ OP* o)
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))
+ && (fields =
+ (GV**)hv_fetchs(PadnameTYPE(lexname), "FIELDS", FALSE))
&& isGV(*fields) && GvHV(*fields);
for (; key_op;
key_op = (SVOP*)OP_SIBLING(key_op)) {
@@ -2320,9 +2320,9 @@ S_finalize_op(pTHX_ OP* o)
if (check_fields
&& !hv_fetch_ent(GvHV(*fields), *svp, FALSE, 0)) {
Perl_croak(aTHX_ "No such class field \"%"SVf"\" "
- "in variable %"SVf" of type %"HEKf,
- SVfARG(*svp), SVfARG(lexname),
- HEKfARG(HvNAME_HEK(SvSTASH(lexname))));
+ "in variable %"PNf" of type %"HEKf,
+ SVfARG(*svp), PNfARG(lexname),
+ HEKfARG(HvNAME_HEK(PadnameTYPE(lexname))));
}
}
break;
@@ -2815,8 +2815,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
case OP_PADSV:
PL_modcount++;
if (!type) /* local() */
- Perl_croak(aTHX_ "Can't localize lexical variable %"SVf,
- PAD_COMPNAME_SV(o->op_targ));
+ Perl_croak(aTHX_ "Can't localize lexical variable %"PNf,
+ PNfARG(PAD_COMPNAME(o->op_targ)));
if (!(o->op_private & OPpLVAL_INTRO)
|| ( type != OP_SASSIGN && type != OP_AASSIGN
&& PadnameIsSTATE(PAD_COMPNAME_SV(o->op_targ)) ))
@@ -7255,11 +7255,10 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP
*block, OP *cont)
else
Perl_croak(aTHX_ "Can't use %s for loop variable",
PL_op_desc[sv->op_type]);
if (padoff) {
- SV *const namesv = PAD_COMPNAME_SV(padoff);
- STRLEN len;
- const char *const name = SvPV_const(namesv, len);
+ PADNAME * const pn = PAD_COMPNAME(padoff);
+ const char * const name = PadnamePV(pn);
- if (len == 2 && name[0] == '$' && name[1] == '_')
+ if (PadnameLEN(pn) == 2 && name[0] == '$' && name[1] == '_')
iterpflags |= OPpITER_DEF;
}
}
@@ -7781,7 +7780,7 @@ S_op_const_sv(pTHX_ const OP *o, CV *cv, bool allow_lex)
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;
@@ -7894,7 +7893,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP
*attrs, OP *block)
spot = (CV **)svspot;
if (!(PL_parser && PL_parser->error_count))
- move_proto_attr(&proto, &attrs, (GV *)name);
+ move_proto_attr(&proto, &attrs, (GV *)PadnameSV(name));
if (proto) {
assert(proto->op_type == OP_CONST);
@@ -7923,9 +7922,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP
*attrs, OP *block)
else if (PadnameIsSTATE(name) || CvDEPTH(outcv))
cv = *spot;
else {
- MAGIC *mg;
- SvUPGRADE(name, SVt_PVMG);
- mg = mg_find(name, PERL_MAGIC_proto);
assert (SvTYPE(*spot) == SVt_PVCV);
if (CvNAMED(*spot))
hek = CvNAME_HEK(*spot);
@@ -7942,15 +7938,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP
*attrs, OP *block)
);
CvLEXICAL_on(*spot);
}
- if (mg) {
- assert(mg->mg_obj);
- cv = (CV *)mg->mg_obj;
- }
- else {
- sv_magic(name, &PL_sv_undef, PERL_MAGIC_proto, NULL, 0);
- mg = mg_find(name, PERL_MAGIC_proto);
- }
- spot = (CV **)(svspot = &mg->mg_obj);
+ cv = PadnamePROTOCV(name);
+ svspot = (SV **)(spot = &PadnamePROTOCV(name));
}
if (block) {
@@ -7985,7 +7974,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP
*attrs, OP *block)
* skipping the prototype check
*/
if (exists || SvPOK(cv))
- cv_ckproto_len_flags(cv, (GV *)name, ps, ps_len, ps_utf8);
+ cv_ckproto_len_flags(cv, (GV *)PadnameSV(name), ps, ps_len,
+ ps_utf8);
/* already defined? */
if (exists) {
if (S_already_defined(aTHX_ cv,block,NULL,name,&const_sv))
@@ -9833,10 +9823,11 @@ Perl_ck_fun(pTHX_ OP *o)
*/
priv = OPpDEREF;
if (kid->op_type == OP_PADSV) {
- SV *const namesv
+ PADNAME * const pn
= PAD_COMPNAME_SV(kid->op_targ);
- name = SvPV_const(namesv, len);
- name_utf8 = SvUTF8(namesv);
+ name = PadnamePV (pn);
+ len = PadnameLEN(pn);
+ name_utf8 = PadnameUTF8(pn);
}
else if (kid->op_type == OP_RV2SV
&& kUNOP->op_first->op_type == OP_GV)
@@ -10779,14 +10770,17 @@ S_simplify_sort(pTHX_ OP *o)
kid = kBINOP->op_first;
do {
if (kid->op_type == OP_PADSV) {
- SV * const name = PAD_COMPNAME_SV(kid->op_targ);
- if (SvCUR(name) == 2 && *SvPVX(name) == '$'
- && (SvPVX(name)[1] == 'a' || SvPVX(name)[1] == 'b'))
+ PADNAME * const name = PAD_COMPNAME(kid->op_targ);
+ if (PadnameLEN(name) == 2 && *PadnamePV(name) == '$'
+ && ( PadnamePV(name)[1] == 'a'
+ || PadnamePV(name)[1] == 'b' ))
/* diag_listed_as: "my %s" used in sort comparison */
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"\"%s %s\" used in sort comparison",
- SvPAD_STATE(name) ? "state" : "my",
- SvPVX(name));
+ PadnameIsSTATE(name)
+ ? "state"
+ : "my",
+ PadnamePV(name));
}
} while ((kid = OP_SIBLING(kid)));
return;
@@ -10999,11 +10993,8 @@ Perl_find_lexical_cv(pTHX_ PADOFFSET off)
[off = PARENT_PAD_INDEX(name)];
}
assert(!PadnameIsOUR(name));
- if (!PadnameIsSTATE(name) && SvMAGICAL(name)) {
- MAGIC * mg = mg_find(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];
}
diff --git a/pad.c b/pad.c
index eb89c1b..18fdfb1 100644
--- a/pad.c
+++ b/pad.c
@@ -46,10 +46,10 @@ internal purpose in XSUBs.
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>.
@@ -59,12 +59,13 @@ AV which is @_. Other entries are storage for variables
and op targets.
Iterating over the PADNAMELIST iterates over all possible pad
items. Pad slots for targets (SVs_PADTMP)
-and GVs end up having &PL_sv_undef
-"names", while slots for constants have &PL_sv_no "names" (see
-pad_alloc()). That &PL_sv_no is used is an implementation detail subject
-to change. To test for it, use C<PadnamePV(name) && !PadnameLEN(name)>.
+and GVs end up having &PL_padname_undef "names", while slots for constants
+have &PL_padname_const "names" (see pad_alloc()). That &PL_padname_undef
+and &PL_padname_const are used is an implementation detail subject to
+change. To test for them, use C<!PadnamePV(name)> and C<PadnamePV(name)
+&& !PadnameLEN(name)>, respectively.
-Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
+Only my/our variable slots get valid names.
The rest are op targets/GVs/constants which are statically allocated
or resolved at compile time. These don't have names by which they
can be looked up from Perl code at run time through eval"" the way
@@ -72,10 +73,10 @@ my/our variables can be. Since they can't be looked up by
"name"
but only by their index allocated at compile time (which is usually
in PL_op->op_targ), wasting a name SV for them doesn't make sense.
-The SVs in the names AV have their PV being the name of the variable.
-xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
-which the name is valid (accessed through the macros COP_SEQ_RANGE_LOW and
-_HIGH). During compilation, these fields may hold the special value
+The pad names in the PADNAMELIST have their PV holding the name of
+the variable. The COP_SEQ_RANGE_LOW and _HIGH fields form a range
+(low+1..high inclusive) of cop_seq numbers for which the name is
+valid. During compilation, these fields may hold the special value
PERL_PADSEQ_INTRO to indicate various stages:
COP_SEQ_RANGE_LOW _HIGH
@@ -84,27 +85,24 @@ PERL_PADSEQ_INTRO to indicate various stages:
valid-seq# PERL_PADSEQ_INTRO variable in scope: { my ($x)
valid-seq# valid-seq# compilation of scope complete: { my ($x) }
-For typed lexicals name SV is SVt_PVMG and SvSTASH
-points at the type. For C<our> lexicals, the type is also SVt_PVMG, with the
-SvOURSTASH slot pointing at the stash of the associated global (so that
-duplicate C<our> declarations in the same package can be detected). SvUVX is
-sometimes hijacked to store the generation number during compilation.
-
-If PADNAME_OUTER (SvFAKE) is set on the
-name SV, then that slot in the frame AV is
-a REFCNT'ed reference to a lexical from "outside". In this case,
-the name SV does not use xlow and xhigh to store a cop_seq range, since it is
-in scope throughout. Instead xhigh stores some flags containing info about
+For typed lexicals PadnameTYPE points at the type stash. For C<our>
+lexicals, PadnameOURSTASH points at the stash of the associated global (so
+that duplicate C<our> declarations in the same package can be detected).
+PadnameGEN is sometimes used to store the generation number during
+compilation.
+
+If PadnameOUTER is set on the pad name, then that slot in the frame AV
+is a REFCNT'ed reference to a lexical from "outside". Such entries
+are sometimes referred to as 'fake'. In this case, the name does not
+use 'low' and 'high' to store a cop_seq range, since it is in scope
+throughout. Instead 'high' stores some flags containing info about
the real lexical (is it declared in an anon, and is it capable of being
-instantiated multiple times?), and for fake ANONs, xlow contains the index
+instantiated multiple times?), and for fake ANONs, 'low' contains the index
within the parent's pad where the lexical's value is stored, to make
cloning quicker.
If the 'name' is '&' the corresponding entry in the PAD
is a CV representing a possible closure.
-(PADNAME_OUTER and name of '&' is not a
-meaningful combination currently but could
-become so if C<my sub foo {}> is implemented.)
Note that formats are treated as anon subs, and are cloned each time
write is called (if necessary).
@@ -116,7 +114,8 @@ to be generated in evals, such as
{ my $x = 1; sub f { eval '$x'} } f();
-For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'.
+For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised',
+but this internal state is stored in a separate pad entry.
=for apidoc AmxU|PADNAMELIST *|PL_comppad_name
@@ -146,54 +145,12 @@ Points directly to the body of the L</PL_comppad> array.
#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
-
-/*
-This is basically sv_eq_flags() in sv.c, but we avoid the magic
-and bytes checking.
-*/
-
-static bool
-sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const
U32 flags) {
- if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
- const char *pv1 = SvPVX_const(sv);
- STRLEN cur1 = SvCUR(sv);
- const char *pv2 = pv;
- STRLEN cur2 = pvlen;
- if (IN_ENCODING) {
- SV* svrecode = NULL;
- if (SvUTF8(sv)) {
- svrecode = newSVpvn(pv2, cur2);
- sv_recode_to_utf8(svrecode, _get_encoding());
- pv2 = SvPV_const(svrecode, cur2);
- }
- else {
- svrecode = newSVpvn(pv1, cur1);
- sv_recode_to_utf8(svrecode, _get_encoding());
- pv1 = SvPV_const(svrecode, cur1);
- }
- SvREFCNT_dec_NN(svrecode);
- }
- if (flags & SVf_UTF8)
- return (bytes_cmp_utf8(
- (const U8*)pv1, cur1,
- (const U8*)pv2, cur2) == 0);
- else
- return (bytes_cmp_utf8(
- (const U8*)pv2, cur2,
- (const U8*)pv1, cur1) == 0);
- }
- else
- return ((SvPVX_const(sv) == pv)
- || memEQ(SvPVX_const(sv), pv, pvlen));
-}
+#define PARENT_PAD_INDEX_set COP_SEQ_RANGE_LOW_set
+#define PARENT_FAKELEX_FLAGS_set COP_SEQ_RANGE_HIGH_set
#ifdef DEBUGGING
void
@@ -229,7 +186,8 @@ PADLIST *
Perl_pad_new(pTHX_ int flags)
{
PADLIST *padlist;
- PAD *padname, *pad;
+ PADNAMELIST *padname;
+ PAD *pad;
PAD **ary;
ASSERT_CURPAD_LEGAL("pad_new");
@@ -275,13 +233,12 @@ Perl_pad_new(pTHX_ int flags)
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_padname_undef);
}
/* Most subroutines never recurse, hence only need 2 entries in the padlist
@@ -291,7 +248,7 @@ Perl_pad_new(pTHX_ int flags)
Newx(ary, 2, PAD *);
PadlistMAX(padlist) = 1;
PadlistARRAY(padlist) = ary;
- ary[0] = padname;
+ ary[0] = (PAD *)padname;
ary[1] = pad;
/* ... then update state variables */
@@ -439,14 +396,13 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
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);
+ PADNAME ** const namepad = PadnamelistARRAY(comppad_name);
PAD * const comppad = PadlistARRAY(padlist)[1];
SV ** const curpad = AvARRAY(comppad);
- for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
- SV * const namesv = namepad[ix];
- if (namesv && namesv != &PL_sv_undef
- && *SvPVX_const(namesv) == '&')
+ for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) {
+ PADNAME * const name = namepad[ix];
+ if (name && PadnamePV(name) && *PadnamePV(name) == '&')
{
CV * const innercv = MUTABLE_CV(curpad[ix]);
U32 inner_rc = SvREFCNT(innercv);
@@ -489,10 +445,10 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
}
}
{
- 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);
@@ -565,14 +521,14 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
}
/*
-=for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV
*ourstash
+=for apidoc m|PADOFFSET|pad_alloc_name|PADNAME *name|U32 flags|HV
*typestash|HV *ourstash
Allocates a place in the currently-compiling
pad (via L<perlapi/pad_alloc>) and
-then stores a name for that entry. I<namesv> is adopted and becomes the
-name entry; it must already contain the name string and be sufficiently
-upgraded. I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
-added to I<namesv>. None of the other
+then stores a name for that entry. I<name> is adopted and
+becomes the name entry; it must already contain the name
+string. I<typestash> and I<ourstash> and the C<padadd_STATE>
+flag get added to I<name>. None of the other
processing of L<perlapi/pad_add_name_pvn>
is done. Returns the offset of the allocated pad slot.
@@ -580,7 +536,8 @@ is done. Returns the offset of the allocated pad slot.
*/
static PADOFFSET
-S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
+S_pad_alloc_name(pTHX_ PADNAME *name, U32 flags, HV *typestash,
+ HV *ourstash)
{
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
@@ -589,20 +546,20 @@ S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV
*typestash, HV *ourstash)
ASSERT_CURPAD_ACTIVE("pad_alloc_name");
if (typestash) {
- assert(SvTYPE(namesv) == SVt_PVMG);
- SvPAD_TYPED_on(namesv);
- SvSTASH_set(namesv,
MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+ SvPAD_TYPED_on(name);
+ PadnameTYPE(name) =
+ MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash)));
}
if (ourstash) {
- SvPAD_OUR_on(namesv);
- SvOURSTASH_set(namesv, ourstash);
+ SvPAD_OUR_on(name);
+ SvOURSTASH_set(name, ourstash);
SvREFCNT_inc_simple_void_NN(ourstash);
}
else if (flags & padadd_STATE) {
- SvPAD_STATE_on(namesv);
+ SvPAD_STATE_on(name);
}
- av_store(PL_comppad_name, offset, namesv);
+ padnamelist_store(PL_comppad_name, offset, name);
PadnamelistMAXNAMED(PL_comppad_name) = offset;
return offset;
}
@@ -633,44 +590,30 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN
namelen,
U32 flags, HV *typestash, HV *ourstash)
{
PADOFFSET offset;
- SV *namesv;
- bool is_utf8;
+ PADNAME *name;
PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
- if (flags &
~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
+ if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
- namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
-
- if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
- namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
- }
-
- sv_setpvn(namesv, namepv, namelen);
-
- if (is_utf8) {
- flags |= padadd_UTF8_NAME;
- SvUTF8_on(namesv);
- }
- else
- flags &= ~padadd_UTF8_NAME;
+ name = newPADNAMEpvn(namepv, namelen);
if ((flags & padadd_NO_DUP_CHECK) == 0) {
ENTER;
- SAVEFREESV(namesv); /* in case of fatal warnings */
+ SAVEFREEPADNAME(name); /* in case of fatal warnings */
/* check for duplicate declaration */
- pad_check_dup(namesv, flags & padadd_OUR, ourstash);
- SvREFCNT_inc_simple_void_NN(namesv);
+ pad_check_dup(name, flags & padadd_OUR, ourstash);
+ PadnameREFCNT(name)++;
LEAVE;
}
- offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash,
ourstash);
+ offset = pad_alloc_name(name, flags, typestash, ourstash);
/* not yet introduced */
- COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
- COP_SEQ_RANGE_HIGH_set(namesv, 0);
+ COP_SEQ_RANGE_LOW_set(name, PERL_PADSEQ_INTRO);
+ COP_SEQ_RANGE_HIGH_set(name, 0);
if (!PL_min_intro_pending)
PL_min_intro_pending = offset;
@@ -687,7 +630,7 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN
namelen,
assert(SvPADMY(PL_curpad[offset]));
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
- (long)offset, SvPVX(namesv),
+ (long)offset, PadnamePV(name),
PTR2UV(PL_curpad[offset])));
return offset;
@@ -725,9 +668,7 @@ Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV
*typestash, HV *ourstash)
char *namepv;
STRLEN namelen;
PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
- namepv = SvPV(name, namelen);
- if (SvUTF8(name))
- flags |= padadd_UTF8_NAME;
+ namepv = SvPVutf8(name, namelen);
return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
}
@@ -784,8 +725,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
* 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 (;;) {
@@ -799,8 +740,9 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
* stant or a target. For a target, things marked PADTMP
* can be reused; not so for constants.
*/
+ PADNAME *pn;
if (++retval <= names_fill &&
- (sv = names[retval]) && sv != &PL_sv_undef)
+ (pn = names[retval]) && PadnamePV(pn))
continue;
sv = *av_fetch(PL_comppad, retval, TRUE);
if (!(SvFLAGS(sv) &
@@ -813,7 +755,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
break;
}
if (konst) {
- av_store(PL_comppad_name, retval, &PL_sv_no);
+ padnamelist_store(PL_comppad_name, retval, &PL_padname_const);
tmptype &= ~SVf_READONLY;
tmptype |= SVs_PADTMP;
}
@@ -855,18 +797,17 @@ PADOFFSET
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);
- 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);
@@ -902,9 +843,9 @@ C<is_our> indicates that the name to check is an 'our'
declaration.
*/
STATIC void
-S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
+S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash)
{
- SV **svp;
+ PADNAME **svp;
PADOFFSET top, off;
const U32 is_our = flags & padadd_OUR;
@@ -914,31 +855,31 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV
*ourstash)
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 ? */
for (off = top; (I32)off > PL_comppad_name_floor; off--) {
- SV * const sv = svp[off];
+ PADNAME * const sv = svp[off];
if (sv
- && PadnameLEN(sv)
- && !SvFAKE(sv)
+ && PadnameLEN(sv) == PadnameLEN(name)
+ && !PadnameOUTER(sv)
&& ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
|| COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
- && sv_eq(name, sv))
+ && memEQ(PadnamePV(sv), PadnamePV(name), PadnameLEN(name)))
{
if (is_our && (SvPAD_OUR(sv)))
break; /* "our" masking "our" */
/* diag_listed_as: "%s" variable %s masks earlier declaration in
same %s */
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "\"%s\" %s %"SVf" masks earlier declaration in same %s",
+ "\"%s\" %s %"PNf" masks earlier declaration in same %s",
(is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
- *SvPVX(sv) == '&' ? "subroutine" : "variable",
- SVfARG(sv),
+ *PadnamePV(sv) == '&' ? "subroutine" : "variable",
+ PNfARG(sv),
(COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
? "scope" : "statement"));
--off;
@@ -948,17 +889,17 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV
*ourstash)
/* check the rest of the pad */
if (is_our) {
while (off > 0) {
- SV * const sv = svp[off];
+ PADNAME * const sv = svp[off];
if (sv
- && PadnameLEN(sv)
- && !SvFAKE(sv)
+ && PadnameLEN(sv) == PadnameLEN(name)
+ && !PadnameOUTER(sv)
&& ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
|| COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
&& SvOURSTASH(sv) == ourstash
- && sv_eq(name, sv))
+ && memEQ(PadnamePV(sv), PadnamePV(name), PadnameLEN(name)))
{
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "\"our\" variable %"SVf" redeclared", SVfARG(sv));
+ "\"our\" variable %"PNf" redeclared", PNfARG(sv));
if ((I32)off <= PL_comppad_name_floor)
Perl_warner(aTHX_ packWARN(WARN_MISC),
"\t(Did you mean \"local\" instead of \"our\"?)\n");
@@ -988,32 +929,22 @@ or C<NOT_IN_PAD> if no such lexical is in scope.
PADOFFSET
Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
{
- SV *out_sv;
+ PADNAME *out_pn;
int out_flags;
I32 offset;
- const AV *nameav;
- SV **name_svp;
+ const PADNAMELIST *namelist;
+ PADNAME **name_p;
PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
pad_peg("pad_findmy_pvn");
- if (flags & ~padadd_UTF8_NAME)
+ if (flags)
Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
- if (flags & padadd_UTF8_NAME) {
- bool is_utf8 = TRUE;
- namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
-
- if (is_utf8)
- flags |= padadd_UTF8_NAME;
- else
- flags &= ~padadd_UTF8_NAME;
- }
-
offset = pad_findlex(namepv, namelen, flags,
- PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
+ PL_compcv, PL_cop_seqmax, 1, NULL, &out_pn, &out_flags);
if ((PADOFFSET)offset != NOT_IN_PAD)
return offset;
@@ -1025,16 +956,16 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN
namelen, U32 flags)
* our $foo = 0 unless defined $foo;
* to not give a warning. (Yes, this is a hack) */
- nameav = PadlistARRAY(CvPADLIST(PL_compcv))[0];
- name_svp = AvARRAY(nameav);
- for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
- const SV * const namesv = name_svp[offset];
- if (namesv && PadnameLEN(namesv) == namelen
- && !SvFAKE(namesv)
- && (SvPAD_OUR(namesv))
- && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
- flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
- && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
+ 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)
+ && (PadnameIsOUR(name))
+ && ( PadnamePV(name) == namepv
+ || memEQ(PadnamePV(name), namepv, namelen) )
+ && COP_SEQ_RANGE_LOW(name) == PERL_PADSEQ_INTRO
)
return offset;
}
@@ -1072,9 +1003,7 @@ Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
char *namepv;
STRLEN namelen;
PERL_ARGS_ASSERT_PAD_FINDMY_SV;
- namepv = SvPV(name, namelen);
- if (SvUTF8(name))
- flags |= padadd_UTF8_NAME;
+ namepv = SvPVutf8(name, namelen);
return pad_findmy_pvn(namepv, namelen, flags);
}
@@ -1093,10 +1022,10 @@ L</find_rundefsv> is likely to be more convenient.
PADOFFSET
Perl_find_rundefsvoffset(pTHX)
{
- SV *out_sv;
+ PADNAME *out_pn;
int out_flags;
return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
- NULL, &out_sv, &out_flags);
+ NULL, &out_pn, &out_flags);
}
/*
@@ -1112,14 +1041,14 @@ or will otherwise be the global one.
SV *
Perl_find_rundefsv(pTHX)
{
- SV *namesv;
+ PADNAME *name;
int flags;
PADOFFSET po;
po = pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
- NULL, &namesv, &flags);
+ NULL, &name, &flags);
- if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
+ if (po == NOT_IN_PAD || PadnameIsOUR(name))
return DEFSV;
return PAD_SVl(po);
@@ -1128,23 +1057,23 @@ Perl_find_rundefsv(pTHX)
SV *
Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
{
- SV *namesv;
+ PADNAME *name;
int flags;
PADOFFSET po;
PERL_ARGS_ASSERT_FIND_RUNDEFSV2;
po = pad_findlex("$_", 2, 0, cv, seq, 1,
- NULL, &namesv, &flags);
+ NULL, &name, &flags);
- if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
+ if (po == NOT_IN_PAD || PadnameIsOUR(name))
return DEFSV;
return AvARRAY(PadlistARRAY(CvPADLIST(cv))[CvDEPTH(cv)])[po];
}
/*
-=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32
flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int
*out_flags
+=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32
flags|const CV* cv|U32 seq|int warn|SV** out_capture|PADNAME** out_name|int
*out_flags
Find a named lexical anywhere in a chain of nested pads. Add fake entries
in the inner pads if it's found in an outer one.
@@ -1154,14 +1083,14 @@ cv is the CV in which to start the search, and seq is
the current cop_seq
to match against. If warn is true, print appropriate warnings. The out_*
vars return values, and so are pointers to where the returned values
should be stored. out_capture, if non-null, requests that the innermost
-instance of the lexical is captured; out_name_sv is set to the innermost
-matched namesv or fake namesv; out_flags returns the flags normally
-associated with the IVX field of a fake namesv.
+instance of the lexical is captured; out_name is set to the innermost
+matched pad name or fake pad name; out_flags returns the flags normally
+associated with the PARENT_FAKELEX_FLAGS field of a fake pad name.
Note that pad_findlex() is recursive; it recurses up the chain of CVs,
then comes back down, adding fake entries
as it goes. It has to be this way
-because fake namesvs in anon protoypes have to store in xlow the index into
+because fake names in anon protoypes have to store in xlow the index into
the parent pad.
=cut
@@ -1175,20 +1104,20 @@ the parent pad.
#define CvLATE(cv) (CvANON(cv) || CvCLONE(cv) || SvTYPE(cv) == SVt_PVFM)
static void
-S_unavailable(pTHX_ SV *namesv)
+S_unavailable(pTHX_ PADNAME *name)
{
/* diag_listed_as: Variable "%s" is not available */
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "%se \"%"SVf"\" is not available",
- *SvPVX_const(namesv) == '&'
+ "%se \"%"PNf"\" is not available",
+ *PadnamePV(name) == '&'
? "Subroutin"
: "Variabl",
- SVfARG(namesv));
+ PNfARG(name));
}
STATIC PADOFFSET
S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV*
cv, U32 seq,
- int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
+ int warn, SV** out_capture, PADNAME** out_name, int *out_flags)
{
I32 offset, new_offset;
SV *new_capture;
@@ -1198,10 +1127,10 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
PERL_ARGS_ASSERT_PAD_FINDLEX;
- if (flags & ~(padadd_UTF8_NAME|padadd_STALEOK))
+ flags &= ~ padadd_STALEOK; /* one-shot flag */
+ if (flags)
Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
(UV)flags);
- flags &= ~ padadd_STALEOK; /* one-shot flag */
*out_flags = 0;
@@ -1214,20 +1143,20 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
if (padlist) { /* not an undef CV */
I32 fake_offset = 0;
- const AV * const nameav = PadlistARRAY(padlist)[0];
- SV * const * const name_svp = AvARRAY(nameav);
-
- for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
- const SV * const namesv = name_svp[offset];
- if (namesv && PadnameLEN(namesv) == namelen
- && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
- flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
+ const PADNAMELIST * const names = PadlistNAMES(padlist);
+ PADNAME * const * const name_p = PadnamelistARRAY(names);
+
+ for (offset = PadnamelistMAXNAMED(names); offset > 0; offset--) {
+ const PADNAME * const name = name_p[offset];
+ if (name && PadnameLEN(name) == namelen
+ && ( PadnamePV(name) == namepv
+ || memEQ(PadnamePV(name), namepv, namelen) ))
{
- if (SvFAKE(namesv)) {
+ if (PadnameOUTER(name)) {
fake_offset = offset; /* in case we don't find a real one */
continue;
}
- if (PadnameIN_SCOPE(namesv, seq))
+ if (PadnameIN_SCOPE(name, seq))
break;
}
}
@@ -1235,7 +1164,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
if (offset > 0 || fake_offset > 0 ) { /* a match! */
if (offset > 0) { /* not fake */
fake_offset = 0;
- *out_name_sv = name_svp[offset]; /* return the namesv */
+ *out_name = name_p[offset]; /* return the name */
/* set PAD_FAKELEX_MULTI if this lex can have multiple
* instances. For now, we just test !CvUNIQUE(cv), but
@@ -1252,17 +1181,17 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
PTR2UV(cv), (long)offset,
- (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
- (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
+ (unsigned long)COP_SEQ_RANGE_LOW(*out_name),
+ (unsigned long)COP_SEQ_RANGE_HIGH(*out_name)));
}
else { /* fake match */
offset = fake_offset;
- *out_name_sv = name_svp[offset]; /* return the namesv */
- *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
+ *out_name = name_p[offset]; /* return the name */
+ *out_flags = PARENT_FAKELEX_FLAGS(*out_name);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx
index=%lu\n",
PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
- (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
+ (unsigned long) PARENT_PAD_INDEX(*out_name)
));
}
@@ -1271,7 +1200,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
if (out_capture) {
/* our ? */
- if (SvPAD_OUR(*out_name_sv)) {
+ if (PadnameIsOUR(*out_name)) {
*out_capture = NULL;
return offset;
}
@@ -1283,9 +1212,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
{
if (warn)
S_unavailable(aTHX_
- newSVpvn_flags(namepv, namelen,
- SVs_TEMP |
- (flags & padadd_UTF8_NAME ?
SVf_UTF8 : 0)));
+ *out_name);
*out_capture = NULL;
}
@@ -1294,29 +1221,30 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
else {
int newwarn = warn;
if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
- && !SvPAD_STATE(name_svp[offset])
+ && !PadnameIsSTATE(name_p[offset])
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
+ /* diag_listed_as: Variable "%s" will not stay
+ shared */
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%"SVf"\" will not stay shared",
- SVfARG(newSVpvn_flags(namepv, namelen,
- SVs_TEMP |
- (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))));
+ "%se \"%"UTF8f"\" will not stay shared",
+ *namepv == '&' ? "Subroutin" : "Variabl",
+ UTF8fARG(1, namelen, namepv));
}
if (fake_offset && CvANON(cv)
&& CvCLONE(cv) &&!CvCLONED(cv))
{
- SV *n;
+ PADNAME *n;
/* not yet caught - look further up */
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" chasing lex in outer
pad\n",
PTR2UV(cv)));
- n = *out_name_sv;
+ n = *out_name;
(void) pad_findlex(namepv, namelen, flags,
CvOUTSIDE(cv),
CvOUTSIDE_SEQ(cv),
- newwarn, out_capture, out_name_sv, out_flags);
- *out_name_sv = n;
+ newwarn, out_capture, out_name, out_flags);
+ *out_name = n;
return offset;
}
@@ -1328,12 +1256,10 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
if (SvPADSTALE(*out_capture)
&& (!CvDEPTH(cv) || !staleok)
- && !SvPAD_STATE(name_svp[offset]))
+ && !PadnameIsSTATE(name_p[offset]))
{
S_unavailable(aTHX_
- newSVpvn_flags(namepv, namelen,
- SVs_TEMP |
- (flags & padadd_UTF8_NAME ?
SVf_UTF8 : 0)));
+ name_p[offset]);
*out_capture = NULL;
}
}
@@ -1366,7 +1292,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
offset = pad_findlex(namepv, namelen,
flags | padadd_STALEOK*(new_capturep == &new_capture),
CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
- new_capturep, out_name_sv, out_flags);
+ new_capturep, out_name, out_flags);
if ((PADOFFSET)offset == NOT_IN_PAD)
return NOT_IN_PAD;
@@ -1382,48 +1308,47 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen,
U32 flags, const CV* cv,
type as the source, independent of the flags set, and on it being
"good" and only copying flag bits and pointers that it understands.
*/
- SV *new_namesv = newSVsv(*out_name_sv);
- AV * const ocomppad_name = PL_comppad_name;
+ PADNAME *new_name = newPADNAMEouter(*out_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);
new_offset
- = pad_alloc_name(new_namesv,
- (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
- SvPAD_TYPED(*out_name_sv)
- ? SvSTASH(*out_name_sv) : NULL,
- SvOURSTASH(*out_name_sv)
+ = pad_alloc_name(new_name,
+ PadnameIsSTATE(*out_name) ? padadd_STATE : 0,
+ PadnameTYPE(*out_name),
+ PadnameOURSTASH(*out_name)
);
- SvFAKE_on(new_namesv);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad addname: %ld \"%.*s\" FAKE\n",
(long)new_offset,
- (int) SvCUR(new_namesv), SvPVX(new_namesv)));
- PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
+ (int) PadnameLEN(new_name),
+ PadnamePV(new_name)));
+ PARENT_FAKELEX_FLAGS_set(new_name, *out_flags);
- PARENT_PAD_INDEX_set(new_namesv, 0);
- if (SvPAD_OUR(new_namesv)) {
+ PARENT_PAD_INDEX_set(new_name, 0);
+ if (PadnameIsOUR(new_name)) {
NOOP; /* do nothing */
}
else if (CvLATE(cv)) {
/* delayed creation - just note the offset within parent pad */
- PARENT_PAD_INDEX_set(new_namesv, offset);
+ PARENT_PAD_INDEX_set(new_name, offset);
CvCLONE_on(cv);
}
else {
/* immediate creation - capture outer value right now */
av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
/* But also note the offset, as newMYSUB needs it */
- PARENT_PAD_INDEX_set(new_namesv, offset);
+ PARENT_PAD_INDEX_set(new_name, offset);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset
%ld\n",
PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
}
- *out_name_sv = new_namesv;
- *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
+ *out_name = new_name;
+ *out_flags = PARENT_FAKELEX_FLAGS(new_name);
PL_comppad_name = ocomppad_name;
PL_comppad = ocomppad;
@@ -1501,7 +1426,7 @@ Perl_pad_block_start(pTHX_ int full)
{
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);
**** PATCH TRUNCATED AT 2000 LINES -- 1700 NOT SHOWN ****
--
Perl5 Master Repository
