This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Store the BM table in mg_ptr instead of after SvCUR().
authorNicholas Clark <nick@ccl4.org>
Wed, 18 May 2011 10:45:22 +0000 (11:45 +0100)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2011 07:40:03 +0000 (09:40 +0200)
Previously the 256 byte Boyer-Moore table was stored in the buffer of SvPVX()
after the raw string by extending the buffer.

Given that the scalar is alway upgraded to add PERL_MAGIC_bm magic, to clear
the table and other flags, there's no extra memory cost in using mg_ptr in the
MAGIC struct to point directly to the table.

I believe that this removes the last place in the core that stores data beyond
SvCUR().

ext/B/B.xs
ext/Devel-Peek/t/Peek.t
sv.h
util.c

index 1ca4fd8..44f8402 100644 (file)
@@ -1619,10 +1619,19 @@ PV(sv)
        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.)
@@ -1635,9 +1644,17 @@ PV(sv)
               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);
index 715d7f0..c0cfa93 100644 (file)
@@ -816,6 +816,8 @@ unless ($Config{useithreads}) {
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_bm
     MG_TYPE = PERL_MAGIC_bm\\(B\\)
+    MG_LEN = 256
+    MG_PTR = $ADDR "(?:\\\\\d){256}"
   RARE = \d+
   PREVIOUS = 1
   USEFUL = 100
@@ -833,6 +835,8 @@ unless ($Config{useithreads}) {
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_bm
     MG_TYPE = PERL_MAGIC_bm\\(B\\)
+    MG_LEN = 256
+    MG_PTR = $ADDR "(?:\\\\\d){256}"
   RARE = \d+
   PREVIOUS = 1
   USEFUL = 100
diff --git a/sv.h b/sv.h
index c102985..fe8a70a 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1287,8 +1287,6 @@ the scalar's value cannot change unless written to.
                 } STMT_END
 #endif
 
-#define PERL_FBM_TABLE_OFFSET 1        /* Number of bytes between EOS and table */
-
 /* SvPOKp not SvPOK in the assertion because the string can be tainted! eg
    perl -T -e '/$^X/'
 */
diff --git a/util.c b/util.c
index 165e61a..8c836c2 100644 (file)
--- a/util.c
+++ b/util.c
@@ -549,6 +549,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     STRLEN len;
     STRLEN rarest = 0;
     U32 frequency = 256;
+    MAGIC *mg;
 
     PERL_ARGS_ASSERT_FBM_COMPILE;
 
@@ -575,29 +576,45 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     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++) {
@@ -772,8 +789,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
        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 */