# define LOG_OF_MIN_ARENA 14
#endif
-#ifndef lint
-# if defined(DEBUGGING) && !defined(NO_RCHECK)
-# define RCHECK
-# endif
-# if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_MFILL) && !defined(MALLOC_FILL)
-# define MALLOC_FILL
-# endif
-# if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_FILL_CHECK) && !defined(MALLOC_FILL_CHECK)
-# define MALLOC_FILL_CHECK
-# endif
-# if defined(RCHECK) && defined(IGNORE_SMALL_BAD_FREE)
-# undef IGNORE_SMALL_BAD_FREE
-# endif
+#if defined(DEBUGGING) && !defined(NO_RCHECK)
+# define RCHECK
+#endif
+#if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_MFILL) && !defined(MALLOC_FILL)
+# define MALLOC_FILL
+#endif
+#if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_FILL_CHECK) && !defined(MALLOC_FILL_CHECK)
+# define MALLOC_FILL_CHECK
+#endif
+#if defined(RCHECK) && defined(IGNORE_SMALL_BAD_FREE)
+# undef IGNORE_SMALL_BAD_FREE
+#endif
/*
* malloc.c (Caltech) 2/21/82
* Chris Kingsley, kingsley@cit-20.
# ifndef UVxf
# define UVxf "lx"
# endif
-# ifndef Nullch
-# define Nullch NULL
-# endif
# ifndef MEM_ALIGNBYTES
# define MEM_ALIGNBYTES 4
# endif
# ifndef pTHX
# define pTHX void
# define pTHX_
-# ifdef HASATTRIBUTE
+# ifdef HASATTRIBUTE_UNUSED
# define dTHX extern int Perl___notused PERL_UNUSED_DECL
# else
# define dTHX extern int Perl___notused
#ifdef BUCKETS_ROOT2
# define MAX_BUCKET_BY_TABLE 13
-static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
+static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
{
0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80,
};
# define N_BLKS(bucket) n_blks[bucket]
#endif
-static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
+static const u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
{
# if BUCKETS_PER_POW2==1
0, 0,
# define BLK_SHIFT(bucket) blk_shift[bucket]
#endif
-static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
+static const u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
{
# if BUCKETS_PER_POW2==1
0, 0,
# else
# define SIZE_TABLE_MAX 64
# endif
-static char bucket_of[] =
+static const char bucket_of[] =
{
# ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */
/* 0 to 15 in 4-byte increments. */
dTHX;
/* First offense, give a possibility to recover by dieing. */
/* No malloc involved here: */
- GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0);
SV *sv;
char *pv;
- STRLEN n_a;
+ GV **gvp = (GV**)hv_fetchs(PL_defstash, "^M", FALSE);
- if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0);
+ if (!gvp) gvp = (GV**)hv_fetchs(PL_defstash, "\015", FALSE);
if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv)
|| (SvLEN(sv) < (1<<LOG_OF_MIN_ARENA) - M_OVERHEAD))
return NULL; /* Now die die die... */
/* Got it, now detach SvPV: */
- pv = SvPV(sv, n_a);
+ pv = SvPV_nolen(sv);
/* Check alignment: */
if ((PTR2UV(pv) - sizeof(union overhead)) & (NEEDED_ALIGNMENT - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
}
SvPOK_off(sv);
- SvPV_set(sv, Nullch);
+ SvPV_set(sv, NULL);
SvCUR_set(sv, 0);
SvLEN_set(sv, 0);
*size = malloced_size(pv) + M_OVERHEAD;
if (emergency_buffer_size) {
add_to_chain(emergency_buffer, emergency_buffer_size, 0);
emergency_buffer_size = 0;
- emergency_buffer = Nullch;
+ emergency_buffer = NULL;
have = 1;
}
MALLOC_UNLOCK;
emergency_sbrk_croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
/* NOTREACHED */
- return Nullch;
+ return NULL;
}
#else /* !defined(PERL_EMERGENCY_SBRK) */
#ifdef DEBUGGING
#undef ASSERT
-#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__); else
+#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__);
+
static void
botch(char *diag, char *s, char *file, int line)
{
+ dVAR;
if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
goto do_write;
else {
{
unsigned char *e = s + nbytes;
long *lp;
- long lfill = *(long*)fill;
+ const long lfill = *(long*)fill;
if (PTR2UV(s) & (sizeof(long)-1)) { /* Align the pattern */
int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1));
{
unsigned char *e = s + nbytes;
long *lp;
- long lfill = *(long*)fill;
+ const long lfill = *(long*)fill;
if (PTR2UV(s) & (sizeof(long)-1)) { /* Align the pattern */
int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1));
# define FILLCHECK_DEADBEEF(s, n) ((void)0)
#endif
-Malloc_t
-Perl_malloc(register size_t nbytes)
+int
+S_ajust_size_and_find_bucket(size_t *nbytes_p)
{
- register union overhead *p;
- register int bucket;
- register MEM_SIZE shiftr;
-
-#if defined(DEBUGGING) || defined(RCHECK)
- MEM_SIZE size = nbytes;
-#endif
-
- BARK_64K_LIMIT("Allocation",nbytes,nbytes);
-#ifdef DEBUGGING
- if ((long)nbytes < 0)
- croak("%s", "panic: malloc");
-#endif
+ MEM_SIZE shiftr;
+ int bucket;
+ size_t nbytes = *nbytes_p;
/*
* Convert amount of memory requested into
while (shiftr >>= 1)
bucket += BUCKETS_PER_POW2;
}
+ *nbytes_p = nbytes;
+ return bucket;
+}
+
+Malloc_t
+Perl_malloc(size_t nbytes)
+{
+ dVAR;
+ register union overhead *p;
+ register int bucket;
+
+#if defined(DEBUGGING) || defined(RCHECK)
+ MEM_SIZE size = nbytes;
+#endif
+
+ BARK_64K_LIMIT("Allocation",nbytes,nbytes);
+#ifdef DEBUGGING
+ if ((long)nbytes < 0)
+ croak("%s", "panic: malloc");
+#endif
+
+ bucket = S_ajust_size_and_find_bucket(&nbytes);
MALLOC_LOCK;
/*
* If nothing in hash bucket right now,
|| (p->ov_next && PTR2UV(p->ov_next) < (1<<LOG_OF_MIN_ARENA)) ) {
dTHX;
PerlIO_printf(PerlIO_stderr(),
- "Unaligned `next' pointer in the free "
+ "Unaligned \"next\" pointer in the free "
"chain 0x%"UVxf" at 0x%"UVxf"\n",
PTR2UV(p->ov_next), PTR2UV(p));
}
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;
# endif
}
#endif
- ; /* Finish `else' */
+ ; /* Finish "else" */
sbrked_remains = require - needed;
last_op = cp;
}
static void
morecore(register int bucket)
{
+ dVAR;
register union overhead *ovp;
register int rnu; /* 2^rnu bytes will be requested */
int nblks; /* become nblks blocks of the desired size */
}
}
if (t && *t) {
- write2("Unrecognized part of PERL_MALLOC_OPT: `");
+ write2("Unrecognized part of PERL_MALLOC_OPT: \"");
write2(t);
- write2("'\n");
+ write2("\"\n");
}
if (changed)
MallocCfg[MallocCfg_cfg_env_read] = 1;
}
Free_t
-Perl_mfree(void *mp)
+Perl_mfree(Malloc_t where)
{
+ dVAR;
register MEM_SIZE size;
register union overhead *ovp;
- char *cp = (char*)mp;
+ char *cp = (char*)where;
#ifdef PACK_MALLOC
u_char bucket;
#endif
Malloc_t
Perl_realloc(void *mp, size_t nbytes)
{
+ dVAR;
register MEM_SIZE onb;
union overhead *ovp;
char *res;
bad_free_warn = (pbf) ? atoi(pbf) : 1;
}
if (!bad_free_warn)
- return Nullch;
+ return NULL;
#ifdef RCHECK
#ifdef PERL_CORE
{
warn("%s", "Bad realloc() ignored");
#endif
#endif
- return Nullch; /* sanity */
+ return NULL; /* sanity */
}
onb = BUCKET_SIZE_REAL(bucket);
MEM_SIZE l = strlen(s);
char *s1 = (char *)Perl_malloc(l+1);
- return CopyD(s, s1, (MEM_SIZE)(l+1), char);
+ return (char *)CopyD(s, s1, (MEM_SIZE)(l+1), char);
}
#ifdef PERL_CORE
if (l < sizeof(buf))
var = buf;
else
- var = Perl_malloc(l + 1);
+ var = (char *)Perl_malloc(l + 1);
Copy(a, var, l, char);
var[l + 1] = 0;
my_setenv(var, val+1);
MEM_SIZE
Perl_malloced_size(void *p)
{
- union overhead *ovp = (union overhead *)
+ union overhead * const ovp = (union overhead *)
((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT);
- int bucket = OV_INDEX(ovp);
+ const int bucket = OV_INDEX(ovp);
+
+ PERL_ARGS_ASSERT_MALLOCED_SIZE;
+
#ifdef RCHECK
/* The caller wants to have a complete control over the chunk,
disable the memory checking inside the chunk. */
if (bucket <= MAX_SHORT_BUCKET) {
- MEM_SIZE size = BUCKET_SIZE_REAL(bucket);
+ const MEM_SIZE size = BUCKET_SIZE_REAL(bucket);
ovp->ov_size = size + M_OVERHEAD - 1;
*((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RMAGIC_SZ)) = RMAGIC;
}
return BUCKET_SIZE_REAL(bucket);
}
+
+MEM_SIZE
+Perl_malloc_good_size(size_t wanted)
+{
+ return BUCKET_SIZE_REAL(S_ajust_size_and_find_bucket(&wanted));
+}
+
# ifdef BUCKETS_ROOT2
# define MIN_EVEN_REPORT 6
# else
register union overhead *p;
struct chunk_chain_s* nextchain;
+ PERL_ARGS_ASSERT_GET_MSTATS;
+
buf->topbucket = buf->topbucket_ev = buf->topbucket_odd
= buf->totfree = buf->total = buf->total_chain = 0;
buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i);
}
}
+#else /* defined DEBUGGING_MSTATS */
+ PerlIO_printf(Perl_error_log, "perl not compiled with DEBUGGING_MSTATS\n");
#endif /* defined DEBUGGING_MSTATS */
return 0; /* XXX unused */
}
* frees for each size category.
*/
void
-Perl_dump_mstats(pTHX_ char *s)
+Perl_dump_mstats(pTHX_ const char *s)
{
#ifdef DEBUGGING_MSTATS
register int i;
UV nf[NBUCKETS];
UV nt[NBUCKETS];
+ PERL_ARGS_ASSERT_DUMP_MSTATS;
+
buffer.nfree = nf;
buffer.ntotal = nt;
get_mstats(&buffer, NBUCKETS, 0);
buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good,
buffer.sbrk_slack, buffer.start_slack,
buffer.total_chain, buffer.sbrked_remains);
+#else /* DEBUGGING_MSTATS */
+ PerlIO_printf(Perl_error_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",s);
#endif /* DEBUGGING_MSTATS */
}
-#endif /* lint */
#ifdef USE_PERL_SBRK
* indent-tabs-mode: t
* End:
*
- * vim: ts=8 sts=4 sw=4 noet:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */