X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=8310047b456329b732a80767e8d404b53d6ddc06;hb=55d729e4e15089064cd25ed6dce2c105389f3837;hp=45fb77f07bf3d13dfc2b780ed829f6947aeabd96;hpb=fc36a67e8855d031b2a6921819d899eb149eee2d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index 45fb77f..8310047 100644 --- a/sv.c +++ b/sv.c @@ -57,6 +57,13 @@ 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)); + +#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv) + +#ifndef PURIFY +static void *my_safemalloc(MEM_SIZE size); +#endif typedef void (*SVFUNC) _((SV*)); @@ -64,14 +71,18 @@ typedef void (*SVFUNC) _((SV*)); #define new_SV(p) \ do { \ + LOCK_SV_MUTEX; \ (p) = (SV*)safemalloc(sizeof(SV)); \ reg_add(p); \ + UNLOCK_SV_MUTEX; \ } while (0) #define del_SV(p) \ do { \ + LOCK_SV_MUTEX; \ reg_remove(p); \ - free((char*)(p)); \ + Safefree((char*)(p)); \ + UNLOCK_SV_MUTEX; \ } while (0) static SV **registry; @@ -106,8 +117,7 @@ SV* sv; I32 oldsize = regsize; regsize = regsize ? ((regsize << 2) + 1) : 2037; - registry = (SV**)safemalloc(regsize * sizeof(SV*)); - memzero(registry, regsize * sizeof(SV*)); + Newz(707, registry, regsize, SV*); if (oldreg) { I32 i; @@ -153,7 +163,7 @@ U32 size; U32 flags; { if (!(flags & SVf_FAKE)) - free(ptr); + Safefree(ptr); } #else /* ! PURIFY */ @@ -170,6 +180,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,23 +188,28 @@ 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 { \ + LOCK_SV_MUTEX; \ + if (sv_root) \ + uproot_SV(p); \ + else \ + (p) = more_sv(); \ + 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 { \ + LOCK_SV_MUTEX; \ + if (debug & 32768) \ + del_sv(p); \ + else \ + plant_SV(p); \ + UNLOCK_SV_MUTEX; \ + } while (0) static void -del_sv(p) -SV* p; +del_sv(SV *p) { if (debug & 32768) { SV* sva; @@ -221,10 +237,7 @@ SV* p; #endif /* DEBUGGING */ void -sv_add_arena(ptr, size, flags) -char* ptr; -U32 size; -U32 flags; +sv_add_arena(char *ptr, U32 size, U32 flags) { SV* sva = (SV*)ptr; register SV* sv; @@ -250,8 +263,9 @@ U32 flags; SvFLAGS(sv) = SVTYPEMASK; } +/* sv_mutex must be held while calling more_sv() */ static SV* -more_sv() +more_sv(void) { register SV* sv; @@ -269,8 +283,7 @@ more_sv() } static void -visit(f) -SVFUNC f; +visit(SVFUNC f) { SV* sva; SV* sv; @@ -288,8 +301,7 @@ SVFUNC f; #endif /* PURIFY */ static void -do_report_used(sv) -SV* sv; +do_report_used(SV *sv) { if (SvTYPE(sv) != SVTYPEMASK) { /* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */ @@ -299,14 +311,13 @@ SV* sv; } void -sv_report_used() +sv_report_used(void) { visit(do_report_used); } static void -do_clean_objs(sv) -SV* sv; +do_clean_objs(SV *sv) { SV* rv; @@ -322,18 +333,28 @@ SV* sv; #ifndef DISABLE_DESTRUCTOR_KLUDGE static void -do_clean_named_objs(sv) -SV* sv; +do_clean_named_objs(SV *sv) { - if (SvTYPE(sv) == SVt_PVGV && GvSV(sv)) - do_clean_objs(GvSV(sv)); + if (SvTYPE(sv) == SVt_PVGV) { + if ( SvOBJECT(GvSV(sv)) || + GvAV(sv) && SvOBJECT(GvAV(sv)) || + GvHV(sv) && SvOBJECT(GvHV(sv)) || + GvIO(sv) && SvOBJECT(GvIO(sv)) || + GvCV(sv) && SvOBJECT(GvCV(sv)) ) + { + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));) + SvREFCNT_dec(sv); + } + else if (GvSV(sv)) + do_clean_objs(GvSV(sv)); + } } #endif static bool in_clean_objs = FALSE; void -sv_clean_objs() +sv_clean_objs(void) { in_clean_objs = TRUE; #ifndef DISABLE_DESTRUCTOR_KLUDGE @@ -344,8 +365,7 @@ sv_clean_objs() } static void -do_clean_all(sv) -SV* sv; +do_clean_all(SV *sv) { DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));) SvFLAGS(sv) |= SVf_BREAK; @@ -355,7 +375,7 @@ SV* sv; static bool in_clean_all = FALSE; void -sv_clean_all() +sv_clean_all(void) { in_clean_all = TRUE; visit(do_clean_all); @@ -363,7 +383,7 @@ sv_clean_all() } void -sv_free_arenas() +sv_free_arenas(void) { SV* sva; SV* svanext; @@ -380,12 +400,16 @@ sv_free_arenas() Safefree((void *)sva); } + if (nice_chunk) + Safefree(nice_chunk); + nice_chunk = Nullch; + nice_chunk_size = 0; sv_arenaroot = 0; sv_root = 0; } static XPVIV* -new_xiv() +new_xiv(void) { IV** xiv; if (xiv_root) { @@ -400,8 +424,7 @@ new_xiv() } static void -del_xiv(p) -XPVIV* p; +del_xiv(XPVIV *p) { IV** xiv = (IV**)((char*)(p) + sizeof(XPV)); *xiv = (IV *)xiv_root; @@ -409,11 +432,12 @@ XPVIV* p; } static XPVIV* -more_xiv() +more_xiv(void) { register IV** xiv; register IV** xivend; - XPV* ptr = (XPV*)safemalloc(1008); + XPV* ptr; + New(705, ptr, 1008/sizeof(XPV), XPV); ptr->xpv_pv = (char*)xiv_arenaroot; /* linked list of xiv arenas */ xiv_arenaroot = ptr; /* to keep Purify happy */ @@ -430,7 +454,7 @@ more_xiv() } static XPVNV* -new_xnv() +new_xnv(void) { double* xnv; if (xnv_root) { @@ -442,8 +466,7 @@ new_xnv() } static void -del_xnv(p) -XPVNV* p; +del_xnv(XPVNV *p) { double* xnv = (double*)((char*)(p) + sizeof(XPVIV)); *(double**)xnv = xnv_root; @@ -451,11 +474,11 @@ XPVNV* p; } static XPVNV* -more_xnv() +more_xnv(void) { register double* xnv; register double* xnvend; - xnv = (double*)safemalloc(1008); + New(711, xnv, 1008/sizeof(double), double); xnvend = &xnv[1008 / sizeof(double) - 1]; xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */ xnv_root = xnv; @@ -468,7 +491,7 @@ more_xnv() } static XRV* -new_xrv() +new_xrv(void) { XRV* xrv; if (xrv_root) { @@ -480,19 +503,18 @@ new_xrv() } static void -del_xrv(p) -XRV* p; +del_xrv(XRV *p) { p->xrv_rv = (SV*)xrv_root; xrv_root = p; } static XRV* -more_xrv() +more_xrv(void) { register XRV* xrv; register XRV* xrvend; - xrv_root = (XRV*)safemalloc(1008); + New(712, xrv_root, 1008/sizeof(XRV), XRV); xrv = xrv_root; xrvend = &xrv[1008 / sizeof(XRV) - 1]; while (xrv < xrvend) { @@ -504,7 +526,7 @@ more_xrv() } static XPV* -new_xpv() +new_xpv(void) { XPV* xpv; if (xpv_root) { @@ -516,19 +538,18 @@ new_xpv() } static void -del_xpv(p) -XPV* p; +del_xpv(XPV *p) { p->xpv_pv = (char*)xpv_root; xpv_root = p; } static XPV* -more_xpv() +more_xpv(void) { register XPV* xpv; register XPV* xpvend; - xpv_root = (XPV*)safemalloc(1008); + New(713, xpv_root, 1008/sizeof(XPV), XPV); xpv = xpv_root; xpvend = &xpv[1008 / sizeof(XPV) - 1]; while (xpv < xpvend) { @@ -541,73 +562,85 @@ more_xpv() #ifdef PURIFY #define new_XIV() (void*)safemalloc(sizeof(XPVIV)) -#define del_XIV(p) free((char*)p) +#define del_XIV(p) Safefree((char*)p) #else #define new_XIV() (void*)new_xiv() -#define del_XIV(p) del_xiv(p) +#define del_XIV(p) del_xiv((XPVIV*) p) #endif #ifdef PURIFY #define new_XNV() (void*)safemalloc(sizeof(XPVNV)) -#define del_XNV(p) free((char*)p) +#define del_XNV(p) Safefree((char*)p) #else #define new_XNV() (void*)new_xnv() -#define del_XNV(p) del_xnv(p) +#define del_XNV(p) del_xnv((XPVNV*) p) #endif #ifdef PURIFY #define new_XRV() (void*)safemalloc(sizeof(XRV)) -#define del_XRV(p) free((char*)p) +#define del_XRV(p) Safefree((char*)p) #else #define new_XRV() (void*)new_xrv() -#define del_XRV(p) del_xrv(p) +#define del_XRV(p) del_xrv((XRV*) p) #endif #ifdef PURIFY #define new_XPV() (void*)safemalloc(sizeof(XPV)) -#define del_XPV(p) free((char*)p) +#define del_XPV(p) Safefree((char*)p) #else #define new_XPV() (void*)new_xpv() -#define del_XPV(p) del_xpv(p) +#define del_XPV(p) del_xpv((XPV *)p) #endif -#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV)) -#define del_XPVIV(p) free((char*)p) - -#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV)) -#define del_XPVNV(p) free((char*)p) - -#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG)) -#define del_XPVMG(p) free((char*)p) - -#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV)) -#define del_XPVLV(p) free((char*)p) - -#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV)) -#define del_XPVAV(p) free((char*)p) - -#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV)) -#define del_XPVHV(p) free((char*)p) - -#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV)) -#define del_XPVCV(p) free((char*)p) - -#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV)) -#define del_XPVGV(p) free((char*)p) - -#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM)) -#define del_XPVBM(p) free((char*)p) - -#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM)) -#define del_XPVFM(p) free((char*)p) - -#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO)) -#define del_XPVIO(p) free((char*)p) +#ifdef PURIFY +# define my_safemalloc(s) safemalloc(s) +# define my_safefree(s) free(s) +#else +static void* +my_safemalloc(MEM_SIZE size) +{ + char *p; + New(717, p, size, char); + return (void*)p; +} +# define my_safefree(s) Safefree(s) +#endif + +#define new_XPVIV() (void*)my_safemalloc(sizeof(XPVIV)) +#define del_XPVIV(p) my_safefree((char*)p) + +#define new_XPVNV() (void*)my_safemalloc(sizeof(XPVNV)) +#define del_XPVNV(p) my_safefree((char*)p) + +#define new_XPVMG() (void*)my_safemalloc(sizeof(XPVMG)) +#define del_XPVMG(p) my_safefree((char*)p) + +#define new_XPVLV() (void*)my_safemalloc(sizeof(XPVLV)) +#define del_XPVLV(p) my_safefree((char*)p) + +#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV)) +#define del_XPVAV(p) my_safefree((char*)p) + +#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV)) +#define del_XPVHV(p) my_safefree((char*)p) + +#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV)) +#define del_XPVCV(p) my_safefree((char*)p) + +#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV)) +#define del_XPVGV(p) my_safefree((char*)p) + +#define new_XPVBM() (void*)my_safemalloc(sizeof(XPVBM)) +#define del_XPVBM(p) my_safefree((char*)p) + +#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM)) +#define del_XPVFM(p) my_safefree((char*)p) + +#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO)) +#define del_XPVIO(p) my_safefree((char*)p) bool -sv_upgrade(sv, mt) -register SV* sv; -U32 mt; +sv_upgrade(register SV *sv, U32 mt) { char* pv; U32 cur; @@ -787,7 +820,7 @@ U32 mt; Safefree(pv); SvPVX(sv) = 0; AvMAX(sv) = -1; - AvFILL(sv) = -1; + AvFILLp(sv) = -1; SvIVX(sv) = 0; SvNVX(sv) = 0.0; SvMAGIC(sv) = magic; @@ -882,13 +915,13 @@ U32 mt; #ifdef DEBUGGING char * -sv_peek(sv) -register SV *sv; +sv_peek(SV *sv) { SV *t = sv_newmortal(); STRLEN prevlen; int unref = 0; + sv_setpvn(t, "", 0); retry: if (!sv) { sv_catpv(t, "VOID"); @@ -951,7 +984,7 @@ register SV *sv; case SVt_NULL: sv_catpv(t, "UNDEF"); - return tokenbuf; + goto finish; case SVt_IV: sv_catpv(t, "IV"); break; @@ -1029,8 +1062,7 @@ register SV *sv; #endif int -sv_backoff(sv) -register SV *sv; +sv_backoff(register SV *sv) { assert(SvOOK(sv)); if (SvIVX(sv)) { @@ -1045,12 +1077,10 @@ register SV *sv; } char * -sv_grow(sv,newlen) -register SV *sv; #ifndef DOSISH -register I32 newlen; +sv_grow(register SV *sv, register I32 newlen) #else -unsigned long newlen; +sv_grow(SV* sv, unsigned long newlen) #endif { register char *s; @@ -1072,6 +1102,10 @@ unsigned long newlen; s = SvPVX(sv); if (newlen > SvLEN(sv)) newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */ +#ifdef HAS_64K_LIMIT + if (newlen >= 0x10000) + newlen = 0xFFFF; +#endif } else s = SvPVX(sv); @@ -1087,16 +1121,9 @@ unsigned long newlen; } void -sv_setiv(sv,i) -register SV *sv; -IV i; +sv_setiv(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); @@ -1120,8 +1147,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_desc[op->op_type]); + } } (void)SvIOK_only(sv); /* validate number */ SvIVX(sv) = i; @@ -1129,9 +1159,14 @@ IV i; } void -sv_setuv(sv,u) -register SV *sv; -UV u; +sv_setiv_mg(register SV *sv, IV i) +{ + sv_setiv(sv,i); + SvSETMAGIC(sv); +} + +void +sv_setuv(register SV *sv, UV u) { if (u <= IV_MAX) sv_setiv(sv, u); @@ -1140,22 +1175,21 @@ UV u; } void -sv_setnv(sv,num) -register SV *sv; -double num; +sv_setuv_mg(register SV *sv, UV u) { - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } + sv_setuv(sv,u); + SvSETMAGIC(sv); +} + +void +sv_setnv(register SV *sv, double num) +{ + SV_CHECK_THINKFIRST(sv); switch (SvTYPE(sv)) { case SVt_NULL: case SVt_IV: sv_upgrade(sv, SVt_NV); break; - case SVt_NV: case SVt_RV: case SVt_PV: case SVt_PVIV: @@ -1179,18 +1213,28 @@ 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 */ SvTAINT(sv); } +void +sv_setnv_mg(register SV *sv, double num) +{ + sv_setnv(sv,num); + SvSETMAGIC(sv); +} + static void -not_a_number(sv) -SV *sv; +not_a_number(SV *sv) { + dTHR; char tmpbuf[64]; char *d = tmpbuf; char *s; @@ -1243,8 +1287,7 @@ SV *sv; } IV -sv_2iv(sv) -register SV *sv; +sv_2iv(register SV *sv) { if (!sv) return 0; @@ -1261,8 +1304,11 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) return asIV(sv); if (!SvROK(sv)) { - if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - warn(warn_uninit); + if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!localizing) + warn(warn_uninit); + } return 0; } } @@ -1312,6 +1358,7 @@ register SV *sv; SvIVX(sv) = asIV(sv); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1322,8 +1369,7 @@ register SV *sv; } UV -sv_2uv(sv) -register SV *sv; +sv_2uv(register SV *sv) { if (!sv) return 0; @@ -1336,8 +1382,11 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) return asUV(sv); if (!SvROK(sv)) { - if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - warn(warn_uninit); + if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!localizing) + warn(warn_uninit); + } return 0; } } @@ -1381,8 +1430,11 @@ register SV *sv; SvUVX(sv) = asUV(sv); } else { - if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - warn(warn_uninit); + if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!localizing) + warn(warn_uninit); + } return 0; } DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n", @@ -1391,8 +1443,7 @@ register SV *sv; } double -sv_2nv(sv) -register SV *sv; +sv_2nv(register SV *sv) { if (!sv) return 0.0; @@ -1409,8 +1460,11 @@ register SV *sv; if (SvIOKp(sv)) return (double)SvIVX(sv); if (!SvROK(sv)) { - if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - warn(warn_uninit); + if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!localizing) + warn(warn_uninit); + } return 0; } } @@ -1460,6 +1514,7 @@ register SV *sv; SvNVX(sv) = atof(SvPVX(sv)); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0.0; @@ -1472,8 +1527,7 @@ register SV *sv; } static IV -asIV(sv) -SV *sv; +asIV(SV *sv) { I32 numtype = looks_like_number(sv); double d; @@ -1491,13 +1545,14 @@ SV *sv; } static UV -asUV(sv) -SV *sv; +asUV(SV *sv) { I32 numtype = looks_like_number(sv); +#ifdef HAS_STRTOUL if (numtype == 1) - return atol(SvPVX(sv)); + return strtoul(SvPVX(sv), Null(char**), 10); +#endif if (!numtype && dowarn) not_a_number(sv); SET_NUMERIC_STANDARD(); @@ -1505,8 +1560,7 @@ SV *sv; } I32 -looks_like_number(sv) -SV *sv; +looks_like_number(SV *sv) { register char *s; register char *send; @@ -1585,13 +1639,12 @@ SV *sv; } char * -sv_2pv(sv, lp) -register SV *sv; -STRLEN *lp; +sv_2pv(register SV *sv, STRLEN *lp) { register char *s; int olderrno; SV *tsv; + char tmpbuf[64]; /* Must fit sprintf/Gconvert of longest IV/NV */ if (!sv) { *lp = 0; @@ -1604,19 +1657,22 @@ 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)) { - if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - warn(warn_uninit); + if (dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!localizing) + warn(warn_uninit); + } *lp = 0; return ""; } @@ -1647,7 +1703,7 @@ STRLEN *lp; case SVt_PVHV: s = "HASH"; break; case SVt_PVCV: s = "CODE"; break; case SVt_PVGV: s = "GLOB"; break; - case SVt_PVFM: s = "FORMATLINE"; break; + case SVt_PVFM: s = "FORMLINE"; break; case SVt_PVIO: s = "IO"; break; default: s = "UNKNOWN"; break; } @@ -1665,12 +1721,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; } @@ -1680,8 +1736,7 @@ STRLEN *lp; return ""; } } - if (!SvUPGRADE(sv, SVt_PV)) - return 0; + (void)SvUPGRADE(sv, SVt_PV); if (SvNOKp(sv)) { if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); @@ -1709,14 +1764,20 @@ STRLEN *lp; #endif } else if (SvIOKp(sv)) { + U32 oldIOK = SvIOK(sv); if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); olderrno = errno; /* some Xenix systems wipe out errno here */ - sv_setpvf(sv, "%Vd", SvIVX(sv)); + sv_setpviv(sv, SvIVX(sv)); errno = olderrno; s = SvEND(sv); + if (oldIOK) + SvIOK_on(sv); + else + SvIOKp_on(sv); } else { + dTHR; if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); *lp = 0; @@ -1734,7 +1795,7 @@ STRLEN *lp; tokensaveref: if (!tsv) - tsv = newSVpv(tokenbuf, 0); + tsv = newSVpv(tmpbuf, 0); sv_2mortal(tsv); *lp = SvCUR(tsv); return SvPVX(tsv); @@ -1749,8 +1810,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') { @@ -1770,8 +1831,7 @@ STRLEN *lp; /* This function is only called on magical items */ bool -sv_2bool(sv) -register SV *sv; +sv_2bool(register SV *sv) { if (SvGMAGICAL(sv)) mg_get(sv); @@ -1781,6 +1841,7 @@ register SV *sv; if (SvROK(sv)) { #ifdef OVERLOAD { + dTHR; SV* tmpsv; if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_))) return SvTRUE(tmpsv); @@ -1789,11 +1850,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; @@ -1816,22 +1877,16 @@ register SV *sv; */ void -sv_setsv(dstr,sstr) -SV *dstr; -register SV *sstr; +sv_setsv(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); @@ -1851,8 +1906,11 @@ register SV *sstr; switch (stype) { case SVt_NULL: - (void)SvOK_off(dstr); - return; + if (dtype != SVt_PVGV) { + (void)SvOK_off(dstr); + return; + } + break; case SVt_IV: if (dtype != SVt_IV && dtype < SVt_PVIV) { if (dtype < SVt_IV) @@ -1899,11 +1957,6 @@ register SV *sstr; if (dtype < SVt_PVNV) sv_upgrade(dstr, SVt_PVNV); break; - - case SVt_PVLV: - sv_upgrade(dstr, SVt_PVLV); - break; - case SVt_PVAV: case SVt_PVHV: case SVt_PVCV: @@ -1923,11 +1976,16 @@ register SV *sstr; STRLEN len = GvNAMELEN(sstr); sv_upgrade(dstr, SVt_PVGV); sv_magic(dstr, dstr, '*', name, len); - GvSTASH(dstr) = GvSTASH(sstr); + GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr)); GvNAME(dstr) = savepvn(name, len); GvNAMELEN(dstr) = len; SvFAKE_on(dstr); /* can coerce to non-glob */ } + /* ahem, death to those who redefine active sort subs */ + else if (curstackinfo->si_type == SI_SORT + && GvCV(dstr) && sortcop == CvSTART(GvCV(dstr))) + croak("Can't redefine active sort subroutine %s", + GvNAME(dstr)); (void)SvOK_off(dstr); GvINTRO_off(dstr); /* one-shot flag */ gp_free((GV*)dstr); @@ -1949,8 +2007,10 @@ register SV *sstr; goto glob_assign; } } - if (dtype < stype) - sv_upgrade(dstr, stype); + if (stype == SVt_PVLV) + SvUPGRADE(dstr, SVt_PVNV); + else + SvUPGRADE(dstr, stype); } sflags = SvFLAGS(sstr); @@ -1958,6 +2018,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); @@ -2010,12 +2071,24 @@ register SV *sstr; if (!GvCVGEN((GV*)dstr) && (CvROOT(cv) || CvXSUB(cv))) { + /* ahem, death to those who redefine + * active sort subs */ + if (curstackinfo->si_type == SI_SORT && + sortcop == CvSTART(cv)) + croak( + "Can't redefine active sort subroutine %s", + GvENAME((GV*)dstr)); if (cv_const_sv(cv)) warn("Constant subroutine %s redefined", GvENAME((GV*)dstr)); - else if (dowarn) - warn("Subroutine %s redefined", - GvENAME((GV*)dstr)); + else if (dowarn) { + if (!(CvGV(cv) && GvSTASH(CvGV(cv)) + && HvNAME(GvSTASH(CvGV(cv))) + && strEQ(HvNAME(GvSTASH(CvGV(cv))), + "autouse"))) + warn("Subroutine %s redefined", + GvENAME((GV*)dstr)); + } } cv_ckproto(cv, (GV*)dstr, SvPOK(sref) ? SvPVX(sref) : Nullch); @@ -2085,6 +2158,7 @@ register SV *sstr; */ if (SvTEMP(sstr) && /* slated for free anyway? */ + SvREFCNT(sstr) == 1 && /* and no other references to it? */ !(sflags & SVf_OOK)) /* and not involved in OOK hack? */ { if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */ @@ -2138,25 +2212,30 @@ register SV *sstr; SvIVX(dstr) = SvIVX(sstr); } else { - (void)SvOK_off(dstr); + if (dtype == SVt_PVGV) { + if (dowarn) + warn("Undefined value assigned to typeglob"); + } + else + (void)SvOK_off(dstr); } SvTAINT(dstr); } void -sv_setpvn(sv,ptr,len) -register SV *sv; -register const char *ptr; -register STRLEN len; +sv_setsv_mg(SV *dstr, register SV *sstr) +{ + sv_setsv(dstr,sstr); + SvSETMAGIC(dstr); +} + +void +sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len) { + register char *dptr; 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; @@ -2165,29 +2244,31 @@ register STRLEN len; if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) sv_unglob(sv); } - else if (!sv_upgrade(sv, SVt_PV)) - return; + else + sv_upgrade(sv, SVt_PV); + SvGROW(sv, len + 1); - Move(ptr,SvPVX(sv),len,char); + dptr = SvPVX(sv); + Move(ptr,dptr,len,char); + dptr[len] = '\0'; SvCUR_set(sv, len); - *SvEND(sv) = '\0'; (void)SvPOK_only(sv); /* validate pointer */ SvTAINT(sv); } void -sv_setpv(sv,ptr) -register SV *sv; -register const char *ptr; +sv_setpvn_mg(register SV *sv, register const char *ptr, register STRLEN len) +{ + sv_setpvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +void +sv_setpv(register SV *sv, 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; @@ -2197,8 +2278,9 @@ register const char *ptr; if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) sv_unglob(sv); } - else if (!sv_upgrade(sv, SVt_PV)) - return; + else + sv_upgrade(sv, SVt_PV); + SvGROW(sv, len + 1); Move(ptr,SvPVX(sv),len+1,char); SvCUR_set(sv, len); @@ -2207,19 +2289,17 @@ register const char *ptr; } void -sv_usepvn(sv,ptr,len) -register SV *sv; -register char *ptr; -register STRLEN len; +sv_setpv_mg(register SV *sv, register const char *ptr) { - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } - if (!SvUPGRADE(sv, SVt_PV)) - return; + sv_setpv(sv,ptr); + SvSETMAGIC(sv); +} + +void +sv_usepvn(register SV *sv, register char *ptr, register STRLEN len) +{ + SV_CHECK_THINKFIRST(sv); + (void)SvUPGRADE(sv, SVt_PV); if (!ptr) { (void)SvOK_off(sv); return; @@ -2236,20 +2316,34 @@ register STRLEN len; } void -sv_chop(sv,ptr) /* like set but assuming ptr is in sv */ -register SV *sv; -register char *ptr; +sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len) +{ + sv_usepvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +static void +sv_check_thinkfirst(register SV *sv) +{ + if (SvREADONLY(sv)) { + dTHR; + if (curcop != &compiling) + croak(no_modify); + } + if (SvROK(sv)) + sv_unref(sv); +} + +void +sv_chop(register SV *sv, register char *ptr) /* like set but assuming ptr is in sv */ + + { register STRLEN delta; 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); @@ -2266,10 +2360,7 @@ register char *ptr; } void -sv_catpvn(sv,ptr,len) -register SV *sv; -register char *ptr; -register STRLEN len; +sv_catpvn(register SV *sv, register char *ptr, register STRLEN len) { STRLEN tlen; char *junk; @@ -2286,9 +2377,14 @@ register STRLEN len; } void -sv_catsv(dstr,sstr) -SV *dstr; -register SV *sstr; +sv_catpvn_mg(register SV *sv, register char *ptr, register STRLEN len) +{ + sv_catpvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +void +sv_catsv(SV *dstr, register SV *sstr) { char *s; STRLEN len; @@ -2299,9 +2395,14 @@ register SV *sstr; } void -sv_catpv(sv,ptr) -register SV *sv; -register char *ptr; +sv_catsv_mg(SV *dstr, register SV *sstr) +{ + sv_catsv(dstr,sstr); + SvSETMAGIC(dstr); +} + +void +sv_catpv(register SV *sv, register char *ptr) { register STRLEN len; STRLEN tlen; @@ -2320,14 +2421,15 @@ register char *ptr; SvTAINT(sv); } +void +sv_catpv_mg(register SV *sv, register char *ptr) +{ + sv_catpv(sv,ptr); + SvSETMAGIC(sv); +} + SV * -#ifdef LEAKTEST -newSV(x,len) -I32 x; -#else -newSV(len) -#endif -STRLEN len; +newSV(STRLEN len) { register SV *sv; @@ -2345,17 +2447,15 @@ STRLEN len; /* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */ void -sv_magic(sv, obj, how, name, namlen) -register SV *sv; -SV *obj; -int how; -char *name; -I32 namlen; +sv_magic(register SV *sv, SV *obj, int how, char *name, 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') @@ -2364,16 +2464,16 @@ I32 namlen; } } else { - if (!SvUPGRADE(sv, SVt_PVMG)) - return; + (void)SvUPGRADE(sv, SVt_PVMG); } Newz(702,mg, 1, MAGIC); mg->mg_moremagic = SvMAGIC(sv); SvMAGIC(sv) = mg; - if (!obj || obj == sv || how == '#') + if (!obj || obj == sv || how == '#' || how == 'r') mg->mg_obj = obj; else { + dTHR; mg->mg_obj = SvREFCNT_inc(obj); mg->mg_flags |= MGf_REFCOUNTED; } @@ -2431,6 +2531,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; @@ -2443,6 +2548,9 @@ I32 namlen; case 'q': mg->mg_virtual = &vtbl_packelem; break; + case 'r': + mg->mg_virtual = &vtbl_regexp; + break; case 'S': mg->mg_virtual = &vtbl_sig; break; @@ -2489,9 +2597,7 @@ I32 namlen; } int -sv_unmagic(sv, type) -SV* sv; -int type; +sv_unmagic(SV *sv, int type) { MAGIC* mg; MAGIC** mgp; @@ -2525,22 +2631,24 @@ int type; } void -sv_insert(bigstr,offset,len,little,littlelen) -SV *bigstr; -STRLEN offset; -STRLEN len; -char *little; -STRLEN littlelen; +sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen) { register char *big; register char *mid; register char *midend; register char *bigend; register I32 i; + STRLEN curlen; + if (!bigstr) croak("Can't modify non-existent substring"); - SvPV_force(bigstr, na); + SvPV_force(bigstr, curlen); + if (offset + len > curlen) { + SvGROW(bigstr, offset+len+1); + Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char); + SvCUR_set(bigstr, offset+len); + } i = littlelen - len; if (i > 0) { /* string might grow */ @@ -2608,17 +2716,10 @@ STRLEN littlelen; /* make sv point to what nstr did */ void -sv_replace(sv,nsv) -register SV *sv; -register SV *nsv; +sv_replace(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)) { @@ -2641,71 +2742,63 @@ register SV *nsv; } void -sv_clear(sv) -register SV *sv; +sv_clear(register SV *sv) { + HV* stash; assert(sv); assert(SvREFCNT(sv) == 0); if (SvOBJECT(sv)) { + dTHR; if (defstash) { /* Still have a symbol table? */ - dSP; + djSP; GV* destructor; + SV ref; - ENTER; - SAVEFREESV(SvSTASH(sv)); - - destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); - if (destructor) { - SV ref; - - Zero(&ref, 1, SV); - sv_upgrade(&ref, SVt_RV); - SvRV(&ref) = SvREFCNT_inc(sv); - SvROK_on(&ref); - SvREFCNT(&ref) = 1; /* Fake, but otherwise - creating+destructing a ref - leads to disaster. */ - - EXTEND(SP, 2); - PUSHMARK(SP); - PUSHs(&ref); - PUTBACK; - perl_call_sv((SV*)GvCV(destructor), - G_DISCARD|G_EVAL|G_KEEPERR); - del_XRV(SvANY(&ref)); - SvREFCNT(sv)--; - } + Zero(&ref, 1, SV); + sv_upgrade(&ref, SVt_RV); + SvROK_on(&ref); + SvREADONLY_on(&ref); /* DESTROY() could be naughty */ + SvREFCNT(&ref) = 1; - LEAVE; + do { + stash = SvSTASH(sv); + destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); + if (destructor) { + ENTER; + PUSHSTACK(SI_DESTROY); + SvRV(&ref) = SvREFCNT_inc(sv); + EXTEND(SP, 2); + PUSHMARK(SP); + PUSHs(&ref); + PUTBACK; + perl_call_sv((SV*)GvCV(destructor), + G_DISCARD|G_EVAL|G_KEEPERR); + SvREFCNT(sv)--; + POPSTACK(); + LEAVE; + } + } while (SvOBJECT(sv) && SvSTASH(sv) != stash); + + del_XRV(SvANY(&ref)); } - else - SvREFCNT_dec(SvSTASH(sv)); + if (SvOBJECT(sv)) { + SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */ SvOBJECT_off(sv); /* Curse the object. */ if (SvTYPE(sv) != SVt_PVIO) --sv_objcount; /* XXX Might want something more general */ } if (SvREFCNT(sv)) { - SV *ret; - if ( perldb - && (ret = perl_get_sv("DB::ret", FALSE)) - && SvROK(ret) && SvRV(ret) == sv && SvREFCNT(sv) == 1) { - /* Debugger is prone to dangling references. */ - SvRV(ret) = 0; - SvROK_off(ret); - SvREFCNT(sv) = 0; - } - else { if (in_clean_objs) croak("DESTROY created new reference to dead object"); /* DESTROY gave object new lease on life */ return; - } } } if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) mg_free(sv); + stash = NULL; switch (SvTYPE(sv)) { case SVt_PVIO: if (IoIFP(sv) != PerlIO_stdin() && @@ -2731,6 +2824,11 @@ register SV *sv; case SVt_PVGV: gp_free((GV*)sv); Safefree(GvNAME(sv)); + /* cannot decrease stash refcount yet, as we might recursively delete + ourselves when the refcnt drops to zero. Delay SvREFCNT_dec + of stash until current sv is completely gone. + -- JohnPC, 27 Mar 1998 */ + stash = GvSTASH(sv); /* FALL THROUGH */ case SVt_PVLV: case SVt_PVMG: @@ -2792,7 +2890,13 @@ register SV *sv; break; case SVt_PVGV: del_XPVGV(SvANY(sv)); - break; + /* code duplication for increased performance. */ + SvFLAGS(sv) &= SVf_BREAK; + SvFLAGS(sv) |= SVTYPEMASK; + /* decrease refcount of the stash that owns this GV, if any */ + if (stash) + SvREFCNT_dec(stash); + return; /* not break, SvFLAGS reset already happened */ case SVt_PVBM: del_XPVBM(SvANY(sv)); break; @@ -2808,18 +2912,18 @@ register SV *sv; } SV * -sv_newref(sv) -SV* sv; +sv_newref(SV *sv) { if (sv) - SvREFCNT(sv)++; + ATOMIC_INC(SvREFCNT(sv)); return sv; } void -sv_free(sv) -SV *sv; +sv_free(SV *sv) { + int refcount_is_zero; + if (!sv) return; if (SvREADONLY(sv)) { @@ -2834,11 +2938,12 @@ SV *sv; warn("Attempt to free unreferenced scalar"); return; } - if (--SvREFCNT(sv) > 0) + ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv)); + if (!refcount_is_zero) return; #ifdef DEBUGGING if (SvTEMP(sv)) { - warn("Attempt to free temp prematurely"); + warn("Attempt to free temp prematurely: %s", SvPEEK(sv)); return; } #endif @@ -2848,8 +2953,7 @@ SV *sv; } STRLEN -sv_len(sv) -register SV *sv; +sv_len(register SV *sv) { char *junk; STRLEN len; @@ -2865,9 +2969,7 @@ register SV *sv; } I32 -sv_eq(str1,str2) -register SV *str1; -register SV *str2; +sv_eq(register SV *str1, register SV *str2) { char *pv1; STRLEN cur1; @@ -2893,14 +2995,12 @@ register SV *str2; } I32 -sv_cmp(str1, str2) -register SV *str1; -register SV *str2; +sv_cmp(register SV *str1, register SV *str2) { STRLEN cur1 = 0; - char *pv1 = str1 ? SvPV(str1, cur1) : NULL; + char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL; STRLEN cur2 = 0; - char *pv2 = str2 ? SvPV(str2, cur2) : NULL; + char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL; I32 retval; if (!cur1) @@ -2921,9 +3021,7 @@ register SV *str2; } I32 -sv_cmp_locale(sv1, sv2) -register SV *sv1; -register SV *sv2; +sv_cmp_locale(register SV *sv1, register SV *sv2) { #ifdef USE_LOCALE_COLLATE @@ -2935,9 +3033,9 @@ register SV *sv2; goto raw_compare; len1 = 0; - pv1 = sv1 ? sv_collxfrm(sv1, &len1) : NULL; + pv1 = sv1 ? sv_collxfrm(sv1, &len1) : (char *) NULL; len2 = 0; - pv2 = sv2 ? sv_collxfrm(sv2, &len2) : NULL; + pv2 = sv2 ? sv_collxfrm(sv2, &len2) : (char *) NULL; if (!pv1 || !len1) { if (pv2 && len2) @@ -2978,13 +3076,11 @@ register SV *sv2; * according to the locale settings. */ char * -sv_collxfrm(sv, nxp) - SV *sv; - STRLEN *nxp; +sv_collxfrm(SV *sv, STRLEN *nxp) { MAGIC *mg; - mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : NULL; + mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : (MAGIC *) NULL; if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) { char *s, *xf; STRLEN len, xlen; @@ -2996,7 +3092,7 @@ sv_collxfrm(sv, nxp) if (SvREADONLY(sv)) { SAVEFREEPV(xf); *nxp = xlen; - return xf; + return xf + sizeof(collation_ix); } if (! mg) { sv_magic(sv, 0, 'o', 0, 0); @@ -3026,11 +3122,9 @@ sv_collxfrm(sv, nxp) #endif /* USE_LOCALE_COLLATE */ char * -sv_gets(sv,fp,append) -register SV *sv; -register PerlIO *fp; -I32 append; +sv_gets(register SV *sv, register PerlIO *fp, I32 append) { + dTHR; char *rsptr; STRLEN rslen; register STDCHAR rslast; @@ -3038,14 +3132,8 @@ I32 append; register I32 cnt; I32 i; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv) && curcop != &compiling) - croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } - if (!SvUPGRADE(sv, SVt_PV)) - return 0; + SV_CHECK_THINKFIRST(sv); + (void)SvUPGRADE(sv, SVt_PV); SvSCREAM_off(sv); if (RsSNARF(rs)) { @@ -3206,8 +3294,8 @@ thats_really_all_folks: *bp = '\0'; SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: done, len=%d, string=|%.*s|\n", - SvCUR(sv),(int)SvCUR(sv),SvPVX(sv))); + "Screamer: done, len=%ld, string=|%.*s|\n", + (long)SvCUR(sv),(int)SvCUR(sv),SvPVX(sv))); } else { @@ -3241,7 +3329,19 @@ screamer2: memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen))) { append = -1; - goto screamer2; + /* + * If we're reading from a TTY and we get a short read, + * indicating that the user hit his EOF character, we need + * to notice it now, because if we try to read from the TTY + * again, the EOF condition will disappear. + * + * The comparison of cnt to sizeof(buf) is an optimization + * that prevents unnecessary calls to feof(). + * + * - jik 9/25/96 + */ + if (!(cnt < sizeof(buf) && PerlIO_eof(fp))) + goto screamer2; } } @@ -3255,13 +3355,16 @@ screamer2: } } +#ifdef WIN32 + win32_strip_return(sv); +#endif + return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch; } void -sv_inc(sv) -register SV *sv; +sv_inc(register SV *sv) { register char *d; int flags; @@ -3269,8 +3372,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; @@ -3336,16 +3442,18 @@ register SV *sv; } void -sv_dec(sv) -register SV *sv; +sv_dec(register SV *sv) { int flags; 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; @@ -3387,16 +3495,17 @@ register SV *sv; * permanent location. */ static void -sv_mortalgrow() +sv_mortalgrow(void) { + dTHR; tmps_max += (tmps_max < 512) ? 128 : 512; Renew(tmps_stack, tmps_max, SV*); } SV * -sv_mortalcopy(oldstr) -SV *oldstr; +sv_mortalcopy(SV *oldstr) { + dTHR; register SV *sv; new_SV(sv); @@ -3412,8 +3521,9 @@ SV *oldstr; } SV * -sv_newmortal() +sv_newmortal(void) { + dTHR; register SV *sv; new_SV(sv); @@ -3429,9 +3539,9 @@ sv_newmortal() /* same thing without the copying */ SV * -sv_2mortal(sv) -register SV *sv; +sv_2mortal(register SV *sv) { + dTHR; if (!sv) return sv; if (SvREADONLY(sv) && curcop != &compiling) @@ -3444,9 +3554,7 @@ register SV *sv; } SV * -newSVpv(s,len) -char *s; -STRLEN len; +newSVpv(char *s, STRLEN len) { register SV *sv; @@ -3460,6 +3568,21 @@ STRLEN len; return sv; } +SV * +newSVpvn(s,len) +char *s; +STRLEN len; +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_setpvn(sv,s,len); + return sv; +} + #ifdef I_STDARG SV * newSVpvf(const char* pat, ...) @@ -3490,8 +3613,7 @@ va_dcl SV * -newSVnv(n) -double n; +newSVnv(double n) { register SV *sv; @@ -3504,8 +3626,7 @@ double n; } SV * -newSViv(i) -IV i; +newSViv(IV i) { register SV *sv; @@ -3518,9 +3639,9 @@ IV i; } SV * -newRV(ref) -SV *ref; +newRV(SV *ref) { + dTHR; register SV *sv; new_SV(sv); @@ -3534,10 +3655,10 @@ SV *ref; return sv; } -#ifdef CRIPPLED_CC + + SV * -newRV_noinc(ref) -SV *ref; +Perl_newRV_noinc(SV *ref) { register SV *sv; @@ -3545,13 +3666,11 @@ SV *ref; SvREFCNT_dec(ref); return sv; } -#endif /* CRIPPLED_CC */ /* make an exact duplicate of old */ SV * -newSVsv(old) -register SV *old; +newSVsv(register SV *old) { register SV *sv; @@ -3576,9 +3695,7 @@ register SV *old; } void -sv_reset(s,stash) -register char *s; -HV *stash; +sv_reset(register char *s, HV *stash) { register HE *entry; register GV *gv; @@ -3588,9 +3705,12 @@ HV *stash; register I32 max; char todo[256]; + if (!stash) + return; + if (!*s) { /* reset ?? searches */ for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) { - pm->op_pmflags &= ~PMf_USED; + pm->op_pmdynflags &= ~PMdf_USED; } return; } @@ -3641,8 +3761,7 @@ HV *stash; } IO* -sv_2io(sv) -SV *sv; +sv_2io(SV *sv) { IO* io; GV* gv; @@ -3675,11 +3794,7 @@ SV *sv; } CV * -sv_2cv(sv, st, gvp, lref) -SV *sv; -HV **st; -GV **gvp; -I32 lref; +sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref) { GV *gv; CV *cv; @@ -3738,21 +3853,18 @@ I32 lref; } } -#ifndef SvTRUE I32 -SvTRUE(sv) -register SV *sv; +sv_true(register SV *sv) { + dTHR; if (!sv) return 0; - if (SvGMAGICAL(sv)) - mg_get(sv); if (SvPOK(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* tXpv; + if ((tXpv = (XPV*)SvANY(sv)) && + (*tXpv->xpv_pv > '0' || + tXpv->xpv_cur > 1 || + (tXpv->xpv_cur && *tXpv->xpv_pv != '0'))) return 1; else return 0; @@ -3768,46 +3880,33 @@ register SV *sv; } } } -#endif /* !SvTRUE */ -#ifndef SvIV IV -SvIV(sv) -register SV *sv; +sv_iv(register SV *sv) { if (SvIOK(sv)) return SvIVX(sv); return sv_2iv(sv); } -#endif /* !SvIV */ -#ifndef SvUV UV -SvUV(sv) -register SV *sv; +sv_uv(register SV *sv) { if (SvIOK(sv)) return SvUVX(sv); return sv_2uv(sv); } -#endif /* !SvUV */ -#ifndef SvNV double -SvNV(sv) -register SV *sv; +sv_nv(register SV *sv) { if (SvNOK(sv)) return SvNVX(sv); return sv_2nv(sv); } -#endif /* !SvNV */ -#ifdef CRIPPLED_CC char * -sv_pvn(sv, lp) -SV *sv; -STRLEN *lp; +sv_pvn(SV *sv, STRLEN *lp) { if (SvPOK(sv)) { *lp = SvCUR(sv); @@ -3815,17 +3914,17 @@ STRLEN *lp; } return sv_2pv(sv, lp); } -#endif char * -sv_pvn_force(sv, lp) -SV *sv; -STRLEN *lp; +sv_pvn_force(SV *sv, 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); @@ -3837,9 +3936,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); @@ -3865,9 +3966,7 @@ STRLEN *lp; } char * -sv_reftype(sv, ob) -SV* sv; -int ob; +sv_reftype(SV *sv, int ob) { if (ob && SvOBJECT(sv)) return HvNAME(SvSTASH(sv)); @@ -3898,8 +3997,7 @@ int ob; } int -sv_isobject(sv) -SV *sv; +sv_isobject(SV *sv) { if (!sv) return 0; @@ -3914,9 +4012,7 @@ SV *sv; } int -sv_isa(sv, name) -SV *sv; -char *name; +sv_isa(SV *sv, char *name) { if (!sv) return 0; @@ -3932,17 +4028,25 @@ char *name; } SV* -newSVrv(rv, classname) -SV *rv; -char *classname; +newSVrv(SV *rv, char *classname) { + dTHR; SV *sv; new_SV(sv); SvANY(sv) = 0; SvREFCNT(sv) = 0; SvFLAGS(sv) = 0; - sv_upgrade(rv, SVt_RV); + + SV_CHECK_THINKFIRST(rv); +#ifdef OVERLOAD + SvAMAGIC_off(rv); +#endif /* OVERLOAD */ + + if (SvTYPE(rv) < SVt_RV) + sv_upgrade(rv, SVt_RV); + + (void)SvOK_off(rv); SvRV(rv) = SvREFCNT_inc(sv); SvROK_on(rv); @@ -3954,54 +4058,42 @@ char *classname; } SV* -sv_setref_pv(rv, classname, pv) -SV *rv; -char *classname; -void* pv; +sv_setref_pv(SV *rv, char *classname, void *pv) { - if (!pv) + if (!pv) { sv_setsv(rv, &sv_undef); + SvSETMAGIC(rv); + } else sv_setiv(newSVrv(rv,classname), (IV)pv); return rv; } SV* -sv_setref_iv(rv, classname, iv) -SV *rv; -char *classname; -IV iv; +sv_setref_iv(SV *rv, char *classname, IV iv) { sv_setiv(newSVrv(rv,classname), iv); return rv; } SV* -sv_setref_nv(rv, classname, nv) -SV *rv; -char *classname; -double nv; +sv_setref_nv(SV *rv, char *classname, double nv) { sv_setnv(newSVrv(rv,classname), nv); return rv; } SV* -sv_setref_pvn(rv, classname, pv, n) -SV *rv; -char *classname; -char* pv; -I32 n; +sv_setref_pvn(SV *rv, char *classname, char *pv, I32 n) { sv_setpvn(newSVrv(rv,classname), pv, n); return rv; } SV* -sv_bless(sv,stash) -SV* sv; -HV* stash; +sv_bless(SV *sv, HV *stash) { + dTHR; SV *ref; if (!SvROK(sv)) croak("Can't bless non-reference value"); @@ -4032,13 +4124,16 @@ HV* stash; } static void -sv_unglob(sv) -SV* sv; +sv_unglob(SV *sv) { assert(SvTYPE(sv) == SVt_PVGV); SvFAKE_off(sv); if (GvGP(sv)) gp_free((GV*)sv); + if (GvSTASH(sv)) { + SvREFCNT_dec(GvSTASH(sv)); + GvSTASH(sv) = Nullhv; + } sv_unmagic(sv, '*'); Safefree(GvNAME(sv)); GvMULTI_off(sv); @@ -4047,8 +4142,7 @@ SV* sv; } void -sv_unref(sv) -SV* sv; +sv_unref(SV *sv) { SV* rv = SvRV(sv); @@ -4061,15 +4155,13 @@ SV* sv; } void -sv_taint(sv) -SV *sv; +sv_taint(SV *sv) { sv_magic((sv), Nullsv, 't', Nullch, 0); } void -sv_untaint(sv) -SV *sv; +sv_untaint(SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { MAGIC *mg = mg_find(sv, 't'); @@ -4079,8 +4171,7 @@ SV *sv; } bool -sv_tainted(sv) -SV *sv; +sv_tainted(SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { MAGIC *mg = mg_find(sv, 't'); @@ -4090,6 +4181,47 @@ SV *sv; return FALSE; } +void +sv_setpviv(SV *sv, IV iv) +{ + STRLEN len; + char buf[TYPE_DIGITS(UV)]; + char *ptr = buf + sizeof(buf); + int sign; + UV uv; + char *p; + + sv_setpvn(sv, "", 0); + if (iv >= 0) { + uv = iv; + sign = 0; + } else { + uv = -iv; + sign = 1; + } + do { + *--ptr = '0' + (uv % 10); + } while (uv /= 10); + len = (buf + sizeof(buf)) - ptr; + /* taking advantage of SvCUR(sv) == 0 */ + SvGROW(sv, sign + len + 1); + p = SvPVX(sv); + if (sign) + *p++ = '-'; + memcpy(p, ptr, len); + p += len; + *p = '\0'; + SvCUR(sv) = p - SvPVX(sv); +} + + +void +sv_setpviv_mg(SV *sv, IV iv) +{ + sv_setpviv(sv,iv); + SvSETMAGIC(sv); +} + #ifdef I_STDARG void sv_setpvf(SV *sv, const char* pat, ...) @@ -4112,6 +4244,30 @@ sv_setpvf(sv, pat, va_alist) va_end(args); } + +#ifdef I_STDARG +void +sv_setpvf_mg(SV *sv, const char* pat, ...) +#else +/*VARARGS0*/ +void +sv_setpvf_mg(sv, pat, va_alist) + SV *sv; + const char *pat; + va_dcl +#endif +{ + va_list args; +#ifdef I_STDARG + va_start(args, pat); +#else + va_start(args); +#endif + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); + SvSETMAGIC(sv); +} + #ifdef I_STDARG void sv_catpvf(SV *sv, const char* pat, ...) @@ -4134,35 +4290,46 @@ sv_catpvf(sv, pat, va_alist) va_end(args); } +#ifdef I_STDARG +void +sv_catpvf_mg(SV *sv, const char* pat, ...) +#else +/*VARARGS0*/ void -sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) +sv_catpvf_mg(sv, pat, va_alist) SV *sv; const char *pat; - STRLEN patlen; - va_list *args; - SV **svargs; - I32 svmax; - bool *used_locale; + va_dcl +#endif +{ + va_list args; +#ifdef I_STDARG + va_start(args, pat); +#else + va_start(args); +#endif + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); + SvSETMAGIC(sv); +} + +void +sv_vsetpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale) { sv_setpvn(sv, "", 0); sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale); } void -sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) - SV *sv; - const char *pat; - STRLEN patlen; - va_list *args; - SV **svargs; - I32 svmax; - bool *used_locale; +sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale) { + dTHR; char *p; char *q; char *patend; STRLEN origlen; I32 svix = 0; + static char nullstr[] = "(null)"; /* no matter what, this is a string now */ (void)SvPV_force(sv, origlen); @@ -4173,8 +4340,10 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) if (patlen == 2 && pat[0] == '%') { switch (pat[1]) { case 's': - if (args) - sv_catpv(sv, va_arg(*args, char*)); + if (args) { + char *s = va_arg(*args, char*); + sv_catpv(sv, s ? s : nullstr); + } else if (svix < svmax) sv_catsv(sv, *svargs); return; @@ -4340,7 +4509,12 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) case 's': if (args) { eptr = va_arg(*args, char*); - elen = strlen(eptr); + if (eptr) + elen = strlen(eptr); + else { + eptr = nullstr; + elen = sizeof nullstr - 1; + } } else if (svix < svmax) eptr = SvPVx(svargs[svix++], elen); @@ -4447,6 +4621,8 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) switch (base) { unsigned dig; case 16: + if (!uv) + alt = FALSE; p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef"; do { dig = uv & 15; @@ -4473,8 +4649,12 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) break; } elen = (ebuf + sizeof ebuf) - eptr; - if (has_precis && precis > elen) - zeros = precis - elen; + if (has_precis) { + if (precis > elen) + zeros = precis - elen; + else if (precis == 0 && elen == 1 && *eptr == '0') + elen = 0; + } break; /* FLOATING POINT */ @@ -4498,8 +4678,8 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) i = PERL_INT_MIN; (void)frexp(nv, &i); if (i == PERL_INT_MIN) - need = 400; /* busted -- be safe */ - else if (i > 0) + die("panic: frexp"); + if (i > 0) need = BIT_DIGITS(i); } need += has_precis ? precis : 6; /* known default */ @@ -4527,6 +4707,8 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) } if (fill == '0') *--eptr = fill; + if (left) + *--eptr = '-'; if (plus) *--eptr = plus; if (alt) @@ -4555,8 +4737,12 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) case 'n': i = SvCUR(sv) - origlen; if (args) { - int *ip = va_arg(*args, int*); - *ip = i; + switch (intsize) { + case 'h': *(va_arg(*args, short*)) = i; break; + default: *(va_arg(*args, int*)) = i; break; + case 'l': *(va_arg(*args, long*)) = i; break; + case 'V': *(va_arg(*args, IV*)) = i; break; + } } else if (svix < svmax) sv_setuv(svargs[svix++], (UV)i); @@ -4566,17 +4752,40 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) default: unknown: - /* output mangled stuff without comment */ + if (!args && dowarn && + (op->op_type == OP_PRTF || op->op_type == OP_SPRINTF)) { + SV *msg = sv_newmortal(); + sv_setpvf(msg, "Invalid conversion in %s: ", + (op->op_type == OP_PRTF) ? "printf" : "sprintf"); + if (c) + sv_catpvf(msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"", + c & 0xFF); + else + sv_catpv(msg, "end of string"); + warn("%_", msg); /* yes, this is reentrant */ + } + + /* output mangled stuff ... */ + if (c == '\0') + --q; eptr = p; elen = q - p; - break; + + /* ... right here, because formatting flags should not apply */ + SvGROW(sv, SvCUR(sv) + elen + 1); + p = SvEND(sv); + memcpy(p, eptr, elen); + p += elen; + *p = '\0'; + SvCUR(sv) = p - SvPVX(sv); + continue; /* not "break" */ } have = esignlen + zeros + elen; need = (have > width ? have : width); gap = need - have; - SvGROW(sv, SvLEN(sv) + need); + SvGROW(sv, SvCUR(sv) + need + 1); p = SvEND(sv); if (esignlen && fill == '0') { for (i = 0; i < esignlen; i++) @@ -4609,8 +4818,7 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) #ifdef DEBUGGING void -sv_dump(sv) -SV* sv; +sv_dump(SV *sv) { SV *d = sv_newmortal(); char *s; @@ -4682,6 +4890,10 @@ SV* sv; sv_catpv(d, " ),"); } } + case SVt_PVBM: + if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); + if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); + break; } if (*(SvEND(d) - 1) == ',') @@ -4781,7 +4993,7 @@ SV* sv; case SVt_PVAV: PerlIO_printf(Perl_debug_log, " ARRAY = 0x%lx\n", (long)AvARRAY(sv)); PerlIO_printf(Perl_debug_log, " ALLOC = 0x%lx\n", (long)AvALLOC(sv)); - PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILL(sv)); + PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILLp(sv)); PerlIO_printf(Perl_debug_log, " MAX = %ld\n", (long)AvMAX(sv)); PerlIO_printf(Perl_debug_log, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv)); flags = AvFLAGS(sv); @@ -4824,13 +5036,20 @@ 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; case SVt_PVGV: PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", GvNAME(sv)); PerlIO_printf(Perl_debug_log, " NAMELEN = %ld\n", (long)GvNAMELEN(sv)); - PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", HvNAME(GvSTASH(sv))); + PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", + SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)"); PerlIO_printf(Perl_debug_log, " GP = 0x%lx\n", (long)GvGP(sv)); PerlIO_printf(Perl_debug_log, " SV = 0x%lx\n", (long)GvSV(sv)); PerlIO_printf(Perl_debug_log, " REFCNT = %ld\n", (long)GvREFCNT(sv)); @@ -4867,8 +5086,11 @@ SV* sv; } #else void -sv_dump(sv) -SV* sv; +sv_dump(SV *sv) { } #endif + + + +