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

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

diff --git a/util.c b/util.c
index b70d315..420232c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -94,10 +94,17 @@ Perl_safesysmalloc(MEM_SIZE size)
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
     if (ptr != NULL) {
 #ifdef PERL_TRACK_MEMPOOL
-        ((struct perl_memory_debug_header *)ptr)->interpreter = aTHX;
+       struct perl_memory_debug_header *const header
+           = (struct perl_memory_debug_header *)ptr;
+
+       header->interpreter = aTHX;
+       /* Link us into the list.  */
+       header->prev = &PL_memory_debug_header;
+       header->next = PL_memory_debug_header.next;
+       PL_memory_debug_header.next = header;
+       header->next->prev = header;
 #  ifdef PERL_POISON
-        ((struct perl_memory_debug_header *)ptr)->size = size;
-        ((struct perl_memory_debug_header *)ptr)->in_use = PERL_POISON_INUSE;
+       header->size = size;
 #  endif
         ptr = (Malloc_t)((char*)ptr+sTHX);
 #endif
@@ -139,18 +146,24 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 #ifdef PERL_TRACK_MEMPOOL
     where = (Malloc_t)((char*)where-sTHX);
     size += sTHX;
-    if (((struct perl_memory_debug_header *)where)->interpreter != aTHX) {
-        Perl_croak_nocontext("panic: realloc from wrong pool");
-    }
+    {
+       struct perl_memory_debug_header *const header
+           = (struct perl_memory_debug_header *)where;
+
+       if (header->interpreter != aTHX) {
+           Perl_croak_nocontext("panic: realloc from wrong pool");
+       }
+       assert(header->next->prev == header);
+       assert(header->prev->next == header);
 #  ifdef PERL_POISON
-    if (((struct perl_memory_debug_header *)where)->size > size) {
-       const MEM_SIZE freed_up =
-           ((struct perl_memory_debug_header *)where)->size - size;
-       char *start_of_freed = ((char *)where) + size;
-       Poison(start_of_freed, freed_up, char);
-    }
-    ((struct perl_memory_debug_header *)where)->size = size;
+       if (header->size > size) {
+           const MEM_SIZE freed_up = header->size - size;
+           char *start_of_freed = ((char *)where) + size;
+           Poison(start_of_freed, freed_up, char);
+       }
+       header->size = size;
 #  endif
+    }
 #endif
 #ifdef DEBUGGING
     if ((long)size < 0)
@@ -164,6 +177,12 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 
     if (ptr != NULL) {
 #ifdef PERL_TRACK_MEMPOOL
+       struct perl_memory_debug_header *const header
+           = (struct perl_memory_debug_header *)ptr;
+
+       header->next->prev = header;
+       header->prev->next = header;
+
         ptr = (Malloc_t)((char*)ptr+sTHX);
 #endif
        return ptr;
@@ -190,24 +209,29 @@ Perl_safesysfree(Malloc_t where)
     if (where) {
 #ifdef PERL_TRACK_MEMPOOL
         where = (Malloc_t)((char*)where-sTHX);
-        if (((struct perl_memory_debug_header *)where)->interpreter != aTHX) {
-            Perl_croak_nocontext("panic: free from wrong pool");
-       }
-#  ifdef PERL_POISON
        {
-           if (((struct perl_memory_debug_header *)where)->in_use
-               == PERL_POISON_FREE) {
+           struct perl_memory_debug_header *const header
+               = (struct perl_memory_debug_header *)where;
+
+           if (header->interpreter != aTHX) {
+               Perl_croak_nocontext("panic: free from wrong pool");
+           }
+           if (!header->prev) {
                Perl_croak_nocontext("panic: duplicate free");
            }
-           if (((struct perl_memory_debug_header *)where)->in_use
-               != PERL_POISON_INUSE) {
-               Perl_croak_nocontext("panic: bad free ");
+           if (!(header->next) || header->next->prev != header
+               || header->prev->next != header) {
+               Perl_croak_nocontext("panic: bad free");
            }
-           ((struct perl_memory_debug_header *)where)->in_use
-               = PERL_POISON_FREE;
-       }
-       Poison(where, ((struct perl_memory_debug_header *)where)->size, char);
+           /* Unlink us from the chain.  */
+           header->next->prev = header->prev;
+           header->prev->next = header->next;
+#  ifdef PERL_POISON
+           Poison(where, header->size, char);
 #  endif
+           /* Trigger the duplicate free warning.  */
+           header->next = NULL;
+       }
 #endif
        PerlMem_free(where);
     }
@@ -242,12 +266,21 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
     if (ptr != NULL) {
        memset((void*)ptr, 0, size);
 #ifdef PERL_TRACK_MEMPOOL
-        ((struct perl_memory_debug_header *)ptr)->interpreter = aTHX;
+       {
+           struct perl_memory_debug_header *const header
+               = (struct perl_memory_debug_header *)ptr;
+
+           header->interpreter = aTHX;
+           /* Link us into the list.  */
+           header->prev = &PL_memory_debug_header;
+           header->next = PL_memory_debug_header.next;
+           PL_memory_debug_header.next = header;
+           header->next->prev = header;
 #  ifdef PERL_POISON
-        ((struct perl_memory_debug_header *)ptr)->size = size;
-        ((struct perl_memory_debug_header *)ptr)->in_use = PERL_POISON_INUSE;
+           header->size = size;
 #  endif
-        ptr = (Malloc_t)((char*)ptr+sTHX);
+           ptr = (Malloc_t)((char*)ptr+sTHX);
+       }
 #endif
        return ptr;
     }
@@ -461,7 +494,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
            s--, i++;
        }
     }
-    sv_magic(sv, Nullsv, PERL_MAGIC_bm, NULL, 0);      /* deep magic */
+    sv_magic(sv, NULL, PERL_MAGIC_bm, NULL, 0);        /* deep magic */
     SvVALID_on(sv);
 
     s = (const unsigned char*)(SvPVX_const(sv));       /* deeper magic */
@@ -1100,7 +1133,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 
        save_re_context();
        SAVESPTR(PL_stderrgv);
-       PL_stderrgv = Nullgv;
+       PL_stderrgv = NULL;
 
        PUSHSTACKi(PERLSI_MAGIC);
 
@@ -2129,7 +2162,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
            }
        }
 #endif
-       do_aexec5(Nullsv, args-1, args-1+n, pp[1], did_pipes);
+       do_aexec5(NULL, args-1, args-1+n, pp[1], did_pipes);
        PerlProc__exit(1);
 #undef THIS
 #undef THAT