Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
[perl.git] / sv.c
diff --git a/sv.c b/sv.c
index a1f1d60..2a25a30 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -76,13 +76,17 @@ U32 flags;
 #else
 
 #define new_SV()                       \
-    if (sv_root) {                     \
-       sv = sv_root;                   \
-       sv_root = (SV*)SvANY(sv);       \
-       ++sv_count;                     \
-    }                                  \
-    else                               \
-       sv = more_sv();
+    do {                               \
+       MUTEX_LOCK(&sv_mutex);          \
+       if (sv_root) {                  \
+           sv = sv_root;               \
+           sv_root = (SV*)SvANY(sv);   \
+           ++sv_count;                 \
+       }                               \
+       else                            \
+           sv = more_sv();             \
+       MUTEX_UNLOCK(&sv_mutex);        \
+    } while (0)
 
 static SV*
 new_sv()
@@ -1026,8 +1030,11 @@ IV i;
     case SVt_PVCV:
     case SVt_PVFM:
     case SVt_PVIO:
-       croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
-           op_name[op->op_type]);
+       {
+           dTHR;
+           croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
+                 op_name[op->op_type]);
+       }
     }
     (void)SvIOK_only(sv);                      /* validate number */
     SvIVX(sv) = i;
@@ -1074,8 +1081,11 @@ double num;
     case SVt_PVCV:
     case SVt_PVFM:
     case SVt_PVIO:
-       croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
-           op_name[op->op_type]);
+       {
+           dTHR;
+           croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
+                 op_name[op->op_type]);
+       }
     }
     SvNVX(sv) = num;
     (void)SvNOK_only(sv);                      /* validate number */
@@ -1086,6 +1096,7 @@ static void
 not_a_number(sv)
 SV *sv;
 {
+    dTHR;
     char tmpbuf[64];
     char *d = tmpbuf;
     char *s;
@@ -1195,6 +1206,7 @@ register SV *sv;
        SvIVX(sv) = (IV)atol(SvPVX(sv));
     }
     else  {
+       dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        return 0;
@@ -1267,6 +1279,7 @@ register SV *sv;
        SvNVX(sv) = atof(SvPVX(sv));
     }
     else  {
+       dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        return 0.0;
@@ -1398,6 +1411,7 @@ STRLEN *lp;
        while (*s) s++;
     }
     else {
+       dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        *lp = 0;
@@ -1450,6 +1464,7 @@ register SV *sv;
     if (SvROK(sv)) {
 #ifdef OVERLOAD
       {
+       dTHR;
        SV* tmpsv;
        if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
          return SvTRUE(tmpsv);
@@ -1458,11 +1473,11 @@ register SV *sv;
       return SvRV(sv) != 0;
     }
     if (SvPOKp(sv)) {
-       register XPV* Xpv;
-       if ((Xpv = (XPV*)SvANY(sv)) &&
-               (*Xpv->xpv_pv > '0' ||
-               Xpv->xpv_cur > 1 ||
-               (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+       register XPV* Xpvtmp;
+       if ((Xpvtmp = (XPV*)SvANY(sv)) &&
+               (*Xpvtmp->xpv_pv > '0' ||
+               Xpvtmp->xpv_cur > 1 ||
+               (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0')))
            return 1;
        else
            return 0;
@@ -1489,6 +1504,7 @@ sv_setsv(dstr,sstr)
 SV *dstr;
 register SV *sstr;
 {
+    dTHR;
     register U32 sflags;
     register int dtype;
     register int stype;
@@ -1622,6 +1638,7 @@ register SV *sstr;
     if (sflags & SVf_ROK) {
        if (dtype >= SVt_PV) {
            if (dtype == SVt_PVGV) {
+               dTHR;
                SV *sref = SvREFCNT_inc(SvRV(sstr));
                SV *dref = 0;
                int intro = GvINTRO(dstr);
@@ -2021,6 +2038,7 @@ I32 namlen;
     if (!obj || obj == sv || how == '#')
        mg->mg_obj = obj;
     else {
+       dTHR;
        mg->mg_obj = SvREFCNT_inc(obj);
        mg->mg_flags |= MGf_REFCOUNTED;
     }
@@ -2272,6 +2290,7 @@ register SV *sv;
     assert(SvREFCNT(sv) == 0);
 
     if (SvOBJECT(sv)) {
+       dTHR;
        dSP;
        GV* destructor;
 
@@ -2281,6 +2300,7 @@ register SV *sv;
            ENTER;
            SAVEFREESV(SvSTASH(sv));
            if (destructor && GvCV(destructor)) {
+               dTHR;
                SV ref;
 
                Zero(&ref, 1, SV);
@@ -2841,6 +2861,7 @@ register SV *sv;
 static void
 sv_mortalgrow()
 {
+    dTHR;
     tmps_max += 128;
     Renew(tmps_stack, tmps_max, SV*);
 }
@@ -2849,6 +2870,7 @@ SV *
 sv_mortalcopy(oldstr)
 SV *oldstr;
 {
+    dTHR;
     register SV *sv;
 
     new_SV();
@@ -2866,6 +2888,7 @@ SV *oldstr;
 SV *
 sv_newmortal()
 {
+    dTHR;
     register SV *sv;
 
     new_SV();
@@ -2884,6 +2907,7 @@ SV *
 sv_2mortal(sv)
 register SV *sv;
 {
+    dTHR;
     if (!sv)
        return sv;
     if (SvREADONLY(sv) && curcop != &compiling)
@@ -2944,6 +2968,7 @@ SV *
 newRV(ref)
 SV *ref;
 {
+    dTHR;
     register SV *sv;
 
     new_SV();
@@ -3205,9 +3230,11 @@ STRLEN *lp;
                s = SvPVX(sv);
                *lp = SvCUR(sv);
            }
-           else
+           else {
+               dTHR;
                croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
                    op_name[op->op_type]);
+           }
        }
        else
            s = sv_2pv(sv, lp);
@@ -3296,6 +3323,7 @@ newSVrv(rv, classname)
 SV *rv;
 char *classname;
 {
+    dTHR;
     SV *sv;
 
     new_SV();
@@ -3362,6 +3390,7 @@ sv_bless(sv,stash)
 SV* sv;
 HV* stash;
 {
+    dTHR;
     SV *ref;
     if (!SvROK(sv))
         croak("Can't bless non-reference value");
@@ -3591,6 +3620,11 @@ SV* sv;
        fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
        fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
        fprintf(stderr, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+#ifdef USE_THREADS
+       fprintf(stderr, "  MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv));
+       fprintf(stderr, "  CONDP = 0x%lx\n", (long)CvCONDP(sv));
+       fprintf(stderr, "  OWNER = 0x%lx\n", (long)CvOWNER(sv));
+#endif /* USE_THREADS */
        if (type == SVt_PVFM)
            fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
        break;