# Type of size argument for allocation functions
MEM_SIZE unsigned long
+ # size of void*
+ PTRSIZE 4
+
# Maximal value in LONG
LONG_MAX 0x7FFFFFFF
# Fatal error reporting function
croak(format, arg) warn(idem) + exit(1)
+ # Fatal error reporting function
+ croak2(format, arg1, arg2) warn2(idem) + exit(1)
+
# Error reporting function
warn(format, arg) fprintf(stderr, idem)
+ # Error reporting function
+ warn2(format, arg1, arg2) fprintf(stderr, idem)
+
# Locking/unlocking for MT operation
- MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex)
- MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex)
+ MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex)
+ MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex)
# Locking/unlocking mutex for MT operation
MUTEX_LOCK(l) void
# include "perl.h"
# if defined(PERL_IMPLICIT_CONTEXT)
# define croak Perl_croak_nocontext
+# define croak2 Perl_croak_nocontext
# define warn Perl_warn_nocontext
+# define warn2 Perl_warn_nocontext
+# else
+# define croak2 croak
+# define warn2 warn
# endif
#else
# ifdef PERL_FOR_X2P
# ifndef Malloc_t
# define Malloc_t void *
# endif
+# ifndef PTRSIZE
+# define PTRSIZE 4
+# endif
# ifndef MEM_SIZE
# define MEM_SIZE unsigned long
# endif
# ifndef croak /* make depend */
# define croak(mess, arg) (warn((mess), (arg)), exit(1))
# endif
+# ifndef croak2 /* make depend */
+# define croak2(mess, arg1, arg2) (warn2((mess), (arg1), (arg2)), exit(1))
+# endif
# ifndef warn
# define warn(mess, arg) fprintf(stderr, (mess), (arg))
# endif
+# ifndef warn2
+# define warn2(mess, arg1) fprintf(stderr, (mess), (arg1), (arg2))
+# endif
# ifdef DEBUG_m
# undef DEBUG_m
# 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
#endif
#ifndef MALLOC_LOCK
-# define MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex)
+# define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex)
#endif
#ifndef MALLOC_UNLOCK
-# define MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex)
+# define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex)
#endif
# ifndef fatalcroak /* make depend */
# 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
+#ifdef PERL_IMPLICIT_CONTEXT
+# define PERL_IS_ALIVE aTHX
+#else
+# define PERL_IS_ALIVE TRUE
+#endif
+
+
/*
* Layout of memory:
* ~~~~~~~~~~~~~~~~
double strut; /* alignment problems */
#endif
struct {
- u_char ovu_magic; /* magic number */
+/*
+ * Keep the ovu_index and ovu_magic in this order, having a char
+ * field first gives alignment indigestion in some systems, such as
+ * MachTen.
+ */
u_char ovu_index; /* bucket # */
+ u_char ovu_magic; /* magic number */
#ifdef RCHECK
u_short ovu_size; /* actual block size */
u_int ovu_rmagic; /* range magic number */
# define SBRK_FAILURE_PRICE 50
#endif
-#if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)
+static void morecore (register int bucket);
+# if defined(DEBUGGING)
+static void botch (char *diag, char *s);
+# endif
+static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip);
+static void* get_from_chain (MEM_SIZE size);
+static void* get_from_bigger_buckets(int bucket, MEM_SIZE size);
+static union overhead *getpages (MEM_SIZE needed, int *nblksp, int bucket);
+static int getpages_adjacent(MEM_SIZE require);
-# ifndef BIG_SIZE
-# define BIG_SIZE (1<<16) /* 64K */
-# endif
+#ifdef PERL_CORE
#ifdef I_MACH_CTHREADS
# undef MUTEX_LOCK
# define MUTEX_UNLOCK(m) STMT_START { if (*m) mutex_unlock(*m); } STMT_END
#endif
-static char *emergency_buffer;
-static MEM_SIZE emergency_buffer_size;
+#ifndef BITS_IN_PTR
+# define BITS_IN_PTR (8*PTRSIZE)
+#endif
-static int findbucket (union overhead *freep, int srchlen);
-static void morecore (register int bucket);
-# if defined(DEBUGGING)
-static void botch (char *diag, char *s);
+/*
+ * nextf[i] is the pointer to the next free block of size 2^i. The
+ * smallest allocatable block is 8 bytes. The overhead information
+ * precedes the data area returned to the user.
+ */
+#define NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1)
+static union overhead *nextf[NBUCKETS];
+
+#if defined(PURIFY) && !defined(USE_PERL_SBRK)
+# define USE_PERL_SBRK
+#endif
+
+#ifdef USE_PERL_SBRK
+# define sbrk(a) Perl_sbrk(a)
+Malloc_t Perl_sbrk (int size);
+#else
+# ifndef HAS_SBRK_PROTO /* <unistd.h> usually takes care of this */
+extern Malloc_t sbrk(int);
+# endif
+#endif
+
+#ifdef DEBUGGING_MSTATS
+/*
+ * nmalloc[i] is the difference between the number of mallocs and frees
+ * for a given block size.
+ */
+static u_int nmalloc[NBUCKETS];
+static u_int sbrk_slack;
+static u_int start_slack;
+#else /* !( defined DEBUGGING_MSTATS ) */
+# define sbrk_slack 0
+#endif
+
+static u_int goodsbrk;
+
+# ifdef PERL_EMERGENCY_SBRK
+
+# ifndef BIG_SIZE
+# define BIG_SIZE (1<<16) /* 64K */
# endif
-static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip);
-static Malloc_t emergency_sbrk (MEM_SIZE size);
-static void* get_from_chain (MEM_SIZE size);
-static void* get_from_bigger_buckets(int bucket, MEM_SIZE size);
-static union overhead *getpages (int needed, int *nblksp, int bucket);
-static int getpages_adjacent(int require);
+
+static char *emergency_buffer;
+static MEM_SIZE emergency_buffer_size;
+static int no_mem; /* 0 if the last request for more memory succeeded.
+ Otherwise the size of the failing request. */
static Malloc_t
emergency_sbrk(MEM_SIZE size)
{
MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<<LOG_OF_MIN_ARENA;
- if (size >= BIG_SIZE) {
- /* Give the possibility to recover: */
+ if (size >= BIG_SIZE && (!no_mem || (size < no_mem))) {
+ /* Give the possibility to recover, but avoid an infinite cycle. */
MALLOC_UNLOCK;
- croak("Out of memory during \"large\" request for %i bytes", size);
+ no_mem = size;
+ croak2("Out of memory during \"large\" request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
}
if (emergency_buffer_size >= rsize) {
}
do_croak:
MALLOC_UNLOCK;
- croak("Out of memory during request for %i bytes", size);
+ croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
/* NOTREACHED */
return Nullch;
}
-#else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
+# else /* !defined(PERL_EMERGENCY_SBRK) */
# define emergency_sbrk(size) -1
-#endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
-
-/*
- * nextf[i] is the pointer to the next free block of size 2^i. The
- * smallest allocatable block is 8 bytes. The overhead information
- * precedes the data area returned to the user.
- */
-#define NBUCKETS (32*BUCKETS_PER_POW2 + 1)
-static union overhead *nextf[NBUCKETS];
-
-#ifdef USE_PERL_SBRK
-#define sbrk(a) Perl_sbrk(a)
-Malloc_t Perl_sbrk (int size);
-#else
-#ifdef DONT_DECLARE_STD
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
-#else
-extern Malloc_t sbrk(int);
-#endif
-#endif
-
-#ifdef DEBUGGING_MSTATS
-/*
- * nmalloc[i] is the difference between the number of mallocs and frees
- * for a given block size.
- */
-static u_int nmalloc[NBUCKETS];
-static u_int sbrk_slack;
-static u_int start_slack;
-#endif
-
-static u_int goodsbrk;
+# endif
+#endif /* ifdef PERL_CORE */
#ifdef DEBUGGING
#undef ASSERT
static void
botch(char *diag, char *s)
{
- dTHXo;
+ dTHX;
PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s);
PerlProc_abort();
}
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) */
{
dTHX;
if (!PL_nomemok) {
- PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
+#if defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC)
+ PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
+#else
+ char buff[80];
+ char *eb = buff + sizeof(buff) - 1;
+ char *s = eb;
+ size_t n = nbytes;
+
+ PerlIO_puts(PerlIO_stderr(),"Out of memory during request for ");
+#if defined(DEBUGGING) || defined(RCHECK)
+ n = size;
+#endif
+ *s = 0;
+ do {
+ *--s = '0' + (n % 10);
+ } while (n /= 10);
+ PerlIO_puts(PerlIO_stderr(),s);
+ PerlIO_puts(PerlIO_stderr()," bytes, total sbrk() is ");
+ s = eb;
+ n = goodsbrk + sbrk_slack;
+ do {
+ *--s = '0' + (n % 10);
+ } while (n /= 10);
+ PerlIO_puts(PerlIO_stderr(),s);
+ PerlIO_puts(PerlIO_stderr()," bytes!\n");
+#endif /* defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) */
my_exit(1);
}
}
}
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) malloc %ld bytes\n",
- (unsigned long)(p+1), (unsigned long)(PL_an++),
+ "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)) {
- dTHXo;
- PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n",
- (unsigned long)*((int*)p),(unsigned long)p);
+ dTHX;
+ PerlIO_printf(PerlIO_stderr(),
+ "Unaligned pointer in the free chain 0x%"UVxf"\n",
+ PTR2UV(p));
+ }
+ if ((PTR2UV(p->ov_next)) & (MEM_ALIGNBYTES - 1)) {
+ dTHX;
+ PerlIO_printf(PerlIO_stderr(),
+ "Unaligned `next' pointer in the free "
+ "chain 0x%"UVxf" at 0x%"UVxf"\n",
+ PTR2UV(p->ov_next), PTR2UV(p));
}
#endif
nextf[bucket] = p->ov_next;
}
static union overhead *
-getpages(int needed, int *nblksp, int bucket)
+getpages(MEM_SIZE needed, int *nblksp, int bucket)
{
/* Need to do (possibly expensive) system call. Try to
optimize it for rare calling. */
MEM_SIZE require = needed - sbrked_remains;
char *cp;
union overhead *ovp;
- int slack = 0;
+ MEM_SIZE slack = 0;
if (sbrk_good > 0) {
if (!last_sbrk_top && require < FIRST_SBRK)
sbrked_remains = require - needed;
last_op = cp;
}
+#if !defined(PLAIN_MALLOC) && !defined(NO_FANCY_MALLOC)
+ no_mem = 0;
+#endif
last_sbrk_top = cp + require;
#ifdef DEBUGGING_MSTATS
goodsbrk += require;
}
static int
-getpages_adjacent(int require)
+getpages_adjacent(MEM_SIZE require)
{
if (require <= sbrked_remains) {
sbrked_remains -= require;
#endif
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) free\n",
- (unsigned long)cp, (unsigned long)(PL_an++)));
+ "0x%"UVxf": (%05lu) free\n",
+ PTR2UV(cp), (unsigned long)(PL_an++)));
if (cp == NULL)
return;
{
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
{
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 */
}
#endif
res = cp;
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) realloc %ld bytes inplace\n",
- (unsigned long)res,(unsigned long)(PL_an++),
+ "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n",
+ PTR2UV(res),(unsigned long)(PL_an++),
(long)size));
} else if (incr == 1 && (cp - M_OVERHEAD == last_op)
&& (onb > (1 << LOG_OF_MIN_ARENA))) {
} else {
hard_way:
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x%lx: (%05lu) realloc %ld bytes the hard way\n",
- (unsigned long)cp,(unsigned long)(PL_an++),
+ "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n",
+ PTR2UV(cp),(unsigned long)(PL_an++),
(long)size));
if ((res = (char*)Perl_malloc(nbytes)) == NULL)
return (NULL);
return ((Malloc_t)res);
}
-/*
- * Search ``srchlen'' elements of each free list for a block whose
- * header starts at ``freep''. If srchlen is -1 search the whole list.
- * Return bucket number, or -1 if not found.
- */
-static int
-findbucket(union overhead *freep, int srchlen)
-{
- register union overhead *p;
- register int i, j;
-
- for (i = 0; i < NBUCKETS; i++) {
- j = 0;
- for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
- if (p == freep)
- return (i);
- j++;
- }
- }
- return (-1);
-}
-
Malloc_t
Perl_calloc(register size_t elements, register size_t size)
{
Perl_strdup(const char *s)
{
MEM_SIZE l = strlen(s);
- char *s1 = (char *)Perl_malloc(l);
+ char *s1 = (char *)Perl_malloc(l+1);
- Copy(s, s1, (MEM_SIZE)l, char);
+ Copy(s, s1, (MEM_SIZE)(l+1), char);
return s1;
}
else
var = Perl_malloc(l + 1);
Copy(a, var, l, char);
- val++;
- my_setenv(var,val);
+ var[l + 1] = 0;
+ my_setenv(var, val+1);
if (var != buf)
Perl_mfree(var);
return 0;
# else
# define MIN_EVEN_REPORT MIN_BUCKET
# endif
-/*
- * mstats - print out statistics about malloc
- *
- * Prints two lines of numbers, one showing the length of the free list
- * for each size category, the second showing the number of mallocs -
- * frees for each size category.
- */
-void
-Perl_dump_mstats(pTHX_ char *s)
+
+int
+Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level)
{
#ifdef DEBUGGING_MSTATS
register int i, j;
register union overhead *p;
- int topbucket=0, topbucket_ev=0, topbucket_odd=0, totfree=0, total=0;
- u_int nfree[NBUCKETS];
- int total_chain = 0;
struct chunk_chain_s* nextchain;
+ buf->topbucket = buf->topbucket_ev = buf->topbucket_odd
+ = buf->totfree = buf->total = buf->total_chain = 0;
+
+ buf->minbucket = MIN_BUCKET;
MALLOC_LOCK;
for (i = MIN_BUCKET ; i < NBUCKETS; i++) {
for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
;
- nfree[i] = j;
- totfree += nfree[i] * BUCKET_SIZE_REAL(i);
- total += nmalloc[i] * BUCKET_SIZE_REAL(i);
+ if (i < buflen) {
+ buf->nfree[i] = j;
+ buf->ntotal[i] = nmalloc[i];
+ }
+ buf->totfree += j * BUCKET_SIZE_REAL(i);
+ buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i);
if (nmalloc[i]) {
- i % 2 ? (topbucket_odd = i) : (topbucket_ev = i);
- topbucket = i;
+ i % 2 ? (buf->topbucket_odd = i) : (buf->topbucket_ev = i);
+ buf->topbucket = i;
}
}
nextchain = chunk_chain;
while (nextchain) {
- total_chain += nextchain->size;
+ buf->total_chain += nextchain->size;
nextchain = nextchain->next;
}
+ buf->total_sbrk = goodsbrk + sbrk_slack;
+ buf->sbrks = sbrks;
+ buf->sbrk_good = sbrk_good;
+ buf->sbrk_slack = sbrk_slack;
+ buf->start_slack = start_slack;
+ buf->sbrked_remains = sbrked_remains;
MALLOC_UNLOCK;
+ buf->nbuckets = NBUCKETS;
+ if (level) {
+ for (i = MIN_BUCKET ; i < NBUCKETS; i++) {
+ if (i >= buflen)
+ break;
+ buf->bucket_mem_size[i] = BUCKET_SIZE(i);
+ buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i);
+ }
+ }
+#endif /* defined DEBUGGING_MSTATS */
+ return 0; /* XXX unused */
+}
+/*
+ * mstats - print out statistics about malloc
+ *
+ * Prints two lines of numbers, one showing the length of the free list
+ * for each size category, the second showing the number of mallocs -
+ * frees for each size category.
+ */
+void
+Perl_dump_mstats(pTHX_ char *s)
+{
+#ifdef DEBUGGING_MSTATS
+ register int i;
+ perl_mstats_t buffer;
+ UV nf[NBUCKETS];
+ UV nt[NBUCKETS];
+
+ buffer.nfree = nf;
+ buffer.ntotal = nt;
+ get_mstats(&buffer, NBUCKETS, 0);
+
if (s)
PerlIO_printf(Perl_error_log,
- "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n",
+ "Memory allocation statistics %s (buckets %"IVdf"(%"IVdf")..%"IVdf"(%"IVdf")\n",
s,
- (long)BUCKET_SIZE_REAL(MIN_BUCKET),
- (long)BUCKET_SIZE(MIN_BUCKET),
- (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket));
- PerlIO_printf(Perl_error_log, "%8d free:", totfree);
- for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
+ (IV)BUCKET_SIZE_REAL(MIN_BUCKET),
+ (IV)BUCKET_SIZE(MIN_BUCKET),
+ (IV)BUCKET_SIZE_REAL(buffer.topbucket),
+ (IV)BUCKET_SIZE(buffer.topbucket));
+ PerlIO_printf(Perl_error_log, "%8"IVdf" free:", buffer.totfree);
+ for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- nfree[i]);
+ ? " %5"UVuf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)),
+ buffer.nfree[i]);
}
#ifdef BUCKETS_ROOT2
PerlIO_printf(Perl_error_log, "\n\t ");
- for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
+ for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- nfree[i]);
+ ? " %5"UVuf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)),
+ buffer.nfree[i]);
}
#endif
- PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree);
- for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
+ PerlIO_printf(Perl_error_log, "\n%8"IVdf" used:", buffer.total - buffer.totfree);
+ for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- nmalloc[i] - nfree[i]);
+ ? " %5"IVdf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)),
+ buffer.ntotal[i] - buffer.nfree[i]);
}
#ifdef BUCKETS_ROOT2
PerlIO_printf(Perl_error_log, "\n\t ");
- for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
+ for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- nmalloc[i] - nfree[i]);
+ ? " %5"IVdf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)),
+ buffer.ntotal[i] - buffer.nfree[i]);
}
#endif
- PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n",
- goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack,
- start_slack, total_chain, sbrked_remains);
+ PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %"IVdf"/%"IVdf":%"IVdf". Odd ends: pad+heads+chain+tail: %"IVdf"+%"IVdf"+%"IVdf"+%"IVdf".\n",
+ buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good,
+ buffer.sbrk_slack, buffer.start_slack,
+ buffer.total_chain, buffer.sbrked_remains);
#endif /* DEBUGGING_MSTATS */
}
#endif /* lint */
#ifdef USE_PERL_SBRK
-# if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__)
+# if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__) || defined(PURIFY)
# define PERL_SBRK_VIA_MALLOC
-/*
- * MachTen's malloc() returns a buffer aligned on a two-byte boundary.
- * While this is adequate, it may slow down access to longer data
- * types by forcing multiple memory accesses. It also causes
- * complaints when RCHECK is in force. So we allocate six bytes
- * more than we need to, and return an address rounded up to an
- * eight-byte boundary.
- *
- * 980701 Dominic Dunlop <domo@computer.org>
- */
-# define SYSTEM_ALLOC_ALIGNMENT 2
# endif
# ifdef PERL_SBRK_VIA_MALLOC
}
}
- DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
- size, reqsize, Perl_sbrk_oldsize, got));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n",
+ size, reqsize, Perl_sbrk_oldsize, PTR2UV(got)));
return (void *)got;
}
https://perl5.git.perl.org / perl5.git / blobdiff