U32 utf8 = 0;
CODE:
if (ix == 3) {
+#ifndef PERL_FBM_TABLE_OFFSET
+ const MAGIC *const mg = mg_find(sv, PERL_MAGIC_bm);
+
+ if (!mg)
+ croak("argument to B::BM::TABLE is not a PVBM");
+ p = mg->mg_ptr;
+ len = mg->mg_len;
+#else
p = SvPV(sv, len);
/* Boyer-Moore table is just after string and its safety-margin \0 */
p += len + PERL_FBM_TABLE_OFFSET;
len = 256;
+#endif
} else if (ix == 2) {
/* This used to read 257. I think that that was buggy - should have
been 258. (The "\0", the flags byte, and 256 for the table.)
first used by the compiler in 651aa52ea1faa806. It's used to
get a "complete" dump of the buffer at SvPVX(), not just the
PVBM table. This permits the generated bytecode to "load"
- SvPVX in "one" hit. */
+ SvPVX in "one" hit.
+
+ 5.15 and later store the BM table via MAGIC, so the compiler
+ should handle this just fine without changes if PVBM now
+ always returns the SvPVX() buffer. */
p = SvPVX_const(sv);
+#ifdef PERL_FBM_TABLE_OFFSET
len = SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0);
+#else
+ len = SvCUR(sv);
+#endif
} else if (ix) {
p = SvPVX(sv);
len = strlen(p);
STRLEN len;
STRLEN rarest = 0;
U32 frequency = 256;
+ MAGIC *mg;
PERL_ARGS_ASSERT_FBM_COMPILE;
SvIOK_off(sv);
SvNOK_off(sv);
SvVALID_on(sv);
+
+ /* "deep magic", the comment used to add. The use of MAGIC itself isn't
+ really. MAGIC was originally added in 79072805bf63abe5 (perl 5.0 alpha 2)
+ to call SvVALID_off() if the scalar was assigned to.
+
+ The comment itself (and "deeper magic" below) date back to
+ 378cc40b38293ffc (perl 2.0). "deep magic" was an annotation on
+ str->str_pok |= 2;
+ where the magic (presumably) was that the scalar had a BM table hidden
+ inside itself.
+
+ As MAGIC is always present on BMs [in Perl 5 :-)], we can use it to store
+ the table instead of the previous (somewhat hacky) approach of co-opting
+ the string buffer and storing it after the string. */
+
+ assert(!mg_find(sv, PERL_MAGIC_bm));
+ mg = sv_magicext(sv, NULL, PERL_MAGIC_bm, &PL_vtbl_bm, NULL, 0);
+ assert(mg);
+
if (len > 2) {
/* Shorter strings are special-cased in Perl_fbm_instr(), and don't use
the BM table. */
- const unsigned char *sb;
const U8 mlen = (len>255) ? 255 : (U8)len;
+ const unsigned char *const sb = s + len - mlen; /* first char (maybe) */
register U8 *table;
- Sv_Grow(sv, len + 256 + PERL_FBM_TABLE_OFFSET);
- table
- = (unsigned char*)(SvPVX_mutable(sv) + len + PERL_FBM_TABLE_OFFSET);
- s = table - 1 - PERL_FBM_TABLE_OFFSET; /* last char */
+ Newx(table, 256, U8);
memset((void*)table, mlen, 256);
+ mg->mg_ptr = (char *)table;
+ mg->mg_len = 256;
+
+ s += len - 1; /* last char */
i = 0;
- sb = s - mlen + 1; /* first char (maybe) */
while (s >= sb) {
if (table[*s] == mlen)
table[*s] = (U8)i;
s--, i++;
}
- } else {
- Sv_Grow(sv, len + PERL_FBM_TABLE_OFFSET);
}
- sv_magic(sv, NULL, PERL_MAGIC_bm, NULL, 0); /* deep magic */
s = (const unsigned char*)(SvPVX_const(sv)); /* deeper magic */
for (i = 0; i < len; i++) {
return NULL;
{
- register const unsigned char * const table
- = little + littlelen + PERL_FBM_TABLE_OFFSET;
+ const MAGIC *const mg = mg_find(littlestr, PERL_MAGIC_bm);
+ const unsigned char * const table = (const unsigned char *) mg->mg_ptr;
register const unsigned char *oldlittle;
--littlelen; /* Last char found by table lookup */