OS/2-specific fixes, round II

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index 3ba64e0..fb77773 100644 (file)
--- a/util.c
+++ b/util.c
@@ -454,8 +454,6 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit
     return NULL;
 }
 
-#define FBM_TABLE_OFFSET 2     /* Number of bytes between EOS and table*/
-
 /* As a space optimization, we do not compile tables for strings of length
    0 and 1, and for strings of length 2 unless FBMcf_TAIL.  These are
    special-cased in fbm_instr().
@@ -492,17 +490,19 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     s = (U8*)SvPV_force_mutable(sv, len);
     if (len == 0)              /* TAIL might be on a zero-length string. */
        return;
-    SvUPGRADE(sv, SVt_PVBM);
+    SvUPGRADE(sv, SVt_PVGV);
+    SvIOK_off(sv);
     if (len > 2) {
        const unsigned char *sb;
        const U8 mlen = (len>255) ? 255 : (U8)len;
        register U8 *table;
 
-       Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET);
-       table = (unsigned char*)(SvPVX_mutable(sv) + len + FBM_TABLE_OFFSET);
-       s = table - 1 - FBM_TABLE_OFFSET;       /* last char */
+       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 */
        memset((void*)table, mlen, 256);
-       table[-1] = (U8)flags;
+       table[PERL_FBM_FLAGS_OFFSET_FROM_TABLE] = (U8)flags;
        i = 0;
        sb = s - mlen + 1;                      /* first char (maybe) */
        while (s >= sb) {
@@ -510,6 +510,8 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
                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 */
     SvVALID_on(sv);
@@ -522,7 +524,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
        }
     }
     BmRARE(sv) = s[rarest];
-    BmPREVIOUS(sv) = (U16)rarest;
+    BmPREVIOUS_set(sv, rarest);
     BmUSEFUL(sv) = 100;                        /* Initial value */
     if (flags & FBMcf_TAIL)
        SvTAIL_on(sv);
@@ -663,7 +665,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
        }
        return NULL;
     }
-    if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
+    if (!SvVALID(littlestr)) {
        char * const b = ninstr((char*)big,(char*)bigend,
                         (char*)little, (char*)little + littlelen);
 
@@ -680,12 +682,15 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
        return b;
     }
 
-    {  /* Do actual FBM.  */
-       register const unsigned char * const table = little + littlelen + FBM_TABLE_OFFSET;
+    /* Do actual FBM.  */
+    if (littlelen > (STRLEN)(bigend - big))
+       return NULL;
+
+    {
+       register const unsigned char * const table
+           = little + littlelen + PERL_FBM_TABLE_OFFSET;
        register const unsigned char *oldlittle;
 
-       if (littlelen > (STRLEN)(bigend - big))
-           return NULL;
        --littlelen;                    /* Last char found by table lookup */
 
        s = big + littlelen;
@@ -718,7 +723,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
            }
        }
       check_end:
-       if ( s == bigend && (table[-1] & FBMcf_TAIL)
+       if ( s == bigend
+            && (table[PERL_FBM_FLAGS_OFFSET_FROM_TABLE] & FBMcf_TAIL)
             && memEQ((char *)(bigend - littlelen),
                      (char *)(oldlittle - littlelen), littlelen) )
            return (char*)bigend - littlelen;
@@ -754,12 +760,15 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     register const unsigned char *littleend;
     I32 found = 0;
 
+    assert(SvTYPE(littlestr) == SVt_PVGV);
+    assert(SvVALID(littlestr));
+
     if (*old_posp == -1
        ? (pos = PL_screamfirst[BmRARE(littlestr)]) < 0
        : (((pos = *old_posp), pos += PL_screamnext[pos]) == 0)) {
       cant_find:
        if ( BmRARE(littlestr) == '\n'
-            && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) {
+            && BmPREVIOUS(littlestr) == (U8)SvCUR(littlestr) - 1) {
            little = (const unsigned char *)(SvPVX_const(littlestr));
            littleend = little + SvCUR(littlestr);
            first = *little++;
@@ -2258,8 +2267,12 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
         PerlLIO_close(pp[0]);
     return PerlIO_fdopen(p[This], mode);
 #else
+#  ifdef OS2   /* Same, without fork()ing and all extra overhead... */
+    return my_syspopen4(aTHX_ Nullch, mode, n, args);
+#  else
     Perl_croak(aTHX_ "List form of piped open not implemented");
     return (PerlIO *) NULL;
+#  endif
 #endif
 }
 
@@ -2347,6 +2360,14 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
            PerlProc__exit(1);
        }
 #endif /* defined OS2 */
+
+#ifdef PERLIO_USING_CRLF
+   /* Since we circumvent IO layers when we manipulate low-level
+      filedescriptors directly, need to manually switch to the
+      default, binary, low-level mode; see PerlIOBuf_open(). */
+   PerlLIO_setmode((*mode == 'r'), O_BINARY);
+#endif 
+
        if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
            SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), PerlProc_getpid());