clean up some stray "global" symbols

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

diff --git a/sv.c b/sv.c
index 1fff726..042ffcc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -42,28 +42,30 @@
 
 #else /* !PERL_OBJECT */
 
-static IV asIV _((SV* sv));
-static UV asUV _((SV* sv));
-static SV *more_sv _((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));
-static XRV *new_xrv _((void));
-static void del_xiv _((XPVIV* p));
-static void del_xnv _((XPVNV* p));
-static void del_xpv _((XPV* p));
-static void del_xrv _((XRV* p));
-static void sv_unglob _((SV* sv));
+static IV asIV (SV* sv);
+static UV asUV (SV* sv);
+static SV *more_sv (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);
+static XRV *new_xrv (void);
+static void del_xiv (XPVIV* p);
+static void del_xnv (XPVNV* p);
+static void del_xpv (XPV* p);
+static void del_xrv (XRV* p);
+static void sv_unglob (SV* sv);
+static void sv_add_backref (SV *tsv, SV *sv);
+static void sv_del_backref (SV *sv);
 
 #ifndef PURIFY
 static void *my_safemalloc(MEM_SIZE size);
 #endif
 
-typedef void (*SVFUNC) _((SV*));
+typedef void (*SVFUNC) (SV*);
 #define VTBL *vtbl
 #define FCALL *f
 
@@ -114,9 +116,8 @@ static I32 registry_size;
 #define REG_ADD(sv)    REG_REPLACE(sv,Nullsv,sv)
 #define REG_REMOVE(sv) REG_REPLACE(sv,sv,Nullsv)
 
-static void
-reg_add(sv)
-SV* sv;
+STATIC void
+reg_add(SV *sv)
 {
     if (PL_sv_count >= (registry_size >> 1))
     {
@@ -142,17 +143,15 @@ SV* sv;
     ++PL_sv_count;
 }
 
-static void
-reg_remove(sv)
-SV* sv;
+STATIC void
+reg_remove(SV *sv)
 {
     REG_REMOVE(sv);
     --PL_sv_count;
 }
 
-static void
-visit(f)
-SVFUNC f;
+STATIC void
+visit(SVFUNC f)
 {
     I32 i;
 
@@ -164,10 +163,7 @@ SVFUNC f;
 }
 
 void
-sv_add_arena(ptr, size, flags)
-char* ptr;
-U32 size;
-U32 flags;
+sv_add_arena(char *ptr, U32 size, U32 flags)
 {
     if (!(flags & SVf_FAKE))
        Safefree(ptr);
@@ -2769,6 +2765,9 @@ sv_magic(register SV *sv, SV *obj, int how, const char *name, I32 namlen)
     case '.':
        mg->mg_virtual = &PL_vtbl_pos;
        break;
+    case '<':
+       mg->mg_virtual = &PL_vtbl_backref;
+       break;
     case '~':  /* Reserved for use by extensions not perl internals.   */
        /* Useful for attaching extension internal data to perl vars.   */
        /* Note that multiple extensions may clash if magical scalars   */
@@ -2817,6 +2816,63 @@ sv_unmagic(SV *sv, int type)
     return 0;
 }
 
+SV *
+sv_rvweaken(SV *sv)
+{
+    SV *tsv;
+    if (!SvOK(sv))  /* let undefs pass */
+       return sv;
+    if (!SvROK(sv))
+       croak("Can't weaken a nonreference");
+    else if (SvWEAKREF(sv)) {
+       dTHR;
+       if (ckWARN(WARN_MISC))
+           warner(WARN_MISC, "Reference is already weak");
+       return sv;
+    }
+    tsv = SvRV(sv);
+    sv_add_backref(tsv, sv);
+    SvWEAKREF_on(sv);
+    SvREFCNT_dec(tsv);              
+    return sv;
+}
+
+STATIC void
+sv_add_backref(SV *tsv, SV *sv)
+{
+    AV *av;
+    MAGIC *mg;
+    if (SvMAGICAL(tsv) && (mg = mg_find(tsv, '<')))
+       av = (AV*)mg->mg_obj;
+    else {
+       av = newAV();
+       sv_magic(tsv, (SV*)av, '<', NULL, 0);
+       SvREFCNT_dec(av);           /* for sv_magic */
+    }
+    av_push(av,sv);
+}
+
+STATIC void 
+sv_del_backref(SV *sv)
+{
+    AV *av;
+    SV **svp;
+    I32 i;
+    SV *tsv = SvRV(sv);
+    MAGIC *mg;
+    if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, '<')))
+       croak("panic: del_backref");
+    av = (AV *)mg->mg_obj;
+    svp = AvARRAY(av);
+    i = AvFILLp(av);
+    while (i >= 0) {
+       if (svp[i] == sv) {
+           svp[i] = &PL_sv_undef; /* XXX */
+       }
+       i--;
+    }
+}
+
 void
 sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
 {
@@ -3038,8 +3094,12 @@ sv_clear(register SV *sv)
        /* FALL THROUGH */
     case SVt_PV:
     case SVt_RV:
-       if (SvROK(sv))
-           SvREFCNT_dec(SvRV(sv));
+       if (SvROK(sv)) {
+           if (SvWEAKREF(sv))
+               sv_del_backref(sv);
+           else
+               SvREFCNT_dec(SvRV(sv));
+       }
        else if (SvPVX(sv) && SvLEN(sv))
            Safefree(SvPVX(sv));
        break;
@@ -4148,6 +4208,9 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
            ENTER;
            tmpsv = NEWSV(704,0);
            gv_efullname3(tmpsv, gv, Nullch);
+           /* XXX this is probably not what they think they're getting.
+            * It has the same effect as "sub name;", i.e. just a forward
+            * declaration! */
            newSUB(start_subparse(FALSE, 0),
                   newSVOP(OP_CONST, 0, tmpsv),
                   Nullop,
@@ -4452,7 +4515,13 @@ void
 sv_unref(SV *sv)
 {
     SV* rv = SvRV(sv);
-    
+
+    if (SvWEAKREF(sv)) {
+       sv_del_backref(sv);
+       SvWEAKREF_off(sv);
+       SvRV(sv) = 0;
+       return;
+    }
     SvRV(sv) = 0;
     SvROK_off(sv);
     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))