This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add transr op type
authorFather Chrysostomos <sprout@cpan.org>
Wed, 3 Nov 2010 03:18:15 +0000 (20:18 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 3 Nov 2010 04:32:33 +0000 (21:32 -0700)
for the upcoming y///r feature. There are not enough flag bits,
hence the extra type.

embed.h
opcode.h
opnames.h
pp.sym
proto.h
regen/opcode.pl

diff --git a/embed.h b/embed.h
index 31cd119..ae2db75 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define pp_time()              Perl_pp_time(aTHX)
 #define pp_tms()               Perl_pp_tms(aTHX)
 #define pp_trans()             Perl_pp_trans(aTHX)
+#define pp_transr()            Perl_pp_transr(aTHX)
 #define pp_truncate()          Perl_pp_truncate(aTHX)
 #define pp_uc()                        Perl_pp_uc(aTHX)
 #define pp_ucfirst()           Perl_pp_ucfirst(aTHX)
index c7a304d..bb07bef 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -402,6 +402,7 @@ EXTCONST char* const PL_op_name[] = {
        "reach",
        "rkeys",
        "rvalues",
+       "transr",
 };
 #endif
 
@@ -778,6 +779,7 @@ EXTCONST char* const PL_op_desc[] = {
        "each on reference",
        "keys on reference",
        "values on reference",
+       "transliteration (tr///)",
 };
 #endif
 
@@ -834,7 +836,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        Perl_pp_qr,
        Perl_pp_subst,
        Perl_pp_substcont,
-       Perl_pp_trans,
+       Perl_pp_trans,  /* Perl_pp_trans */
        Perl_pp_sassign,
        Perl_pp_aassign,
        Perl_pp_chop,
@@ -1168,6 +1170,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        Perl_pp_rkeys,  /* Perl_pp_reach */
        Perl_pp_rkeys,
        Perl_pp_rkeys,  /* Perl_pp_rvalues */
+       Perl_pp_trans,  /* Perl_pp_transr */
 }
 #endif
 #ifdef PERL_PPADDR_INITED
@@ -1555,6 +1558,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_each,           /* reach */
        Perl_ck_each,           /* rkeys */
        Perl_ck_each,           /* rvalues */
+       Perl_ck_match,          /* transr */
 }
 #endif
 #ifdef PERL_CHECK_INITED
@@ -1936,6 +1940,7 @@ EXTCONST U32 PL_opargs[] = {
        0x00001b00,     /* reach */
        0x00001b08,     /* rkeys */
        0x00001b08,     /* rvalues */
+       0x00001804,     /* transr */
 };
 #endif
 
index 26c3ba1..609c6e2 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -384,10 +384,11 @@ typedef enum opcode {
        OP_REACH         = 366,
        OP_RKEYS         = 367,
        OP_RVALUES       = 368,
+       OP_TRANSR        = 369,
        OP_max          
 } opcode;
 
-#define MAXO 369
+#define MAXO 370
 #define OP_phoney_INPUT_ONLY -1
 #define OP_phoney_OUTPUT_ONLY -2
 
diff --git a/pp.sym b/pp.sym
index 095ee2e..11e8f78 100644 (file)
--- a/pp.sym
+++ b/pp.sym
@@ -413,5 +413,6 @@ Perl_pp_once
 Perl_pp_reach
 Perl_pp_rkeys
 Perl_pp_rvalues
+Perl_pp_transr
 
 # ex: set ro:
diff --git a/proto.h b/proto.h
index c17071b..ffbf147 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3178,6 +3178,7 @@ PERL_CALLCONV OP *        Perl_pp_tied(pTHX);
 PERL_CALLCONV OP *     Perl_pp_time(pTHX);
 PERL_CALLCONV OP *     Perl_pp_tms(pTHX);
 PERL_CALLCONV OP *     Perl_pp_trans(pTHX);
+PERL_CALLCONV OP *     Perl_pp_transr(pTHX);
 PERL_CALLCONV OP *     Perl_pp_truncate(pTHX);
 PERL_CALLCONV OP *     Perl_pp_uc(pTHX);
 PERL_CALLCONV OP *     Perl_pp_ucfirst(pTHX);
index 9369c2e..90c1bc0 100755 (executable)
@@ -38,7 +38,8 @@ while (<DATA>) {
     my ($key, $desc, $check, $flags, $args) = split(/\t+/, $_, 5);
     $args = '' unless defined $args;
 
-    warn qq[Description "$desc" duplicates $seen{$desc}\n] if $seen{$desc};
+    warn qq[Description "$desc" duplicates $seen{$desc}\n]
+     if $seen{$desc} and $key ne "transr";
     die qq[Opcode "$key" duplicates $seen{$key}\n] if $seen{$key};
     $seen{$desc} = qq[description of opcode "$key"];
     $seen{$key} = qq[opcode "$key"];
@@ -106,6 +107,7 @@ my @raw_alias = (
                 Perl_pp_rv2av => ['rv2hv'],
                 Perl_pp_akeys => ['avalues'],
                 Perl_pp_rkeys => [qw(rvalues reach)],
+                Perl_pp_trans => [qw(trans transr)],
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
@@ -653,6 +655,7 @@ qr          pattern quote (qr//)    ck_match        s/
 subst          substitution (s///)     ck_match        dis/    S
 substcont      substitution iterator   ck_null         dis|    
 trans          transliteration (tr///) ck_match        is"     S
+# transr (the /r version) is further down.
 
 # Lvalue operators.
 # sassign is special-cased for op class
@@ -1105,3 +1108,6 @@ custom            unknown custom operator         ck_null         0
 reach          each on reference                       ck_each         %       S
 rkeys          keys on reference                       ck_each         t%      S
 rvalues                values on reference                     ck_each         t%      S
+
+# y///r
+transr         transliteration (tr///) ck_match        is"     S