new_body_type doesn't need to subtract the offset, that's what

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

diff --git a/sv.c b/sv.c
index 3aa3e5b..36cea18 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -575,21 +575,23 @@ Perl_sv_clean_all(pTHX)
 */
 #define ARENASETS 1
 
-union arena {
-    double alignthis;  /* maybe too big, NV instead ? */
-    unsigned char data[PERL_ARENA_SIZE];
-};
-
 struct arena_desc {
-    union arena* arena;                /* the raw storage */
-    size_t        size;                /* its size ~4k typ */
-    int           unit_type;   /* useful for arena audits */
+    char       *arena;         /* the raw storage, allocated aligned */
+    size_t      size;          /* its size ~4k typ */
+    int         unit_type;     /* useful for arena audits */
     /* info for sv-heads (eventually)
        int count, flags;
     */
 };
 
-#define ARENAS_PER_SET  256+64 /* x 3words/arena_desc -> ~ 4kb/arena_set */
+struct arena_set;
+
+/* Get the maximum number of elements in set[] such that struct arena_set
+   will fit within PERL_ARENA_SIZE, which is probabably just under 4K, and
+   therefore likely to be 1 aligned memory page.  */
+
+#define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
+                         - 2 * sizeof(int)) / sizeof (struct arena_desc))
 
 struct arena_set {
     struct arena_set* next;
@@ -968,8 +970,7 @@ static const struct body_details bodies_by_type[] = {
 };
 
 #define new_body_type(sv_type)                 \
-    (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type)\
-            - bodies_by_type[sv_type].offset)
+    (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type))
 
 #define del_body_type(p, sv_type)      \
     del_body(p, &PL_body_roots[sv_type])
@@ -1152,9 +1153,10 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
     SvFLAGS(sv) &= ~SVTYPEMASK;
     SvFLAGS(sv) |= new_type;
 
+    /* This can't happen, as SVt_NULL is <= all values of new_type, so one of
+       the return statements above will have triggered.  */
+    assert (new_type != SVt_NULL);
     switch (new_type) {
-    case SVt_NULL:
-       Perl_croak(aTHX_ "Can't upgrade to undef");
     case SVt_IV:
        assert(old_type == SVt_NULL);
        SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
@@ -1171,21 +1173,27 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        SvRV_set(sv, 0);
        return;
     case SVt_PVHV:
-       SvANY(sv) = new_XPVHV();
-       HvFILL(sv)      = 0;
-       HvMAX(sv)       = 0;
-       HvTOTALKEYS(sv) = 0;
-
-       goto hv_av_common;
-
     case SVt_PVAV:
-       SvANY(sv) = new_XPVAV();
-       AvMAX(sv)       = -1;
-       AvFILLp(sv)     = -1;
-       AvALLOC(sv)     = 0;
-       AvREAL_only(sv);
+       assert(new_type_details->size);
+
+#ifndef PURIFY 
+       assert(new_type_details->arena);
+       /* This points to the start of the allocated area.  */
+       new_body_inline(new_body, new_type_details->size, new_type);
+       Zero(new_body, new_type_details->size, char);
+       new_body = ((char *)new_body) - new_type_details->offset;
+#else
+       /* We always allocated the full length item with PURIFY. To do this
+          we fake things so that arena is false for all 16 types..  */
+       new_body = new_NOARENAZ(new_type_details);
+#endif
+       SvANY(sv) = new_body;
+       if (new_type == SVt_PVAV) {
+           AvMAX(sv)   = -1;
+           AvFILLp(sv) = -1;
+           AvREAL_only(sv);
+       }
 
-    hv_av_common:
        /* SVt_NULL isn't the only thing upgraded to AV or HV.
           The target created by newSVrv also is, and it can have magic.
           However, it never has SvPVX set.
@@ -1201,9 +1209,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        if (old_type >= SVt_PVMG) {
            SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_magic);
            SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash);
-       } else {
-           SvMAGIC_set(sv, NULL);
-           SvSTASH_set(sv, NULL);
        }
        break;
 
@@ -6990,8 +6995,11 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
     GV *gv = NULL;
     CV *cv = NULL;
 
-    if (!sv)
-       return *st = NULL, *gvp = NULL, NULL;
+    if (!sv) {
+       *st = NULL;
+       *gvp = NULL;
+       return NULL;
+    }
     switch (SvTYPE(sv)) {
     case SVt_PVCV:
        *st = CvSTASH(sv);
@@ -10393,6 +10401,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     param->flags = flags;
     param->proto_perl = proto_perl;
 
+    INIT_TRACK_MEMPOOL(my_perl->Imemory_debug_header, my_perl);
+
     PL_body_arenas = NULL;
     Zero(&PL_body_roots, 1, PL_body_roots);