Optimize out unicode_to_native(), native_to_unicode()

These just return their argument on ASCII platforms, so can get rid of
the function call overhead there.

Thanks to Zefram and Matthew Horsfall for their help in this.

diff --git a/lib/utf8.pm b/lib/utf8.pm
index 4980c7c..ed23b61 100644 (file)
--- a/lib/utf8.pm
+++ b/lib/utf8.pm
@@ -2,7 +2,7 @@ package utf8;
 
 $utf8::hint_bits = 0x00800000;
 
-our $VERSION = '1.14';
+our $VERSION = '1.15';
 
 sub import {
     $^H |= $utf8::hint_bits;
@@ -186,6 +186,7 @@ L<Encode>.
 
 =item * C<$unicode = utf8::native_to_unicode($code_point)>
 
+(Since Perl v5.8.0)
 This takes an unsigned integer (which represents the ordinal number of a
 character (or a code point) on the platform the program is being run on) and
 returns its Unicode equivalent value.  Since ASCII platforms natively use the
@@ -195,8 +196,12 @@ platforms it converts from EBCIDC to Unicode.
 A meaningless value will currently be returned if the input is not an unsigned
 integer.
 
+Since Perl v5.22.0, calls to this function are optimized out on ASCII
+platforms, so there is no performance hit in using it there.
+
 =item * C<$native = utf8::unicode_to_native($code_point)>
 
+(Since Perl v5.8.0)
 This is the inverse of C<utf8::native_to_unicode()>, converting the other
 direction.  Again, on ASCII platforms, this returns its input, but on EBCDIC
 platforms it will find the native platform code point, given any Unicode one.
@@ -204,6 +209,9 @@ platforms it will find the native platform code point, given any Unicode one.
 A meaningless value will currently be returned if the input is not an unsigned
 integer.
 
+Since Perl v5.22.0, calls to this function are optimized out on ASCII
+platforms, so there is no performance hit in using it there.
+
 =item * C<$flag = utf8::is_utf8($string)>
 
 (Since Perl 5.8.1)  Test whether I<$string> is marked internally as encoded in

diff --git a/lib/utf8.t b/lib/utf8.t
index 8578444..bf722f3 100644 (file)
--- a/lib/utf8.t
+++ b/lib/utf8.t
@@ -481,7 +481,7 @@ SKIP: {
             use strict;
             my $s = "hlagh";
             my $r = \$s;
-            %s($r);
+            my $dummy = %s($r);
             $$r;
         ], $func;
         my $ret = eval $code or my $error = $@;
@@ -603,6 +603,21 @@ for my $pos (0..5) {
     is($s, "A$utf8_bytes","(pos $pos) str after  U; utf8::encode");
 }
 
+SKIP: {
+    skip("Test only valid on ASCII platform", 1) unless $::IS_ASCII;
+    require Config;
+    skip("Test needs a B module, which is lacking in this Perl", 1)
+        if $Config::Config{'extensions'} !~ /\bB\b/;
+
+    my $out = runperl ( switches => ["-XMO=Concise"],
+                    prog => 'utf8::unicode_to_native(0x41);
+                             utf8::native_to_unicode(0x42)',
+                    stderr => 1 );
+    unlike($out, qr/entersub/,
+            "utf8::unicode_to_native() and native_to_unicode() optimized out");
+}
+
+
 # [perl #119043] utf8::upgrade should not croak on read-only COWs
 for(__PACKAGE__) {
        eval { utf8::upgrade($_) };

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 91c23d2..822281e 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -89,7 +89,12 @@ There may well be none in a stable release.
 
 =item *
 
-XXX
+The functions
+C<utf8::native_to_unicode()> and
+C<utf8::unicode_to_native()> (see L<utf8>)
+are now optimized out on ASCII platforms.
+There is now not even a minimal performance hit in writing code portable
+between ASCII and EBCDIC platforms.
 
 =back
 

diff --git a/universal.c b/universal.c
index 4c98510..864558f 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -1035,6 +1035,53 @@ static const struct xsub_details details[] = {
     {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
 };
 
+STATIC OP*
+optimize_out_native_convert_function(pTHX_ OP* entersubop,
+                                           GV* namegv,
+                                           SV* protosv)
+{
+    /* Optimizes out an identity function, i.e., one that just returns its
+     * argument.  The passed in function is assumed to be an identity function,
+     * with no checking.  This is designed to be called for utf8_to_native()
+     * and native_to_utf8() on ASCII platforms, as they just return their
+     * arguments, but it could work on any such function.
+     *
+     * The code is mostly just cargo-culted from Memoize::Lift */
+
+    OP *pushop, *argop;
+    SV* prototype = newSVpvs("$");
+
+    PERL_UNUSED_ARG(protosv);
+
+    assert(entersubop->op_type == OP_ENTERSUB);
+
+    entersubop = ck_entersub_args_proto(entersubop, namegv, prototype);
+
+    SvREFCNT_dec(prototype);
+
+    pushop = cUNOPx(entersubop)->op_first;
+    if (! pushop->op_sibling) {
+        pushop = cUNOPx(pushop)->op_first;
+    }
+    argop = pushop->op_sibling;
+
+    /* Carry on without doing the optimization if it is not something we're
+     * expecting, so continues to work */
+    if (   ! argop
+        || ! argop->op_sibling
+        ||   argop->op_sibling->op_sibling
+    ) {
+        return entersubop;
+    }
+
+    pushop->op_sibling = argop->op_sibling;
+    argop->op_sibling = NULL;
+    argop->op_lastsib = 1;
+
+    op_free(entersubop);
+    return argop;
+}
+
 void
 Perl_boot_core_UNIVERSAL(pTHX)
 {
@@ -1046,6 +1093,22 @@ Perl_boot_core_UNIVERSAL(pTHX)
        newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
     } while (++xsub < end);
 
+#ifndef EBCDIC
+    { /* On ASCII platforms these functions just return their argument, so can
+         be optimized away */
+
+        CV* to_native_cv = get_cv("utf8::unicode_to_native", 0);
+        CV* to_unicode_cv = get_cv("utf8::native_to_unicode", 0);
+
+        cv_set_call_checker(to_native_cv,
+                            optimize_out_native_convert_function,
+                            (SV*) to_native_cv);
+        cv_set_call_checker(to_unicode_cv,
+                            optimize_out_native_convert_function,
+                            (SV*) to_unicode_cv);
+    }
+#endif
+
     /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t  */
     {
        CV * const cv =