[asperl] integrate latest win32 branch

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index f3ca97c..a4d72bc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -40,6 +40,12 @@
 #  define FAST_SV_GETS
 #endif
 
+#ifdef PERL_OBJECT
+#define FCALL this->*f
+#define VTBL this->*vtbl
+
+#else /* !PERL_OBJECT */
+
 static IV asIV _((SV* sv));
 static UV asUV _((SV* sv));
 static SV *more_sv _((void));
@@ -59,11 +65,17 @@ 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*));
+#define VTBL *vtbl
+#define FCALL *f
+
+#endif /* PERL_OBJECT */
 
 #ifdef PURIFY
 
@@ -206,7 +218,7 @@ U32 flags;
        UNLOCK_SV_MUTEX;        \
     } while (0)
 
-static void
+STATIC void
 del_sv(SV *p)
 {
     if (debug & 32768) {
@@ -262,7 +274,7 @@ sv_add_arena(char *ptr, U32 size, U32 flags)
 }
 
 /* sv_mutex must be held while calling more_sv() */
-static SV*
+STATIC SV*
 more_sv(void)
 {
     register SV* sv;
@@ -280,7 +292,7 @@ more_sv(void)
     return sv;
 }
 
-static void
+STATIC void
 visit(SVFUNC f)
 {
     SV* sva;
@@ -291,14 +303,14 @@ visit(SVFUNC f)
        svend = &sva[SvREFCNT(sva)];
        for (sv = sva + 1; sv < svend; ++sv) {
            if (SvTYPE(sv) != SVTYPEMASK)
-               (*f)(sv);
+               (FCALL)(sv);
        }
     }
 }
 
 #endif /* PURIFY */
 
-static void
+STATIC void
 do_report_used(SV *sv)
 {
     if (SvTYPE(sv) != SVTYPEMASK) {
@@ -314,7 +326,7 @@ sv_report_used(void)
     visit(do_report_used);
 }
 
-static void
+STATIC void
 do_clean_objs(SV *sv)
 {
     SV* rv;
@@ -330,7 +342,7 @@ do_clean_objs(SV *sv)
 }
 
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
-static void
+STATIC void
 do_clean_named_objs(SV *sv)
 {
     if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
@@ -338,8 +350,6 @@ do_clean_named_objs(SV *sv)
 }
 #endif
 
-static bool in_clean_objs = FALSE;
-
 void
 sv_clean_objs(void)
 {
@@ -351,7 +361,7 @@ sv_clean_objs(void)
     in_clean_objs = FALSE;
 }
 
-static void
+STATIC void
 do_clean_all(SV *sv)
 {
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
@@ -359,8 +369,6 @@ do_clean_all(SV *sv)
     SvREFCNT_dec(sv);
 }
 
-static bool in_clean_all = FALSE;
-
 void
 sv_clean_all(void)
 {
@@ -391,7 +399,7 @@ sv_free_arenas(void)
     sv_root = 0;
 }
 
-static XPVIV*
+STATIC XPVIV*
 new_xiv(void)
 {
     IV** xiv;
@@ -406,7 +414,7 @@ new_xiv(void)
     return more_xiv();
 }
 
-static void
+STATIC void
 del_xiv(XPVIV *p)
 {
     IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
@@ -414,7 +422,7 @@ del_xiv(XPVIV *p)
     xiv_root = xiv;
 }
 
-static XPVIV*
+STATIC XPVIV*
 more_xiv(void)
 {
     register IV** xiv;
@@ -436,7 +444,7 @@ more_xiv(void)
     return new_xiv();
 }
 
-static XPVNV*
+STATIC XPVNV*
 new_xnv(void)
 {
     double* xnv;
@@ -448,7 +456,7 @@ new_xnv(void)
     return more_xnv();
 }
 
-static void
+STATIC void
 del_xnv(XPVNV *p)
 {
     double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
@@ -456,7 +464,7 @@ del_xnv(XPVNV *p)
     xnv_root = xnv;
 }
 
-static XPVNV*
+STATIC XPVNV*
 more_xnv(void)
 {
     register double* xnv;
@@ -473,7 +481,7 @@ more_xnv(void)
     return new_xnv();
 }
 
-static XRV*
+STATIC XRV*
 new_xrv(void)
 {
     XRV* xrv;
@@ -485,14 +493,14 @@ new_xrv(void)
     return more_xrv();
 }
 
-static void
+STATIC void
 del_xrv(XRV *p)
 {
     p->xrv_rv = (SV*)xrv_root;
     xrv_root = p;
 }
 
-static XRV*
+STATIC XRV*
 more_xrv(void)
 {
     register XRV* xrv;
@@ -508,7 +516,7 @@ more_xrv(void)
     return new_xrv();
 }
 
-static XPV*
+STATIC XPV*
 new_xpv(void)
 {
     XPV* xpv;
@@ -520,14 +528,14 @@ new_xpv(void)
     return more_xpv();
 }
 
-static void
+STATIC void
 del_xpv(XPV *p)
 {
     p->xpv_pv = (char*)xpv_root;
     xpv_root = p;
 }
 
-static XPV*
+STATIC XPV*
 more_xpv(void)
 {
     register XPV* xpv;
@@ -579,7 +587,7 @@ more_xpv(void)
 #  define my_safemalloc(s) safemalloc(s)
 #  define my_safefree(s) free(s)
 #else
-static void* 
+STATIC void* 
 my_safemalloc(MEM_SIZE size)
 {
     char *p;
@@ -1106,7 +1114,7 @@ sv_grow(SV* sv, unsigned long newlen)
 void
 sv_setiv(register SV *sv, IV i)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        sv_upgrade(sv, SVt_IV);
@@ -1167,7 +1175,7 @@ sv_setuv_mg(register SV *sv, UV u)
 void
 sv_setnv(register SV *sv, double num)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
     case SVt_IV:
@@ -1214,7 +1222,7 @@ sv_setnv_mg(register SV *sv, double num)
     SvSETMAGIC(sv);
 }
 
-static void
+STATIC void
 not_a_number(SV *sv)
 {
     dTHR;
@@ -1509,7 +1517,7 @@ sv_2nv(register SV *sv)
     return SvNVX(sv);
 }
 
-static IV
+STATIC IV
 asIV(SV *sv)
 {
     I32 numtype = looks_like_number(sv);
@@ -1527,7 +1535,7 @@ asIV(SV *sv)
        return (IV) U_V(d);
 }
 
-static UV
+STATIC UV
 asUV(SV *sv)
 {
     I32 numtype = looks_like_number(sv);
@@ -1869,7 +1877,7 @@ sv_setsv(SV *dstr, register SV *sstr)
 
     if (sstr == dstr)
        return;
-    sv_check_thinkfirst(dstr);
+    SV_CHECK_THINKFIRST(dstr);
     if (!sstr)
        sstr = &sv_undef;
     stype = SvTYPE(sstr);
@@ -2204,7 +2212,7 @@ 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. */
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2237,7 +2245,7 @@ sv_setpv(register SV *sv, register const char *ptr)
 {
     register STRLEN len;
 
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2267,7 +2275,7 @@ sv_setpv_mg(register SV *sv, register const char *ptr)
 void
 sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     (void)SvUPGRADE(sv, SVt_PV);
     if (!ptr) {
        (void)SvOK_off(sv);
@@ -2291,18 +2299,16 @@ sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
     SvSETMAGIC(sv);
 }
 
-static void
+STATIC void
 sv_check_thinkfirst(register SV *sv)
 {
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv)) {
-           dTHR;
-           if (curcop != &compiling)
-               croak(no_modify);
-       }
-       if (SvROK(sv))
-           sv_unref(sv);
+    if (SvREADONLY(sv)) {
+       dTHR;
+       if (curcop != &compiling)
+           croak(no_modify);
     }
+    if (SvROK(sv))
+       sv_unref(sv);
 }
     
 void
@@ -2314,7 +2320,7 @@ sv_chop(register SV *sv, register char *ptr)      /* like set but assuming ptr is in
 
     if (!ptr || !SvPOKp(sv))
        return;
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (SvTYPE(sv) < SVt_PVIV)
        sv_upgrade(sv,SVt_PVIV);
 
@@ -2583,8 +2589,8 @@ sv_unmagic(SV *sv, int type)
        if (mg->mg_type == type) {
            MGVTBL* vtbl = mg->mg_virtual;
            *mgp = mg->mg_moremagic;
-           if (vtbl && vtbl->svt_free)
-               (*vtbl->svt_free)(sv, mg);
+           if (vtbl && (vtbl->svt_free != NULL))
+               (VTBL->svt_free)(sv, mg);
            if (mg->mg_ptr && mg->mg_type != 'g')
                if (mg->mg_len >= 0)
                    Safefree(mg->mg_ptr);
@@ -2687,7 +2693,7 @@ void
 sv_replace(register SV *sv, register SV *nsv)
 {
     U32 refcnt = SvREFCNT(sv);
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (SvREFCNT(nsv) != 1)
        warn("Reference miscount in sv_replace()");
     if (SvMAGICAL(sv)) {
@@ -2721,23 +2727,23 @@ sv_clear(register SV *sv)
            djSP;
            GV* destructor;
            HV* stash;
-           SV ref;
+           SV tmpref;
 
-           Zero(&ref, 1, SV);
-           sv_upgrade(&ref, SVt_RV);
-           SvROK_on(&ref);
-           SvREADONLY_on(&ref);        /* DESTROY() could be naughty */
-           SvREFCNT(&ref) = 1;
+           Zero(&tmpref, 1, SV);
+           sv_upgrade(&tmpref, SVt_RV);
+           SvROK_on(&tmpref);
+           SvREADONLY_on(&tmpref);     /* DESTROY() could be naughty */
+           SvREFCNT(&tmpref) = 1;
 
            do {
                stash = SvSTASH(sv);
                destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
                if (destructor) {
                    ENTER;
-                   SvRV(&ref) = SvREFCNT_inc(sv);
+                   SvRV(&tmpref) = SvREFCNT_inc(sv);
                    EXTEND(SP, 2);
                    PUSHMARK(SP);
-                   PUSHs(&ref);
+                   PUSHs(&tmpref);
                    PUTBACK;
                    perl_call_sv((SV*)GvCV(destructor),
                                 G_DISCARD|G_EVAL|G_KEEPERR);
@@ -2746,7 +2752,7 @@ sv_clear(register SV *sv)
                }
            } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
 
-           del_XRV(SvANY(&ref));
+           del_XRV(SvANY(&tmpref));
        }
 
        if (SvOBJECT(sv)) {
@@ -2914,7 +2920,7 @@ sv_len(register SV *sv)
        return 0;
 
     if (SvGMAGICAL(sv))
-       len = mg_len(sv);
+       len = mg_length(sv);
     else
        junk = SvPV(sv, len);
     return len;
@@ -3084,7 +3090,7 @@ sv_gets(register SV *sv, register PerlIO *fp, I32 append)
     register I32 cnt;
     I32 i;
 
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     (void)SvUPGRADE(sv, SVt_PV);
     SvSCREAM_off(sv);
 
@@ -3446,7 +3452,7 @@ sv_dec(register SV *sv)
  * hopefully we won't free it until it has been assigned to a
  * permanent location. */
 
-static void
+STATIC void
 sv_mortalgrow(void)
 {
     dTHR;
@@ -3521,9 +3527,7 @@ newSVpv(char *s, STRLEN len)
 }
 
 SV *
-newSVpvn(s,len)
-char *s;
-STRLEN len;
+newSVpvn(char *s, STRLEN len)
 {
     register SV *sv;
 
@@ -3591,7 +3595,7 @@ newSViv(IV i)
 }
 
 SV *
-newRV(SV *ref)
+newRV(SV *tmpRef)
 {
     dTHR;
     register SV *sv;
@@ -3601,8 +3605,8 @@ newRV(SV *ref)
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
     sv_upgrade(sv, SVt_RV);
-    SvTEMP_off(ref);
-    SvRV(sv) = SvREFCNT_inc(ref);
+    SvTEMP_off(tmpRef);
+    SvRV(sv) = SvREFCNT_inc(tmpRef);
     SvROK_on(sv);
     return sv;
 }
@@ -3610,12 +3614,12 @@ newRV(SV *ref)
 
 
 SV *
-Perl_newRV_noinc(SV *ref)
+Perl_newRV_noinc(SV *tmpRef)
 {
     register SV *sv;
 
-    sv = newRV(ref);
-    SvREFCNT_dec(ref);
+    sv = newRV(tmpRef);
+    SvREFCNT_dec(tmpRef);
     return sv;
 }
 
@@ -3990,7 +3994,7 @@ newSVrv(SV *rv, char *classname)
     SvREFCNT(sv) = 0;
     SvFLAGS(sv) = 0;
 
-    sv_check_thinkfirst(rv);
+    SV_CHECK_THINKFIRST(rv);
 #ifdef OVERLOAD
     SvAMAGIC_off(rv);
 #endif /* OVERLOAD */
@@ -4046,24 +4050,24 @@ SV*
 sv_bless(SV *sv, HV *stash)
 {
     dTHR;
-    SV *ref;
+    SV *tmpRef;
     if (!SvROK(sv))
         croak("Can't bless non-reference value");
-    ref = SvRV(sv);
-    if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
-       if (SvREADONLY(ref))
+    tmpRef = SvRV(sv);
+    if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
+       if (SvREADONLY(tmpRef))
            croak(no_modify);
-       if (SvOBJECT(ref)) {
-           if (SvTYPE(ref) != SVt_PVIO)
+       if (SvOBJECT(tmpRef)) {
+           if (SvTYPE(tmpRef) != SVt_PVIO)
                --sv_objcount;
-           SvREFCNT_dec(SvSTASH(ref));
+           SvREFCNT_dec(SvSTASH(tmpRef));
        }
     }
-    SvOBJECT_on(ref);
-    if (SvTYPE(ref) != SVt_PVIO)
+    SvOBJECT_on(tmpRef);
+    if (SvTYPE(tmpRef) != SVt_PVIO)
        ++sv_objcount;
-    (void)SvUPGRADE(ref, SVt_PVMG);
-    SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
+    (void)SvUPGRADE(tmpRef, SVt_PVMG);
+    SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash);
 
 #ifdef OVERLOAD
     if (Gv_AMG(stash))
@@ -4075,7 +4079,7 @@ sv_bless(SV *sv, HV *stash)
     return sv;
 }
 
-static void
+STATIC void
 sv_unglob(SV *sv)
 {
     assert(SvTYPE(sv) == SVt_PVGV);