X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=2f5fcf819d93b823262fa4d5f30038049ee688e1;hb=0a6b11f8fedc4bae957f03efab3ecb64338ce939;hp=3b9262f53e9ee653fac53477416e3b4b18c13a93;hpb=a953d64ff8ab628dc446ce4f5b539fedafa19a09;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index 3b9262f..2f5fcf8 100644
--- a/util.c
+++ b/util.c
@@ -15,8 +15,7 @@
 #include "EXTERN.h"
 #include "perl.h"
 
-/* XXX Configure test needed */
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
 #endif
 
@@ -2280,9 +2279,9 @@ repeatcpy(register char *to, register char *from, I32 len, register I32 count)
     register char *frombase = from;
 
     if (len == 1) {
-	todo = *from;
+	register char c = *from;
 	while (count-- > 0)
-	    *to++ = todo;
+	    *to++ = c;
 	return;
     }
     while (count-- > 0) {
@@ -2396,6 +2395,29 @@ same_dirent(char *a, char *b)
 #endif /* !HAS_RENAME */
 
 UV
+scan_bin(char *start, I32 len, I32 *retlen)
+{
+    register char *s = start;
+    register UV retval = 0;
+    bool overflowed = FALSE;
+    while (len && *s >= '0' && *s <= '1') {
+      register UV n = retval << 1;
+      if (!overflowed && (n >> 1) != retval) {
+          warn("Integer overflow in binary number");
+          overflowed = TRUE;
+      }
+      retval = n | (*s++ - '0');
+      len--;
+    }
+    if (len && (*s >= '2' || *s <= '9')) {
+      dTHR;
+      if (ckWARN(WARN_UNSAFE))
+          warner(WARN_UNSAFE, "Illegal binary digit ignored");
+    }
+    *retlen = s - start;
+    return retval;
+}
+UV
 scan_oct(char *start, I32 len, I32 *retlen)
 {
     register char *s = start;
@@ -2459,7 +2481,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
     dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
-    char tmpbuf[512];
+    char tmpbuf[MAXPATHLEN];
     register char *s;
     I32 len;
     int retval;
@@ -2602,7 +2624,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 	    if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
 		continue;	/* don't search dir with too-long name */
 	    if (len
-#if defined(atarist) || defined(DOSISH)
+#if defined(atarist) || defined(__MINT__) || defined(DOSISH)
 		&& tmpbuf[len - 1] != '/'
 		&& tmpbuf[len - 1] != '\\'
 #endif
@@ -2838,11 +2860,6 @@ new_struct_thread(struct perl_thread *t)
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
 
-    PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
-    PL_defstash = t->Tdefstash;   /* XXX maybe these should */
-    PL_curstash = t->Tcurstash;   /* always be set to main? */
-
-
     /* top_env needs to be non-zero. It points to an area
        in which longjmp() stuff is stored, as C callstack
        info there at least is thread specific this has to
@@ -2859,6 +2876,25 @@ new_struct_thread(struct perl_thread *t)
     PL_in_eval = FALSE;
     PL_restartop = 0;
 
+    PL_statname = NEWSV(66,0);
+    PL_maxscream = -1;
+    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+    PL_regindent = 0;
+    PL_reginterp_cnt = 0;
+    PL_lastscream = Nullsv;
+    PL_screamfirst = 0;
+    PL_screamnext = 0;
+    PL_reg_start_tmp = 0;
+    PL_reg_start_tmpl = 0;
+
+    /* parent thread's data needs to be locked while we make copy */
+    MUTEX_LOCK(&t->mutex);
+
+    PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
+    PL_defstash = t->Tdefstash;   /* XXX maybe these should */
+    PL_curstash = t->Tcurstash;   /* always be set to main? */
+
     PL_tainted = t->Ttainted;
     PL_curpm = t->Tcurpm;         /* XXX No PMOP ref count */
     PL_nrs = newSVsv(t->Tnrs);
@@ -2872,18 +2908,6 @@ new_struct_thread(struct perl_thread *t)
     PL_bodytarget = newSVsv(t->Tbodytarget);
     PL_toptarget = newSVsv(t->Ttoptarget);
 
-    PL_statname = NEWSV(66,0);
-    PL_maxscream = -1;
-    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
-    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
-    PL_regindent = 0;
-    PL_reginterp_cnt = 0;
-    PL_lastscream = Nullsv;
-    PL_screamfirst = 0;
-    PL_screamnext = 0;
-    PL_reg_start_tmp = 0;
-    PL_reg_start_tmpl = 0;
-    
     /* Initialise all per-thread SVs that the template thread used */
     svp = AvARRAY(t->threadsv);
     for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
@@ -2906,6 +2930,9 @@ new_struct_thread(struct perl_thread *t)
     thr->next->prev = thr;
     MUTEX_UNLOCK(&PL_threads_mutex);
 
+    /* done copying parent's state */
+    MUTEX_UNLOCK(&t->mutex);
+
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
 #endif /* HAVE_THREAD_INTERN */
@@ -3051,9 +3078,11 @@ get_vtbl(int vtbl_id)
     case want_vtbl_regdatum:
 	result = &PL_vtbl_regdatum;
 	break;
+#ifdef USE_LOCALE_COLLATE
     case want_vtbl_collxfrm:
 	result = &PL_vtbl_collxfrm;
 	break;
+#endif
     case want_vtbl_amagic:
 	result = &PL_vtbl_amagic;
 	break;