*
*/
+#if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS)
+# define DEBUGGING_MSTATS
+#endif
+
#ifndef lint
# if defined(DEBUGGING) && !defined(NO_RCHECK)
# define RCHECK
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
-static char *
+static Malloc_t
emergency_sbrk(size)
MEM_SIZE size;
{
}
if (!emergency_buffer) {
+ dTHR;
/* First offense, give a possibility to recover by dieing. */
/* No malloc involved here: */
GV **gvp = (GV**)hv_fetch(defstash, "^M", 2, 0);
#ifdef USE_PERL_SBRK
#define sbrk(a) Perl_sbrk(a)
-char * Perl_sbrk _((int size));
+Malloc_t Perl_sbrk _((int size));
+#else
+#ifdef DONT_DECLARE_STD
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
#else
-extern char *sbrk();
+extern Malloc_t sbrk(int);
+#endif
#endif
#ifdef DEBUGGING_MSTATS
#ifdef DEBUGGING
#define ASSERT(p) if (!(p)) botch(STRINGIFY(p)); else
static void
-botch(s)
- char *s;
+botch(char *s)
{
PerlIO_printf(PerlIO_stderr(), "assertion botched: %s\n", s);
- abort();
+ PerlProc_abort();
}
#else
#define ASSERT(p)
#endif
Malloc_t
-malloc(nbytes)
- register MEM_SIZE nbytes;
+malloc(register size_t nbytes)
{
register union overhead *p;
register int bucket = 0;
* Allocate more memory to the indicated bucket.
*/
static void
-morecore(bucket)
- register int bucket;
+morecore(register int bucket)
{
register union overhead *ovp;
register int rnu; /* 2^rnu bytes will be requested */
}
Free_t
-free(mp)
- Malloc_t mp;
+free(void *mp)
{
register MEM_SIZE size;
register union overhead *ovp;
if (OV_MAGIC(ovp, bucket) != MAGIC) {
static int bad_free_warn = -1;
if (bad_free_warn == -1) {
- char *pbf = getenv("PERL_BADFREE");
+ char *pbf = PerlEnv_getenv("PERL_BADFREE");
bad_free_warn = (pbf) ? atoi(pbf) : 1;
}
if (!bad_free_warn)
int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
Malloc_t
-realloc(mp, nbytes)
- Malloc_t mp;
- MEM_SIZE nbytes;
+realloc(void *mp, size_t nbytes)
{
register MEM_SIZE onb;
union overhead *ovp;
#ifdef PERL_CORE
#ifdef DEBUGGING
if (debug & 128) {
- PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++));
- PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) realloc %ld bytes\n",
+ PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++));
+ PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) realloc %ld bytes\n",
(unsigned long)res,(unsigned long)(an++),(long)size);
}
#endif
* Return bucket number, or -1 if not found.
*/
static int
-findbucket(freep, srchlen)
- union overhead *freep;
- int srchlen;
+findbucket(union overhead *freep, int srchlen)
{
register union overhead *p;
register int i, j;
}
Malloc_t
-calloc(elements, size)
- register MEM_SIZE elements;
- register MEM_SIZE size;
+calloc(register size_t elements, register size_t size)
{
long sz = elements * size;
Malloc_t p = malloc(sz);
* frees for each size category.
*/
void
-dump_mstats(s)
- char *s;
+dump_mstats(char *s)
{
register int i, j;
register union overhead *p;
}
#else
void
-dump_mstats(s)
- char *s;
+dump_mstats(char *s)
{
}
#endif
# define PERLSBRK_32_K (1<<15)
# define PERLSBRK_64_K (1<<16)
-char *
+Malloc_t
Perl_sbrk(size)
int size;
{
#ifdef PERL_CORE
reqsize = size; /* just for the DEBUG_m statement */
#endif
+#ifdef PACK_MALLOC
+ size = (size + 0x7ff) & ~0x7ff;
+#endif
if (size <= Perl_sbrk_oldsize) {
got = Perl_sbrk_oldchunk;
Perl_sbrk_oldchunk += size;
small = 1;
}
got = (IV)SYSTEM_ALLOC(size);
+#ifdef PACK_MALLOC
+ got = (got + 0x7ff) & ~0x7ff;
+#endif
if (small) {
/* Chunk is small, register the rest for future allocs. */
Perl_sbrk_oldchunk = got + reqsize;
}
#ifdef PERL_CORE
- DEBUG_m(PerlIO_printf(PerlIO_stderr(), "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
+ 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));
#endif