+#if !defined(PACK_MALLOC) && defined(BUCKETS_ROOT2)
+# undef BUCKETS_ROOT2
+#endif
+
+#ifdef BUCKETS_ROOT2
+# define BUCKET_TABLE_SHIFT 2
+# define BUCKET_POW2_SHIFT 1
+# define BUCKETS_PER_POW2 2
+#else
+# define BUCKET_TABLE_SHIFT MIN_BUC_POW2
+# define BUCKET_POW2_SHIFT 0
+# 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] =
+ {
+ 0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80,
+ };
+# define BUCKET_SIZE(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT)))
+# define BUCKET_SIZE_REAL(i) ((i) <= MAX_BUCKET_BY_TABLE \
+ ? buck_size[i] \
+ : ((1 << ((i) >> BUCKET_POW2_SHIFT)) \
+ - MEM_OVERHEAD(i) \
+ + POW2_OPTIMIZE_SURPLUS(i)))
+#else
+# define BUCKET_SIZE(i) (1 << ((i) >> BUCKET_POW2_SHIFT))
+# define BUCKET_SIZE_REAL(i) (BUCKET_SIZE(i) - MEM_OVERHEAD(i) + POW2_OPTIMIZE_SURPLUS(i))
+#endif
+
+
+#ifdef PACK_MALLOC
+/* In this case it is assumed that if we do sbrk() in 2K units, we
+ * will get 2K aligned arenas (at least after some initial
+ * alignment). The bucket number of the given subblock is on the start
+ * of 2K arena which contains the subblock. Several following bytes
+ * contain the magic numbers for the subblocks in the block.
+ *
+ * Sizes of chunks are powers of 2 for chunks in buckets <=
+ * MAX_PACKED, after this they are (2^n - sizeof(union overhead)) (to
+ * get alignment right).
+ *
+ * Consider an arena for 2^n with n>MAX_PACKED. We suppose that
+ * starts of all the chunks in a 2K arena are in different
+ * 2^n-byte-long chunks. If the top of the last chunk is aligned on a
+ * boundary of 2K block, this means that sizeof(union
+ * overhead)*"number of chunks" < 2^n, or sizeof(union overhead)*2K <
+ * 4^n, or n > 6 + log2(sizeof()/2)/2, since a chunk of size 2^n -
+ * overhead is used. Since this rules out n = 7 for 8 byte alignment,
+ * we specialcase allocation of the first of 16 128-byte-long chunks.
+ *
+ * Note that with the above assumption we automatically have enough
+ * place for MAGIC at the start of 2K block. Note also that we
+ * overlay union overhead over the chunk, thus the start of small chunks
+ * is immediately overwritten after freeing. */
+# define MAX_PACKED_POW2 6
+# define MAX_PACKED (MAX_PACKED_POW2 * BUCKETS_PER_POW2 + BUCKET_POW2_SHIFT)
+# define MAX_POW2_ALGO ((1<<(MAX_PACKED_POW2 + 1)) - M_OVERHEAD)
+# define TWOK_MASK ((1<<LOG_OF_MIN_ARENA) - 1)
+# define TWOK_MASKED(x) ((u_bigint)(x) & ~TWOK_MASK)
+# define TWOK_SHIFT(x) ((u_bigint)(x) & TWOK_MASK)
+# define OV_INDEXp(block) ((u_char*)(TWOK_MASKED(block)))
+# define OV_INDEX(block) (*OV_INDEXp(block))
+# define OV_MAGIC(block,bucket) (*(OV_INDEXp(block) + \
+ (TWOK_SHIFT(block)>> \
+ (bucket>>BUCKET_POW2_SHIFT)) + \
+ (bucket >= MIN_NEEDS_SHIFT ? 1 : 0)))
+ /* A bucket can have a shift smaller than it size, we need to
+ shift its magic number so it will not overwrite index: */
+# ifdef BUCKETS_ROOT2
+# define MIN_NEEDS_SHIFT (7*BUCKETS_PER_POW2 - 1) /* Shift 80 greater than chunk 64. */
+# else
+# define MIN_NEEDS_SHIFT (7*BUCKETS_PER_POW2) /* Shift 128 greater than chunk 32. */
+# endif
+# define CHUNK_SHIFT 0
+
+/* Number of active buckets of given ordinal. */
+#ifdef IGNORE_SMALL_BAD_FREE
+#define FIRST_BUCKET_WITH_CHECK (6 * BUCKETS_PER_POW2) /* 64 */
+# define N_BLKS(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \
+ ? ((1<<LOG_OF_MIN_ARENA) - 1)/BUCKET_SIZE(bucket) \
+ : n_blks[bucket] )
+#else
+# define N_BLKS(bucket) n_blks[bucket]
+#endif
+
+static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
+ {
+# if BUCKETS_PER_POW2==1
+ 0, 0,
+ (MIN_BUC_POW2==2 ? 384 : 0),
+ 224, 120, 62, 31, 16, 8, 4, 2
+# else
+ 0, 0, 0, 0,
+ (MIN_BUC_POW2==2 ? 384 : 0), (MIN_BUC_POW2==2 ? 384 : 0), /* 4, 4 */
+ 224, 149, 120, 80, 62, 41, 31, 25, 16, 16, 8, 8, 4, 4, 2, 2
+# endif
+ };
+
+/* Shift of the first bucket with the given ordinal inside 2K chunk. */
+#ifdef IGNORE_SMALL_BAD_FREE
+# define BLK_SHIFT(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \
+ ? ((1<<LOG_OF_MIN_ARENA) \
+ - BUCKET_SIZE(bucket) * N_BLKS(bucket)) \
+ : blk_shift[bucket])
+#else
+# define BLK_SHIFT(bucket) blk_shift[bucket]
+#endif
+
+static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
+ {
+# if BUCKETS_PER_POW2==1
+ 0, 0,
+ (MIN_BUC_POW2==2 ? 512 : 0),
+ 256, 128, 64, 64, /* 8 to 64 */
+ 16*sizeof(union overhead),
+ 8*sizeof(union overhead),
+ 4*sizeof(union overhead),
+ 2*sizeof(union overhead),
+# else
+ 0, 0, 0, 0,
+ (MIN_BUC_POW2==2 ? 512 : 0), (MIN_BUC_POW2==2 ? 512 : 0),
+ 256, 260, 128, 128, 64, 80, 64, 48, /* 8 to 96 */
+ 16*sizeof(union overhead), 16*sizeof(union overhead),
+ 8*sizeof(union overhead), 8*sizeof(union overhead),
+ 4*sizeof(union overhead), 4*sizeof(union overhead),
+ 2*sizeof(union overhead), 2*sizeof(union overhead),
+# endif
+ };
+
+#else /* !PACK_MALLOC */
+
+# define OV_MAGIC(block,bucket) (block)->ov_magic
+# define OV_INDEX(block) (block)->ov_index
+# define CHUNK_SHIFT 1
+# define MAX_PACKED -1
+#endif /* !PACK_MALLOC */
+
+#define M_OVERHEAD (sizeof(union overhead) + RSLOP)
+
+#ifdef PACK_MALLOC
+# define MEM_OVERHEAD(bucket) \
+ (bucket <= MAX_PACKED ? 0 : M_OVERHEAD)
+# ifdef SMALL_BUCKET_VIA_TABLE
+# define START_SHIFTS_BUCKET ((MAX_PACKED_POW2 + 1) * BUCKETS_PER_POW2)
+# define START_SHIFT MAX_PACKED_POW2
+# ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */
+# define SIZE_TABLE_MAX 80
+# else
+# define SIZE_TABLE_MAX 64
+# endif
+static char bucket_of[] =
+ {
+# ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */
+ /* 0 to 15 in 4-byte increments. */
+ (sizeof(void*) > 4 ? 6 : 5), /* 4/8, 5-th bucket for better reports */
+ 6, /* 8 */
+ 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 */
+ 13, 13, 13, 13, /* 80 */
+ 13, 13, 13, 13 /* 80 */
+# else /* !BUCKETS_ROOT2 */
+ /* 0 to 15 in 4-byte increments. */
+ (sizeof(void*) > 4 ? 3 : 2),
+ 3,
+ 4, 4,
+ 5, 5, 5, 5,
+ 6, 6, 6, 6,
+ 6, 6, 6, 6
+# endif /* !BUCKETS_ROOT2 */
+ };
+# else /* !SMALL_BUCKET_VIA_TABLE */
+# define START_SHIFTS_BUCKET MIN_BUCKET
+# define START_SHIFT (MIN_BUC_POW2 - 1)
+# endif /* !SMALL_BUCKET_VIA_TABLE */
+#else /* !PACK_MALLOC */
+# define MEM_OVERHEAD(bucket) M_OVERHEAD
+# ifdef SMALL_BUCKET_VIA_TABLE
+# undef SMALL_BUCKET_VIA_TABLE
+# endif
+# define START_SHIFTS_BUCKET MIN_BUCKET
+# define START_SHIFT (MIN_BUC_POW2 - 1)
+#endif /* !PACK_MALLOC */
+
+/*
+ * Big allocations are often of the size 2^n bytes. To make them a
+ * little bit better, make blocks of size 2^n+pagesize for big n.
+ */
+
+#ifdef TWO_POT_OPTIMIZE
+
+# ifndef PERL_PAGESIZE
+# define PERL_PAGESIZE 4096
+# endif
+# ifndef FIRST_BIG_POW2
+# define FIRST_BIG_POW2 15 /* 32K, 16K is used too often. */
+# endif
+# define FIRST_BIG_BLOCK (1<<FIRST_BIG_POW2)
+/* If this value or more, check against bigger blocks. */
+# define FIRST_BIG_BOUND (FIRST_BIG_BLOCK - M_OVERHEAD)
+/* If less than this value, goes into 2^n-overhead-block. */
+# define LAST_SMALL_BOUND ((FIRST_BIG_BLOCK>>1) - M_OVERHEAD)
+
+# define POW2_OPTIMIZE_ADJUST(nbytes) \
+ ((nbytes >= FIRST_BIG_BOUND) ? nbytes -= PERL_PAGESIZE : 0)
+# define POW2_OPTIMIZE_SURPLUS(bucket) \
+ ((bucket >= FIRST_BIG_POW2 * BUCKETS_PER_POW2) ? PERL_PAGESIZE : 0)
+
+#else /* !TWO_POT_OPTIMIZE */
+# define POW2_OPTIMIZE_ADJUST(nbytes)
+# define POW2_OPTIMIZE_SURPLUS(bucket) 0
+#endif /* !TWO_POT_OPTIMIZE */
+
+#if defined(HAS_64K_LIMIT) && defined(PERL_CORE)
+# define BARK_64K_LIMIT(what,nbytes,size) \
+ if (nbytes > 0xffff) { \
+ PerlIO_printf(PerlIO_stderr(), \
+ "%s too large: %lx\n", what, size); \
+ my_exit(1); \
+ }
+#else /* !HAS_64K_LIMIT || !PERL_CORE */
+# define BARK_64K_LIMIT(what,nbytes,size)
+#endif /* !HAS_64K_LIMIT || !PERL_CORE */
+
+#ifndef MIN_SBRK
+# define MIN_SBRK 2048
+#endif
+
+#ifndef FIRST_SBRK
+# define FIRST_SBRK (48*1024)
+#endif
+
+/* Minimal sbrk in percents of what is already alloced. */
+#ifndef MIN_SBRK_FRAC
+# define MIN_SBRK_FRAC 3
+#endif
+
+#ifndef SBRK_ALLOW_FAILURES
+# define SBRK_ALLOW_FAILURES 3
+#endif
+
+#ifndef SBRK_FAILURE_PRICE
+# define SBRK_FAILURE_PRICE 50
+#endif
+
+#if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)
+
+# ifndef BIG_SIZE
+# define BIG_SIZE (1<<16) /* 64K */
+# endif
+
+static char *emergency_buffer;
+static MEM_SIZE emergency_buffer_size;
+
+static Malloc_t
+emergency_sbrk(size)
+ MEM_SIZE size;
+{
+ if (size >= BIG_SIZE) {
+ /* Give the possibility to recover: */
+ MUTEX_UNLOCK(&malloc_mutex);
+ croak("Out of memory during \"large\" request for %i bytes", 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);
+ SV *sv;
+ char *pv;
+
+ if (!gvp) gvp = (GV**)hv_fetch(defstash, "\015", 1, 0);
+ if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv)
+ || (SvLEN(sv) < (1<<LOG_OF_MIN_ARENA) - M_OVERHEAD))
+ return (char *)-1; /* Now die die die... */
+
+ /* Got it, now detach SvPV: */
+ pv = SvPV(sv, na);
+ /* Check alignment: */
+ if (((u_bigint)(pv - M_OVERHEAD)) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
+ PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
+ return (char *)-1; /* die die die */
+ }
+
+ emergency_buffer = pv - M_OVERHEAD;
+ emergency_buffer_size = SvLEN(sv) + M_OVERHEAD;
+ SvPOK_off(sv);
+ SvREADONLY_on(sv);
+ MUTEX_UNLOCK(&malloc_mutex);
+ croak("Out of memory during request for %i bytes", size);
+ }
+ else if (emergency_buffer_size >= size) {
+ emergency_buffer_size -= size;
+ return emergency_buffer + emergency_buffer_size;
+ }
+
+ return (char *)-1; /* poor guy... */
+}
+
+#else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
+# define emergency_sbrk(size) -1
+#endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
+