develooper Front page | perl.perl5.porters | Postings from November 2014

[perl #123108] [PATCH 2/5] end the pp_mapstart trickery

From:
Jim Cromie
Date:
November 2, 2014 21:03
Subject:
[perl #123108] [PATCH 2/5] end the pp_mapstart trickery
Message ID:
rt-4.0.18-18676-1414962153-867.123108-75-0@perl.org
# New Ticket Created by  Jim Cromie 
# Please include the string:  [perl #123108]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/Ticket/Display.html?id=123108 >


Current codebase wires Perl_pp_mapstart to Perl_unimplemented_op (by
regen/opcode.pl) [1], but then avoids runtime panics by Perl_ck_grep
changing all OP_MAPSTART nodes to use PL_ppaddr[OP_GREPSTART] [2].

This is all too clever by half, so this patch undoes the trickery, and
treats these 2 OPS like 93bad3fd5548 did for OP_AELEMFAST and \1_LEX.

I cant glean a reason for this historical arrangement:
Looking at regen/opcode.pl blamelog..

65bca31a68 added Perl_unimplemented_op() used by 3 'unreachable' ops,
and replaced a 'panic: mapstart' diag with a common one, so the trick
goes further back.

c78ff9799bf moved a minimal/DIEing pp_mapstart implementation to
mathoms.c from pp_ctl.c.  Perl_ck_grep also did the GREPSTART patching
back then.

f54cb97a39f did minor tweaks to a full pp_mapstart implementation.  I
couldnt find the commit between it and c78ff that changed pp_mapstart
to a DIEing one, or I fat-fingered it, or I got distracted.

looking at ck-grep(), the code doing [2] is from 22c35a8c23 in 1998.

So anyway, I tried the following, it worked, it seems the historical
reason is no longer relevant.

[1] change regen/opcode.pl generated mapping
   -#define Perl_pp_mapstart Perl_unimplemented_op
   +#define Perl_pp_mapstart Perl_pp_grepstart

   this sets PL_ppaddr[OP_MAPSTART] = PL_ppaddr[OP_GREPSTART] during
   init, which makes the optype trickery in ck_grep[2] unneeded.

[2] Drop re-type-ing of MAPSTARTs as GREPSTARTs by Perl_ck_grep(OP* o)
   Given 1, mapstart & grepstart share code, so just leave optype alone.

requires make regen
---
 op.c            | 1 -
 opcode.h        | 4 ++--
 regen/opcode.pl | 3 ++-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/op.c b/op.c
index dbb2886..f259e68 100644
--- a/op.c
+++ b/op.c
@@ -9850,7 +9850,6 @@ Perl_ck_grep(pTHX_ OP *o)
 
     PERL_ARGS_ASSERT_CK_GREP;
 
-    o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
     /* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
 
     if (o->op_flags & OPf_STACKED) {
diff --git a/opcode.h b/opcode.h
index 40cdc81..c367c09 100644
--- a/opcode.h
+++ b/opcode.h
@@ -44,7 +44,7 @@
 #define Perl_pp_keys Perl_do_kv
 #define Perl_pp_rv2hv Perl_pp_rv2av
 #define Perl_pp_pop Perl_pp_shift
-#define Perl_pp_mapstart Perl_unimplemented_op
+#define Perl_pp_mapstart Perl_pp_grepstart
 #define Perl_pp_dor Perl_pp_defined
 #define Perl_pp_andassign Perl_pp_and
 #define Perl_pp_orassign Perl_pp_or
@@ -1106,7 +1106,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 	Perl_pp_reverse,
 	Perl_pp_grepstart,
 	Perl_pp_grepwhile,
-	Perl_pp_mapstart,	/* implemented by Perl_unimplemented_op */
+	Perl_pp_mapstart,	/* implemented by Perl_pp_grepstart */
 	Perl_pp_mapwhile,
 	Perl_pp_range,
 	Perl_pp_flip,
diff --git a/regen/opcode.pl b/regen/opcode.pl
index b9d7042..df0fbf4 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -78,7 +78,7 @@ my %alias;
 # Format is "this function" => "does these op names"
 my @raw_alias = (
 		 Perl_do_kv => [qw( keys values )],
-		 Perl_unimplemented_op => [qw(padany mapstart custom)],
+		 Perl_unimplemented_op => [qw(padany custom)],
 		 # All the ops with a body of { return NORMAL; }
 		 Perl_pp_null => [qw(scalar regcmaybe lineseq scope)],
 
@@ -135,6 +135,7 @@ my @raw_alias = (
 					 spwent epwent sgrent egrent)],
 		 Perl_pp_shostent => [qw(snetent sprotoent sservent)],
 		 Perl_pp_aelemfast => ['aelemfast_lex'],
+		 Perl_pp_grepstart => ['mapstart'],
 		);
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
-- 
1.8.3.1




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About