get Compiler "working" under useithreads

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

diff --git a/malloc.c b/malloc.c
index c4a7a90..9c6a6d8 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -332,6 +332,13 @@
     } STMT_END
 #endif
 
+#ifdef PERL_IMPLICIT_CONTEXT
+#  define PERL_IS_ALIVE                aTHX
+#else
+#  define PERL_IS_ALIVE                TRUE
+#endif
+    
+
 /*
  * Layout of memory:
  * ~~~~~~~~~~~~~~~~
@@ -951,7 +958,7 @@ static      u_int goodsbrk;
 static void
 botch(char *diag, char *s)
 {
-       dTHXo;
+       dTHX;
        PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s);
        PerlProc_abort();
 }
@@ -1036,13 +1043,13 @@ Perl_malloc(register size_t nbytes)
        /* remove from linked list */
 #if defined(RCHECK)
        if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) {
-           dTHXo;
+           dTHX;
            PerlIO_printf(PerlIO_stderr(),
                          "Unaligned pointer in the free chain 0x%"UVxf"\n",
                          PTR2UV(p));
        }
        if ((PTR2UV(p->ov_next)) & (MEM_ALIGNBYTES - 1)) {
-           dTHXo;
+           dTHX;
            PerlIO_printf(PerlIO_stderr(),
                          "Unaligned `next' pointer in the free "
                          "chain 0x"UVxf" at 0x%"UVxf"\n",
@@ -1506,18 +1513,36 @@ Perl_mfree(void *mp)
            {
                static int bad_free_warn = -1;
                if (bad_free_warn == -1) {
-                   dTHXo;
+                   dTHX;
                    char *pbf = PerlEnv_getenv("PERL_BADFREE");
                    bad_free_warn = (pbf) ? atoi(pbf) : 1;
                }
                if (!bad_free_warn)
                    return;
 #ifdef RCHECK
+#ifdef PERL_CORE
+               {
+                   dTHX;
+                   if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+                       Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored",
+                                   ovp->ov_rmagic == RMAGIC - 1 ?
+                                   "Duplicate" : "Bad");
+               }
+#else
                warn("%s free() ignored",
                    ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
+#endif         
+#else
+#ifdef PERL_CORE
+               {
+                   dTHX;
+                   if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+                       Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored");
+               }
 #else
                warn("%s", "Bad free() ignored");
 #endif
+#endif
                return;                         /* sanity */
            }
 #ifdef RCHECK
@@ -1588,19 +1613,39 @@ Perl_realloc(void *mp, size_t nbytes)
            {
                static int bad_free_warn = -1;
                if (bad_free_warn == -1) {
-                   dTHXo;
+                   dTHX;
                    char *pbf = PerlEnv_getenv("PERL_BADFREE");
                    bad_free_warn = (pbf) ? atoi(pbf) : 1;
                }
                if (!bad_free_warn)
                    return Nullch;
 #ifdef RCHECK
+#ifdef PERL_CORE
+               {
+                   dTHX;
+                   if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+                       Perl_warner(aTHX_ WARN_MALLOC, "%srealloc() %signored",
+                                   (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
+                                   ovp->ov_rmagic == RMAGIC - 1
+                                   ? "of freed memory " : "");
+               }
+#else
                warn("%srealloc() %signored",
                    (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
                     ovp->ov_rmagic == RMAGIC - 1 ? "of freed memory " : "");
+#endif
+#else
+#ifdef PERL_CORE
+               {
+                   dTHX;
+                   if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+                       Perl_warner(aTHX_ WARN_MALLOC, "%s",
+                                   "Bad realloc() ignored");
+               }
 #else
                warn("%s", "Bad realloc() ignored");
 #endif
+#endif
                return Nullch;                  /* sanity */
            }