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, 44 insertions, 56 deletions

diff --git a/op.c b/op.c
index 2fc4d94d41..4ea83d172c 100644
--- a/op.c
+++ b/op.c
@@ -6344,8 +6344,9 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     I32 j;
     I32 grows = 0;
     OPtrans_map *tbl;
+    SSize_t struct_size; /* malloced size of table struct */
 
-    const I32 complement = o->op_private & OPpTRANS_COMPLEMENT;
+    const bool complement = cBOOL(o->op_private & OPpTRANS_COMPLEMENT);
     const I32 squash     = o->op_private & OPpTRANS_SQUASH;
     I32 del              = o->op_private & OPpTRANS_DELETE;
     SV* swash;
@@ -6611,35 +6612,43 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	goto warnins;
     }
 
-    /* Non-utf8 case: set o->op_pv to point to a simple 256-entry lookup
+    /* Non-utf8 case: set o->op_pv to point to a simple 256+ entry lookup
      * table. Entries with the value -1 indicate chars not to be
      * translated, while -2 indicates a search char without a
      * corresponding replacement char under /d.
      *
-     * With /c, an extra length arg is stored at the end of the table to
-     * indicate the number of chars in the replacement string, plus any
-     * excess replacement chars not paired with search chars. The extra
-     * chars are needed for utf8 strings. For example,
-     * tr/\x00-\xfd/abcd/c is logically equivalent to
-     * tr/\xfe\xff\x{100}\x{101}.../abcdddd.../, so the c,d chars need to
-     * be kept even though they aren't paired with any chars in the table
-     * (which represents chars \x00-\xff). Even without excess chars, the
-     * last replacement char needs to be kept.
+     * Normally, the table has 256 slots. However, in the presence of
+     * /c, the search charlist has an implicit \x{100}-\x{7fffffff}
+     * added, and if there are enough replacement chars to start pairing
+     * with the \x{100},... search chars, then a larger (> 256) table
+     * is allocated.
+     *
+     * In addition, regardless of whether under /c, an extra slot at the
+     * end is used to store the final repeating char, or -3 under an empty
+     * replacement list, or -2 under /d; which makes the runtime code
+     * easier.
      *
      * The toker will have already expanded char ranges in t and r.
      */
 
-    tbl = (OPtrans_map*)PerlMemShared_calloc(
-                    complement  ? sizeof(OPtrans_map_ex) : sizeof(OPtrans_map),
-                    sizeof(char));
+    /* Initially allocate 257-slot table: 256 for basic (non /c) usage,
+     * plus final slot for repeat/-2/-3. Later we realloc if excess > * 0.
+     * The OPtrans_map struct already contains one slot; hence the -1.
+     */
+    struct_size = sizeof(OPtrans_map) + (256 - 1 + 1)*sizeof(short);
+    tbl = (OPtrans_map*)PerlMemShared_calloc(struct_size, 1);
+    tbl->size = 256;
     cPVOPo->op_pv = (char*)tbl;
 
     if (complement) {
+        SSize_t excess;
+
         /* in this branch, j is a count of 'consumed' (i.e. paired off
          * with a search char) replacement chars (so j <= rlen always)
          */
 	for (i = 0; i < (I32)tlen; i++)
 	    tbl->map[t[i]] = -1;
+
 	for (i = 0, j = 0; i < 256; i++) {
 	    if (!tbl->map[i]) {
 		if (j == (I32)rlen) {
@@ -6659,52 +6668,29 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	}
 
         assert(j <= (I32)rlen);
+        excess = rlen - (SSize_t)j;
 
-        /* populate extended portion of table */
-
-	{
-                    /* the repeat char: it may be used to fill the 0x100+
-                     * range. For example,
-                     *     tr/\x00-AE-\xff/bcd/c
-                     * is equivalent to
-                     *     tr/BCD\x{100}-\x{7fffffff}/bcd/
-                     * which is equivalent to
-                     *     tr/BCD\x{100}-\x{7fffffff}/bcddddddddd..../
-                     * So remember the 'd'.
-                     */
-            short   repeat_char;
-            SSize_t excess = rlen - (SSize_t)j;
-            OPtrans_map_ex *extbl = (OPtrans_map_ex*)tbl;
+        if (excess) {
+            /* More replacement chars than search chars:
+             * store excess replacement chars at end of main table.
+             */
 
-	    if (excess) {
-                /* More replacement chars than search chars:
-                 * store excess replacement chars at end of main table.
-                 */
+            struct_size += excess;
+            tbl = (OPtrans_map*)PerlMemShared_realloc(tbl,
+                        struct_size + excess * sizeof(short));
+            tbl->size += excess;
+            cPVOPo->op_pv = (char*)tbl;
 
-		extbl = (OPtrans_map_ex *) PerlMemShared_realloc(extbl,
-                            sizeof(OPtrans_map_ex) + excess * sizeof(short));
-		cPVOPo->op_pv = (char*)extbl;
-                for (i = 0; i < (I32)excess; i++)
-                    extbl->map_ex[i] = r[j+i];
-                repeat_char = r[rlen-1];
-	    }
-	    else {
-                /* no more replacement chars than search chars */
+            for (i = 0; i < (I32)excess; i++)
+                tbl->map[i + 256] = r[j+i];
+        }
+        else {
+            /* no more replacement chars than search chars */
+            if (!rlen && !del && !squash)
+                o->op_private |= OPpTRANS_IDENTICAL;
+        }
 
-                if (rlen)
-                    repeat_char = r[rlen - 1];
-                else {
-                    /* empty replacement list */
-                    repeat_char = 0; /* this value isn't used at runtime */
-                    /* -1 excess count indicates empty replacement charlist */
-                    excess = -1;
-                    if (!(squash | del))
-                        o->op_private |= OPpTRANS_IDENTICAL;
-                }
-	    }
-            extbl->excess_len  = excess;      /* excess char count */
-            extbl->repeat_char = (short)repeat_char; /* repeated replace char */
-	}
+        tbl->map[tbl->size] = del ? -2 : rlen ? r[rlen - 1] : -3;
     }
     else {
 	if (!rlen && !del) {
@@ -6715,6 +6701,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	else if (!squash && rlen == tlen && memEQ((char*)t, (char*)r, tlen)) {
 	    o->op_private |= OPpTRANS_IDENTICAL;
 	}
+
 	for (i = 0; i < 256; i++)
 	    tbl->map[i] = -1;
 	for (i = 0, j = 0; i < (I32)tlen; i++,j++) {
@@ -6733,6 +6720,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 		tbl->map[t[i]] = r[j];
 	    }
 	}
+        tbl->map[tbl->size] = del ? -1 : rlen ? -1 : -3;
     }
 
     /* both non-utf8 and utf8 code paths end up here */