# define MAX_PACKED_POW2 6
# define MAX_PACKED (MAX_PACKED_POW2 * BUCKETS_PER_POW2 + BUCKET_POW2_SHIFT)
# define MAX_POW2_ALGO ((1<<(MAX_PACKED_POW2 + 1)) - M_OVERHEAD)
-# define TWOK_MASK ((1<<LOG_OF_MIN_ARENA) - 1)
+# define TWOK_MASK nBIT_MASK(LOG_OF_MIN_ARENA)
# define TWOK_MASKED(x) (PTR2UV(x) & ~TWOK_MASK)
# define TWOK_SHIFT(x) (PTR2UV(x) & TWOK_MASK)
# define OV_INDEXp(block) (INT2PTR(u_char*,TWOK_MASKED(block)))
#ifdef IGNORE_SMALL_BAD_FREE
#define FIRST_BUCKET_WITH_CHECK (6 * BUCKETS_PER_POW2) /* 64 */
# define N_BLKS(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \
- ? ((1<<LOG_OF_MIN_ARENA) - 1)/BUCKET_SIZE_NO_SURPLUS(bucket) \
+ ? nBIT_MASK(LOG_OF_MIN_ARENA)/BUCKET_SIZE_NO_SURPLUS(bucket) \
: n_blks[bucket] )
#else
# define N_BLKS(bucket) n_blks[bucket]
static void
botch(const char *diag, const char *s, const char *file, int line)
{
- dVAR;
dTHX;
if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
goto do_write;
return bucket;
}
+/*
+These have the same interfaces as the C lib ones, so are considered documented
+
+=for apidoc malloc
+=for apidoc calloc
+=for apidoc realloc
+=cut
+*/
+
Malloc_t
Perl_malloc(size_t nbytes)
{
- dVAR;
union overhead *p;
int bucket;
+#if defined(DEBUGGING) || defined(RCHECK)
+ MEM_SIZE size = nbytes;
+#endif
/* A structure that has more than PTRDIFF_MAX bytes is unfortunately
* legal in C, but in such, if two elements are far enough apart, we
* malloc so that pointer subtraction in the same structure is always
* well defined */
if (nbytes > PTRDIFF_MAX) {
+ dTHX;
MYMALLOC_WRITE2STDERR("Memory requests are limited to PTRDIFF_MAX"
" bytes to prevent possible undefined"
" behavior");
return NULL;
}
-#if defined(DEBUGGING) || defined(RCHECK)
- MEM_SIZE size = nbytes;
-#endif
-
BARK_64K_LIMIT("Allocation",nbytes,nbytes);
#ifdef DEBUGGING
if ((long)nbytes < 0)
MALLOC_UNLOCK;
DEBUG_m(PerlIO_printf(Perl_debug_log,
- "0x% "UVxf ": (%05lu) malloc %ld bytes\n",
- PTR2UV((Malloc_t)(p + CHUNK_SHIFT)), (unsigned long)(PL_an++),
+ "%p: (%05lu) malloc %ld bytes\n",
+ (Malloc_t)(p + CHUNK_SHIFT),
+ (unsigned long)(PL_an++),
(long)size));
FILLCHECK_DEADBEEF((unsigned char*)(p + CHUNK_SHIFT),
static union overhead *
getpages(MEM_SIZE needed, int *nblksp, int bucket)
{
- dVAR;
/* Need to do (possibly expensive) system call. Try to
optimize it for rare calling. */
MEM_SIZE require = needed - sbrked_remains;
static void
morecore(int bucket)
{
- dVAR;
union overhead *ovp;
int rnu; /* 2^rnu bytes will be requested */
int nblks; /* become nblks blocks of the desired size */
/* It's our first time. Initialize ourselves */
were_called = 1; /* Avoid a loop */
if (!MallocCfg[MallocCfg_skip_cfg_env]) {
- char *s = getenv("PERL_MALLOC_OPT"), *t = s, *off;
+ char *s = getenv("PERL_MALLOC_OPT"), *t = s;
+ const char *off;
const char *opts = PERL_MALLOC_OPT_CHARS;
int changed = 0;
IV val = 0;
t += 2;
- while (*t <= '9' && *t >= '0')
+ while (isDIGIT(*t))
val = 10*val + *t++ - '0';
if (!*t || *t == ';') {
if (MallocCfg[off - opts] != val)
Free_t
Perl_mfree(Malloc_t where)
{
- dVAR;
MEM_SIZE size;
union overhead *ovp;
char *cp = (char*)where;
Malloc_t
Perl_realloc(void *mp, size_t nbytes)
{
- dVAR;
MEM_SIZE onb;
union overhead *ovp;
char *res;
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)
- ? " %5"UVuf
- : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)),
+ ? " %5" UVuf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3" UVuf
+ : " %" UVuf)),
buffer.nfree[i]);
}
#ifdef BUCKETS_ROOT2
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)
- ? " %5"IVdf
- : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)),
+ ? " %5" IVdf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3" IVdf : " %" IVdf)),
buffer.ntotal[i] - buffer.nfree[i]);
}
#ifdef BUCKETS_ROOT2