diff options
| -rw-r--r-- | doop.c | 114 | ||||
| -rw-r--r-- | ext/B/B.xs | 19 | ||||
| -rw-r--r-- | lib/B/Deparse.pm | 5 | ||||
| -rw-r--r-- | op.c | 100 | ||||
| -rw-r--r-- | op.h | 14 |
5 files changed, 77 insertions, 175 deletions
@@ -166,11 +166,11 @@ S_do_trans_complex(pTHX_ SV * const sv) U8 *s = (U8*)SvPV_nomg(sv, len); U8 * const send = s+len; I32 matches = 0; - const OPtrans_map_ex * const extbl = (OPtrans_map_ex*)cPVOP->op_pv; + const OPtrans_map * const tbl = (OPtrans_map*)cPVOP->op_pv; PERL_ARGS_ASSERT_DO_TRANS_COMPLEX; - if (!extbl) + if (!tbl) Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__); if (!SvUTF8(sv)) { @@ -180,7 +180,7 @@ S_do_trans_complex(pTHX_ SV * const sv) if (PL_op->op_private & OPpTRANS_SQUASH) { const U8* p = send; while (s < send) { - const I32 ch = extbl->map[*s]; + const I32 ch = tbl->map[*s]; if (ch >= 0) { *d = (U8)ch; matches++; @@ -196,7 +196,7 @@ S_do_trans_complex(pTHX_ SV * const sv) } else { while (s < send) { - const I32 ch = extbl->map[*s]; + const I32 ch = tbl->map[*s]; if (ch >= 0) { matches++; *d++ = (U8)ch; @@ -212,25 +212,19 @@ S_do_trans_complex(pTHX_ SV * const sv) SvCUR_set(sv, d - dstart); } else { /* is utf8 */ - const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT; + const bool squash = cBOOL(PL_op->op_private & OPpTRANS_SQUASH); const I32 grows = PL_op->op_private & OPpTRANS_GROWS; - const I32 del = PL_op->op_private & OPpTRANS_DELETE; U8 *d; U8 *dstart; - SSize_t excess = 0; + Size_t size = tbl->size; + UV pch = 0xfeedface; if (grows) Newx(d, len*2+1, U8); else d = s; dstart = d; - if (complement) - /* number of replacement chars in excess of any 0x00..0xff - * search characters */ - excess = extbl->excess_len; - if (PL_op->op_private & OPpTRANS_SQUASH) { - UV pch = 0xfeedface; while (s < send) { STRLEN len; const UV comp = utf8n_to_uvchr(s, send - s, &len, @@ -238,40 +232,13 @@ S_do_trans_complex(pTHX_ SV * const sv) UV ch; short sch; - if (comp > 0xff) { - if (!complement) { - Move(s, d, len, U8); - d += len; - } - else { - /* use the implicit 0x100..0x7fffffff search range */ - UV comp100 = comp - 0x100; - matches++; - ch = del - /* setting ch to pch forces char to be deleted */ - ? ((excess > (IV)comp100) - ? (UV)extbl->map_ex[comp100] - : pch ) - - : ( (excess == -1) ? comp : - (UV)(( excess == 0 - || excess <= (IV)comp100) - ? extbl->repeat_char - : extbl->map_ex[comp100] - ) - ); - if (ch != pch) { - d = uvchr_to_utf8(d, ch); - pch = ch; - } - s += len; - continue; - } - } - else if ((sch = extbl->map[comp]) >= 0) { + sch = tbl->map[comp >= size ? size : comp]; + + if (sch >= 0) { ch = (UV)sch; + replace: matches++; - if (ch != pch) { + if (LIKELY(!squash || ch != pch)) { d = uvchr_to_utf8(d, ch); pch = ch; } @@ -282,59 +249,18 @@ S_do_trans_complex(pTHX_ SV * const sv) Move(s, d, len, U8); d += len; } - else if (sch == -2) /* -2 is delete character */ + else if (sch == -2) /* -2 is delete character */ matches++; + else { + assert(sch == -3); /* -3 is empty replacement */ + ch = comp; + goto replace; + } + s += len; pch = 0xfeedface; } - } - else { - while (s < send) { - STRLEN len; - const UV comp = utf8n_to_uvchr(s, send - s, &len, - UTF8_ALLOW_DEFAULT); - UV ch; - short sch; - if (comp > 0xff) { - if (!complement) { - Move(s, d, len, U8); - d += len; - } - else { - /* use the implicit 0x100..0x7fffffff search range */ - UV comp100 = comp - 0x100; - matches++; - if (del) { - if (excess > (IV)comp100) { - ch = (UV)extbl->map_ex[comp100]; - d = uvchr_to_utf8(d, ch); - } - } - else { - /* tr/...//c should call S_do_trans_count - * instead */ - assert(excess != -1); - ch = ( excess == 0 - || excess <= (IV)comp100) - ? (UV)extbl->repeat_char - : (UV)extbl->map_ex[comp100]; - d = uvchr_to_utf8(d, ch); - } - } - } - else if ((sch = extbl->map[comp]) >= 0) { - d = uvchr_to_utf8(d, (UV)sch); - matches++; - } - else if (sch == -1) { /* -1 is unmapped character */ - Move(s, d, len, U8); - d += len; - } - else if (sch == -2) /* -2 is delete character */ - matches++; - s += len; - } - } + if (grows) { sv_setpvn(sv, (char*)dstart, d - dstart); Safefree(dstart); diff --git a/ext/B/B.xs b/ext/B/B.xs index 426cbf3319..d9d77157c6 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1022,22 +1022,17 @@ next(o) ret = make_sv_object(aTHX_ NULL); break; case 41: /* B::PVOP::pv */ - /* OP_TRANS uses op_pv to point to a OPtrans_map or - * OPtrans_map_ex struct, whereas other PVOPs point to a - * null terminated string. For trans, for now just return the - * whole struct as a string and let the caller unpack() it */ + /* OP_TRANS uses op_pv to point to a OPtrans_map struct, + * whereas other PVOPs point to a null terminated string. + * For trans, for now just return the whole struct as a + * string and let the caller unpack() it */ if ( cPVOPo->op_type == OP_TRANS || cPVOPo->op_type == OP_TRANSR) { - const OPtrans_map_ex * const extbl = - (OPtrans_map_ex*)cPVOPo->op_pv; - char *end = (char*)(&(extbl->map[256])); - if (cPVOPo->op_private & OPpTRANS_COMPLEMENT) { - SSize_t excess_len = extbl->excess_len; - end = (char*)(&(extbl->map_ex[excess_len])); - } + const OPtrans_map *const tbl = (OPtrans_map*)cPVOPo->op_pv; ret = newSVpvn_flags(cPVOPo->op_pv, - end - (char*)extbl, + (char*)(&tbl->map[tbl->size + 1]) + - (char*)tbl, SVs_TEMP); } else 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 @@ -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 */ @@ -628,21 +628,13 @@ typedef enum { #endif -/* basic and extended translation tables attached to OP_TRANS/OP_TRANSR ops */ +/* translation table attached to OP_TRANS/OP_TRANSR ops */ typedef struct { - short map[256]; + Size_t size; /* number of entries in map[], not including final slot */ + short map[1]; /* Unwarranted chumminess */ } OPtrans_map; -/* used in the presence of tr///c to record any replacement chars that - * are paired with the implicit 0x100..0x7fffffff search chars */ -typedef struct { - short map[256]; - SSize_t excess_len; /* number of entries in map_ex[] */ - short repeat_char; - short map_ex[1]; /* Unwarranted chumminess */ -} OPtrans_map_ex; - /* =head1 Optree Manipulation Functions |