STRLEN rlen;
const U8 *t = (U8*)SvPV_const(tstr, tlen);
const U8 *r = (U8*)SvPV_const(rstr, rlen);
- I32 i;
- I32 j;
- I32 grows = 0;
+ Size_t i, j;
+ bool grows = FALSE;
OPtrans_map *tbl;
+ SSize_t struct_size; /* malloced size of table struct */
- const I32 complement = o->op_private & OPpTRANS_COMPLEMENT;
- const I32 squash = o->op_private & OPpTRANS_SQUASH;
- I32 del = o->op_private & OPpTRANS_DELETE;
+ const bool complement = cBOOL(o->op_private & OPpTRANS_COMPLEMENT);
+ const bool squash = cBOOL(o->op_private & OPpTRANS_SQUASH);
+ const bool del = cBOOL(o->op_private & OPpTRANS_DELETE);
SV* swash;
PERL_ARGS_ASSERT_PMTRANS;
none = ++max;
if (del)
- del = ++max;
+ ++max;
if (max > 0xffff)
bits = 32;
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) {
+ Size_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++)
+ for (i = 0; i < tlen; i++)
tbl->map[t[i]] = -1;
+
for (i = 0, j = 0; i < 256; i++) {
if (!tbl->map[i]) {
- if (j == (I32)rlen) {
+ if (j == rlen) {
if (del)
tbl->map[i] = -2;
else if (rlen)
tbl->map[i] = (short)i;
}
else {
- if (UVCHR_IS_INVARIANT(i) && ! UVCHR_IS_INVARIANT(r[j]))
- grows = 1;
tbl->map[i] = r[j++];
}
+ if ( tbl->map[i] >= 0
+ && UVCHR_IS_INVARIANT((UV)i)
+ && !UVCHR_IS_INVARIANT((UV)(tbl->map[i]))
+ )
+ grows = TRUE;
}
}
- assert(j <= (I32)rlen);
+ ASSUME(j <= rlen);
+ excess = rlen - 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 < 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) {
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++) {
- if (j >= (I32)rlen) {
+ for (i = 0, j = 0; i < tlen; i++,j++) {
+ if (j >= rlen) {
if (del) {
if (tbl->map[t[i]] == -1)
tbl->map[t[i]] = -2;
if (tbl->map[t[i]] == -1) {
if ( UVCHR_IS_INVARIANT(t[i])
&& ! UVCHR_IS_INVARIANT(r[j]))
- grows = 1;
+ grows = TRUE;
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 */
https://perl5.git.perl.org / perl5.git / blobdiff