Re: [perl #22719] ISA cache problem with blessed stash objects

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

diff --git a/malloc.c b/malloc.c
index d39927a..409eed5 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -962,7 +962,7 @@ static char bucket_of[] =
 
 static void    morecore        (register int bucket);
 #  if defined(DEBUGGING)
-static void    botch           (char *diag, char *s);
+static void    botch           (char *diag, char *s, char *file, int line);
 #  endif
 static void    add_to_chain    (void *p, MEM_SIZE size, MEM_SIZE chip);
 static void*   get_from_chain  (MEM_SIZE size);
@@ -1035,6 +1035,16 @@ extern   Malloc_t sbrk(int);
 #ifndef NO_MALLOC_DYNAMIC_CFG
 #  define PERL_MALLOC_OPT_CHARS "FMfAPGdac"
 
+#  ifndef FILL_DEAD_DEFAULT
+#    define FILL_DEAD_DEFAULT  1
+#  endif
+#  ifndef FILL_ALIVE_DEFAULT
+#    define FILL_ALIVE_DEFAULT 1
+#  endif
+#  ifndef FILL_CHECK_DEFAULT
+#    define FILL_CHECK_DEFAULT 1
+#  endif
+
 static IV MallocCfg[MallocCfg_last] = {
   FIRST_SBRK,
   MIN_SBRK,
@@ -1042,9 +1052,9 @@ static IV MallocCfg[MallocCfg_last] = {
   SBRK_ALLOW_FAILURES,
   SBRK_FAILURE_PRICE,
   SBRK_ALLOW_FAILURES * SBRK_FAILURE_PRICE,    /* sbrk_goodness */
-  1,                   /* FILL_DEAD */
-  1,                   /* FILL_ALIVE */
-  1,                   /* FILL_CHECK */
+  FILL_DEAD_DEFAULT,   /* FILL_DEAD */
+  FILL_ALIVE_DEFAULT,  /* FILL_ALIVE */
+  FILL_CHECK_DEFAULT,  /* FILL_CHECK */
   0,                   /* MallocCfg_skip_cfg_env */
   0,                   /* MallocCfg_cfg_env_read */
   0,                   /* MallocCfg_emergency_buffer_size */
@@ -1261,23 +1271,36 @@ write2(char *mess)
 
 #ifdef DEBUGGING
 #undef ASSERT
-#define        ASSERT(p,diag)   if (!(p)) botch(diag,STRINGIFY(p));  else
+#define        ASSERT(p,diag)   if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__);  else
 static void
-botch(char *diag, char *s)
+botch(char *diag, char *s, char *file, int line)
 {
     if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
        goto do_write;
     else {
        dTHX;
-
        if (PerlIO_printf(PerlIO_stderr(),
-                         "assertion botched (%s?): %s\n", diag, s) != 0) {
+                         "assertion botched (%s?): %s%s %s:%d\n",
+                         diag, s, file, line) != 0) {
         do_write:              /* Can be initializing interpreter */
            write2("assertion botched (");
            write2(diag);
            write2("?): ");
            write2(s);
-           write2("\n");
+           write2(" (");
+           write2(file);
+           write2(":");
+           {
+             char linebuf[10];
+             char *s = linebuf + sizeof(linebuf) - 1;
+             int n = line;
+             *s = 0;
+             do {
+               *--s = '0' + (n % 10);
+             } while (n /= 10);
+             write2(s);
+           }
+           write2(")\n");
        }
        PerlProc_abort();
     }