X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=0495e8acf5cad2db0ce440278df92fcd26084554;hb=24caa93f50e1f4f416dac288b4fd89a65015bad9;hp=6f9ad541928f4be05167d9010ba3786282d5ddaa;hpb=599cee73f2261c5e09cde7ceba3f9a896989e117;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 6f9ad54..0495e8a 100644
--- a/sv.c
+++ b/sv.c
@@ -49,10 +49,10 @@
 static IV asIV _((SV* sv));
 static UV asUV _((SV* sv));
 static SV *more_sv _((void));
-static XPVIV *more_xiv _((void));
-static XPVNV *more_xnv _((void));
-static XPV *more_xpv _((void));
-static XRV *more_xrv _((void));
+static void more_xiv _((void));
+static void more_xnv _((void));
+static void more_xpv _((void));
+static void more_xrv _((void));
 static XPVIV *new_xiv _((void));
 static XPVNV *new_xnv _((void));
 static XPV *new_xpv _((void));
@@ -417,26 +417,29 @@ STATIC XPVIV*
 new_xiv(void)
 {
     IV* xiv;
-    if (PL_xiv_root) {
-	xiv = PL_xiv_root;
-	/*
-	 * See comment in more_xiv() -- RAM.
-	 */
-	PL_xiv_root = *(IV**)xiv;
-	return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
-    }
-    return more_xiv();
+    LOCK_SV_MUTEX;
+    if (!PL_xiv_root)
+	more_xiv();
+    xiv = PL_xiv_root;
+    /*
+     * See comment in more_xiv() -- RAM.
+     */
+    PL_xiv_root = *(IV**)xiv;
+    UNLOCK_SV_MUTEX;
+    return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
 }
 
 STATIC void
 del_xiv(XPVIV *p)
 {
     IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
+    LOCK_SV_MUTEX;
     *(IV**)xiv = PL_xiv_root;
     PL_xiv_root = xiv;
+    UNLOCK_SV_MUTEX;
 }
 
-STATIC XPVIV*
+STATIC void
 more_xiv(void)
 {
     register IV* xiv;
@@ -455,30 +458,32 @@ more_xiv(void)
 	xiv++;
     }
     *(IV**)xiv = 0;
-    return new_xiv();
 }
 
 STATIC XPVNV*
 new_xnv(void)
 {
     double* xnv;
-    if (PL_xnv_root) {
-	xnv = PL_xnv_root;
-	PL_xnv_root = *(double**)xnv;
-	return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
-    }
-    return more_xnv();
+    LOCK_SV_MUTEX;
+    if (!PL_xnv_root)
+	more_xnv();
+    xnv = PL_xnv_root;
+    PL_xnv_root = *(double**)xnv;
+    UNLOCK_SV_MUTEX;
+    return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
 }
 
 STATIC void
 del_xnv(XPVNV *p)
 {
     double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
+    LOCK_SV_MUTEX;
     *(double**)xnv = PL_xnv_root;
     PL_xnv_root = xnv;
+    UNLOCK_SV_MUTEX;
 }
 
-STATIC XPVNV*
+STATIC void
 more_xnv(void)
 {
     register double* xnv;
@@ -492,29 +497,31 @@ more_xnv(void)
 	xnv++;
     }
     *(double**)xnv = 0;
-    return new_xnv();
 }
 
 STATIC XRV*
 new_xrv(void)
 {
     XRV* xrv;
-    if (PL_xrv_root) {
-	xrv = PL_xrv_root;
-	PL_xrv_root = (XRV*)xrv->xrv_rv;
-	return xrv;
-    }
-    return more_xrv();
+    LOCK_SV_MUTEX;
+    if (!PL_xrv_root)
+	more_xrv();
+    xrv = PL_xrv_root;
+    PL_xrv_root = (XRV*)xrv->xrv_rv;
+    UNLOCK_SV_MUTEX;
+    return xrv;
 }
 
 STATIC void
 del_xrv(XRV *p)
 {
+    LOCK_SV_MUTEX;
     p->xrv_rv = (SV*)PL_xrv_root;
     PL_xrv_root = p;
+    UNLOCK_SV_MUTEX;
 }
 
-STATIC XRV*
+STATIC void
 more_xrv(void)
 {
     register XRV* xrv;
@@ -527,29 +534,31 @@ more_xrv(void)
 	xrv++;
     }
     xrv->xrv_rv = 0;
-    return new_xrv();
 }
 
 STATIC XPV*
 new_xpv(void)
 {
     XPV* xpv;
-    if (PL_xpv_root) {
-	xpv = PL_xpv_root;
-	PL_xpv_root = (XPV*)xpv->xpv_pv;
-	return xpv;
-    }
-    return more_xpv();
+    LOCK_SV_MUTEX;
+    if (!PL_xpv_root)
+	more_xpv();
+    xpv = PL_xpv_root;
+    PL_xpv_root = (XPV*)xpv->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpv;
 }
 
 STATIC void
 del_xpv(XPV *p)
 {
+    LOCK_SV_MUTEX;
     p->xpv_pv = (char*)PL_xpv_root;
     PL_xpv_root = p;
+    UNLOCK_SV_MUTEX;
 }
 
-STATIC XPV*
+STATIC void
 more_xpv(void)
 {
     register XPV* xpv;
@@ -562,7 +571,6 @@ more_xpv(void)
 	xpv++;
     }
     xpv->xpv_pv = 0;
-    return new_xpv();
 }
 
 #ifdef PURIFY
@@ -1313,9 +1321,9 @@ sv_2iv(register SV *sv)
 	if (SvPOKp(sv) && SvLEN(sv))
 	    return asIV(sv);
 	if (!SvROK(sv)) {
-	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
-		if (!PL_localizing)
+		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    warner(WARN_UNINITIALIZED, warn_uninit);
 	    }
 	    return 0;
@@ -1339,8 +1347,11 @@ sv_2iv(register SV *sv)
 	    }
 	    if (SvPOKp(sv) && SvLEN(sv))
 		return asIV(sv);
-	    if (ckWARN(WARN_UNINITIALIZED))
-		warner(WARN_UNINITIALIZED, warn_uninit);
+	    {
+		dTHR;
+		if (ckWARN(WARN_UNINITIALIZED))
+		    warner(WARN_UNINITIALIZED, warn_uninit);
+	    }
 	    return 0;
 	}
     }
@@ -1391,9 +1402,9 @@ sv_2uv(register SV *sv)
 	if (SvPOKp(sv) && SvLEN(sv))
 	    return asUV(sv);
 	if (!SvROK(sv)) {
-	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
-		if (!PL_localizing)
+		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    warner(WARN_UNINITIALIZED, warn_uninit);
 	    }
 	    return 0;
@@ -1414,8 +1425,11 @@ sv_2uv(register SV *sv)
 	    }
 	    if (SvPOKp(sv) && SvLEN(sv))
 		return asUV(sv);
-	    if (ckWARN(WARN_UNINITIALIZED))
-		warner(WARN_UNINITIALIZED, warn_uninit);
+	    {
+		dTHR;
+		if (ckWARN(WARN_UNINITIALIZED))
+		    warner(WARN_UNINITIALIZED, warn_uninit);
+	    }
 	    return 0;
 	}
     }
@@ -1439,9 +1453,9 @@ sv_2uv(register SV *sv)
 	SvUVX(sv) = asUV(sv);
     }
     else  {
-	if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+	if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 	    dTHR;
-	    if (!PL_localizing)
+	    if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		warner(WARN_UNINITIALIZED, warn_uninit);
 	}
 	return 0;
@@ -1461,6 +1475,7 @@ sv_2nv(register SV *sv)
 	if (SvNOKp(sv))
 	    return SvNVX(sv);
 	if (SvPOKp(sv) && SvLEN(sv)) {
+	    dTHR;
 	    if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 		not_a_number(sv);
 	    SET_NUMERIC_STANDARD();
@@ -1469,9 +1484,9 @@ sv_2nv(register SV *sv)
 	if (SvIOKp(sv))
 	    return (double)SvIVX(sv);
         if (!SvROK(sv)) {
-	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
-		if (!PL_localizing)
+		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    warner(WARN_UNINITIALIZED, warn_uninit);
 	    }
             return 0;
@@ -1487,6 +1502,7 @@ sv_2nv(register SV *sv)
 	  return (double)(unsigned long)SvRV(sv);
 	}
 	if (SvREADONLY(sv)) {
+	    dTHR;
 	    if (SvPOKp(sv) && SvLEN(sv)) {
 		if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 		    not_a_number(sv);
@@ -1517,6 +1533,7 @@ sv_2nv(register SV *sv)
 	SvNVX(sv) = (double)SvIVX(sv);
     }
     else if (SvPOKp(sv) && SvLEN(sv)) {
+	dTHR;
 	if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 	    not_a_number(sv);
 	SET_NUMERIC_STANDARD();
@@ -1543,8 +1560,11 @@ asIV(SV *sv)
 
     if (numtype == 1)
 	return atol(SvPVX(sv));
-    if (!numtype && ckWARN(WARN_NUMERIC))
-	not_a_number(sv);
+    if (!numtype) {
+	dTHR;
+	if (ckWARN(WARN_NUMERIC))
+	    not_a_number(sv);
+    }
     SET_NUMERIC_STANDARD();
     d = atof(SvPVX(sv));
     if (d < 0.0)
@@ -1562,8 +1582,11 @@ asUV(SV *sv)
     if (numtype == 1)
 	return strtoul(SvPVX(sv), Null(char**), 10);
 #endif
-    if (!numtype && ckWARN(WARN_NUMERIC))
-	not_a_number(sv);
+    if (!numtype) {
+	dTHR;
+	if (ckWARN(WARN_NUMERIC))
+	    not_a_number(sv);
+    }
     SET_NUMERIC_STANDARD();
     return U_V(atof(SvPVX(sv)));
 }
@@ -1677,9 +1700,9 @@ sv_2pv(register SV *sv, STRLEN *lp)
 	    goto tokensave;
 	}
         if (!SvROK(sv)) {
-	    if (ckWARN(WARN_UNINITIALIZED) && !(SvFLAGS(sv) & SVs_PADTMP)) {
+	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
-		if (!PL_localizing)
+		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    warner(WARN_UNINITIALIZED, warn_uninit);
 	    }
             *lp = 0;
@@ -1785,8 +1808,11 @@ sv_2pv(register SV *sv, STRLEN *lp)
 		tsv = Nullsv;
 		goto tokensave;
 	    }
-	    if (ckWARN(WARN_UNINITIALIZED))
-		warner(WARN_UNINITIALIZED, warn_uninit);
+	    {
+		dTHR;
+		if (ckWARN(WARN_UNINITIALIZED))
+		    warner(WARN_UNINITIALIZED, warn_uninit);
+	    }
 	    *lp = 0;
 	    return "";
 	}
@@ -2587,6 +2613,12 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
     case 'B':
 	mg->mg_virtual = &vtbl_bm;
 	break;
+    case 'D':
+	mg->mg_virtual = &vtbl_regdata;
+	break;
+    case 'd':
+	mg->mg_virtual = &vtbl_regdatum;
+	break;
     case 'E':
 	mg->mg_virtual = &vtbl_env;
 	break;
@@ -3064,8 +3096,8 @@ sv_len(register SV *sv)
 STRLEN
 sv_len_utf8(register SV *sv)
 {
-    unsigned char *s;
-    unsigned char *send;
+    U8 *s;
+    U8 *send;
     STRLEN len;
 
     if (!sv)
@@ -3076,7 +3108,7 @@ sv_len_utf8(register SV *sv)
 	len = mg_length(sv);
     else
 #endif
-	s = SvPV(sv, len);
+	s = (U8*)SvPV(sv, len);
     send = s + len;
     len = 0;
     while (s < send) {
@@ -3089,16 +3121,16 @@ sv_len_utf8(register SV *sv)
 void
 sv_pos_u2b(register SV *sv, I32* offsetp, I32* lenp)
 {
-    unsigned char *start;
-    unsigned char *s;
-    unsigned char *send;
+    U8 *start;
+    U8 *s;
+    U8 *send;
     I32 uoffset = *offsetp;
     STRLEN len;
 
     if (!sv)
 	return;
 
-    start = s = SvPV(sv, len);
+    start = s = (U8*)SvPV(sv, len);
     send = s + len;
     while (s < send && uoffset--)
 	s += UTF8SKIP(s);
@@ -3116,14 +3148,14 @@ sv_pos_u2b(register SV *sv, I32* offsetp, I32* lenp)
 void
 sv_pos_b2u(register SV *sv, I32* offsetp)
 {
-    unsigned char *s;
-    unsigned char *send;
+    U8 *s;
+    U8 *send;
     STRLEN len;
 
     if (!sv)
 	return;
 
-    s = SvPV(sv, len);
+    s = (U8*)SvPV(sv, len);
     if (len < *offsetp)
 	croak("panic: bad byte offset");
     send = s + *offsetp;
@@ -4511,7 +4543,7 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
 	STRLEN precis = 0;
 
 	char esignbuf[4];
-	char utf8buf[10];
+	U8 utf8buf[10];
 	STRLEN esignlen = 0;
 
 	char *eptr = Nullch;
@@ -4646,8 +4678,8 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
 		else
 		    uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
 
-		eptr = utf8buf;
-		elen = uv_to_utf8(eptr, uv) - utf8buf;
+		eptr = (char*)utf8buf;
+		elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
 		goto string;
 	    }
 	    if (args)