diff options
Diffstat (limited to 'sv.c')
| -rw-r--r-- | sv.c | 222 |
1 files changed, 131 insertions, 91 deletions
@@ -57,6 +57,7 @@ static void del_xpv _((XPV* p)); static void del_xrv _((XRV* p)); static void sv_mortalgrow _((void)); static void sv_unglob _((SV* sv)); +static void sv_check_thinkfirst _((SV *sv)); typedef void (*SVFUNC) _((SV*)); @@ -64,14 +65,18 @@ typedef void (*SVFUNC) _((SV*)); #define new_SV(p) \ do { \ + MUTEX_LOCK(&sv_mutex); \ (p) = (SV*)safemalloc(sizeof(SV)); \ reg_add(p); \ + MUTEX_UNLOCK(&sv_mutex); \ } while (0) #define del_SV(p) \ do { \ + MUTEX_LOCK(&sv_mutex); \ reg_remove(p); \ free((char*)(p)); \ + MUTEX_UNLOCK(&sv_mutex); \ } while (0) static SV **registry; @@ -170,6 +175,7 @@ U32 flags; --sv_count; \ } while (0) +/* sv_mutex must be held while calling uproot_SV() */ #define uproot_SV(p) \ do { \ (p) = sv_root; \ @@ -177,19 +183,25 @@ U32 flags; ++sv_count; \ } while (0) -#define new_SV(p) \ - if (sv_root) \ - uproot_SV(p); \ - else \ - (p) = more_sv() +#define new_SV(p) do { \ + MUTEX_LOCK(&sv_mutex); \ + if (sv_root) \ + uproot_SV(p); \ + else \ + (p) = more_sv(); \ + MUTEX_UNLOCK(&sv_mutex); \ + } while (0) #ifdef DEBUGGING -#define del_SV(p) \ - if (debug & 32768) \ - del_sv(p); \ - else \ - plant_SV(p) +#define del_SV(p) do { \ + MUTEX_LOCK(&sv_mutex); \ + if (debug & 32768) \ + del_sv(p); \ + else \ + plant_SV(p); \ + MUTEX_UNLOCK(&sv_mutex); \ + } while (0) static void del_sv(p) @@ -250,6 +262,7 @@ U32 flags; SvFLAGS(sv) = SVTYPEMASK; } +/* sv_mutex must be held while calling more_sv() */ static SV* more_sv() { @@ -1092,12 +1105,7 @@ sv_setiv(sv,i) register SV *sv; IV i; { - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); switch (SvTYPE(sv)) { case SVt_NULL: sv_upgrade(sv, SVt_IV); @@ -1121,8 +1129,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_desc[op->op_type]); + { + dTHR; + croak("Can't coerce %s to integer in %s", sv_reftype(sv,0), + op_desc[op->op_type]); + } } (void)SvIOK_only(sv); /* validate number */ SvIVX(sv) = i; @@ -1145,12 +1156,7 @@ sv_setnv(sv,num) register SV *sv; double num; { - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); switch (SvTYPE(sv)) { case SVt_NULL: case SVt_IV: @@ -1180,8 +1186,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 */ @@ -1192,6 +1201,7 @@ static void not_a_number(sv) SV *sv; { + dTHR; char tmpbuf[64]; char *d = tmpbuf; char *s; @@ -1262,6 +1272,7 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) return asIV(sv); if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1313,6 +1324,7 @@ register SV *sv; SvIVX(sv) = asIV(sv); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1337,6 +1349,7 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) return asUV(sv); if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1382,6 +1395,7 @@ register SV *sv; SvUVX(sv) = asUV(sv); } else { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1410,6 +1424,7 @@ register SV *sv; if (SvIOKp(sv)) return (double)SvIVX(sv); if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1461,6 +1476,7 @@ register SV *sv; SvNVX(sv) = atof(SvPVX(sv)); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0.0; @@ -1595,6 +1611,7 @@ STRLEN *lp; register char *s; int olderrno; SV *tsv; + char tmpbuf[64]; /* Must fit sprintf/Gconvert of longest IV/NV */ if (!sv) { *lp = 0; @@ -1607,17 +1624,18 @@ STRLEN *lp; return SvPVX(sv); } if (SvIOKp(sv)) { - (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv)); + (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv)); tsv = Nullsv; goto tokensave; } if (SvNOKp(sv)) { SET_NUMERIC_STANDARD(); - Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf); + Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf); tsv = Nullsv; goto tokensave; } if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); *lp = 0; @@ -1668,12 +1686,12 @@ STRLEN *lp; if (SvREADONLY(sv)) { if (SvNOKp(sv)) { SET_NUMERIC_STANDARD(); - Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf); + Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf); tsv = Nullsv; goto tokensave; } if (SvIOKp(sv)) { - (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv)); + (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv)); tsv = Nullsv; goto tokensave; } @@ -1725,6 +1743,7 @@ STRLEN *lp; SvIOKp_on(sv); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); *lp = 0; @@ -1742,7 +1761,7 @@ STRLEN *lp; tokensaveref: if (!tsv) - tsv = newSVpv(tokenbuf, 0); + tsv = newSVpv(tmpbuf, 0); sv_2mortal(tsv); *lp = SvCUR(tsv); return SvPVX(tsv); @@ -1757,8 +1776,8 @@ STRLEN *lp; len = SvCUR(tsv); } else { - t = tokenbuf; - len = strlen(tokenbuf); + t = tmpbuf; + len = strlen(tmpbuf); } #ifdef FIXNEGATIVEZERO if (len == 2 && t[0] == '-' && t[1] == '0') { @@ -1789,6 +1808,7 @@ register SV *sv; if (SvROK(sv)) { #ifdef OVERLOAD { + dTHR; SV* tmpsv; if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_))) return SvTRUE(tmpsv); @@ -1797,11 +1817,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; @@ -1828,18 +1848,14 @@ sv_setsv(dstr,sstr) SV *dstr; register SV *sstr; { + dTHR; register U32 sflags; register int dtype; register int stype; if (sstr == dstr) return; - if (SvTHINKFIRST(dstr)) { - if (SvREADONLY(dstr) && curcop != &compiling) - croak(no_modify); - if (SvROK(dstr)) - sv_unref(dstr); - } + sv_check_thinkfirst(dstr); if (!sstr) sstr = &sv_undef; stype = SvTYPE(sstr); @@ -1971,6 +1987,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); @@ -2171,12 +2188,7 @@ register STRLEN len; { assert(len >= 0); /* STRLEN is probably unsigned, so this may elicit a warning, but it won't hurt. */ - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); if (!ptr) { (void)SvOK_off(sv); return; @@ -2202,12 +2214,7 @@ register const char *ptr; { register STRLEN len; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); if (!ptr) { (void)SvOK_off(sv); return; @@ -2232,12 +2239,7 @@ register SV *sv; register char *ptr; register STRLEN len; { - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); if (!SvUPGRADE(sv, SVt_PV)) return; if (!ptr) { @@ -2255,6 +2257,21 @@ register STRLEN len; SvTAINT(sv); } +static void +sv_check_thinkfirst(sv) +register SV *sv; +{ + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv)) { + dTHR; + if (curcop != &compiling) + croak(no_modify); + } + if (SvROK(sv)) + sv_unref(sv); + } +} + void sv_chop(sv,ptr) /* like set but assuming ptr is in sv */ register SV *sv; @@ -2264,12 +2281,7 @@ register char *ptr; if (!ptr || !SvPOKp(sv)) return; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv,SVt_PVIV); @@ -2374,8 +2386,11 @@ I32 namlen; { MAGIC* mg; - if (SvREADONLY(sv) && curcop != &compiling && !strchr("gBf", how)) - croak(no_modify); + if (SvREADONLY(sv)) { + dTHR; + if (curcop != &compiling && !strchr("gBf", how)) + croak(no_modify); + } if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) { if (SvMAGIC(sv) && (mg = mg_find(sv, how))) { if (how == 't') @@ -2394,6 +2409,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; } @@ -2402,8 +2418,10 @@ I32 namlen; if (name) if (namlen >= 0) mg->mg_ptr = savepvn(name, namlen); - else if (namlen == HEf_SVKEY) + else if (namlen == HEf_SVKEY) { + dTHR; /* just for SvREFCNT_inc */ mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name); + } switch (how) { case 0: @@ -2451,6 +2469,11 @@ I32 namlen; case 'l': mg->mg_virtual = &vtbl_dbline; break; +#ifdef USE_THREADS + case 'm': + mg->mg_virtual = &vtbl_mutex; + break; +#endif /* USE_THREADS */ #ifdef USE_LOCALE_COLLATE case 'o': mg->mg_virtual = &vtbl_collxfrm; @@ -2633,12 +2656,7 @@ register SV *sv; register SV *nsv; { U32 refcnt = SvREFCNT(sv); - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); if (SvREFCNT(nsv) != 1) warn("Reference miscount in sv_replace()"); if (SvMAGICAL(sv)) { @@ -2668,7 +2686,9 @@ register SV *sv; assert(SvREFCNT(sv) == 0); if (SvOBJECT(sv)) { + dTHR; if (defstash) { /* Still have a symbol table? */ + dTHR; dSP; GV* destructor; @@ -2847,7 +2867,7 @@ SV *sv; return; #ifdef DEBUGGING if (SvTEMP(sv)) { - warn("Attempt to free temp prematurely"); + warn("Attempt to free temp prematurely: %s", SvPEEK(sv)); return; } #endif @@ -3047,12 +3067,7 @@ I32 append; register I32 cnt; I32 i; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_check_thinkfirst(sv); if (!SvUPGRADE(sv, SVt_PV)) return 0; SvSCREAM_off(sv); @@ -3290,8 +3305,11 @@ register SV *sv; if (!sv) return; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); + if (SvREADONLY(sv)) { + dTHR; + if (curcop != &compiling) + croak(no_modify); + } if (SvROK(sv)) { #ifdef OVERLOAD if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return; @@ -3365,8 +3383,11 @@ register SV *sv; if (!sv) return; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); + if (SvREADONLY(sv)) { + dTHR; + if (curcop != &compiling) + croak(no_modify); + } if (SvROK(sv)) { #ifdef OVERLOAD if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return; @@ -3410,6 +3431,7 @@ register SV *sv; static void sv_mortalgrow() { + dTHR; tmps_max += (tmps_max < 512) ? 128 : 512; Renew(tmps_stack, tmps_max, SV*); } @@ -3418,6 +3440,7 @@ SV * sv_mortalcopy(oldstr) SV *oldstr; { + dTHR; register SV *sv; new_SV(sv); @@ -3435,6 +3458,7 @@ SV *oldstr; SV * sv_newmortal() { + dTHR; register SV *sv; new_SV(sv); @@ -3453,6 +3477,7 @@ SV * sv_2mortal(sv) register SV *sv; { + dTHR; if (!sv) return sv; if (SvREADONLY(sv) && curcop != &compiling) @@ -3542,6 +3567,7 @@ SV * newRV(ref) SV *ref; { + dTHR; register SV *sv; new_SV(sv); @@ -3845,8 +3871,11 @@ STRLEN *lp; { char *s; - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); + if (SvREADONLY(sv)) { + dTHR; + if (curcop != &compiling) + croak(no_modify); + } if (SvPOK(sv)) { *lp = SvCUR(sv); @@ -3858,9 +3887,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); @@ -3957,6 +3988,7 @@ newSVrv(rv, classname) SV *rv; char *classname; { + dTHR; SV *sv; new_SV(sv); @@ -4023,6 +4055,7 @@ sv_bless(sv,stash) SV* sv; HV* stash; { + dTHR; SV *ref; if (!SvROK(sv)) croak("Can't bless non-reference value"); @@ -4215,6 +4248,7 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) I32 svmax; bool *used_locale; { + dTHR; char *p; char *q; char *patend; @@ -4907,6 +4941,12 @@ SV* sv; PerlIO_printf(Perl_debug_log, " DEPTH = %ld\n", (long)CvDEPTH(sv)); PerlIO_printf(Perl_debug_log, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv)); PerlIO_printf(Perl_debug_log, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv)); +#ifdef USE_THREADS + PerlIO_printf(Perl_debug_log, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv)); + PerlIO_printf(Perl_debug_log, " OWNER = 0x%lx\n", (long)CvOWNER(sv)); +#endif /* USE_THREADS */ + PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", + (unsigned long)CvFLAGS(sv)); if (type == SVt_PVFM) PerlIO_printf(Perl_debug_log, " LINES = %ld\n", (long)FmLINES(sv)); break; |