Welcome to 2007! Time to update copyrights from changes earlier

[perl5.git] / util.c

diff --git a/util.c b/util.c
index c5f69ae..343ba5a 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,7 +1,7 @@
 /*    util.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -478,7 +478,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     register const U8 *s;
     register U32 i;
     STRLEN len;
-    I32 rarest = 0;
+    U32 rarest = 0;
     U32 frequency = 256;
 
     if (flags & FBMcf_TAIL) {
@@ -492,6 +492,8 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
        return;
     SvUPGRADE(sv, SVt_PVGV);
     SvIOK_off(sv);
+    SvNOK_off(sv);
+    SvVALID_on(sv);
     if (len > 2) {
        const unsigned char *sb;
        const U8 mlen = (len>255) ? 255 : (U8)len;
@@ -502,7 +504,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
            = (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[PERL_FBM_FLAGS_OFFSET_FROM_TABLE] = (U8)flags;
+       BmFLAGS(sv) = (U8)flags;
        i = 0;
        sb = s - mlen + 1;                      /* first char (maybe) */
        while (s >= sb) {
@@ -514,7 +516,6 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
        Sv_Grow(sv, len + PERL_FBM_TABLE_OFFSET);
     }
     sv_magic(sv, NULL, PERL_MAGIC_bm, NULL, 0);        /* deep magic */
-    SvVALID_on(sv);
 
     s = (const unsigned char*)(SvPVX_const(sv));       /* deeper magic */
     for (i = 0; i < len; i++) {
@@ -524,12 +525,12 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
        }
     }
     BmRARE(sv) = s[rarest];
-    BmPREVIOUS_set(sv, rarest);
+    BmPREVIOUS(sv) = rarest;
     BmUSEFUL(sv) = 100;                        /* Initial value */
     if (flags & FBMcf_TAIL)
        SvTAIL_on(sv);
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %d\n",
-                         BmRARE(sv),BmPREVIOUS(sv)));
+    DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %lu\n",
+                         BmRARE(sv),(unsigned long)BmPREVIOUS(sv)));
 }
 
 /* If SvTAIL(littlestr), it has a fake '\n' at end. */
@@ -724,7 +725,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
        }
       check_end:
        if ( s == bigend
-            && (table[PERL_FBM_FLAGS_OFFSET_FROM_TABLE] & FBMcf_TAIL)
+            && (BmFLAGS(littlestr) & FBMcf_TAIL)
             && memEQ((char *)(bigend - littlelen),
                      (char *)(oldlittle - littlelen), littlelen) )
            return (char*)bigend - littlelen;
@@ -2267,8 +2268,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
 }
 
@@ -5516,13 +5521,14 @@ Perl_my_clearenv(pTHX)
 
 #ifdef PERL_IMPLICIT_CONTEXT
 
-/* implements the MY_CXT_INIT macro. The first time a module is loaded,
+/* Implements the MY_CXT_INIT macro. The first time a module is loaded,
 the global PL_my_cxt_index is incremented, and that value is assigned to
 that module's static my_cxt_index (who's address is passed as an arg).
 Then, for each interpreter this function is called for, it makes sure a
 void* slot is available to hang the static data off, by allocating or
 extending the interpreter's PL_my_cxt_list array */
 
+#ifndef PERL_GLOBAL_STRUCT_PRIVATE
 void *
 Perl_my_cxt_init(pTHX_ int *index, size_t size)
 {
@@ -5553,7 +5559,70 @@ Perl_my_cxt_init(pTHX_ int *index, size_t size)
     Zero(p, size, char);
     return p;
 }
-#endif
+
+#else /* #ifndef PERL_GLOBAL_STRUCT_PRIVATE */
+
+int
+Perl_my_cxt_index(pTHX_ const char *my_cxt_key)
+{
+    dVAR;
+    int index;
+
+    for (index = 0; index < PL_my_cxt_index; index++) {
+       const char *key = PL_my_cxt_keys[index];
+       /* try direct pointer compare first - there are chances to success,
+        * and it's much faster.
+        */
+       if ((key == my_cxt_key) || strEQ(key, my_cxt_key))
+           return index;
+    }
+    return -1;
+}
+
+void *
+Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
+{
+    dVAR;
+    void *p;
+    int index;
+
+    index = Perl_my_cxt_index(aTHX_ my_cxt_key);
+    if (index == -1) {
+       /* this module hasn't been allocated an index yet */
+       MUTEX_LOCK(&PL_my_ctx_mutex);
+       index = PL_my_cxt_index++;
+       MUTEX_UNLOCK(&PL_my_ctx_mutex);
+    }
+
+    /* make sure the array is big enough */
+    if (PL_my_cxt_size <= index) {
+       int old_size = PL_my_cxt_size;
+       int i;
+       if (PL_my_cxt_size) {
+           while (PL_my_cxt_size <= index)
+               PL_my_cxt_size *= 2;
+           Renew(PL_my_cxt_list, PL_my_cxt_size, void *);
+           Renew(PL_my_cxt_keys, PL_my_cxt_size, const char *);
+       }
+       else {
+           PL_my_cxt_size = 16;
+           Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
+           Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
+       }
+       for (i = old_size; i < PL_my_cxt_size; i++) {
+           PL_my_cxt_keys[i] = 0;
+           PL_my_cxt_list[i] = 0;
+       }
+    }
+    PL_my_cxt_keys[index] = my_cxt_key;
+    /* newSV() allocates one more than needed */
+    p = (void*)SvPVX(newSV(size-1));
+    PL_my_cxt_list[index] = p;
+    Zero(p, size, char);
+    return p;
+}
+#endif /* #ifndef PERL_GLOBAL_STRUCT_PRIVATE */
+#endif /* PERL_IMPLICIT_CONTEXT */
 
 #ifndef HAS_STRLCAT
 Size_t