Make Power MachTen use vfork and perl's malloc

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

diff --git a/sv.c b/sv.c
index f098efa..94fb230 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -96,17 +96,17 @@ typedef void (*SVFUNC) _((SV*));
     } while (0)
 
 static SV **registry;
-static I32 regsize;
+static I32 registry_size;
 
 #define REGHASH(sv,size)  ((((U32)(sv)) >> 2) % (size))
 
 #define REG_REPLACE(sv,a,b) \
     do {                               \
        void* p = sv->sv_any;           \
-       I32 h = REGHASH(sv, regsize);   \
+       I32 h = REGHASH(sv, registry_size);     \
        I32 i = h;                      \
        while (registry[i] != (a)) {    \
-           if (++i >= regsize)         \
+           if (++i >= registry_size)   \
                i = 0;                  \
            if (i == h)                 \
                die("SV registry bug"); \
@@ -121,13 +121,13 @@ static void
 reg_add(sv)
 SV* sv;
 {
-    if (sv_count >= (regsize >> 1))
+    if (sv_count >= (registry_size >> 1))
     {
        SV **oldreg = registry;
-       I32 oldsize = regsize;
+       I32 oldsize = registry_size;
 
-       regsize = regsize ? ((regsize << 2) + 1) : 2037;
-       Newz(707, registry, regsize, SV*);
+       registry_size = registry_size ? ((registry_size << 2) + 1) : 2037;
+       Newz(707, registry, registry_size, SV*);
 
        if (oldreg) {
            I32 i;
@@ -159,9 +159,9 @@ SVFUNC f;
 {
     I32 i;
 
-    for (i = 0; i < regsize; ++i) {
+    for (i = 0; i < registry_size; ++i) {
        SV* sv = registry[i];
-       if (sv)
+       if (sv && SvTYPE(sv) != SVTYPEMASK)
            (*f)(sv);
     }
 }
@@ -355,8 +355,6 @@ do_clean_named_objs(SV *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
@@ -365,10 +363,11 @@ void
 sv_clean_objs(void)
 {
     in_clean_objs = TRUE;
+    visit(FUNC_NAME_TO_PTR(do_clean_objs));
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
+    /* some barnacles may yet remain, clinging to typeglobs */
     visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
 #endif
-    visit(FUNC_NAME_TO_PTR(do_clean_objs));
     in_clean_objs = FALSE;
 }
 
@@ -417,13 +416,13 @@ sv_free_arenas(void)
 STATIC XPVIV*
 new_xiv(void)
 {
-    IV** xiv;
+    IV* xiv;
     if (xiv_root) {
        xiv = xiv_root;
        /*
         * See comment in more_xiv() -- RAM.
         */
-       xiv_root = (IV**)*xiv;
+       xiv_root = *(IV**)xiv;
        return (XPVIV*)((char*)xiv - sizeof(XPV));
     }
     return more_xiv();
@@ -432,30 +431,30 @@ new_xiv(void)
 STATIC void
 del_xiv(XPVIV *p)
 {
-    IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
-    *xiv = (IV *)xiv_root;
+    IV* xiv = (IV*)((char*)(p) + sizeof(XPV));
+    *(IV**)xiv = xiv_root;
     xiv_root = xiv;
 }
 
 STATIC XPVIV*
 more_xiv(void)
 {
-    register IV** xiv;
-    register IV** xivend;
+    register IV* xiv;
+    register IV* xivend;
     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 */
 
-    xiv = (IV**) ptr;
-    xivend = &xiv[1008 / sizeof(IV *) - 1];
-    xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
+    xiv = (IV*) ptr;
+    xivend = &xiv[1008 / sizeof(IV) - 1];
+    xiv += (sizeof(XPV) - 1) / sizeof(IV) + 1;   /* fudge by size of XPV */
     xiv_root = xiv;
     while (xiv < xivend) {
-       *xiv = (IV *)(xiv + 1);
+       *(IV**)xiv = (IV *)(xiv + 1);
        xiv++;
     }
-    *xiv = 0;
+    *(IV**)xiv = 0;
     return new_xiv();
 }
 
@@ -1118,8 +1117,16 @@ sv_grow(SV* sv, unsigned long newlen)
     else
        s = SvPVX(sv);
     if (newlen > SvLEN(sv)) {          /* need more room? */
-        if (SvLEN(sv) && s)
+       if (SvLEN(sv) && s) {
+#ifdef MYMALLOC
+           STRLEN l = malloced_size((void*)SvPVX(sv));
+           if (newlen <= l) {
+               SvLEN_set(sv, l);
+               return s;
+           } else
+#endif 
            Renew(s,newlen,char);
+       }
         else
            New(703,s,newlen,char);
        SvPV_set(sv, s);
@@ -1696,7 +1703,21 @@ sv_2pv(register SV *sv, STRLEN *lp)
            if (!sv)
                s = "NULLREF";
            else {
+               MAGIC *mg;
+               
                switch (SvTYPE(sv)) {
+               case SVt_PVMG:
+                   if ( ((SvFLAGS(sv) &
+                          (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG)) 
+                         == (SVs_OBJECT|SVs_RMG))
+                        && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
+                        && (mg = mg_find(sv, 'r'))) {
+                       regexp *re = (regexp *)mg->mg_obj;
+
+                       *lp = re->prelen;
+                       return re->precomp;
+                   }
+                                       /* Fall through */
                case SVt_NULL:
                case SVt_IV:
                case SVt_NV:
@@ -1704,8 +1725,7 @@ sv_2pv(register SV *sv, STRLEN *lp)
                case SVt_PV:
                case SVt_PVIV:
                case SVt_PVNV:
-               case SVt_PVBM:
-               case SVt_PVMG:  s = "SCALAR";                   break;
+               case SVt_PVBM:  s = "SCALAR";                   break;
                case SVt_PVLV:  s = "LVALUE";                   break;
                case SVt_PVAV:  s = "ARRAY";                    break;
                case SVt_PVHV:  s = "HASH";                     break;
@@ -2562,7 +2582,6 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
        mg->mg_virtual = &vtbl_packelem;
        break;
     case 'r':
-       SvRMAGICAL_on(sv);
        mg->mg_virtual = &vtbl_regexp;
        break;
     case 'S':
@@ -2780,7 +2799,7 @@ sv_clear(register SV *sv)
                destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
                if (destructor) {
                    ENTER;
-                   PUSHSTACK(SI_DESTROY);
+                   PUSHSTACKi(SI_DESTROY);
                    SvRV(&tmpref) = SvREFCNT_inc(sv);
                    EXTEND(SP, 2);
                    PUSHMARK(SP);
@@ -2789,7 +2808,7 @@ sv_clear(register SV *sv)
                    perl_call_sv((SV*)GvCV(destructor),
                                 G_DISCARD|G_EVAL|G_KEEPERR);
                    SvREFCNT(sv)--;
-                   POPSTACK();
+                   POPSTACK;
                    LEAVE;
                }
            } while (SvOBJECT(sv) && SvSTASH(sv) != stash);