X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=e52cc0db2a3a260a036482522640d9b9ca10387a;hb=c16f2413108912acc1226c4ccb6b19c51780a92f;hp=ad6ef07f7f09ce9c9ef0349f940b2bab134e6782;hpb=87c6202a78304039fc9e5218cf4694c9f7e247f9;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/malloc.c b/malloc.c
index ad6ef07..e52cc0d 100644
--- a/malloc.c
+++ b/malloc.c
@@ -51,10 +51,17 @@
     # Use table lookup to decide in which bucket a given allocation will go.
     SMALL_BUCKET_VIA_TABLE	!NO_FANCY_MALLOC
 
-    # Use system-malloc() to emulate sbrk(). Normally only used with broken
-    # sbrk()s.
+    # Use a perl-defined sbrk() instead of the (presumably broken or
+    # missing) system-supplied sbrk().
+    USE_PERL_SBRK		undef
+
+    # Use system malloc() (or calloc() etc.) to emulate sbrk(). Normally
+    # only used with broken sbrk()s.
     PERL_SBRK_VIA_MALLOC	undef
 
+    # Which allocator to use if PERL_SBRK_VIA_MALLOC
+    SYSTEM_ALLOC(a) 		malloc(a)
+
     # Disable memory overwrite checking with DEBUGGING.  Memory and speed
     # optimization, error reporting pessimization.
     NO_RCHECK			undef
@@ -94,9 +101,6 @@
     # This many continuous sbrk()s compensate for one discontinuous one.
     SBRK_FAILURE_PRICE		50
 
-    # Which allocator to use if PERL_SBRK_VIA_MALLOC
-    SYSTEM_ALLOC(a) 		malloc(a)
-
   This implementation assumes that calling PerlIO_printf() does not
   result in any memory allocation calls (used during a panic).
 
@@ -307,6 +311,19 @@ static int findbucket _((union overhead *freep, int srchlen));
 #  define BUCKETS_PER_POW2 1
 #endif 
 
+#if !defined(MEM_ALIGNBYTES) || ((MEM_ALIGNBYTES > 4) && !defined(STRICT_ALIGNMENT))
+/* Figure out the alignment of void*. */
+struct aligner {
+  char c;
+  void *p;
+};
+#  define ALIGN_SMALL ((int)((caddr_t)&(((struct aligner*)0)->p)))
+#else
+#  define ALIGN_SMALL MEM_ALIGNBYTES
+#endif
+
+#define IF_ALIGN_8(yes,no)	((ALIGN_SMALL>4) ? (yes) : (no))
+
 #ifdef BUCKETS_ROOT2
 #  define MAX_BUCKET_BY_TABLE 13
 static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = 
@@ -451,7 +468,7 @@ static char bucket_of[] =
       /* 0 to 15 in 4-byte increments. */
       (sizeof(void*) > 4 ? 6 : 5),	/* 4/8, 5-th bucket for better reports */
       6,				/* 8 */
-      7, 8,				/* 12, 16 */
+      IF_ALIGN_8(8,7), 8,		/* 16/12, 16 */
       9, 9, 10, 10,			/* 24, 32 */
       11, 11, 11, 11,			/* 48 */
       12, 12, 12, 12,			/* 64 */
@@ -718,8 +735,8 @@ malloc(register size_t nbytes)
 			      (long)size));
 
 	/* remove from linked list */
-#ifdef RCHECK
-	if (*((int*)p) & (sizeof(union overhead) - 1))
+#if defined(RCHECK)
+	if (((UV)p) & (MEM_ALIGNBYTES - 1))
 	    PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n",
 		(unsigned long)*((int*)p),(unsigned long)p);
 #endif
@@ -1417,8 +1434,18 @@ calloc(register size_t elements, register size_t size)
 MEM_SIZE
 malloced_size(void *p)
 {
-    int bucket = OV_INDEX((union overhead *)p);
-
+    union overhead *ovp = (union overhead *)
+	((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT);
+    int bucket = OV_INDEX(ovp);
+#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);
+	ovp->ov_size = size + M_OVERHEAD - 1;
+	*((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RSLOP)) = RMAGIC;
+    }
+#endif
     return BUCKET_SIZE_REAL(bucket);
 }
 
@@ -1523,9 +1550,27 @@ dump_mstats(char *s)
 #      define PERL_SBRK_VIA_MALLOC
 #   endif
 
+#   ifdef __MACHTEN_PPC__
+#      define PERL_SBRK_VIA_MALLOC
+/*
+ * MachTen's malloc() returns a buffer aligned on a two-byte boundary.
+ * While this is adequate, it may slow down access to longer data
+ * types by forcing multiple memory accesses.  It also causes
+ * complaints when RCHECK is in force.  So we allocate six bytes
+ * more than we need to, and return an address rounded up to an
+ * eight-byte boundary.
+ *
+ * 980701 Dominic Dunlop <domo@computer.org>
+ */
+#      define SYSTEM_ALLOC(a) ((void *)(((unsigned)malloc((a)+6)+6)&~7))
+#   endif
+
 #   ifdef PERL_SBRK_VIA_MALLOC
 #      if defined(HIDEMYMALLOC) || defined(EMBEDMYMALLOC)
-#         undef malloc
+#         undef malloc		/* Expose names that  */
+#         undef calloc		/* HIDEMYMALLOC hides */
+#         undef realloc
+#         undef free
 #      else
 #         include "Error: -DPERL_SBRK_VIA_MALLOC needs -D(HIDE|EMBED)MYMALLOC"
 #      endif
@@ -1535,7 +1580,9 @@ dump_mstats(char *s)
 /* frequent core dumps within nxzonefreenolock. This sbrk routine put an */
 /* end to the cores */
 
-#      define SYSTEM_ALLOC(a) malloc(a)
+#      ifndef SYSTEM_ALLOC
+#         define SYSTEM_ALLOC(a) malloc(a)
+#      endif
 
 #   endif  /* PERL_SBRK_VIA_MALLOC */