*/
/*
+ * "'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
# ifndef pTHX
# define pTHX void
# define pTHX_
-# define dTHX extern int Perl___notused
+# ifdef HASATTRIBUTE
+# define dTHX extern int Perl___notused PERL_UNUSED_DECL
+# else
+# define dTHX extern int Perl___notused
+# endif
# define WITH_THX(s) s
# endif
# ifndef PERL_GET_INTERP
# undef DEBUG_m
# define DEBUG_m(a) \
STMT_START { \
- if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \
+ if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) { a; } } \
} STMT_END
#endif
POW2_OPTIMIZE_ADJUST(nbytes);
nbytes += M_OVERHEAD;
nbytes = (nbytes + 3) &~ 3;
+#if defined(PACK_MALLOC) && !defined(SMALL_BUCKET_VIA_TABLE)
do_shifts:
+#endif
shiftr = (nbytes - 1) >> START_SHIFT;
bucket = START_SHIFTS_BUCKET;
/* apart from this loop, this is O(1) */
DEBUG_m(PerlIO_printf(Perl_debug_log,
"0x%"UVxf": (%05lu) malloc %ld bytes\n",
- PTR2UV(p+1), (unsigned long)(PL_an++),
+ PTR2UV(p), (unsigned long)(PL_an++),
(long)size));
/* remove from linked list */
{
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