X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=569ac496b01b93c7ba4e6ae639044810516bb4e7;hb=62703e7218aceb3f5d30f70a2307dd02e5eb8c63;hp=e3c144957b8c6e7af7c21c53c7dbe825b90eb92d;hpb=d0bbed784b85a44e92a8a0e3d4046ce7f236db02;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/malloc.c b/malloc.c
index e3c1449..569ac49 100644
--- a/malloc.c
+++ b/malloc.c
@@ -6,6 +6,12 @@
  * "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'"
  */
 
+/* This file contains Perl's own implementation of the malloc library.
+ * It is used if Configure decides that, on your platform, Perl's
+ * version is better than the OS's, or if you give Configure the
+ * -Dusemymalloc command-line option.
+ */
+
 /*
   Here are some notes on configuring Perl's malloc.  (For non-perl
   usage see below.)
@@ -357,6 +363,7 @@
 #      define Free_t void
 #    endif
 #    define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#    define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
 #    define PerlEnv_getenv getenv
 #    define PerlIO_printf fprintf
 #    define PerlIO_stderr() stderr
@@ -566,6 +573,9 @@ union	overhead {
 	union	overhead *ov_next;	/* when free */
 #if MEM_ALIGNBYTES > 4
 	double	strut;			/* alignment problems */
+#  if MEM_ALIGNBYTES > 8
+	char	sstrut[MEM_ALIGNBYTES]; /* for the sizing */
+#  endif
 #endif
 	struct {
 /*
@@ -1065,6 +1075,12 @@ static IV MallocCfg[MallocCfg_last] = {
 };
 IV *MallocCfg_ptr = MallocCfg;
 
+static char* MallocCfgP[MallocCfg_last] = {
+  0,			/* MallocCfgP_emergency_buffer */
+  0,			/* MallocCfgP_emergency_buffer_prepared */
+};
+char **MallocCfgP_ptr = MallocCfgP;
+
 #  undef MIN_SBRK
 #  undef FIRST_SBRK
 #  undef MIN_SBRK_FRAC1000
@@ -1087,6 +1103,9 @@ IV *MallocCfg_ptr = MallocCfg;
 #  define FILL_CHECK_CFG	MallocCfg[MallocCfg_fillcheck]
 #  define FILL_CHECK		(FILL_DEAD && FILL_CHECK_CFG)
 
+#  define emergency_buffer	MallocCfgP[MallocCfgP_emergency_buffer]
+#  define emergency_buffer_prepared	MallocCfgP[MallocCfgP_emergency_buffer_prepared]
+
 #else	/* defined(NO_MALLOC_DYNAMIC_CFG) */
 
 #  define FILL_DEAD	1
@@ -1118,14 +1137,13 @@ static	u_int goodsbrk;
 #    define BIG_SIZE (1<<16)		/* 64K */
 #  endif
 
-static char *emergency_buffer;
-static char *emergency_buffer_prepared;
-
 #  ifdef NO_MALLOC_DYNAMIC_CFG
 static MEM_SIZE emergency_buffer_size;
 	/* 0 if the last request for more memory succeeded.
 	   Otherwise the size of the failing request. */
 static MEM_SIZE emergency_buffer_last_req;
+static char *emergency_buffer;
+static char *emergency_buffer_prepared;
 #  endif
 
 #  ifndef emergency_sbrk_croak
@@ -1157,7 +1175,7 @@ perl_get_emergency_buffer(IV *size)
     }
 
     SvPOK_off(sv);
-    SvPVX(sv) = Nullch;
+    SvPV_set(sv, Nullch);
     SvCUR(sv) = SvLEN(sv) = 0;
     *size = malloced_size(pv) + M_OVERHEAD;
     return pv - sizeof(union overhead);
@@ -1208,14 +1226,15 @@ emergency_sbrk(MEM_SIZE size)
     MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<<LOG_OF_MIN_ARENA;
 
     if (size >= BIG_SIZE
-	&& (!emergency_buffer_last_req || (size < emergency_buffer_last_req))) {
+	&& (!emergency_buffer_last_req ||
+	    (size < (MEM_SIZE)emergency_buffer_last_req))) {
 	/* Give the possibility to recover, but avoid an infinite cycle. */
 	MALLOC_UNLOCK;
 	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) {
+    if ((MEM_SIZE)emergency_buffer_size >= rsize) {
 	char *old = emergency_buffer;
 	
 	emergency_buffer_size -= rsize;
@@ -1282,7 +1301,7 @@ botch(char *diag, char *s, char *file, int line)
     else {
 	dTHX;
 	if (PerlIO_printf(PerlIO_stderr(),
-			  "assertion botched (%s?): %s%s %s:%d\n",
+			  "assertion botched (%s?): %s %s:%d\n",
 			  diag, s, file, line) != 0) {
 	 do_write:		/* Can be initializing interpreter */
 	    write2("assertion botched (");
@@ -1655,9 +1674,9 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket)
     MEM_SIZE slack = 0;
 
     if (sbrk_goodness > 0) {
-	if (!last_sbrk_top && require < FIRST_SBRK) 
+	if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK) 
 	    require = FIRST_SBRK;
-	else if (require < MIN_SBRK) require = MIN_SBRK;
+	else if (require < (MEM_SIZE)MIN_SBRK) require = MIN_SBRK;
 
 	if (require < goodsbrk * MIN_SBRK_FRAC1000 / 1000)
 	    require = goodsbrk * MIN_SBRK_FRAC1000 / 1000;
@@ -2300,8 +2319,7 @@ Perl_strdup(const char *s)
     MEM_SIZE l = strlen(s);
     char *s1 = (char *)Perl_malloc(l+1);
 
-    Copy(s, s1, (MEM_SIZE)(l+1), char);
-    return s1;
+    return CopyD(s, s1, (MEM_SIZE)(l+1), char);
 }
 
 #ifdef PERL_CORE