develooper Front page | perl.perl5.porters | Postings from April 2003

[PATCH 5.8.1 @19053] malloc -DDEBUGGING

Thread Next
From:
Ilya Zakharevich
Date:
April 1, 2003 22:20
Subject:
[PATCH 5.8.1 @19053] malloc -DDEBUGGING
Message ID:
20030402062024.GA5050@math.berkeley.edu
Here is the beefed up version of malloc.c I used to find problems in
threads.xs.  E.g., instead of

  ext/threads/shared/t/av_simple.......Bizarre SvTYPE [62] at ../ext/threads/shared/t/av_simple.t line 78.

it prints something like (with -DDEBUGGING):

lib/Thread/Queue.....................
assertion botched (free()ed/realloc()ed-away memory was overwritten?): !(MallocCfg[MallocCfg_filldead] && MallocCfg[MallocCfg_fillcheck]) || !cmp_pat_4bytes((unsigned char*)(p + 1), ((1 << ((bucket) >> 0)) - (sizeof(union overhead) + sizeof (unsigned int)) + ((bucket >= 15 * 1) ? 4096 : 0)), fill_deadbeef)

Enjoy,
Ilya

ITEMIZED comments:

MANIFEST	-	The malloc API is moved to the new file malloc_ctl.h.
malloc_ctl.h
malloc.c
perl.h

sv.c		-	Parts of interpreter should be initialized early
malloc.c		for proper diagnostics from malloc.c.  malloc.c
			routines may be used with partially initialized
			interpreter too.

malloc.c	-	The -DDEBUGGING tests are beefed up so that they
			detect as many memory access errors as possible
			without OS support.  The malloc()ed memory is provided
			filled with a bitpattern; free()ed/realloc()ed memory
			is immediately overwritten with a different pattern;
			on malloc()/realloc() one checks that the newly
			assigned memory contains the pattern of free()ed
			memory.  [Checks are switchable off at compile and
			at run time, see starting comments in malloc.c for
			details.]

		-	Part of the configuration values for tuning malloc.c
			algorithms is moved from macros to static storage.

			Semi-API (via enum) is provided for read/write access
			to these configuration variables.

		-	Compiles standalone again.  One can use
			emergency_sbrk() standalone (setting buffers via the
			new interface).

		-	More comments.

		-	The new runtime options can now be set via an
			environment variable (configurable at compile time
			and at runtime before the first Perl_malloc())
			PERL_MALLOC_OPT (docs at start of malloc.c).

		-	The framework is provided to make it possible to
			skip reading $ENV{PERL_MALLOC_OPT} for tainted perls.

			Since this should be done before the first malloc(),
			the test for -T option is very rudimental.  If this
			test fails (-T is not the first chars of the first
			switch), then instead of ignoring $ENV{PERL_MALLOC_OPT},
			perl would die() with a proper message.

dosish.h	-	PERL_INIT3() macro communicates to malloc.c whether it
unixish.h		should skip checking $ENV{PERL_MALLOC_OPT} for
vms/vmsish.h		taintedness reasons.
plan9/plan9ish.h
os2/os2ish.h
epoc/epocish.h


--- ./MANIFEST-pre-malloc	Sun Mar 23 21:55:58 2003
+++ ./MANIFEST	Tue Apr  1 21:43:30 2003
@@ -2011,6 +2011,7 @@ makedir.SH			Precursor to makedir
 Makefile.micro			microperl Makefile
 Makefile.SH			A script that generates Makefile
 malloc.c			A version of malloc you might not want
+malloc_ctl.h			A version of malloc you might not want
 MANIFEST			This list of files
 mg.c				Magic code
 mg.h				Magic header
--- ./dosish.h-pre-malloc	Sun Mar 23 21:55:58 2003
+++ ./dosish.h	Tue Apr  1 21:39:24 2003
@@ -15,7 +15,7 @@
 #ifdef DJGPP
 #  define BIT_BUCKET "nul"
 #  define OP_BINARY O_BINARY
-#  define PERL_SYS_INIT(c,v) Perl_DJGPP_init(c,v)
+#  define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v)
 #  define init_os_extras Perl_init_os_extras
 #  include <signal.h>
 #  define HAS_UTIME
@@ -31,14 +31,14 @@
 #  define PERL_FS_VER_FMT	"%d_%d_%d"
 #else	/* DJGPP */
 #  ifdef WIN32
-#    define PERL_SYS_INIT(c,v)	Perl_win32_init(c,v)
+#    define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v)
 #    define BIT_BUCKET "nul"
 #  else
 #	 ifdef NETWARE
-#      define PERL_SYS_INIT(c,v)	Perl_nw5_init(c,v)
+#      define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) Perl_nw5_init(c,v)
 #      define BIT_BUCKET "nwnul"
 #    else
-#      define PERL_SYS_INIT(c,v)
+#      define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v)
 #      define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */
 #    endif /* NETWARE */
 #  endif
--- ./malloc.c-pre-malloc	Sun Nov  3 22:34:38 2002
+++ ./malloc.c	Tue Apr  1 20:43:46 2003
@@ -27,9 +27,12 @@
   options take a precise value, while the others are just boolean.
   The boolean ones are listed first.
 
+    # Read configuration settings from malloc_cfg.h
+    HAVE_MALLOC_CFG_H		undef
+
     # Enable code for an emergency memory pool in $^M.  See perlvar.pod
     # for a description of $^M.
-    PERL_EMERGENCY_SBRK		(!PLAIN_MALLOC && PERL_CORE)
+    PERL_EMERGENCY_SBRK		(!PLAIN_MALLOC && (PERL_CORE || !NO_MALLOC_DYNAMIC_CFG))
 
     # Enable code for printing memory statistics.
     DEBUGGING_MSTATS		(!PLAIN_MALLOC && PERL_CORE)
@@ -78,6 +81,22 @@
     # pessimization, error reporting optimization
     RCHECK			(DEBUGGING && !NO_RCHECK)
 
+    # Do not overwrite uninit areas with DEBUGGING.  Speed
+    # optimization, error reporting pessimization
+    NO_MFILL			undef
+
+    # Overwrite uninit areas with DEBUGGING.  Speed
+    # pessimization, error reporting optimization
+    MALLOC_FILL			(DEBUGGING && !NO_RCHECK && !NO_MFILL)
+
+    # Do not check overwritten uninit areas with DEBUGGING.  Speed
+    # optimization, error reporting pessimization
+    NO_FILL_CHECK		undef
+
+    # Check overwritten uninit areas with DEBUGGING.  Speed
+    # pessimization, error reporting optimization
+    MALLOC_FILL_CHECK		(DEBUGGING && !NO_RCHECK && !NO_FILL_CHECK)
+
     # Failed allocations bigger than this size croak (if
     # PERL_EMERGENCY_SBRK is enabled) without touching $^M.  See
     # perlvar.pod for a description of $^M.
@@ -98,6 +117,9 @@
     # Round up sbrk()s to multiples of this percent of footprint.
     MIN_SBRK_FRAC 		3
 
+    # Round up sbrk()s to multiples of this multiple of 1/1000 of footprint.
+    MIN_SBRK_FRAC1000 		(10 * MIN_SBRK_FRAC)
+
     # Add this much memory to big powers of two to get the bucket size.
     PERL_PAGESIZE 		4096
 
@@ -114,6 +136,20 @@
     # define this to disable 12-byte bucket (will increase memory footprint)
     STRICT_ALIGNMENT		undef
 
+    # Do not allow configuration of runtime options at runtime
+    NO_MALLOC_DYNAMIC_CFG	undef
+
+    # Do not allow configuration of runtime options via $ENV{PERL_MALLOC_OPT}
+    NO_PERL_MALLOC_ENV		undef
+
+	[The variable consists of ;-separated parts of the form CODE=VALUE
+	 with 1-character codes F, M, f, A, P, G, d, a, c for runtime
+	 configuration of FIRST_SBRK, MIN_SBRK, MIN_SBRK_FRAC1000,
+	 SBRK_ALLOW_FAILURES, SBRK_FAILURE_PRICE, sbrk_goodness,
+	 filldead, fillalive, fillcheck.  The last 3 are for DEBUGGING
+	 build, and allow switching the tests for free()ed memory read,
+	 uninit memory reads, and free()ed memory write.]
+
   This implementation assumes that calling PerlIO_printf() does not
   result in any memory allocation calls (used during a panic).
 
@@ -138,12 +174,27 @@
      # Unsigned integer type big enough to keep a pointer
      UV					unsigned long
 
+     # Signed integer of the same sizeof() as UV
+     IV					long
+
      # Type of pointer with 1-byte granularity
      caddr_t				char *
 
      # Type returned by free()
      Free_t				void
 
+     # Conversion of pointer to integer
+     PTR2UV(ptr)			((UV)(ptr))
+
+     # Conversion of integer to pointer
+     INT2PTR(type, i)			((type)(i))
+
+     # printf()-%-Conversion of UV to pointer
+     UVuf				"lu"
+
+     # Alignment to use
+     MEM_ALIGNBYTES			4
+
      # Very fatal condition reporting function (cannot call any )
      fatalcroak(arg)			write(2,arg,strlen(arg)) + exit(2)
   
@@ -168,6 +219,10 @@
      MUTEX_UNLOCK(l)			void
  */
 
+#ifdef HAVE_MALLOC_CFG_H
+#  include "malloc_cfg.h"
+#endif
+
 #ifndef NO_FANCY_MALLOC
 #  ifndef SMALL_BUCKET_VIA_TABLE
 #    define SMALL_BUCKET_VIA_TABLE
@@ -187,7 +242,7 @@
 #  ifndef TWO_POT_OPTIMIZE
 #    define TWO_POT_OPTIMIZE
 #  endif 
-#  if defined(PERL_CORE) && !defined(PERL_EMERGENCY_SBRK)
+#  if (defined(PERL_CORE) || !defined(NO_MALLOC_DYNAMIC_CFG)) && !defined(PERL_EMERGENCY_SBRK)
 #    define PERL_EMERGENCY_SBRK
 #  endif 
 #  if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS)
@@ -211,6 +266,12 @@
 #  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 
@@ -251,6 +312,11 @@
 #    define croak2	croak
 #    define warn2	warn
 #  endif
+#  if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#     define PERL_MAYBE_ALIVE	PL_thr_key
+#  else
+#     define PERL_MAYBE_ALIVE	1
+#  endif
 #else
 #  ifdef PERL_FOR_X2P
 #    include "../EXTERN.h"
@@ -259,6 +325,8 @@
 #    include <stdlib.h>
 #    include <stdio.h>
 #    include <memory.h>
+#    include <io.h>
+#    include <string.h>
 #    ifndef Malloc_t
 #      define Malloc_t void *
 #    endif
@@ -274,6 +342,9 @@
 #    ifndef UV
 #      define UV unsigned long
 #    endif
+#    ifndef IV
+#      define IV long
+#    endif
 #    ifndef caddr_t
 #      define caddr_t char *
 #    endif
@@ -284,6 +355,22 @@
 #    define PerlEnv_getenv getenv
 #    define PerlIO_printf fprintf
 #    define PerlIO_stderr() stderr
+#    define PerlIO_puts(f,s)		fputs(s,f)
+#    ifndef INT2PTR
+#      define INT2PTR(t,i)		((t)(i))
+#    endif
+#    ifndef PTR2UV
+#      define PTR2UV(p)			((UV)(p))
+#    endif
+#    ifndef UVuf
+#      define UVuf			"lu"
+#    endif
+#    ifndef Nullch
+#      define Nullch			NULL
+#    endif
+#    ifndef MEM_ALIGNBYTES
+#      define MEM_ALIGNBYTES		4
+#    endif
 #  endif
 #  ifndef croak				/* make depend */
 #    define croak(mess, arg) (warn((mess), (arg)), exit(1))
@@ -295,7 +382,7 @@
 #    define warn(mess, arg) fprintf(stderr, (mess), (arg))
 #  endif 
 #  ifndef warn2
-#    define warn2(mess, arg1) fprintf(stderr, (mess), (arg1), (arg2))
+#    define warn2(mess, arg1, arg2) fprintf(stderr, (mess), (arg1), (arg2))
 #  endif 
 #  ifdef DEBUG_m
 #    undef DEBUG_m
@@ -317,6 +404,7 @@
 #  ifndef PERL_GET_INTERP
 #     define PERL_GET_INTERP	PL_curinterp
 #  endif
+#  define PERL_MAYBE_ALIVE	1
 #  ifndef Perl_malloc
 #     define Perl_malloc malloc
 #  endif
@@ -332,7 +420,7 @@
 #  ifndef Perl_strdup
 #     define Perl_strdup strdup
 #  endif
-#endif
+#endif	/* defined PERL_CORE */
 
 #ifndef MUTEX_LOCK
 #  define MUTEX_LOCK(l)
@@ -358,7 +446,7 @@
 #  undef DEBUG_m
 #  define DEBUG_m(a) 							\
     STMT_START {							\
-	if (PERL_GET_INTERP) {						\
+	if (PERL_MAYBE_ALIVE && PERL_GET_THX) {						\
 	    dTHX;							\
 	    if (DEBUG_m_TEST) {						\
 		PL_debug &= ~DEBUG_m_FLAG;				\
@@ -480,7 +568,7 @@ union	overhead {
 		u_char	ovu_index;	/* bucket # */
 		u_char	ovu_magic;	/* magic number */
 #ifdef RCHECK
-		u_short	ovu_size;	/* actual block size */
+		u_short	ovu_size;	/* block size (requested + overhead - 1) */
 		u_int	ovu_rmagic;	/* range magic number */
 #endif
 	} ovu;
@@ -497,7 +585,7 @@ union	overhead {
 #ifdef RCHECK
 #  define	RSLOP		sizeof (u_int)
 #  ifdef TWO_POT_OPTIMIZE
-#    define MAX_SHORT_BUCKET (12 * BUCKETS_PER_POW2)
+#    define MAX_SHORT_BUCKET (12 * BUCKETS_PER_POW2) /* size-1 fits in short */
 #  else
 #    define MAX_SHORT_BUCKET (13 * BUCKETS_PER_POW2)
 #  endif 
@@ -883,6 +971,12 @@ static int	getpages_adjacent(MEM_SIZE re
 #  define MUTEX_UNLOCK(m) STMT_START { if (*m) mutex_unlock(*m); } STMT_END
 #endif
 
+#endif	/* defined PERL_CORE */ 
+
+#ifndef PTRSIZE
+#  define PTRSIZE	sizeof(void*)
+#endif
+
 #ifndef BITS_IN_PTR
 #  define BITS_IN_PTR (8*PTRSIZE)
 #endif
@@ -908,6 +1002,85 @@ extern	Malloc_t sbrk(int);
 # endif
 #endif
 
+#ifndef MIN_SBRK_FRAC1000	/* Backward compatibility */
+#  define MIN_SBRK_FRAC1000	(MIN_SBRK_FRAC * 10)
+#endif
+
+#ifndef START_EXTERN_C
+#  ifdef __cplusplus
+#    define START_EXTERN_C	extern "C" {
+#  else
+#    define START_EXTERN_C
+#  endif
+#endif
+
+#ifndef END_EXTERN_C
+#  ifdef __cplusplus
+#    define END_EXTERN_C		};
+#  else
+#    define END_EXTERN_C
+#  endif
+#endif
+
+#include "malloc_ctl.h"
+
+#ifndef NO_MALLOC_DYNAMIC_CFG
+#  define PERL_MALLOC_OPT_CHARS "FMfAPGdac"
+
+static IV MallocCfg[MallocCfg_last] = {
+  FIRST_SBRK,
+  MIN_SBRK,
+  MIN_SBRK_FRAC,
+  SBRK_ALLOW_FAILURES,
+  SBRK_FAILURE_PRICE,
+  SBRK_ALLOW_FAILURES * SBRK_FAILURE_PRICE,	/* sbrk_goodness */
+  1,			/* FILL_DEAD */
+  1,			/* FILL_ALIVE */
+  1,			/* FILL_CHECK */
+  0,			/* MallocCfg_skip_cfg_env */
+  0,			/* MallocCfg_cfg_env_read */
+  0,			/* MallocCfg_emergency_buffer */
+  0,			/* MallocCfg_emergency_buffer_prepared */
+  0,			/* MallocCfg_emergency_buffer_size */
+  0,			/* MallocCfg_emergency_buffer_prepared_size */
+  0			/* MallocCfg_emergency_buffer_last_req */
+};
+IV *MallocCfg_ptr = MallocCfg;
+
+#  undef MIN_SBRK
+#  undef FIRST_SBRK
+#  undef MIN_SBRK_FRAC1000
+#  undef SBRK_ALLOW_FAILURES
+#  undef SBRK_FAILURE_PRICE
+
+#  define MIN_SBRK		MallocCfg[MallocCfg_MIN_SBRK]
+#  define FIRST_SBRK		MallocCfg[MallocCfg_FIRST_SBRK]
+#  define MIN_SBRK_FRAC1000	MallocCfg[MallocCfg_MIN_SBRK_FRAC1000]
+#  define SBRK_ALLOW_FAILURES	MallocCfg[MallocCfg_SBRK_ALLOW_FAILURES]
+#  define SBRK_FAILURE_PRICE	MallocCfg[MallocCfg_SBRK_FAILURE_PRICE]
+
+#  define sbrk_goodness		MallocCfg[MallocCfg_sbrk_goodness]
+
+#  define emergency_buffer	((char*)MallocCfg[MallocCfg_emergency_buffer])
+#  define emergency_buffer_size	MallocCfg[MallocCfg_emergency_buffer_size]
+#  define emergency_buffer_last_req	MallocCfg[MallocCfg_emergency_buffer_last_req]
+
+#  define FILL_DEAD		MallocCfg[MallocCfg_filldead]
+#  define FILL_ALIVE		MallocCfg[MallocCfg_fillalive]
+#  define FILL_CHECK_CFG	MallocCfg[MallocCfg_fillcheck]
+#  define FILL_CHECK		(FILL_DEAD && FILL_CHECK_CFG)
+
+#else	/* defined(NO_MALLOC_DYNAMIC_CFG) */
+
+#  define FILL_DEAD	1
+#  define FILL_ALIVE	1
+#  define FILL_CHECK	1
+static int sbrk_goodness = SBRK_ALLOW_FAILURES * SBRK_FAILURE_PRICE;
+
+#  define NO_PERL_MALLOC_ENV
+
+#endif
+
 #ifdef DEBUGGING_MSTATS
 /*
  * nmalloc[i] is the difference between the number of mallocs and frees
@@ -922,27 +1095,105 @@ static  u_int start_slack;
 
 static	u_int goodsbrk;
 
-# ifdef PERL_EMERGENCY_SBRK
+#ifdef PERL_EMERGENCY_SBRK
 
 #  ifndef BIG_SIZE
 #    define BIG_SIZE (1<<16)		/* 64K */
 #  endif
 
+#  ifdef NO_MALLOC_DYNAMIC_CFG
 static char *emergency_buffer;
 static MEM_SIZE emergency_buffer_size;
-static MEM_SIZE no_mem;	/* 0 if the last request for more memory succeeded.
-			   Otherwise the size of the failing request. */
+	/* 0 if the last request for more memory succeeded.
+	   Otherwise the size of the failing request. */
+static MEM_SIZE emergency_buffer_last_req;
+#  endif
+
+#  ifndef emergency_sbrk_croak
+#    define emergency_sbrk_croak	croak2
+#  endif
+
+#  ifdef PERL_CORE
+static char *
+perl_get_emergency_buffer(IV *size)
+{
+    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;
+
+    if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0);
+    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);
+    /* Check alignment: */
+    if ((PTR2UV(pv) - sizeof(union overhead)) & (NEEDED_ALIGNMENT - 1)) {
+        PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
+        return NULL;		/* die die die */
+    }
+
+    SvPOK_off(sv);
+    SvPVX(sv) = Nullch;
+    SvCUR(sv) = SvLEN(sv) = 0;
+    *size = malloced_size(pv) + M_OVERHEAD;
+    return pv - sizeof(union overhead);
+}
+#    define PERL_GET_EMERGENCY_BUFFER(p)	perl_get_emergency_buffer(p)
+#  else
+#    define PERL_GET_EMERGENCY_BUFFER(p)	NULL
+#  endif	/* defined PERL_CORE */
+
+#  ifndef NO_MALLOC_DYNAMIC_CFG
+static char *
+get_emergency_buffer(IV *size)
+{
+    char *pv = (char*)MallocCfg[MallocCfg_emergency_buffer_prepared];
+
+    *size = MallocCfg[MallocCfg_emergency_buffer_prepared_size];
+    MallocCfg[MallocCfg_emergency_buffer_prepared] = 0;
+    MallocCfg[MallocCfg_emergency_buffer_prepared_size] = 0;
+    return pv;
+}
+
+/* Returns 0 on success, -1 on bad alignment, -2 if not implemented */
+int
+set_emergency_buffer(char *b, IV size)
+{
+    if (PTR2UV(b) & (NEEDED_ALIGNMENT - 1))
+	return -1;
+    if (MallocCfg[MallocCfg_emergency_buffer_prepared_size])
+	add_to_chain((void*)MallocCfg[MallocCfg_emergency_buffer_prepared],
+		     MallocCfg[MallocCfg_emergency_buffer_prepared_size], 0);
+    MallocCfg[MallocCfg_emergency_buffer_prepared] = PTR2UV(b);
+    MallocCfg[MallocCfg_emergency_buffer_prepared_size] = size;
+    return 0;
+}
+#    define GET_EMERGENCY_BUFFER(p)	get_emergency_buffer(p)
+#  else		/* NO_MALLOC_DYNAMIC_CFG */
+#    define GET_EMERGENCY_BUFFER(p)	NULL
+int
+set_emergency_buffer(char *b, IV size)
+{
+    return -1;
+}
+#  endif
 
 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 && (!no_mem || (size < no_mem))) {
+    if (size >= BIG_SIZE
+	&& (!emergency_buffer_last_req || (size < emergency_buffer_last_req))) {
 	/* Give the possibility to recover, but avoid an infinite cycle. */
 	MALLOC_UNLOCK;
-	no_mem = size;
-	croak2("Out of memory during \"large\" request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
+	emergency_buffer_last_req = size;
+	emergency_sbrk_croak("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) {
@@ -952,14 +1203,11 @@ emergency_sbrk(MEM_SIZE size)
 	emergency_buffer += rsize;
 	return old;
     } else {		
-	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;
+	IV Size;
+	char *pv = GET_EMERGENCY_BUFFER(&Size);
 	int have = 0;
-	STRLEN n_a;
 
 	if (emergency_buffer_size) {
 	    add_to_chain(emergency_buffer, emergency_buffer_size, 0);
@@ -967,38 +1215,42 @@ emergency_sbrk(MEM_SIZE size)
 	    emergency_buffer = Nullch;
 	    have = 1;
 	}
-	if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0);
-	if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) 
-	    || (SvLEN(sv) < (1<<LOG_OF_MIN_ARENA) - M_OVERHEAD)) {
+
+	if (!pv)
+	    pv = PERL_GET_EMERGENCY_BUFFER(&Size);
+	if (!pv) {
 	    if (have)
 		goto do_croak;
 	    return (char *)-1;		/* Now die die die... */
 	}
-	/* Got it, now detach SvPV: */
-	pv = SvPV(sv, n_a);
+
 	/* Check alignment: */
-	if ((PTR2UV(pv) - sizeof(union overhead)) & (NEEDED_ALIGNMENT - 1)) {
+	if (PTR2UV(pv) & (NEEDED_ALIGNMENT - 1)) {
+	    dTHX;
+
 	    PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
 	    return (char *)-1;		/* die die die */
 	}
 
-	emergency_buffer = pv - sizeof(union overhead);
-	emergency_buffer_size = malloced_size(pv) + M_OVERHEAD;
-	SvPOK_off(sv);
-	SvPVX(sv) = Nullch;
-	SvCUR(sv) = SvLEN(sv) = 0;
+	emergency_buffer = pv;
+	emergency_buffer_size = Size;
     }
   do_croak:
     MALLOC_UNLOCK;
-    croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
+    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;
 }
 
-# else /*  !defined(PERL_EMERGENCY_SBRK) */
+#else /*  !defined(PERL_EMERGENCY_SBRK) */
 #  define emergency_sbrk(size)	-1
-# endif
-#endif /* ifdef PERL_CORE */
+#endif	/* defined PERL_EMERGENCY_SBRK */
+
+static void
+write2(char *mess)
+{
+  write(2, mess, strlen(mess));
+}
 
 #ifdef DEBUGGING
 #undef ASSERT
@@ -1006,14 +1258,103 @@ emergency_sbrk(MEM_SIZE size)
 static void
 botch(char *diag, char *s)
 {
+    if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
+	goto do_write;
+    else {
 	dTHX;
-	PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s);
+
+	if (PerlIO_printf(PerlIO_stderr(),
+			  "assertion botched (%s?): %s\n", diag, s) != 0) {
+	 do_write:		/* Can be initializing interpreter */
+	    write2("assertion botched (");
+	    write2(diag);
+	    write2("?): ");
+	    write2(s);
+	    write2("\n");
+	}
 	PerlProc_abort();
+    }
 }
 #else
 #define	ASSERT(p, diag)
 #endif
 
+#ifdef MALLOC_FILL
+/* Fill should be long enough to cover long */
+static void
+fill_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill)
+{
+    unsigned char *e = s + nbytes;
+    long *lp;
+    long lfill = *(long*)fill;
+
+    if (PTR2UV(s) & (sizeof(long)-1)) {		/* Align the pattern */
+	int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1));
+	unsigned const char *f = fill + sizeof(long) - shift;
+	unsigned char *e1 = s + shift;
+
+	while (s < e1)
+	    *s++ = *f++;
+    }
+    lp = (long*)s;
+    while ((unsigned char*)(lp + 1) <= e)
+	*lp++ = lfill;
+    s = (unsigned char*)lp;
+    while (s < e)
+	*s++ = *fill++;
+}
+/* Just malloc()ed */
+static const unsigned char fill_feedadad[] =
+ {0xFE, 0xED, 0xAD, 0xAD, 0xFE, 0xED, 0xAD, 0xAD,
+  0xFE, 0xED, 0xAD, 0xAD, 0xFE, 0xED, 0xAD, 0xAD};
+/* Just free()ed */
+static const unsigned char fill_deadbeef[] =
+ {0xDE, 0xAD, 0xBE, 0xEF, 0xDE, 0xAD, 0xBE, 0xEF,
+  0xDE, 0xAD, 0xBE, 0xEF, 0xDE, 0xAD, 0xBE, 0xEF};
+#  define FILL_DEADBEEF(s, n)	\
+	(void)(FILL_DEAD?  (fill_pat_4bytes((s), (n), fill_deadbeef), 0) : 0)
+#  define FILL_FEEDADAD(s, n)	\
+	(void)(FILL_ALIVE? (fill_pat_4bytes((s), (n), fill_feedadad), 0) : 0)
+#else
+#  define FILL_DEADBEEF(s, n)	((void)0)
+#  define FILL_FEEDADAD(s, n)	((void)0)
+#  undef MALLOC_FILL_CHECK
+#endif
+
+#ifdef MALLOC_FILL_CHECK
+static int
+cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill)
+{
+    unsigned char *e = s + nbytes;
+    long *lp;
+    long lfill = *(long*)fill;
+
+    if (PTR2UV(s) & (sizeof(long)-1)) {		/* Align the pattern */
+	int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1));
+	unsigned const char *f = fill + sizeof(long) - shift;
+	unsigned char *e1 = s + shift;
+
+	while (s < e1)
+	    if (*s++ != *f++)
+		return 1;
+    }
+    lp = (long*)s;
+    while ((unsigned char*)(lp + 1) <= e)
+	if (*lp++ != lfill)
+	    return 1;
+    s = (unsigned char*)lp;
+    while (s < e)
+	if (*s++ != *fill++)
+	    return 1;
+    return 0;
+}
+#  define FILLCHECK_DEADBEEF(s, n)					\
+	ASSERT(!FILL_CHECK || !cmp_pat_4bytes(s, n, fill_deadbeef),	\
+	       "free()ed/realloc()ed-away memory was overwritten")
+#else
+#  define FILLCHECK_DEADBEEF(s, n)	((void)0)
+#endif
+
 Malloc_t
 Perl_malloc(register size_t nbytes)
 {
@@ -1135,6 +1476,9 @@ Perl_malloc(register size_t nbytes)
 			      PTR2UV((Malloc_t)(p + CHUNK_SHIFT)), (unsigned long)(PL_an++),
 			      (long)size));
 
+	FILLCHECK_DEADBEEF((unsigned char*)(p + CHUNK_SHIFT),
+			   BUCKET_SIZE_REAL(bucket));
+
 #ifdef IGNORE_SMALL_BAD_FREE
 	if (bucket >= FIRST_BUCKET_WITH_CHECK)
 #endif 
@@ -1161,6 +1505,7 @@ Perl_malloc(register size_t nbytes)
 	    nbytes = (nbytes + 3) &~ 3; 
 	    *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
 	}
+	FILL_FEEDADAD((unsigned char *)(p + CHUNK_SHIFT), size);
 #endif
   	return ((Malloc_t)(p + CHUNK_SHIFT));
 }
@@ -1168,7 +1513,6 @@ Perl_malloc(register size_t nbytes)
 static char *last_sbrk_top;
 static char *last_op;			/* This arena can be easily extended. */
 static MEM_SIZE sbrked_remains;
-static int sbrk_good = SBRK_ALLOW_FAILURES * SBRK_FAILURE_PRICE;
 
 #ifdef DEBUGGING_MSTATS
 static int sbrks;
@@ -1274,13 +1618,13 @@ getpages(MEM_SIZE needed, int *nblksp, i
     union overhead *ovp;
     MEM_SIZE slack = 0;
 
-    if (sbrk_good > 0) {
+    if (sbrk_goodness > 0) {
 	if (!last_sbrk_top && require < FIRST_SBRK) 
 	    require = FIRST_SBRK;
 	else if (require < MIN_SBRK) require = MIN_SBRK;
 
-	if (require < goodsbrk * MIN_SBRK_FRAC / 100)
-	    require = goodsbrk * MIN_SBRK_FRAC / 100;
+	if (require < goodsbrk * MIN_SBRK_FRAC1000 / 1000)
+	    require = goodsbrk * MIN_SBRK_FRAC1000 / 1000;
 	require = ((require - 1 + MIN_SBRK) / MIN_SBRK) * MIN_SBRK;
     } else {
 	require = needed;
@@ -1297,7 +1641,7 @@ getpages(MEM_SIZE needed, int *nblksp, i
 #endif 
     if (cp == last_sbrk_top) {
 	/* Common case, anything is fine. */
-	sbrk_good++;
+	sbrk_goodness++;
 	ovp = (union overhead *) (cp - sbrked_remains);
 	last_op = cp - sbrked_remains;
 	sbrked_remains = require - (needed - sbrked_remains);
@@ -1369,7 +1713,7 @@ getpages(MEM_SIZE needed, int *nblksp, i
 		    if (cp == (char *)-1)
 			return 0;
 		}
-		sbrk_good = -1;	/* Disable optimization!
+		sbrk_goodness = -1;	/* Disable optimization!
 				   Continue with not-aligned... */
 	    } else {
 		cp += slack;
@@ -1378,7 +1722,7 @@ getpages(MEM_SIZE needed, int *nblksp, i
 	}
 
 	if (last_sbrk_top) {
-	    sbrk_good -= SBRK_FAILURE_PRICE;
+	    sbrk_goodness -= SBRK_FAILURE_PRICE;
 	}
 
 	ovp = (union overhead *) cp;
@@ -1411,7 +1755,7 @@ getpages(MEM_SIZE needed, int *nblksp, i
 	last_op = cp;
     }
 #if !defined(PLAIN_MALLOC) && !defined(NO_FANCY_MALLOC)
-    no_mem = 0;
+    emergency_buffer_last_req = 0;
 #endif
     last_sbrk_top = cp + require;
 #ifdef DEBUGGING_MSTATS
@@ -1450,7 +1794,7 @@ getpages_adjacent(MEM_SIZE require)
 		add_to_chain((void*)(last_sbrk_top - sbrked_remains),
 			     sbrked_remains, 0);
 	    add_to_chain((void*)cp, require, 0);
-	    sbrk_good -= SBRK_FAILURE_PRICE;
+	    sbrk_goodness -= SBRK_FAILURE_PRICE;
 	    sbrked_remains = 0;
 	    last_sbrk_top = 0;
 	    last_op = 0;
@@ -1471,9 +1815,44 @@ morecore(register int bucket)
   	register int rnu;       /* 2^rnu bytes will be requested */
   	int nblks;		/* become nblks blocks of the desired size */
 	register MEM_SIZE siz, needed;
+	static int were_called = 0;
 
   	if (nextf[bucket])
   		return;
+#ifndef NO_PERL_MALLOC_ENV
+	if (!were_called) {
+	    /* It's the 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;
+		const char *opts = PERL_MALLOC_OPT_CHARS;
+		int changed = 0;
+
+		while ( t && t[0] && t[1] == '='
+			&& ((off = strchr(opts, *t))) ) {
+		    IV val = 0;
+
+		    t += 2;
+		    while (*t <= '9' && *t >= '0')
+			val = 10*val + *t++ - '0';
+		    if (!*t || *t == ';') {
+			if (MallocCfg[off - opts] != val)
+			    changed = 1;
+			MallocCfg[off - opts] = val;
+			if (*t)
+			    t++;
+		    }
+		}
+		if (t && *t) {
+		    write2("Unrecognized part of PERL_MALLOC_OPT: `");
+		    write2(t);
+		    write2("'\n");
+		}
+		if (changed)
+		    MallocCfg[MallocCfg_cfg_env_read] = 1;
+	    }
+	}
+#endif
 	if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) {
 	    MALLOC_UNLOCK;
 	    croak("%s", "Out of memory during ridiculously large request");
@@ -1518,6 +1897,7 @@ morecore(register int bucket)
 
 	if (!ovp)
 	    return;
+	FILL_DEADBEEF((unsigned char*)ovp, needed);
 
 	/*
 	 * Add new memory allocated to that on
@@ -1544,6 +1924,7 @@ morecore(register int bucket)
 	    start_slack += M_OVERHEAD * nblks;
 	}
 #endif 
+
   	while (--nblks > 0) {
 		ovp->ov_next = (union overhead *)((caddr_t)ovp + siz);
 		ovp = (union overhead *)((caddr_t)ovp + siz);
@@ -1638,7 +2019,10 @@ Perl_mfree(void *mp)
 	    }
 	    nbytes = (nbytes + 3) &~ 3; 
 	    ASSERT(*(u_int *)((caddr_t)ovp + nbytes - RSLOP) == RMAGIC, "chunk's tail overwrite");	    
+	    FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nbytes - RSLOP + sizeof(u_int)),
+			       BUCKET_SIZE_REAL(OV_INDEX(ovp)) - (nbytes - RSLOP + sizeof(u_int)));
 	}
+	FILL_DEADBEEF((unsigned char*)(ovp+1), BUCKET_SIZE_REAL(OV_INDEX(ovp)));
 	ovp->ov_rmagic = RMAGIC - 1;
 #endif
   	ASSERT(OV_INDEX(ovp) < NBUCKETS, "chunk's head overwrite");
@@ -1776,6 +2160,14 @@ Perl_realloc(void *mp, size_t nbytes)
 		       }
 		       nb = (nb + 3) &~ 3; 
 		       ASSERT(*(u_int *)((caddr_t)ovp + nb - RSLOP) == RMAGIC, "chunk's tail overwrite");
+		       FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nb - RSLOP + sizeof(u_int)),
+			       BUCKET_SIZE_REAL(OV_INDEX(ovp)) - (nb - RSLOP + sizeof(u_int)));
+		       if (nbytes > ovp->ov_size + 1 - M_OVERHEAD)
+			   FILL_FEEDADAD((unsigned char*)cp + ovp->ov_size + 1 - M_OVERHEAD,
+				     nbytes - (ovp->ov_size + 1 - M_OVERHEAD));
+		       else
+			   FILL_DEADBEEF((unsigned char*)cp + nbytes,
+					 nb - M_OVERHEAD + RSLOP - nbytes);
 			/*
 			 * Convert amount of memory requested into
 			 * closest block size stored in hash buckets
@@ -1954,7 +2346,7 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf
 	}
 	buf->total_sbrk = goodsbrk + sbrk_slack;
 	buf->sbrks = sbrks;
-	buf->sbrk_good = sbrk_good;
+	buf->sbrk_good = sbrk_goodness;
 	buf->sbrk_slack = sbrk_slack;
 	buf->start_slack = start_slack;
 	buf->sbrked_remains = sbrked_remains;
--- ./perl.h-pre-malloc	Mon Mar 31 22:47:30 2003
+++ ./perl.h	Tue Apr  1 20:05:16 2003
@@ -495,28 +495,43 @@ int usleep(unsigned int);
 #  else
 #    define EMBEDMYMALLOC	/* for compatibility */
 #  endif
-START_EXTERN_C
-Malloc_t Perl_malloc (MEM_SIZE nbytes);
-Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size);
-Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
-/* 'mfree' rather than 'free', since there is already a 'perl_free'
- * that causes clashes with case-insensitive linkers */
-Free_t   Perl_mfree (Malloc_t where);
-END_EXTERN_C
-
-typedef struct perl_mstats perl_mstats_t;
 
 #  define safemalloc  Perl_malloc
 #  define safecalloc  Perl_calloc
 #  define saferealloc Perl_realloc
 #  define safefree    Perl_mfree
+#  define CHECK_MALLOC_TOO_LATE_FOR_(code)	STMT_START {		\
+	if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read])	\
+		code;							\
+    } STMT_END
+#  define CHECK_MALLOC_TOO_LATE_FOR(ch)				\
+	CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
+#  define panic_write2(s)		write(2, s, strlen(s))
+#  define CHECK_MALLOC_TAINT(newval)				\
+	CHECK_MALLOC_TOO_LATE_FOR_(				\
+		if (newval) {					\
+		  panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
+		  exit(1); })
+extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
+#  define MALLOC_CHECK_TAINT(argc,argv,env)	STMT_START {	\
+	if (Perl_doing_taint(argc, argv, env))	{		\
+		MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1;	\
+    }} STMT_END;
 #else  /* MYMALLOC */
 #  define safemalloc  safesysmalloc
 #  define safecalloc  safesyscalloc
 #  define saferealloc safesysrealloc
 #  define safefree    safesysfree
+#  define CHECK_MALLOC_TOO_LATE_FOR(ch)		((void)0)
+#  define CHECK_MALLOC_TAINT()			((void)0)
+#  define MALLOC_CHECK_TAINT(argc,argv,env)
 #endif /* MYMALLOC */
 
+#define TOO_LATE_FOR_(ch,s)	Perl_croak(aTHX_ "Too late for \"-%c\" option%s", (char)(ch), s)
+#define TOO_LATE_FOR(ch)	TOO_LATE_FOR_(ch, "")
+#define MALLOC_TOO_LATE_FOR(ch)	TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
+#define MALLOC_CHECK_TAINT2(argc,argv)	MALLOC_CHECK_TAINT(argc,argv,)
+
 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
 #define strchr index
 #define strrchr rindex
@@ -1696,17 +1711,10 @@ int isnan(double d);
 
 #endif
 
-struct perl_mstats {
-    UV *nfree;
-    UV *ntotal;
-    IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
-    IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
-    IV minbucket;
-    /* Level 1 info */
-    UV *bucket_mem_size;
-    UV *bucket_available_size;
-    UV nbuckets;
-};
+#ifdef MYMALLOC
+#  include "malloc_ctl.h"
+#endif
+
 struct RExC_state_t;
 
 typedef MEM_SIZE STRLEN;
--- ./sv.c-pre-malloc	Thu Mar 13 13:22:36 2003
+++ ./sv.c	Fri Mar 28 16:49:26 2003
@@ -10402,6 +10402,8 @@ perl_clone_using(PerlInterpreter *proto_
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
+    PL_savestack_ix = 0;
+    PL_savestack_max = -1;
     PL_retstack = 0;
     PL_sig_pending = 0;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
@@ -10433,6 +10435,8 @@ perl_clone_using(PerlInterpreter *proto_
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
+    PL_savestack_ix = 0;
+    PL_savestack_max = -1;
     PL_retstack = 0;
     PL_sig_pending = 0;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
--- ./unixish.h-pre-malloc	Sun Mar  2 14:40:14 2003
+++ ./unixish.h	Tue Apr  1 19:54:28 2003
@@ -128,7 +128,7 @@
 #define Mkdir(path,mode)   mkdir((path),(mode))
 
 #ifndef PERL_SYS_INIT
-#  define PERL_SYS_INIT(c,v) PERL_FPU_INIT MALLOC_INIT
+#  define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT MALLOC_INIT
 #endif
 
 #ifndef PERL_SYS_TERM
--- ./vms/vmsish.h-pre-malloc	Fri Jul 19 16:50:12 2002
+++ ./vms/vmsish.h	Tue Apr  1 21:39:48 2003
@@ -328,7 +328,7 @@ struct interp_intern {
 #endif
 
 #define BIT_BUCKET "_NLA0:"
-#define PERL_SYS_INIT(c,v)	vms_image_init((c),(v)); MALLOC_INIT
+#define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); MALLOC_INIT
 #define PERL_SYS_TERM()		OP_REFCNT_TERM; MALLOC_TERM
 #define dXSUB_SYS
 #define HAS_KILL
--- ./plan9/plan9ish.h-pre-malloc	Sun Jan 26 02:42:36 2003
+++ ./plan9/plan9ish.h	Tue Apr  1 21:40:14 2003
@@ -106,7 +106,7 @@
 #define ABORT() kill(PerlProc_getpid(),SIGABRT);
 
 #define BIT_BUCKET "/dev/null"
-#define PERL_SYS_INIT(c,v)	MALLOC_INIT
+#define PERL_SYS_INIT(c,v)	MALLOC_CHECK_TAINT2(*c,*v) MALLOC_INIT
 #define dXSUB_SYS
 #define PERL_SYS_TERM()		MALLOC_TERM
 
--- ./os2/os2ish.h-pre-malloc	Tue Apr  1 19:52:38 2003
+++ ./os2/os2ish.h	Tue Apr  1 19:53:10 2003
@@ -220,6 +220,7 @@ void Perl_OS2_term(void **excH, int exit
 
 #  define PERL_SYS_INIT3(argcp, argvp, envp)	\
   { void *xreg[2];				\
+    MALLOC_CHECK_TAINT(*argcp, *argvp, *envp)	\
     _response(argcp, argvp);			\
     _wildcard(argcp, argvp);			\
     Perl_OS2_init3(*envp, xreg, 0)
--- ./epoc/epocish.h-pre-malloc	Fri Jul 19 16:49:30 2002
+++ ./epoc/epocish.h	Tue Apr  1 21:41:10 2003
@@ -108,7 +108,7 @@
 
 /* epocemx setenv bug workaround */
 #ifndef PERL_SYS_INIT
-#    define PERL_SYS_INIT(c,v)    putenv(".dummy=foo"); putenv(".dummy"); MALLOC_INIT
+#    define PERL_SYS_INIT(c,v)    MALLOC_CHECK_TAINT2(*c,*v) putenv(".dummy=foo"); putenv(".dummy"); MALLOC_INIT
 #endif
 
 #ifndef PERL_SYS_TERM
--- ./malloc_ctl.h-pre-malloc	Tue Apr  1 21:42:36 2003
+++ ./malloc_ctl.h	Tue Apr  1 17:14:00 2003
@@ -0,0 +1,57 @@
+#ifndef MALLOC_CTL_H
+#  define MALLOC_CTL_H
+
+struct perl_mstats {
+    UV *nfree;
+    UV *ntotal;
+    IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
+    IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
+    IV minbucket;
+    /* Level 1 info */
+    UV *bucket_mem_size;
+    UV *bucket_available_size;
+    UV nbuckets;
+};
+typedef struct perl_mstats perl_mstats_t;
+
+START_EXTERN_C
+Malloc_t Perl_malloc (MEM_SIZE nbytes);
+Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size);
+Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
+/* 'mfree' rather than 'free', since there is already a 'perl_free'
+ * that causes clashes with case-insensitive linkers */
+Free_t   Perl_mfree (Malloc_t where);
+END_EXTERN_C
+
+#ifndef NO_MALLOC_DYNAMIC_CFG
+
+enum {
+  MallocCfg_FIRST_SBRK,
+  MallocCfg_MIN_SBRK,
+  MallocCfg_MIN_SBRK_FRAC1000,
+  MallocCfg_SBRK_ALLOW_FAILURES,
+  MallocCfg_SBRK_FAILURE_PRICE,
+  MallocCfg_sbrk_goodness,
+
+  MallocCfg_filldead,
+  MallocCfg_fillalive,
+  MallocCfg_fillcheck,
+
+  MallocCfg_skip_cfg_env,
+  MallocCfg_cfg_env_read,
+
+
+  MallocCfg_emergency_buffer,
+  MallocCfg_emergency_buffer_size,
+  MallocCfg_emergency_buffer_last_req,
+
+  MallocCfg_emergency_buffer_prepared,
+  MallocCfg_emergency_buffer_prepared_size,
+
+  MallocCfg_last
+};
+extern IV *MallocCfg_ptr;
+
+#endif
+
+#endif

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About