*/
/*
+ * "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'"
+ */
+
+/*
Here are some notes on configuring Perl's malloc. (For non-perl
usage see below.)
# include <stdlib.h>
# include <stdio.h>
# include <memory.h>
-# define _(arg) arg
# ifndef Malloc_t
# define Malloc_t void *
# endif
#ifdef DEBUGGING
# undef DEBUG_m
-# define DEBUG_m(a) \
+# define DEBUG_m(a) \
STMT_START { \
- if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) { a; } } \
+ if (PERL_GET_INTERP) { \
+ dTHX; \
+ if (DEBUG_m_TEST) { \
+ PL_debug &= ~DEBUG_m_FLAG; \
+ a; \
+ PL_debug |= DEBUG_m_FLAG; \
+ } \
+ } \
} STMT_END
#endif
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
-static int no_mem; /* 0 if the last request for more memory succeeded.
+static MEM_SIZE no_mem; /* 0 if the last request for more memory succeeded.
Otherwise the size of the failing request. */
static Malloc_t
return (NULL);
}
- DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf": (%05lu) malloc %ld bytes\n",
- PTR2UV(p), (unsigned long)(PL_an++),
- (long)size));
-
/* remove from linked list */
#if defined(RCHECK)
if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) {
MALLOC_UNLOCK;
+ DEBUG_m(PerlIO_printf(Perl_debug_log,
+ "0x%"UVxf": (%05lu) malloc %ld bytes\n",
+ PTR2UV(p), (unsigned long)(PL_an++),
+ (long)size));
+
#ifdef IGNORE_SMALL_BAD_FREE
if (bucket >= FIRST_BUCKET_WITH_CHECK)
#endif
static char *last_sbrk_top;
static char *last_op; /* This arena can be easily extended. */
-static int sbrked_remains;
+static MEM_SIZE sbrked_remains;
static int sbrk_good = SBRK_ALLOW_FAILURES * SBRK_FAILURE_PRICE;
#ifdef DEBUGGING_MSTATS
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored",
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)",
ovp->ov_rmagic == RMAGIC - 1 ?
"Duplicate" : "Bad");
}
#else
- warn("%s free() ignored",
+ warn("%s free() ignored (RMAGIC)",
ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
#endif
#else
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored");
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)");
}
#else
warn("%s", "Bad free() ignored");
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%srealloc() %signored",
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored",
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
ovp->ov_rmagic == RMAGIC - 1
? "of freed memory " : "");
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s",
+ Perl_warner(aTHX_ packWARN(WARN_MALLOC), "%s",
"Bad realloc() ignored");
}
#else