tr///; simplify $utf8 =~ tr/nonutf8/nonutf8/

The run-time code to handle a non-utf8 tr/// against a utf8 string
is complex, with many variants of similar code repeated depending on the
presence of the /s and /c flags.

Simplify them all into a single code block by changing how the translation
table is stored. Formerly, the tr struct contained possibly two tables:
the basic 0-255 slot one, plus in the presence of /c, a second one
to map the implicit search range (\x{100}...) against any residual
replacement chars not consumed by the first table.

This commit merges the two tables into a single unified whole. For example

    tr/\x00-\xfe/abcd/c

is equivalent to

    tr/xff-\x{7fffffff}/abcd/

which generates a 259-entry translation table consisting of:

    0x00  => -1
    0x01  => -1
    ...
    0xfe  => -1
    0xff  =>  a
    0x100 =>  b
    0x101 =>  c
    0x102 =>  d

In addition we store:
    1) the size of the translation table (0x103 in the example above);
    2) an extra 'wildcard' entry stored 1 slot beyond the main table,
       which specifies the action for any codepoints outside the range of
       the table (i.e. chars 0x103..0x7fffffff). This can be either:
        a) a character, when the last replacement char is repeated;
        b) -1 when /c isn't in effect;
        c) -2 when /d is in effect;
        c) -3 identity: when the replacement list is empty but not /d.

       In the example above, this would be
            0x103 =>  d

The addition of -3 as a valid slot value is new.

This makes the main runtime code for the utf8 string with non-utf8 tr//
case look like, at its core:

    size = tbl->size;
    mapped_ch = tbl->map[ch >= size ? size : ch];

which then processes mapped_ch based on whether its >=0, or -1/-2/-3.

This is a lot simpler than the old scheme, and should generally be faster
too.

1 files changed, 3 insertions, 2 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 0b4fafc012..ab691c2491 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -5610,8 +5610,9 @@ sub collapse {
 sub tr_decode_byte {
     my($table, $flags) = @_;
     my $ssize_t = $Config{ptrsize} == 8 ? 'q' : 'l';
-    my (@table) = unpack("s256${ssize_t}ss*", $table);
-    my ($excess_len, $repeat_char) = splice(@table, 256, 2);
+    my ($size, @table) = unpack("${ssize_t}s*", $table);
+    printf "XXX len=%d size=%d scalar\@table=%d\n", length($table), $size, scalar@table;
+    pop @table; # remove the wildcard final entry
 
     my($c, $tr, @from, @to, @delfrom, $delhyphen);
     if ($table[ord "-"] != -1 and