1 /* $NetBSD: jemalloc.c,v 1.38 2015/07/26 17:21:55 martin Exp $ */
4 * Copyright (C) 2006,2007 Jason Evans <jasone@FreeBSD.org>.
7 * Redistribution and use in source and binary forms, with or without
8 * modification, are permitted provided that the following conditions
10 * 1. Redistributions of source code must retain the above copyright
11 * notice(s), this list of conditions and the following disclaimer as
12 * the first lines of this file unmodified other than the possible
13 * addition of one or more copyright notices.
14 * 2. Redistributions in binary form must reproduce the above copyright
15 * notice(s), this list of conditions and the following disclaimer in
16 * the documentation and/or other materials provided with the
19 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER(S) ``AS IS'' AND ANY
20 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
22 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER(S) BE
23 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
26 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
27 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
28 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
29 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 *******************************************************************************
33 * This allocator implementation is designed to provide scalable performance
34 * for multi-threaded programs on multi-processor systems. The following
35 * features are included for this purpose:
37 * + Multiple arenas are used if there are multiple CPUs, which reduces lock
38 * contention and cache sloshing.
40 * + Cache line sharing between arenas is avoided for internal data
43 * + Memory is managed in chunks and runs (chunks can be split into runs),
44 * rather than as individual pages. This provides a constant-time
45 * mechanism for associating allocations with particular arenas.
47 * Allocation requests are rounded up to the nearest size class, and no record
48 * of the original request size is maintained. Allocations are broken into
49 * categories according to size class. Assuming runtime defaults, 4 kB pages
50 * and a 16 byte quantum, the size classes in each category are as follows:
52 * |=====================================|
53 * | Category | Subcategory | Size |
54 * |=====================================|
55 * | Small | Tiny | 2 |
58 * | |----------------+---------|
59 * | | Quantum-spaced | 16 |
66 * | |----------------+---------|
67 * | | Sub-page | 1 kB |
69 * |=====================================|
77 * |=====================================|
82 * |=====================================|
84 * A different mechanism is used for each category:
86 * Small : Each size class is segregated into its own set of runs. Each run
87 * maintains a bitmap of which regions are free/allocated.
89 * Large : Each allocation is backed by a dedicated run. Metadata are stored
90 * in the associated arena chunk header maps.
92 * Huge : Each allocation is backed by a dedicated contiguous set of chunks.
93 * Metadata are stored in a separate red-black tree.
95 *******************************************************************************
100 #if defined(__NetBSD__) || defined(__minix)
101 # define xutrace(a, b) utrace("malloc", (a), (b))
102 # define __DECONST(x, y) ((x)__UNCONST(y))
105 # define xutrace(a, b) utrace((a), (b))
106 #endif /* __NetBSD__ */
109 * MALLOC_PRODUCTION disables assertions and statistics gathering. It also
110 * defaults the A and J runtime options to off. These settings are appropriate
111 * for production systems.
113 #define MALLOC_PRODUCTION
115 #ifndef MALLOC_PRODUCTION
116 # define MALLOC_DEBUG
119 #include <sys/cdefs.h>
120 /* __FBSDID("$FreeBSD: src/lib/libc/stdlib/malloc.c,v 1.147 2007/06/15 22:00:16 jasone Exp $"); */
121 __RCSID("$NetBSD: jemalloc.c,v 1.38 2015/07/26 17:21:55 martin Exp $");
124 #include "libc_private.h"
128 #include "spinlock.h"
130 #include "namespace.h"
131 #include <sys/mman.h>
132 #include <sys/param.h>
134 #include <sys/stddef.h>
136 #include <sys/time.h>
137 #include <sys/types.h>
138 #include <sys/sysctl.h>
139 #include <sys/tree.h>
141 #include <sys/ktrace.h> /* Must come after several other sys/ includes. */
144 #include <machine/atomic.h>
145 #include <machine/cpufunc.h>
147 #include <machine/vmparam.h>
163 # include <reentrant.h>
166 #define STRERROR_R(a, b, c) __strerror_r(a, b, c);
168 * A non localized version of strerror, that avoids bringing in
169 * stdio and the locale code. All the malloc messages are in English
173 __strerror_r(int e
, char *s
, size_t l
)
178 if (e
>= 0 && e
< sys_nerr
) {
179 slen
= strlcpy(s
, sys_errlist
[e
], l
);
182 slen
= snprintf_ss(s
, l
, "Unknown error %u", e
);
185 return slen
>= l
? ERANGE
: rval
;
190 #define STRERROR_R(a, b, c) strerror_r(a, b, c);
191 #include "un-namespace.h"
194 /* MALLOC_STATS enables statistics calculation. */
195 #ifndef MALLOC_PRODUCTION
196 # define MALLOC_STATS
211 /* Disable inlining to make debugging easier. */
215 /* Size of stack-allocated buffer passed to strerror_r(). */
216 #define STRERROR_BUF 64
218 /* Minimum alignment of allocations is 2^QUANTUM_2POW_MIN bytes. */
221 * If you touch the TINY_MIN_2POW definition for any architecture, please
222 * make sure to adjust the corresponding definition for JEMALLOC_TINY_MIN_2POW
223 * in the gcc 4.8 tree in dist/gcc/tree-ssa-ccp.c and verify that a native
224 * gcc is still buildable!
228 # define QUANTUM_2POW_MIN 4
229 # define SIZEOF_PTR_2POW 2
233 # define QUANTUM_2POW_MIN 4
234 # define SIZEOF_PTR_2POW 3
237 # define QUANTUM_2POW_MIN 4
238 # define SIZEOF_PTR_2POW 3
242 # define QUANTUM_2POW_MIN 4
243 # define SIZEOF_PTR_2POW 3
244 # define TINY_MIN_2POW 3
248 # define QUANTUM_2POW_MIN 4
249 # define SIZEOF_PTR_2POW 3
250 # define TINY_MIN_2POW 3
254 # define QUANTUM_2POW_MIN 4
255 # define SIZEOF_PTR_2POW 3
256 # define TINY_MIN_2POW 3
259 # define QUANTUM_2POW_MIN 3
260 # define SIZEOF_PTR_2POW 2
263 # define TINY_MIN_2POW 3
268 # define QUANTUM_2POW_MIN 4
269 # define SIZEOF_PTR_2POW 2
271 # define TINY_MIN_2POW 3
273 #if defined(__sparc__) && !defined(__sparc64__)
274 # define QUANTUM_2POW_MIN 4
275 # define SIZEOF_PTR_2POW 2
279 # define QUANTUM_2POW_MIN 4
280 # define SIZEOF_PTR_2POW 2
284 # define QUANTUM_2POW_MIN 4
285 # define SIZEOF_PTR_2POW 2
289 # define QUANTUM_2POW_MIN 4
290 # define SIZEOF_PTR_2POW 2
294 # define QUANTUM_2POW_MIN 4
295 # define SIZEOF_PTR_2POW 2
298 #if defined(__mips__) || defined(__riscv__)
300 # define SIZEOF_PTR_2POW 3
301 # define TINY_MIN_2POW 3
303 # define SIZEOF_PTR_2POW 2
305 # define QUANTUM_2POW_MIN 4
309 # define QUANTUM_2POW_MIN 4
310 # define SIZEOF_PTR_2POW 2
314 #define SIZEOF_PTR (1 << SIZEOF_PTR_2POW)
316 /* sizeof(int) == (1 << SIZEOF_INT_2POW). */
317 #ifndef SIZEOF_INT_2POW
318 # define SIZEOF_INT_2POW 2
322 * Size and alignment of memory chunks that are allocated by the OS's virtual
325 #define CHUNK_2POW_DEFAULT 20
328 * Maximum size of L1 cache line. This is used to avoid cache line aliasing,
329 * so over-estimates are okay (up to a point), but under-estimates will
330 * negatively affect performance.
332 #define CACHELINE_2POW 6
333 #define CACHELINE ((size_t)(1 << CACHELINE_2POW))
335 /* Smallest size class to support. */
336 #ifndef TINY_MIN_2POW
337 #define TINY_MIN_2POW 2
341 * Maximum size class that is a multiple of the quantum, but not (necessarily)
342 * a power of 2. Above this size, allocations are rounded up to the nearest
345 #define SMALL_MAX_2POW_DEFAULT 9
346 #define SMALL_MAX_DEFAULT (1 << SMALL_MAX_2POW_DEFAULT)
349 * RUN_MAX_OVRHD indicates maximum desired run header overhead. Runs are sized
350 * as small as possible such that this setting is still honored, without
351 * violating other constraints. The goal is to make runs as small as possible
352 * without exceeding a per run external fragmentation threshold.
354 * We use binary fixed point math for overhead computations, where the binary
355 * point is implicitly RUN_BFP bits to the left.
357 * Note that it is possible to set RUN_MAX_OVRHD low enough that it cannot be
358 * honored for some/all object sizes, since there is one bit of header overhead
359 * per object (plus a constant). This constraint is relaxed (ignored) for runs
360 * that are so small that the per-region overhead is greater than:
362 * (RUN_MAX_OVRHD / (reg_size << (3+RUN_BFP))
365 /* \/ Implicit binary fixed point. */
366 #define RUN_MAX_OVRHD 0x0000003dU
367 #define RUN_MAX_OVRHD_RELAX 0x00001800U
369 /* Put a cap on small object run size. This overrides RUN_MAX_OVRHD. */
370 #define RUN_MAX_SMALL_2POW 15
371 #define RUN_MAX_SMALL (1 << RUN_MAX_SMALL_2POW)
373 /******************************************************************************/
377 * Mutexes based on spinlocks. We can't use normal pthread mutexes, because
378 * they require malloc()ed memory.
384 /* Set to true once the allocator has been initialized. */
385 static bool malloc_initialized
= false;
387 /* Used to avoid initialization races. */
388 static malloc_mutex_t init_lock
= {_SPINLOCK_INITIALIZER
};
390 #define malloc_mutex_t mutex_t
392 /* Set to true once the allocator has been initialized. */
393 static bool malloc_initialized
= false;
396 /* Used to avoid initialization races. */
397 static mutex_t init_lock
= MUTEX_INITIALIZER
;
401 /******************************************************************************/
403 * Statistics data structures.
408 typedef struct malloc_bin_stats_s malloc_bin_stats_t
;
409 struct malloc_bin_stats_s
{
411 * Number of allocation requests that corresponded to the size of this
416 /* Total number of runs created for this bin's size class. */
420 * Total number of runs reused by extracting them from the runs tree for
421 * this bin's size class.
425 /* High-water mark for this bin. */
426 unsigned long highruns
;
428 /* Current number of runs in this bin. */
429 unsigned long curruns
;
432 typedef struct arena_stats_s arena_stats_t
;
433 struct arena_stats_s
{
434 /* Number of bytes currently mapped. */
437 /* Per-size-category statistics. */
438 size_t allocated_small
;
439 uint64_t nmalloc_small
;
440 uint64_t ndalloc_small
;
442 size_t allocated_large
;
443 uint64_t nmalloc_large
;
444 uint64_t ndalloc_large
;
447 typedef struct chunk_stats_s chunk_stats_t
;
448 struct chunk_stats_s
{
449 /* Number of chunks that were allocated. */
452 /* High-water mark for number of chunks allocated. */
453 unsigned long highchunks
;
456 * Current number of chunks allocated. This value isn't maintained for
457 * any other purpose, so keep track of it in order to be able to set
460 unsigned long curchunks
;
463 #endif /* #ifdef MALLOC_STATS */
465 /******************************************************************************/
467 * Chunk data structures.
470 /* Tree of chunks. */
471 typedef struct chunk_node_s chunk_node_t
;
472 struct chunk_node_s
{
473 /* Linkage for the chunk tree. */
474 RB_ENTRY(chunk_node_s
) link
;
477 * Pointer to the chunk that this tree node is responsible for. In some
478 * (but certainly not all) cases, this data structure is placed at the
479 * beginning of the corresponding chunk, so this field may point to this
484 /* Total chunk size. */
487 typedef struct chunk_tree_s chunk_tree_t
;
488 RB_HEAD(chunk_tree_s
, chunk_node_s
);
490 /******************************************************************************/
492 * Arena data structures.
495 typedef struct arena_s arena_t
;
496 typedef struct arena_bin_s arena_bin_t
;
498 typedef struct arena_chunk_map_s arena_chunk_map_t
;
499 struct arena_chunk_map_s
{
500 /* Number of pages in run. */
503 * Position within run. For a free run, this is POS_FREE for the first
504 * and last pages. The POS_FREE special value makes it possible to
505 * quickly coalesce free runs.
507 * This is the limiting factor for chunksize; there can be at most 2^31
510 #define POS_FREE ((uint32_t)0xffffffffU)
514 /* Arena chunk header. */
515 typedef struct arena_chunk_s arena_chunk_t
;
516 struct arena_chunk_s
{
517 /* Arena that owns the chunk. */
520 /* Linkage for the arena's chunk tree. */
521 RB_ENTRY(arena_chunk_s
) link
;
524 * Number of pages in use. This is maintained in order to make
525 * detection of empty chunks fast.
530 * Every time a free run larger than this value is created/coalesced,
531 * this value is increased. The only way that the value decreases is if
532 * arena_run_alloc() fails to find a free run as large as advertised by
535 uint32_t max_frun_npages
;
538 * Every time a free run that starts at an earlier page than this value
539 * is created/coalesced, this value is decreased. It is reset in a
540 * similar fashion to max_frun_npages.
542 uint32_t min_frun_ind
;
545 * Map of pages within chunk that keeps track of free/large/small. For
546 * free runs, only the map entries for the first and last pages are
547 * kept up to date, so that free runs can be quickly coalesced.
549 arena_chunk_map_t map
[1]; /* Dynamically sized. */
551 typedef struct arena_chunk_tree_s arena_chunk_tree_t
;
552 RB_HEAD(arena_chunk_tree_s
, arena_chunk_s
);
554 typedef struct arena_run_s arena_run_t
;
556 /* Linkage for run trees. */
557 RB_ENTRY(arena_run_s
) link
;
561 # define ARENA_RUN_MAGIC 0x384adf93
564 /* Bin this run is associated with. */
567 /* Index of first element that might have a free region. */
568 unsigned regs_minelm
;
570 /* Number of free regions in run. */
573 /* Bitmask of in-use regions (0: in use, 1: free). */
574 unsigned regs_mask
[1]; /* Dynamically sized. */
576 typedef struct arena_run_tree_s arena_run_tree_t
;
577 RB_HEAD(arena_run_tree_s
, arena_run_s
);
581 * Current run being used to service allocations of this bin's size
587 * Tree of non-full runs. This tree is used when looking for an
588 * existing run when runcur is no longer usable. We choose the
589 * non-full run that is lowest in memory; this policy tends to keep
590 * objects packed well, and it can also help reduce the number of
591 * almost-empty chunks.
593 arena_run_tree_t runs
;
595 /* Size of regions in a run for this bin's size class. */
598 /* Total size of a run for this bin's size class. */
601 /* Total number of regions in a run for this bin's size class. */
604 /* Number of elements in a run's regs_mask for this bin's size class. */
605 uint32_t regs_mask_nelms
;
607 /* Offset of first region in a run for this bin's size class. */
608 uint32_t reg0_offset
;
611 /* Bin statistics. */
612 malloc_bin_stats_t stats
;
619 # define ARENA_MAGIC 0x947d3d24
622 /* All operations on this arena require that mtx be locked. */
630 * Tree of chunks this arena manages.
632 arena_chunk_tree_t chunks
;
635 * In order to avoid rapid chunk allocation/deallocation when an arena
636 * oscillates right on the cusp of needing a new chunk, cache the most
637 * recently freed chunk. This caching is disabled by opt_hint.
639 * There is one spare chunk per arena, rather than one spare total, in
640 * order to avoid interactions between multiple threads that could make
641 * a single spare inadequate.
643 arena_chunk_t
*spare
;
646 * bins is used to store rings of free regions of the following sizes,
647 * assuming a 16-byte quantum, 4kB pagesize, and default MALLOC_OPTIONS.
668 arena_bin_t bins
[1]; /* Dynamically sized. */
671 /******************************************************************************/
676 /* Number of CPUs. */
677 static unsigned ncpus
;
680 static size_t pagesize
;
681 static size_t pagesize_mask
;
682 static int pagesize_2pow
;
684 /* Various bin-related settings. */
685 static size_t bin_maxclass
; /* Max size class for bins. */
686 static unsigned ntbins
; /* Number of (2^n)-spaced tiny bins. */
687 static unsigned nqbins
; /* Number of quantum-spaced bins. */
688 static unsigned nsbins
; /* Number of (2^n)-spaced sub-page bins. */
689 static size_t small_min
;
690 static size_t small_max
;
692 /* Various quantum-related settings. */
693 static size_t quantum
;
694 static size_t quantum_mask
; /* (quantum - 1). */
696 /* Various chunk-related settings. */
697 static size_t chunksize
;
698 static size_t chunksize_mask
; /* (chunksize - 1). */
699 static int chunksize_2pow
;
700 static unsigned chunk_npages
;
701 static unsigned arena_chunk_header_npages
;
702 static size_t arena_maxclass
; /* Max size class for arenas. */
710 /* Protects chunk-related data structures. */
711 static malloc_mutex_t chunks_mtx
;
714 /* Tree of chunks that are stand-alone huge allocations. */
715 static chunk_tree_t huge
;
719 * Try to use brk for chunk-size allocations, due to address space constraints.
722 * Protects sbrk() calls. This must be separate from chunks_mtx, since
723 * base_pages_alloc() also uses sbrk(), but cannot lock chunks_mtx (doing so
724 * could cause recursive lock acquisition).
726 static malloc_mutex_t brk_mtx
;
727 /* Result of first sbrk(0) call. */
728 static void *brk_base
;
729 /* Current end of brk, or ((void *)-1) if brk is exhausted. */
730 static void *brk_prev
;
731 /* Current upper limit on brk addresses. */
732 static void *brk_max
;
736 /* Huge allocation statistics. */
737 static uint64_t huge_nmalloc
;
738 static uint64_t huge_ndalloc
;
739 static uint64_t huge_nralloc
;
740 static size_t huge_allocated
;
744 * Tree of chunks that were previously allocated. This is used when allocating
745 * chunks, in an attempt to re-use address space.
747 static chunk_tree_t old_chunks
;
749 /****************************/
751 * base (internal allocation).
755 * Current pages that are being used for internal memory allocations. These
756 * pages are carved up in cacheline-size quanta, so that there is no chance of
757 * false cache line sharing.
759 static void *base_pages
;
760 static void *base_next_addr
;
761 static void *base_past_addr
; /* Addr immediately past base_pages. */
762 static chunk_node_t
*base_chunk_nodes
; /* LIFO cache of chunk nodes. */
764 static malloc_mutex_t base_mtx
;
767 static size_t base_mapped
;
776 * Arenas that are used to service external requests. Not all elements of the
777 * arenas array are necessarily used; arenas are created lazily as needed.
779 static arena_t
**arenas
;
780 static unsigned narenas
;
781 static unsigned next_arena
;
783 static malloc_mutex_t arenas_mtx
; /* Protects arenas initialization. */
787 * Map of pthread_self() --> arenas[???], used for selecting an arena to use
791 static __thread arena_t
**arenas_map
;
793 static arena_t
**arenas_map
;
796 #if !defined(NO_TLS) || !defined(_REENTRANT)
797 # define get_arenas_map() (arenas_map)
798 # define set_arenas_map(x) (arenas_map = x)
801 static thread_key_t arenas_map_key
= -1;
803 static inline arena_t
**
809 if (arenas_map_key
== -1) {
810 (void)thr_keycreate(&arenas_map_key
, NULL
);
811 if (arenas_map
!= NULL
) {
812 thr_setspecific(arenas_map_key
, arenas_map
);
817 return thr_getspecific(arenas_map_key
);
821 set_arenas_map(arena_t
**a
)
828 if (arenas_map_key
== -1) {
829 (void)thr_keycreate(&arenas_map_key
, NULL
);
830 if (arenas_map
!= NULL
) {
831 _DIAGASSERT(arenas_map
== a
);
836 thr_setspecific(arenas_map_key
, a
);
841 /* Chunk statistics. */
842 static chunk_stats_t stats_chunks
;
845 /*******************************/
847 * Runtime configuration options.
849 const char *_malloc_options
;
851 #ifndef MALLOC_PRODUCTION
852 static bool opt_abort
= true;
853 static bool opt_junk
= true;
855 static bool opt_abort
= false;
856 static bool opt_junk
= false;
858 static bool opt_hint
= false;
859 static bool opt_print_stats
= false;
860 static int opt_quantum_2pow
= QUANTUM_2POW_MIN
;
861 static int opt_small_max_2pow
= SMALL_MAX_2POW_DEFAULT
;
862 static int opt_chunk_2pow
= CHUNK_2POW_DEFAULT
;
863 static bool opt_utrace
= false;
864 static bool opt_sysv
= false;
865 static bool opt_xmalloc
= false;
866 static bool opt_zero
= false;
867 static int32_t opt_narenas_lshift
= 0;
875 #define UTRACE(a, b, c) \
877 malloc_utrace_t ut; \
881 xutrace(&ut, sizeof(ut)); \
884 /******************************************************************************/
886 * Begin function prototypes for non-inline static functions.
889 static void wrtmessage(const char *p1
, const char *p2
, const char *p3
,
892 static void malloc_printf(const char *format
, ...);
894 static char *size_t2s(size_t x
, char *s
);
895 static bool base_pages_alloc(size_t minsize
);
896 static void *base_alloc(size_t size
);
897 static chunk_node_t
*base_chunk_node_alloc(void);
898 static void base_chunk_node_dealloc(chunk_node_t
*node
);
900 static void stats_print(arena_t
*arena
);
902 static void *pages_map(void *addr
, size_t size
);
903 static void *pages_map_align(void *addr
, size_t size
, int align
);
904 static void pages_unmap(void *addr
, size_t size
);
905 static void *chunk_alloc(size_t size
);
906 static void chunk_dealloc(void *chunk
, size_t size
);
907 static void arena_run_split(arena_t
*arena
, arena_run_t
*run
, size_t size
);
908 static arena_chunk_t
*arena_chunk_alloc(arena_t
*arena
);
909 static void arena_chunk_dealloc(arena_t
*arena
, arena_chunk_t
*chunk
);
910 static arena_run_t
*arena_run_alloc(arena_t
*arena
, size_t size
);
911 static void arena_run_dalloc(arena_t
*arena
, arena_run_t
*run
, size_t size
);
912 static arena_run_t
*arena_bin_nonfull_run_get(arena_t
*arena
, arena_bin_t
*bin
);
913 static void *arena_bin_malloc_hard(arena_t
*arena
, arena_bin_t
*bin
);
914 static size_t arena_bin_run_size_calc(arena_bin_t
*bin
, size_t min_run_size
);
915 static void *arena_malloc(arena_t
*arena
, size_t size
);
916 static void *arena_palloc(arena_t
*arena
, size_t alignment
, size_t size
,
918 static size_t arena_salloc(const void *ptr
);
919 static void *arena_ralloc(void *ptr
, size_t size
, size_t oldsize
);
920 static void arena_dalloc(arena_t
*arena
, arena_chunk_t
*chunk
, void *ptr
);
921 static bool arena_new(arena_t
*arena
);
922 static arena_t
*arenas_extend(unsigned ind
);
923 static void *huge_malloc(size_t size
);
924 static void *huge_palloc(size_t alignment
, size_t size
);
925 static void *huge_ralloc(void *ptr
, size_t size
, size_t oldsize
);
926 static void huge_dalloc(void *ptr
);
927 static void *imalloc(size_t size
);
928 static void *ipalloc(size_t alignment
, size_t size
);
929 static void *icalloc(size_t size
);
930 static size_t isalloc(const void *ptr
);
931 static void *iralloc(void *ptr
, size_t size
);
932 static void idalloc(void *ptr
);
933 static void malloc_print_stats(void);
934 static bool malloc_init_hard(void);
937 * End function prototypes.
939 /******************************************************************************/
945 #define malloc_mutex_init(m) mutex_init(m, NULL)
946 #define malloc_mutex_lock(m) mutex_lock(m)
947 #define malloc_mutex_unlock(m) mutex_unlock(m)
948 #else /* __NetBSD__ */
950 malloc_mutex_init(malloc_mutex_t
*a_mutex
)
952 static const spinlock_t lock
= _SPINLOCK_INITIALIZER
;
954 a_mutex
->lock
= lock
;
958 malloc_mutex_lock(malloc_mutex_t
*a_mutex
)
962 _SPINLOCK(&a_mutex
->lock
);
966 malloc_mutex_unlock(malloc_mutex_t
*a_mutex
)
970 _SPINUNLOCK(&a_mutex
->lock
);
972 #endif /* __NetBSD__ */
977 /******************************************************************************/
979 * Begin Utility functions/macros.
982 /* Return the chunk address for allocation address a. */
983 #define CHUNK_ADDR2BASE(a) \
984 ((void *)((uintptr_t)(a) & ~chunksize_mask))
986 /* Return the chunk offset of address a. */
987 #define CHUNK_ADDR2OFFSET(a) \
988 ((size_t)((uintptr_t)(a) & chunksize_mask))
990 /* Return the smallest chunk multiple that is >= s. */
991 #define CHUNK_CEILING(s) \
992 (((s) + chunksize_mask) & ~chunksize_mask)
994 /* Return the smallest cacheline multiple that is >= s. */
995 #define CACHELINE_CEILING(s) \
996 (((s) + (CACHELINE - 1)) & ~(CACHELINE - 1))
998 /* Return the smallest quantum multiple that is >= a. */
999 #define QUANTUM_CEILING(a) \
1000 (((a) + quantum_mask) & ~quantum_mask)
1002 /* Return the smallest pagesize multiple that is >= s. */
1003 #define PAGE_CEILING(s) \
1004 (((s) + pagesize_mask) & ~pagesize_mask)
1006 /* Compute the smallest power of 2 that is >= x. */
1007 static inline size_t
1017 #if (SIZEOF_PTR == 8)
1025 wrtmessage(const char *p1
, const char *p2
, const char *p3
, const char *p4
)
1028 write(STDERR_FILENO
, p1
, strlen(p1
));
1029 write(STDERR_FILENO
, p2
, strlen(p2
));
1030 write(STDERR_FILENO
, p3
, strlen(p3
));
1031 write(STDERR_FILENO
, p4
, strlen(p4
));
1034 void (*_malloc_message
)(const char *p1
, const char *p2
, const char *p3
,
1035 const char *p4
) = wrtmessage
;
1039 * Print to stderr in such a way as to (hopefully) avoid memory allocation.
1042 malloc_printf(const char *format
, ...)
1047 va_start(ap
, format
);
1048 vsnprintf(buf
, sizeof(buf
), format
, ap
);
1050 _malloc_message(buf
, "", "", "");
1055 * We don't want to depend on vsnprintf() for production builds, since that can
1056 * cause unnecessary bloat for static binaries. size_t2s() provides minimal
1057 * integer printing functionality, so that malloc_printf() use can be limited to
1058 * MALLOC_STATS code.
1060 #define UMAX2S_BUFSIZE 21
1062 size_t2s(size_t x
, char *s
)
1066 /* Make sure UMAX2S_BUFSIZE is large enough. */
1068 assert(sizeof(size_t) <= 8);
1070 i
= UMAX2S_BUFSIZE
- 1;
1074 s
[i
] = "0123456789"[(int)x
% 10];
1075 x
/= (uintmax_t)10LL;
1081 /******************************************************************************/
1084 base_pages_alloc(size_t minsize
)
1090 * Do special brk allocation here, since base allocations don't need to
1093 if (brk_prev
!= (void *)-1) {
1098 csize
= CHUNK_CEILING(minsize
);
1100 malloc_mutex_lock(&brk_mtx
);
1102 /* Get the current end of brk. */
1106 * Calculate how much padding is necessary to
1107 * chunk-align the end of brk. Don't worry about
1108 * brk_cur not being chunk-aligned though.
1110 incr
= (intptr_t)chunksize
1111 - (intptr_t)CHUNK_ADDR2OFFSET(brk_cur
);
1113 if ((size_t)incr
< minsize
)
1116 brk_prev
= sbrk(incr
);
1117 if (brk_prev
== brk_cur
) {
1119 malloc_mutex_unlock(&brk_mtx
);
1120 base_pages
= brk_cur
;
1121 base_next_addr
= base_pages
;
1122 base_past_addr
= (void *)((uintptr_t)base_pages
1125 base_mapped
+= incr
;
1129 } while (brk_prev
!= (void *)-1);
1130 malloc_mutex_unlock(&brk_mtx
);
1134 * Failure during initialization doesn't matter, so avoid
1135 * falling through to the mmap-based page mapping code.
1140 assert(minsize
!= 0);
1141 csize
= PAGE_CEILING(minsize
);
1142 base_pages
= pages_map(NULL
, csize
);
1143 if (base_pages
== NULL
)
1145 base_next_addr
= base_pages
;
1146 base_past_addr
= (void *)((uintptr_t)base_pages
+ csize
);
1148 base_mapped
+= csize
;
1154 base_alloc(size_t size
)
1159 /* Round size up to nearest multiple of the cacheline size. */
1160 csize
= CACHELINE_CEILING(size
);
1162 malloc_mutex_lock(&base_mtx
);
1164 /* Make sure there's enough space for the allocation. */
1165 if ((uintptr_t)base_next_addr
+ csize
> (uintptr_t)base_past_addr
) {
1166 if (base_pages_alloc(csize
)) {
1173 ret
= base_next_addr
;
1174 base_next_addr
= (void *)((uintptr_t)base_next_addr
+ csize
);
1177 malloc_mutex_unlock(&base_mtx
);
1181 static chunk_node_t
*
1182 base_chunk_node_alloc(void)
1186 malloc_mutex_lock(&base_mtx
);
1187 if (base_chunk_nodes
!= NULL
) {
1188 ret
= base_chunk_nodes
;
1190 base_chunk_nodes
= *(chunk_node_t
**)ret
;
1191 malloc_mutex_unlock(&base_mtx
);
1193 malloc_mutex_unlock(&base_mtx
);
1194 ret
= (chunk_node_t
*)base_alloc(sizeof(chunk_node_t
));
1201 base_chunk_node_dealloc(chunk_node_t
*node
)
1204 malloc_mutex_lock(&base_mtx
);
1206 *(chunk_node_t
**)node
= base_chunk_nodes
;
1207 base_chunk_nodes
= node
;
1208 malloc_mutex_unlock(&base_mtx
);
1211 /******************************************************************************/
1215 stats_print(arena_t
*arena
)
1221 " allocated/mapped nmalloc ndalloc\n");
1223 malloc_printf("small: %12zu %-12s %12llu %12llu\n",
1224 arena
->stats
.allocated_small
, "", arena
->stats
.nmalloc_small
,
1225 arena
->stats
.ndalloc_small
);
1226 malloc_printf("large: %12zu %-12s %12llu %12llu\n",
1227 arena
->stats
.allocated_large
, "", arena
->stats
.nmalloc_large
,
1228 arena
->stats
.ndalloc_large
);
1229 malloc_printf("total: %12zu/%-12zu %12llu %12llu\n",
1230 arena
->stats
.allocated_small
+ arena
->stats
.allocated_large
,
1231 arena
->stats
.mapped
,
1232 arena
->stats
.nmalloc_small
+ arena
->stats
.nmalloc_large
,
1233 arena
->stats
.ndalloc_small
+ arena
->stats
.ndalloc_large
);
1235 malloc_printf("bins: bin size regs pgs requests newruns"
1236 " reruns maxruns curruns\n");
1237 for (i
= 0, gap_start
= -1; i
< ntbins
+ nqbins
+ nsbins
; i
++) {
1238 if (arena
->bins
[i
].stats
.nrequests
== 0) {
1239 if (gap_start
== -1)
1242 if (gap_start
!= -1) {
1243 if (i
> gap_start
+ 1) {
1244 /* Gap of more than one size class. */
1245 malloc_printf("[%u..%u]\n",
1248 /* Gap of one size class. */
1249 malloc_printf("[%u]\n", gap_start
);
1254 "%13u %1s %4u %4u %3u %9llu %9llu"
1255 " %9llu %7lu %7lu\n",
1257 i
< ntbins
? "T" : i
< ntbins
+ nqbins
? "Q" : "S",
1258 arena
->bins
[i
].reg_size
,
1259 arena
->bins
[i
].nregs
,
1260 arena
->bins
[i
].run_size
>> pagesize_2pow
,
1261 arena
->bins
[i
].stats
.nrequests
,
1262 arena
->bins
[i
].stats
.nruns
,
1263 arena
->bins
[i
].stats
.reruns
,
1264 arena
->bins
[i
].stats
.highruns
,
1265 arena
->bins
[i
].stats
.curruns
);
1268 if (gap_start
!= -1) {
1269 if (i
> gap_start
+ 1) {
1270 /* Gap of more than one size class. */
1271 malloc_printf("[%u..%u]\n", gap_start
, i
- 1);
1273 /* Gap of one size class. */
1274 malloc_printf("[%u]\n", gap_start
);
1281 * End Utility functions/macros.
1283 /******************************************************************************/
1285 * Begin chunk management functions.
1290 chunk_comp(chunk_node_t
*a
, chunk_node_t
*b
)
1296 if ((uintptr_t)a
->chunk
< (uintptr_t)b
->chunk
)
1298 else if (a
->chunk
== b
->chunk
)
1304 /* Generate red-black tree code for chunks. */
1305 RB_GENERATE_STATIC(chunk_tree_s
, chunk_node_s
, link
, chunk_comp
);
1309 pages_map_align(void *addr
, size_t size
, int align
)
1314 * We don't use MAP_FIXED here, because it can cause the *replacement*
1315 * of existing mappings, and we only want to create new mappings.
1317 ret
= mmap(addr
, size
, PROT_READ
| PROT_WRITE
,
1318 MAP_PRIVATE
| MAP_ANON
| MAP_ALIGNED(align
), -1, 0);
1319 assert(ret
!= NULL
);
1321 if (ret
== MAP_FAILED
)
1323 else if (addr
!= NULL
&& ret
!= addr
) {
1325 * We succeeded in mapping memory, but not in the right place.
1327 if (munmap(ret
, size
) == -1) {
1328 char buf
[STRERROR_BUF
];
1330 STRERROR_R(errno
, buf
, sizeof(buf
));
1331 _malloc_message(getprogname(),
1332 ": (malloc) Error in munmap(): ", buf
, "\n");
1339 assert(ret
== NULL
|| (addr
== NULL
&& ret
!= addr
)
1340 || (addr
!= NULL
&& ret
== addr
));
1345 pages_map(void *addr
, size_t size
)
1348 return pages_map_align(addr
, size
, 0);
1352 pages_unmap(void *addr
, size_t size
)
1355 if (munmap(addr
, size
) == -1) {
1356 char buf
[STRERROR_BUF
];
1358 STRERROR_R(errno
, buf
, sizeof(buf
));
1359 _malloc_message(getprogname(),
1360 ": (malloc) Error in munmap(): ", buf
, "\n");
1367 chunk_alloc(size_t size
)
1370 chunk_node_t
*tchunk
, *delchunk
;
1373 assert((size
& chunksize_mask
) == 0);
1375 malloc_mutex_lock(&chunks_mtx
);
1377 if (size
== chunksize
) {
1379 * Check for address ranges that were previously chunks and try
1384 tchunk
= RB_MIN(chunk_tree_s
, &old_chunks
);
1385 while (tchunk
!= NULL
) {
1386 /* Found an address range. Try to recycle it. */
1388 chunk
= tchunk
->chunk
;
1391 tchunk
= RB_NEXT(chunk_tree_s
, &old_chunks
, delchunk
);
1393 /* Remove delchunk from the tree. */
1395 RB_REMOVE(chunk_tree_s
, &old_chunks
, delchunk
);
1396 base_chunk_node_dealloc(delchunk
);
1399 if ((uintptr_t)chunk
>= (uintptr_t)brk_base
1400 && (uintptr_t)chunk
< (uintptr_t)brk_max
) {
1401 /* Re-use a previously freed brk chunk. */
1406 if ((ret
= pages_map(chunk
, size
)) != NULL
) {
1414 * Try to over-allocate, but allow the OS to place the allocation
1415 * anywhere. Beware of size_t wrap-around.
1417 if (size
+ chunksize
> size
) {
1418 if ((ret
= pages_map_align(NULL
, size
, chunksize_2pow
))
1426 * Try to create allocations in brk, in order to make full use of
1427 * limited address space.
1429 if (brk_prev
!= (void *)-1) {
1434 * The loop is necessary to recover from races with other
1435 * threads that are using brk for something other than malloc.
1437 malloc_mutex_lock(&brk_mtx
);
1439 /* Get the current end of brk. */
1443 * Calculate how much padding is necessary to
1444 * chunk-align the end of brk.
1446 incr
= (intptr_t)size
1447 - (intptr_t)CHUNK_ADDR2OFFSET(brk_cur
);
1448 if (incr
== (intptr_t)size
) {
1451 ret
= (void *)((intptr_t)brk_cur
+ incr
);
1455 brk_prev
= sbrk(incr
);
1456 if (brk_prev
== brk_cur
) {
1458 malloc_mutex_unlock(&brk_mtx
);
1459 brk_max
= (void *)((intptr_t)ret
+ size
);
1462 } while (brk_prev
!= (void *)-1);
1463 malloc_mutex_unlock(&brk_mtx
);
1467 /* All strategies for allocation failed. */
1473 * Clean out any entries in old_chunks that overlap with the
1474 * memory we just allocated.
1478 tchunk
= RB_NFIND(chunk_tree_s
, &old_chunks
, &key
);
1479 while (tchunk
!= NULL
1480 && (uintptr_t)tchunk
->chunk
>= (uintptr_t)ret
1481 && (uintptr_t)tchunk
->chunk
< (uintptr_t)ret
+ size
) {
1484 tchunk
= RB_NEXT(chunk_tree_s
, &old_chunks
, delchunk
);
1486 RB_REMOVE(chunk_tree_s
, &old_chunks
, delchunk
);
1487 base_chunk_node_dealloc(delchunk
);
1493 stats_chunks
.nchunks
+= (size
/ chunksize
);
1494 stats_chunks
.curchunks
+= (size
/ chunksize
);
1496 if (stats_chunks
.curchunks
> stats_chunks
.highchunks
)
1497 stats_chunks
.highchunks
= stats_chunks
.curchunks
;
1499 malloc_mutex_unlock(&chunks_mtx
);
1501 assert(CHUNK_ADDR2BASE(ret
) == ret
);
1506 chunk_dealloc(void *chunk
, size_t size
)
1510 assert(chunk
!= NULL
);
1511 assert(CHUNK_ADDR2BASE(chunk
) == chunk
);
1513 assert((size
& chunksize_mask
) == 0);
1515 malloc_mutex_lock(&chunks_mtx
);
1518 if ((uintptr_t)chunk
>= (uintptr_t)brk_base
1519 && (uintptr_t)chunk
< (uintptr_t)brk_max
) {
1522 malloc_mutex_lock(&brk_mtx
);
1523 /* Get the current end of brk. */
1527 * Try to shrink the data segment if this chunk is at the end
1528 * of the data segment. The sbrk() call here is subject to a
1529 * race condition with threads that use brk(2) or sbrk(2)
1530 * directly, but the alternative would be to leak memory for
1531 * the sake of poorly designed multi-threaded programs.
1533 if (brk_cur
== brk_max
1534 && (void *)((uintptr_t)chunk
+ size
) == brk_max
1535 && sbrk(-(intptr_t)size
) == brk_max
) {
1536 malloc_mutex_unlock(&brk_mtx
);
1537 if (brk_prev
== brk_max
) {
1539 brk_prev
= (void *)((intptr_t)brk_max
1546 malloc_mutex_unlock(&brk_mtx
);
1547 madvise(chunk
, size
, MADV_FREE
);
1550 * Iteratively create records of each chunk-sized
1551 * memory region that 'chunk' is comprised of, so that
1552 * the address range can be recycled if memory usage
1553 * increases later on.
1555 for (offset
= 0; offset
< size
; offset
+= chunksize
) {
1556 node
= base_chunk_node_alloc();
1560 node
->chunk
= (void *)((uintptr_t)chunk
1561 + (uintptr_t)offset
);
1562 node
->size
= chunksize
;
1564 RB_INSERT(chunk_tree_s
, &old_chunks
, node
);
1569 pages_unmap(chunk
, size
);
1572 * Make a record of the chunk's address, so that the address
1573 * range can be recycled if memory usage increases later on.
1574 * Don't bother to create entries if (size > chunksize), since
1575 * doing so could cause scalability issues for truly gargantuan
1576 * objects (many gigabytes or larger).
1578 if (size
== chunksize
) {
1579 node
= base_chunk_node_alloc();
1581 node
->chunk
= (void *)(uintptr_t)chunk
;
1582 node
->size
= chunksize
;
1584 RB_INSERT(chunk_tree_s
, &old_chunks
, node
);
1592 stats_chunks
.curchunks
-= (size
/ chunksize
);
1594 malloc_mutex_unlock(&chunks_mtx
);
1598 * End chunk management functions.
1600 /******************************************************************************/
1606 * Choose an arena based on a per-thread and (optimistically) per-CPU value.
1608 * We maintain at least one block of arenas. Usually there are more.
1609 * The blocks are $ncpu arenas in size. Whole blocks are 'hashed'
1610 * amongst threads. To accomplish this, next_arena advances only in
1613 static __noinline arena_t
*
1614 choose_arena_hard(void)
1619 /* Initialize the current block of arenas and advance to next. */
1620 malloc_mutex_lock(&arenas_mtx
);
1621 assert(next_arena
% ncpus
== 0);
1622 assert(narenas
% ncpus
== 0);
1623 map
= &arenas
[next_arena
];
1624 set_arenas_map(map
);
1625 for (i
= 0; i
< ncpus
; i
++) {
1626 if (arenas
[next_arena
] == NULL
)
1627 arenas_extend(next_arena
);
1628 next_arena
= (next_arena
+ 1) % narenas
;
1630 malloc_mutex_unlock(&arenas_mtx
);
1633 * If we were unable to allocate an arena above, then default to
1634 * the first arena, which is always present.
1636 curcpu
= thr_curcpu();
1637 if (map
[curcpu
] != NULL
)
1642 static inline arena_t
*
1648 map
= get_arenas_map();
1649 curcpu
= thr_curcpu();
1650 if (__predict_true(map
!= NULL
&& map
[curcpu
] != NULL
))
1653 return choose_arena_hard();
1658 arena_chunk_comp(arena_chunk_t
*a
, arena_chunk_t
*b
)
1664 if ((uintptr_t)a
< (uintptr_t)b
)
1672 /* Generate red-black tree code for arena chunks. */
1673 RB_GENERATE_STATIC(arena_chunk_tree_s
, arena_chunk_s
, link
, arena_chunk_comp
);
1678 arena_run_comp(arena_run_t
*a
, arena_run_t
*b
)
1684 if ((uintptr_t)a
< (uintptr_t)b
)
1692 /* Generate red-black tree code for arena runs. */
1693 RB_GENERATE_STATIC(arena_run_tree_s
, arena_run_s
, link
, arena_run_comp
);
1696 static inline void *
1697 arena_run_reg_alloc(arena_run_t
*run
, arena_bin_t
*bin
)
1700 unsigned i
, mask
, bit
, regind
;
1702 assert(run
->magic
== ARENA_RUN_MAGIC
);
1703 assert(run
->regs_minelm
< bin
->regs_mask_nelms
);
1706 * Move the first check outside the loop, so that run->regs_minelm can
1707 * be updated unconditionally, without the possibility of updating it
1710 i
= run
->regs_minelm
;
1711 mask
= run
->regs_mask
[i
];
1713 /* Usable allocation found. */
1714 bit
= ffs((int)mask
) - 1;
1716 regind
= ((i
<< (SIZEOF_INT_2POW
+ 3)) + bit
);
1717 ret
= (void *)(((uintptr_t)run
) + bin
->reg0_offset
1718 + (bin
->reg_size
* regind
));
1722 run
->regs_mask
[i
] = mask
;
1727 for (i
++; i
< bin
->regs_mask_nelms
; i
++) {
1728 mask
= run
->regs_mask
[i
];
1730 /* Usable allocation found. */
1731 bit
= ffs((int)mask
) - 1;
1733 regind
= ((i
<< (SIZEOF_INT_2POW
+ 3)) + bit
);
1734 ret
= (void *)(((uintptr_t)run
) + bin
->reg0_offset
1735 + (bin
->reg_size
* regind
));
1739 run
->regs_mask
[i
] = mask
;
1742 * Make a note that nothing before this element
1743 * contains a free region.
1745 run
->regs_minelm
= i
; /* Low payoff: + (mask == 0); */
1757 arena_run_reg_dalloc(arena_run_t
*run
, arena_bin_t
*bin
, void *ptr
, size_t size
)
1760 * To divide by a number D that is not a power of two we multiply
1761 * by (2^21 / D) and then right shift by 21 positions.
1767 * (X * size_invs[(D >> QUANTUM_2POW_MIN) - 3]) >> SIZE_INV_SHIFT
1769 #define SIZE_INV_SHIFT 21
1770 #define SIZE_INV(s) (((1 << SIZE_INV_SHIFT) / (s << QUANTUM_2POW_MIN)) + 1)
1771 static const unsigned size_invs
[] = {
1773 SIZE_INV(4), SIZE_INV(5), SIZE_INV(6), SIZE_INV(7),
1774 SIZE_INV(8), SIZE_INV(9), SIZE_INV(10), SIZE_INV(11),
1775 SIZE_INV(12),SIZE_INV(13), SIZE_INV(14), SIZE_INV(15),
1776 SIZE_INV(16),SIZE_INV(17), SIZE_INV(18), SIZE_INV(19),
1777 SIZE_INV(20),SIZE_INV(21), SIZE_INV(22), SIZE_INV(23),
1778 SIZE_INV(24),SIZE_INV(25), SIZE_INV(26), SIZE_INV(27),
1779 SIZE_INV(28),SIZE_INV(29), SIZE_INV(30), SIZE_INV(31)
1780 #if (QUANTUM_2POW_MIN < 4)
1782 SIZE_INV(32), SIZE_INV(33), SIZE_INV(34), SIZE_INV(35),
1783 SIZE_INV(36), SIZE_INV(37), SIZE_INV(38), SIZE_INV(39),
1784 SIZE_INV(40), SIZE_INV(41), SIZE_INV(42), SIZE_INV(43),
1785 SIZE_INV(44), SIZE_INV(45), SIZE_INV(46), SIZE_INV(47),
1786 SIZE_INV(48), SIZE_INV(49), SIZE_INV(50), SIZE_INV(51),
1787 SIZE_INV(52), SIZE_INV(53), SIZE_INV(54), SIZE_INV(55),
1788 SIZE_INV(56), SIZE_INV(57), SIZE_INV(58), SIZE_INV(59),
1789 SIZE_INV(60), SIZE_INV(61), SIZE_INV(62), SIZE_INV(63)
1792 unsigned diff
, regind
, elm
, bit
;
1795 assert(run
->magic
== ARENA_RUN_MAGIC
);
1796 assert(((sizeof(size_invs
)) / sizeof(unsigned)) + 3
1797 >= (SMALL_MAX_DEFAULT
>> QUANTUM_2POW_MIN
));
1800 * Avoid doing division with a variable divisor if possible. Using
1801 * actual division here can reduce allocator throughput by over 20%!
1803 diff
= (unsigned)((uintptr_t)ptr
- (uintptr_t)run
- bin
->reg0_offset
);
1804 if ((size
& (size
- 1)) == 0) {
1806 * log2_table allows fast division of a power of two in the
1809 * (x / divisor) becomes (x >> log2_table[divisor - 1]).
1811 static const unsigned char log2_table
[] = {
1812 0, 1, 0, 2, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 4,
1813 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5,
1814 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1815 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6,
1816 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1817 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1818 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1819 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7
1823 regind
= (diff
>> log2_table
[size
- 1]);
1824 else if (size
<= 32768)
1825 regind
= diff
>> (8 + log2_table
[(size
>> 8) - 1]);
1828 * The page size is too large for us to use the lookup
1829 * table. Use real division.
1831 regind
= (unsigned)(diff
/ size
);
1833 } else if (size
<= ((sizeof(size_invs
) / sizeof(unsigned))
1834 << QUANTUM_2POW_MIN
) + 2) {
1835 regind
= size_invs
[(size
>> QUANTUM_2POW_MIN
) - 3] * diff
;
1836 regind
>>= SIZE_INV_SHIFT
;
1839 * size_invs isn't large enough to handle this size class, so
1840 * calculate regind using actual division. This only happens
1841 * if the user increases small_max via the 'S' runtime
1842 * configuration option.
1844 regind
= (unsigned)(diff
/ size
);
1846 assert(diff
== regind
* size
);
1847 assert(regind
< bin
->nregs
);
1849 elm
= regind
>> (SIZEOF_INT_2POW
+ 3);
1850 if (elm
< run
->regs_minelm
)
1851 run
->regs_minelm
= elm
;
1852 bit
= regind
- (elm
<< (SIZEOF_INT_2POW
+ 3));
1853 assert((run
->regs_mask
[elm
] & (1 << bit
)) == 0);
1854 run
->regs_mask
[elm
] |= (1 << bit
);
1856 #undef SIZE_INV_SHIFT
1860 arena_run_split(arena_t
*arena
, arena_run_t
*run
, size_t size
)
1862 arena_chunk_t
*chunk
;
1863 unsigned run_ind
, map_offset
, total_pages
, need_pages
, rem_pages
;
1866 chunk
= (arena_chunk_t
*)CHUNK_ADDR2BASE(run
);
1867 run_ind
= (unsigned)(((uintptr_t)run
- (uintptr_t)chunk
)
1869 total_pages
= chunk
->map
[run_ind
].npages
;
1870 need_pages
= (unsigned)(size
>> pagesize_2pow
);
1871 assert(need_pages
<= total_pages
);
1872 rem_pages
= total_pages
- need_pages
;
1874 /* Split enough pages from the front of run to fit allocation size. */
1875 map_offset
= run_ind
;
1876 for (i
= 0; i
< need_pages
; i
++) {
1877 chunk
->map
[map_offset
+ i
].npages
= need_pages
;
1878 chunk
->map
[map_offset
+ i
].pos
= i
;
1881 /* Keep track of trailing unused pages for later use. */
1882 if (rem_pages
> 0) {
1883 /* Update map for trailing pages. */
1884 map_offset
+= need_pages
;
1885 chunk
->map
[map_offset
].npages
= rem_pages
;
1886 chunk
->map
[map_offset
].pos
= POS_FREE
;
1887 chunk
->map
[map_offset
+ rem_pages
- 1].npages
= rem_pages
;
1888 chunk
->map
[map_offset
+ rem_pages
- 1].pos
= POS_FREE
;
1891 chunk
->pages_used
+= need_pages
;
1894 static arena_chunk_t
*
1895 arena_chunk_alloc(arena_t
*arena
)
1897 arena_chunk_t
*chunk
;
1899 if (arena
->spare
!= NULL
) {
1900 chunk
= arena
->spare
;
1901 arena
->spare
= NULL
;
1904 RB_INSERT(arena_chunk_tree_s
, &arena
->chunks
, chunk
);
1906 chunk
= (arena_chunk_t
*)chunk_alloc(chunksize
);
1910 arena
->stats
.mapped
+= chunksize
;
1913 chunk
->arena
= arena
;
1916 RB_INSERT(arena_chunk_tree_s
, &arena
->chunks
, chunk
);
1919 * Claim that no pages are in use, since the header is merely
1922 chunk
->pages_used
= 0;
1924 chunk
->max_frun_npages
= chunk_npages
-
1925 arena_chunk_header_npages
;
1926 chunk
->min_frun_ind
= arena_chunk_header_npages
;
1929 * Initialize enough of the map to support one maximal free run.
1931 chunk
->map
[arena_chunk_header_npages
].npages
= chunk_npages
-
1932 arena_chunk_header_npages
;
1933 chunk
->map
[arena_chunk_header_npages
].pos
= POS_FREE
;
1934 chunk
->map
[chunk_npages
- 1].npages
= chunk_npages
-
1935 arena_chunk_header_npages
;
1936 chunk
->map
[chunk_npages
- 1].pos
= POS_FREE
;
1943 arena_chunk_dealloc(arena_t
*arena
, arena_chunk_t
*chunk
)
1947 * Remove chunk from the chunk tree, regardless of whether this chunk
1948 * will be cached, so that the arena does not use it.
1951 RB_REMOVE(arena_chunk_tree_s
, &chunk
->arena
->chunks
, chunk
);
1953 if (opt_hint
== false) {
1954 if (arena
->spare
!= NULL
) {
1955 chunk_dealloc((void *)arena
->spare
, chunksize
);
1957 arena
->stats
.mapped
-= chunksize
;
1960 arena
->spare
= chunk
;
1962 assert(arena
->spare
== NULL
);
1963 chunk_dealloc((void *)chunk
, chunksize
);
1965 arena
->stats
.mapped
-= chunksize
;
1970 static arena_run_t
*
1971 arena_run_alloc(arena_t
*arena
, size_t size
)
1973 arena_chunk_t
*chunk
;
1975 unsigned need_npages
, limit_pages
, compl_need_npages
;
1977 assert(size
<= (chunksize
- (arena_chunk_header_npages
<<
1979 assert((size
& pagesize_mask
) == 0);
1982 * Search through arena's chunks in address order for a free run that is
1983 * large enough. Look for the first fit.
1985 need_npages
= (unsigned)(size
>> pagesize_2pow
);
1986 limit_pages
= chunk_npages
- arena_chunk_header_npages
;
1987 compl_need_npages
= limit_pages
- need_npages
;
1989 RB_FOREACH(chunk
, arena_chunk_tree_s
, &arena
->chunks
) {
1991 * Avoid searching this chunk if there are not enough
1992 * contiguous free pages for there to possibly be a large
1995 if (chunk
->pages_used
<= compl_need_npages
&&
1996 need_npages
<= chunk
->max_frun_npages
) {
1997 arena_chunk_map_t
*mapelm
;
1999 unsigned max_frun_npages
= 0;
2000 unsigned min_frun_ind
= chunk_npages
;
2002 assert(chunk
->min_frun_ind
>=
2003 arena_chunk_header_npages
);
2004 for (i
= chunk
->min_frun_ind
; i
< chunk_npages
;) {
2005 mapelm
= &chunk
->map
[i
];
2006 if (mapelm
->pos
== POS_FREE
) {
2007 if (mapelm
->npages
>= need_npages
) {
2008 run
= (arena_run_t
*)
2009 ((uintptr_t)chunk
+ (i
<<
2011 /* Update page map. */
2012 arena_run_split(arena
, run
,
2016 if (mapelm
->npages
>
2021 if (i
< min_frun_ind
) {
2023 if (i
< chunk
->min_frun_ind
)
2024 chunk
->min_frun_ind
= i
;
2027 i
+= mapelm
->npages
;
2030 * Search failure. Reset cached chunk->max_frun_npages.
2031 * chunk->min_frun_ind was already reset above (if
2034 chunk
->max_frun_npages
= max_frun_npages
;
2039 * No usable runs. Create a new chunk from which to allocate the run.
2041 chunk
= arena_chunk_alloc(arena
);
2044 run
= (arena_run_t
*)((uintptr_t)chunk
+ (arena_chunk_header_npages
<<
2046 /* Update page map. */
2047 arena_run_split(arena
, run
, size
);
2052 arena_run_dalloc(arena_t
*arena
, arena_run_t
*run
, size_t size
)
2054 arena_chunk_t
*chunk
;
2055 unsigned run_ind
, run_pages
;
2057 chunk
= (arena_chunk_t
*)CHUNK_ADDR2BASE(run
);
2059 run_ind
= (unsigned)(((uintptr_t)run
- (uintptr_t)chunk
)
2061 assert(run_ind
>= arena_chunk_header_npages
);
2062 assert(run_ind
< (chunksize
>> pagesize_2pow
));
2063 run_pages
= (unsigned)(size
>> pagesize_2pow
);
2064 assert(run_pages
== chunk
->map
[run_ind
].npages
);
2066 /* Subtract pages from count of pages used in chunk. */
2067 chunk
->pages_used
-= run_pages
;
2069 /* Mark run as deallocated. */
2070 assert(chunk
->map
[run_ind
].npages
== run_pages
);
2071 chunk
->map
[run_ind
].pos
= POS_FREE
;
2072 assert(chunk
->map
[run_ind
+ run_pages
- 1].npages
== run_pages
);
2073 chunk
->map
[run_ind
+ run_pages
- 1].pos
= POS_FREE
;
2076 * Tell the kernel that we don't need the data in this run, but only if
2077 * requested via runtime configuration.
2080 madvise(run
, size
, MADV_FREE
);
2082 /* Try to coalesce with neighboring runs. */
2083 if (run_ind
> arena_chunk_header_npages
&&
2084 chunk
->map
[run_ind
- 1].pos
== POS_FREE
) {
2085 unsigned prev_npages
;
2087 /* Coalesce with previous run. */
2088 prev_npages
= chunk
->map
[run_ind
- 1].npages
;
2089 run_ind
-= prev_npages
;
2090 assert(chunk
->map
[run_ind
].npages
== prev_npages
);
2091 assert(chunk
->map
[run_ind
].pos
== POS_FREE
);
2092 run_pages
+= prev_npages
;
2094 chunk
->map
[run_ind
].npages
= run_pages
;
2095 assert(chunk
->map
[run_ind
].pos
== POS_FREE
);
2096 chunk
->map
[run_ind
+ run_pages
- 1].npages
= run_pages
;
2097 assert(chunk
->map
[run_ind
+ run_pages
- 1].pos
== POS_FREE
);
2100 if (run_ind
+ run_pages
< chunk_npages
&&
2101 chunk
->map
[run_ind
+ run_pages
].pos
== POS_FREE
) {
2102 unsigned next_npages
;
2104 /* Coalesce with next run. */
2105 next_npages
= chunk
->map
[run_ind
+ run_pages
].npages
;
2106 run_pages
+= next_npages
;
2107 assert(chunk
->map
[run_ind
+ run_pages
- 1].npages
==
2109 assert(chunk
->map
[run_ind
+ run_pages
- 1].pos
== POS_FREE
);
2111 chunk
->map
[run_ind
].npages
= run_pages
;
2112 chunk
->map
[run_ind
].pos
= POS_FREE
;
2113 chunk
->map
[run_ind
+ run_pages
- 1].npages
= run_pages
;
2114 assert(chunk
->map
[run_ind
+ run_pages
- 1].pos
== POS_FREE
);
2117 if (chunk
->map
[run_ind
].npages
> chunk
->max_frun_npages
)
2118 chunk
->max_frun_npages
= chunk
->map
[run_ind
].npages
;
2119 if (run_ind
< chunk
->min_frun_ind
)
2120 chunk
->min_frun_ind
= run_ind
;
2122 /* Deallocate chunk if it is now completely unused. */
2123 if (chunk
->pages_used
== 0)
2124 arena_chunk_dealloc(arena
, chunk
);
2127 static arena_run_t
*
2128 arena_bin_nonfull_run_get(arena_t
*arena
, arena_bin_t
*bin
)
2131 unsigned i
, remainder
;
2133 /* Look for a usable run. */
2135 if ((run
= RB_MIN(arena_run_tree_s
, &bin
->runs
)) != NULL
) {
2136 /* run is guaranteed to have available space. */
2138 RB_REMOVE(arena_run_tree_s
, &bin
->runs
, run
);
2140 bin
->stats
.reruns
++;
2144 /* No existing runs have any space available. */
2146 /* Allocate a new run. */
2147 run
= arena_run_alloc(arena
, bin
->run_size
);
2151 /* Initialize run internals. */
2154 for (i
= 0; i
< bin
->regs_mask_nelms
; i
++)
2155 run
->regs_mask
[i
] = UINT_MAX
;
2156 remainder
= bin
->nregs
& ((1 << (SIZEOF_INT_2POW
+ 3)) - 1);
2157 if (remainder
!= 0) {
2158 /* The last element has spare bits that need to be unset. */
2159 run
->regs_mask
[i
] = (UINT_MAX
>> ((1 << (SIZEOF_INT_2POW
+ 3))
2163 run
->regs_minelm
= 0;
2165 run
->nfree
= bin
->nregs
;
2167 run
->magic
= ARENA_RUN_MAGIC
;
2172 bin
->stats
.curruns
++;
2173 if (bin
->stats
.curruns
> bin
->stats
.highruns
)
2174 bin
->stats
.highruns
= bin
->stats
.curruns
;
2179 /* bin->runcur must have space available before this function is called. */
2180 static inline void *
2181 arena_bin_malloc_easy(arena_t
*arena
, arena_bin_t
*bin
, arena_run_t
*run
)
2185 assert(run
->magic
== ARENA_RUN_MAGIC
);
2186 assert(run
->nfree
> 0);
2188 ret
= arena_run_reg_alloc(run
, bin
);
2189 assert(ret
!= NULL
);
2195 /* Re-fill bin->runcur, then call arena_bin_malloc_easy(). */
2197 arena_bin_malloc_hard(arena_t
*arena
, arena_bin_t
*bin
)
2200 bin
->runcur
= arena_bin_nonfull_run_get(arena
, bin
);
2201 if (bin
->runcur
== NULL
)
2203 assert(bin
->runcur
->magic
== ARENA_RUN_MAGIC
);
2204 assert(bin
->runcur
->nfree
> 0);
2206 return (arena_bin_malloc_easy(arena
, bin
, bin
->runcur
));
2210 * Calculate bin->run_size such that it meets the following constraints:
2212 * *) bin->run_size >= min_run_size
2213 * *) bin->run_size <= arena_maxclass
2214 * *) bin->run_size <= RUN_MAX_SMALL
2215 * *) run header overhead <= RUN_MAX_OVRHD (or header overhead relaxed).
2217 * bin->nregs, bin->regs_mask_nelms, and bin->reg0_offset are
2218 * also calculated here, since these settings are all interdependent.
2221 arena_bin_run_size_calc(arena_bin_t
*bin
, size_t min_run_size
)
2223 size_t try_run_size
, good_run_size
;
2224 unsigned good_nregs
, good_mask_nelms
, good_reg0_offset
;
2225 unsigned try_nregs
, try_mask_nelms
, try_reg0_offset
;
2227 assert(min_run_size
>= pagesize
);
2228 assert(min_run_size
<= arena_maxclass
);
2229 assert(min_run_size
<= RUN_MAX_SMALL
);
2232 * Calculate known-valid settings before entering the run_size
2233 * expansion loop, so that the first part of the loop always copies
2236 * The do..while loop iteratively reduces the number of regions until
2237 * the run header and the regions no longer overlap. A closed formula
2238 * would be quite messy, since there is an interdependency between the
2239 * header's mask length and the number of regions.
2241 try_run_size
= min_run_size
;
2242 try_nregs
= (unsigned)(((try_run_size
- sizeof(arena_run_t
)) /
2243 bin
->reg_size
) + 1); /* Counter-act try_nregs-- in loop. */
2246 try_mask_nelms
= (try_nregs
>> (SIZEOF_INT_2POW
+ 3)) +
2247 ((try_nregs
& ((1 << (SIZEOF_INT_2POW
+ 3)) - 1)) ? 1 : 0);
2248 try_reg0_offset
= (unsigned)(try_run_size
-
2249 (try_nregs
* bin
->reg_size
));
2250 } while (sizeof(arena_run_t
) + (sizeof(unsigned) * (try_mask_nelms
- 1))
2253 /* run_size expansion loop. */
2256 * Copy valid settings before trying more aggressive settings.
2258 good_run_size
= try_run_size
;
2259 good_nregs
= try_nregs
;
2260 good_mask_nelms
= try_mask_nelms
;
2261 good_reg0_offset
= try_reg0_offset
;
2263 /* Try more aggressive settings. */
2264 try_run_size
+= pagesize
;
2265 try_nregs
= (unsigned)(((try_run_size
- sizeof(arena_run_t
)) /
2266 bin
->reg_size
) + 1); /* Counter-act try_nregs-- in loop. */
2269 try_mask_nelms
= (try_nregs
>> (SIZEOF_INT_2POW
+ 3)) +
2270 ((try_nregs
& ((1 << (SIZEOF_INT_2POW
+ 3)) - 1)) ?
2272 try_reg0_offset
= (unsigned)(try_run_size
- (try_nregs
*
2274 } while (sizeof(arena_run_t
) + (sizeof(unsigned) *
2275 (try_mask_nelms
- 1)) > try_reg0_offset
);
2276 } while (try_run_size
<= arena_maxclass
&& try_run_size
<= RUN_MAX_SMALL
2277 && RUN_MAX_OVRHD
* (bin
->reg_size
<< 3) > RUN_MAX_OVRHD_RELAX
2278 && (try_reg0_offset
<< RUN_BFP
) > RUN_MAX_OVRHD
* try_run_size
);
2280 assert(sizeof(arena_run_t
) + (sizeof(unsigned) * (good_mask_nelms
- 1))
2281 <= good_reg0_offset
);
2282 assert((good_mask_nelms
<< (SIZEOF_INT_2POW
+ 3)) >= good_nregs
);
2284 /* Copy final settings. */
2285 bin
->run_size
= good_run_size
;
2286 bin
->nregs
= good_nregs
;
2287 bin
->regs_mask_nelms
= good_mask_nelms
;
2288 bin
->reg0_offset
= good_reg0_offset
;
2290 return (good_run_size
);
2294 arena_malloc(arena_t
*arena
, size_t size
)
2298 assert(arena
!= NULL
);
2299 assert(arena
->magic
== ARENA_MAGIC
);
2301 assert(QUANTUM_CEILING(size
) <= arena_maxclass
);
2303 if (size
<= bin_maxclass
) {
2307 /* Small allocation. */
2309 if (size
< small_min
) {
2311 size
= pow2_ceil(size
);
2312 bin
= &arena
->bins
[ffs((int)(size
>> (TINY_MIN_2POW
+
2314 #if (!defined(NDEBUG) || defined(MALLOC_STATS))
2316 * Bin calculation is always correct, but we may need
2317 * to fix size for the purposes of assertions and/or
2320 if (size
< (1 << TINY_MIN_2POW
))
2321 size
= (1 << TINY_MIN_2POW
);
2323 } else if (size
<= small_max
) {
2324 /* Quantum-spaced. */
2325 size
= QUANTUM_CEILING(size
);
2326 bin
= &arena
->bins
[ntbins
+ (size
>> opt_quantum_2pow
)
2330 size
= pow2_ceil(size
);
2331 bin
= &arena
->bins
[ntbins
+ nqbins
2332 + (ffs((int)(size
>> opt_small_max_2pow
)) - 2)];
2334 assert(size
== bin
->reg_size
);
2336 malloc_mutex_lock(&arena
->mtx
);
2337 if ((run
= bin
->runcur
) != NULL
&& run
->nfree
> 0)
2338 ret
= arena_bin_malloc_easy(arena
, bin
, run
);
2340 ret
= arena_bin_malloc_hard(arena
, bin
);
2343 malloc_mutex_unlock(&arena
->mtx
);
2348 bin
->stats
.nrequests
++;
2349 arena
->stats
.nmalloc_small
++;
2350 arena
->stats
.allocated_small
+= size
;
2353 /* Large allocation. */
2354 size
= PAGE_CEILING(size
);
2355 malloc_mutex_lock(&arena
->mtx
);
2356 ret
= (void *)arena_run_alloc(arena
, size
);
2358 malloc_mutex_unlock(&arena
->mtx
);
2362 arena
->stats
.nmalloc_large
++;
2363 arena
->stats
.allocated_large
+= size
;
2367 malloc_mutex_unlock(&arena
->mtx
);
2370 memset(ret
, 0xa5, size
);
2372 memset(ret
, 0, size
);
2377 arena_palloc_trim(arena_t
*arena
, arena_chunk_t
*chunk
, unsigned pageind
,
2385 * Modifiy the map such that arena_run_dalloc() sees the run as
2386 * separately allocated.
2388 for (i
= 0; i
< npages
; i
++) {
2389 chunk
->map
[pageind
+ i
].npages
= npages
;
2390 chunk
->map
[pageind
+ i
].pos
= i
;
2392 arena_run_dalloc(arena
, (arena_run_t
*)((uintptr_t)chunk
+ (pageind
<<
2393 pagesize_2pow
)), npages
<< pagesize_2pow
);
2396 /* Only handles large allocations that require more than page alignment. */
2398 arena_palloc(arena_t
*arena
, size_t alignment
, size_t size
, size_t alloc_size
)
2402 arena_chunk_t
*chunk
;
2403 unsigned pageind
, i
, npages
;
2405 assert((size
& pagesize_mask
) == 0);
2406 assert((alignment
& pagesize_mask
) == 0);
2408 npages
= (unsigned)(size
>> pagesize_2pow
);
2410 malloc_mutex_lock(&arena
->mtx
);
2411 ret
= (void *)arena_run_alloc(arena
, alloc_size
);
2413 malloc_mutex_unlock(&arena
->mtx
);
2417 chunk
= (arena_chunk_t
*)CHUNK_ADDR2BASE(ret
);
2419 offset
= (uintptr_t)ret
& (alignment
- 1);
2420 assert((offset
& pagesize_mask
) == 0);
2421 assert(offset
< alloc_size
);
2423 pageind
= (unsigned)(((uintptr_t)ret
- (uintptr_t)chunk
) >>
2426 /* Update the map for the run to be kept. */
2427 for (i
= 0; i
< npages
; i
++) {
2428 chunk
->map
[pageind
+ i
].npages
= npages
;
2429 assert(chunk
->map
[pageind
+ i
].pos
== i
);
2432 /* Trim trailing space. */
2433 arena_palloc_trim(arena
, chunk
, pageind
+ npages
,
2434 (unsigned)((alloc_size
- size
) >> pagesize_2pow
));
2436 size_t leadsize
, trailsize
;
2438 leadsize
= alignment
- offset
;
2439 ret
= (void *)((uintptr_t)ret
+ leadsize
);
2440 pageind
= (unsigned)(((uintptr_t)ret
- (uintptr_t)chunk
) >>
2443 /* Update the map for the run to be kept. */
2444 for (i
= 0; i
< npages
; i
++) {
2445 chunk
->map
[pageind
+ i
].npages
= npages
;
2446 chunk
->map
[pageind
+ i
].pos
= i
;
2449 /* Trim leading space. */
2450 arena_palloc_trim(arena
, chunk
,
2451 (unsigned)(pageind
- (leadsize
>> pagesize_2pow
)),
2452 (unsigned)(leadsize
>> pagesize_2pow
));
2454 trailsize
= alloc_size
- leadsize
- size
;
2455 if (trailsize
!= 0) {
2456 /* Trim trailing space. */
2457 assert(trailsize
< alloc_size
);
2458 arena_palloc_trim(arena
, chunk
, pageind
+ npages
,
2459 (unsigned)(trailsize
>> pagesize_2pow
));
2464 arena
->stats
.nmalloc_large
++;
2465 arena
->stats
.allocated_large
+= size
;
2467 malloc_mutex_unlock(&arena
->mtx
);
2470 memset(ret
, 0xa5, size
);
2472 memset(ret
, 0, size
);
2476 /* Return the size of the allocation pointed to by ptr. */
2478 arena_salloc(const void *ptr
)
2481 arena_chunk_t
*chunk
;
2482 arena_chunk_map_t
*mapelm
;
2485 assert(ptr
!= NULL
);
2486 assert(CHUNK_ADDR2BASE(ptr
) != ptr
);
2489 * No arena data structures that we query here can change in a way that
2490 * affects this function, so we don't need to lock.
2492 chunk
= (arena_chunk_t
*)CHUNK_ADDR2BASE(ptr
);
2493 pageind
= (unsigned)(((uintptr_t)ptr
- (uintptr_t)chunk
) >>
2495 mapelm
= &chunk
->map
[pageind
];
2496 if (mapelm
->pos
!= 0 || ptr
!= (char *)((uintptr_t)chunk
) + (pageind
<<
2500 pageind
-= mapelm
->pos
;
2502 run
= (arena_run_t
*)((uintptr_t)chunk
+ (pageind
<<
2504 assert(run
->magic
== ARENA_RUN_MAGIC
);
2505 ret
= run
->bin
->reg_size
;
2507 ret
= mapelm
->npages
<< pagesize_2pow
;
2513 arena_ralloc(void *ptr
, size_t size
, size_t oldsize
)
2517 /* Avoid moving the allocation if the size class would not change. */
2518 if (size
< small_min
) {
2519 if (oldsize
< small_min
&&
2520 ffs((int)(pow2_ceil(size
) >> (TINY_MIN_2POW
+ 1)))
2521 == ffs((int)(pow2_ceil(oldsize
) >> (TINY_MIN_2POW
+ 1))))
2523 } else if (size
<= small_max
) {
2524 if (oldsize
>= small_min
&& oldsize
<= small_max
&&
2525 (QUANTUM_CEILING(size
) >> opt_quantum_2pow
)
2526 == (QUANTUM_CEILING(oldsize
) >> opt_quantum_2pow
))
2530 * We make no attempt to resize runs here, though it would be
2531 * possible to do so.
2533 if (oldsize
> small_max
&& PAGE_CEILING(size
) == oldsize
)
2538 * If we get here, then size and oldsize are different enough that we
2539 * need to use a different size class. In that case, fall back to
2540 * allocating new space and copying.
2542 ret
= arena_malloc(choose_arena(), size
);
2546 /* Junk/zero-filling were already done by arena_malloc(). */
2548 memcpy(ret
, ptr
, size
);
2550 memcpy(ret
, ptr
, oldsize
);
2554 if (opt_junk
&& size
< oldsize
)
2555 memset((void *)((uintptr_t)ptr
+ size
), 0x5a, oldsize
- size
);
2556 else if (opt_zero
&& size
> oldsize
)
2557 memset((void *)((uintptr_t)ptr
+ oldsize
), 0, size
- oldsize
);
2562 arena_dalloc(arena_t
*arena
, arena_chunk_t
*chunk
, void *ptr
)
2565 arena_chunk_map_t
*mapelm
;
2568 assert(arena
!= NULL
);
2569 assert(arena
->magic
== ARENA_MAGIC
);
2570 assert(chunk
->arena
== arena
);
2571 assert(ptr
!= NULL
);
2572 assert(CHUNK_ADDR2BASE(ptr
) != ptr
);
2574 pageind
= (unsigned)(((uintptr_t)ptr
- (uintptr_t)chunk
) >>
2576 mapelm
= &chunk
->map
[pageind
];
2577 if (mapelm
->pos
!= 0 || ptr
!= (char *)((uintptr_t)chunk
) + (pageind
<<
2582 /* Small allocation. */
2584 pageind
-= mapelm
->pos
;
2586 run
= (arena_run_t
*)((uintptr_t)chunk
+ (pageind
<<
2588 assert(run
->magic
== ARENA_RUN_MAGIC
);
2590 size
= bin
->reg_size
;
2593 memset(ptr
, 0x5a, size
);
2595 malloc_mutex_lock(&arena
->mtx
);
2596 arena_run_reg_dalloc(run
, bin
, ptr
, size
);
2599 if (run
->nfree
== bin
->nregs
) {
2600 /* Deallocate run. */
2601 if (run
== bin
->runcur
)
2603 else if (bin
->nregs
!= 1) {
2605 * This block's conditional is necessary because
2606 * if the run only contains one region, then it
2607 * never gets inserted into the non-full runs
2611 RB_REMOVE(arena_run_tree_s
, &bin
->runs
, run
);
2616 arena_run_dalloc(arena
, run
, bin
->run_size
);
2618 bin
->stats
.curruns
--;
2620 } else if (run
->nfree
== 1 && run
!= bin
->runcur
) {
2622 * Make sure that bin->runcur always refers to the
2623 * lowest non-full run, if one exists.
2625 if (bin
->runcur
== NULL
)
2627 else if ((uintptr_t)run
< (uintptr_t)bin
->runcur
) {
2628 /* Switch runcur. */
2629 if (bin
->runcur
->nfree
> 0) {
2630 /* Insert runcur. */
2632 RB_INSERT(arena_run_tree_s
, &bin
->runs
,
2638 RB_INSERT(arena_run_tree_s
, &bin
->runs
, run
);
2642 arena
->stats
.allocated_small
-= size
;
2643 arena
->stats
.ndalloc_small
++;
2646 /* Large allocation. */
2648 size
= mapelm
->npages
<< pagesize_2pow
;
2649 assert((((uintptr_t)ptr
) & pagesize_mask
) == 0);
2652 memset(ptr
, 0x5a, size
);
2654 malloc_mutex_lock(&arena
->mtx
);
2655 arena_run_dalloc(arena
, (arena_run_t
*)ptr
, size
);
2657 arena
->stats
.allocated_large
-= size
;
2658 arena
->stats
.ndalloc_large
++;
2662 malloc_mutex_unlock(&arena
->mtx
);
2666 arena_new(arena_t
*arena
)
2670 size_t prev_run_size
;
2672 malloc_mutex_init(&arena
->mtx
);
2675 memset(&arena
->stats
, 0, sizeof(arena_stats_t
));
2678 /* Initialize chunks. */
2679 RB_INIT(&arena
->chunks
);
2680 arena
->spare
= NULL
;
2682 /* Initialize bins. */
2683 prev_run_size
= pagesize
;
2685 /* (2^n)-spaced tiny bins. */
2686 for (i
= 0; i
< ntbins
; i
++) {
2687 bin
= &arena
->bins
[i
];
2689 RB_INIT(&bin
->runs
);
2691 bin
->reg_size
= (1 << (TINY_MIN_2POW
+ i
));
2692 prev_run_size
= arena_bin_run_size_calc(bin
, prev_run_size
);
2695 memset(&bin
->stats
, 0, sizeof(malloc_bin_stats_t
));
2699 /* Quantum-spaced bins. */
2700 for (; i
< ntbins
+ nqbins
; i
++) {
2701 bin
= &arena
->bins
[i
];
2703 RB_INIT(&bin
->runs
);
2705 bin
->reg_size
= quantum
* (i
- ntbins
+ 1);
2707 pow2_size = pow2_ceil(quantum * (i - ntbins + 1));
2709 prev_run_size
= arena_bin_run_size_calc(bin
, prev_run_size
);
2712 memset(&bin
->stats
, 0, sizeof(malloc_bin_stats_t
));
2716 /* (2^n)-spaced sub-page bins. */
2717 for (; i
< ntbins
+ nqbins
+ nsbins
; i
++) {
2718 bin
= &arena
->bins
[i
];
2720 RB_INIT(&bin
->runs
);
2722 bin
->reg_size
= (small_max
<< (i
- (ntbins
+ nqbins
) + 1));
2724 prev_run_size
= arena_bin_run_size_calc(bin
, prev_run_size
);
2727 memset(&bin
->stats
, 0, sizeof(malloc_bin_stats_t
));
2732 arena
->magic
= ARENA_MAGIC
;
2738 /* Create a new arena and insert it into the arenas array at index ind. */
2740 arenas_extend(unsigned ind
)
2744 /* Allocate enough space for trailing bins. */
2745 ret
= (arena_t
*)base_alloc(sizeof(arena_t
)
2746 + (sizeof(arena_bin_t
) * (ntbins
+ nqbins
+ nsbins
- 1)));
2747 if (ret
!= NULL
&& arena_new(ret
) == false) {
2751 /* Only reached if there is an OOM error. */
2754 * OOM here is quite inconvenient to propagate, since dealing with it
2755 * would require a check for failure in the fast path. Instead, punt
2756 * by using arenas[0]. In practice, this is an extremely unlikely
2759 _malloc_message(getprogname(),
2760 ": (malloc) Error initializing arena\n", "", "");
2770 /******************************************************************************/
2772 * Begin general internal functions.
2776 huge_malloc(size_t size
)
2782 /* Allocate one or more contiguous chunks for this request. */
2784 csize
= CHUNK_CEILING(size
);
2786 /* size is large enough to cause size_t wrap-around. */
2790 /* Allocate a chunk node with which to track the chunk. */
2791 node
= base_chunk_node_alloc();
2795 ret
= chunk_alloc(csize
);
2797 base_chunk_node_dealloc(node
);
2801 /* Insert node into huge. */
2805 malloc_mutex_lock(&chunks_mtx
);
2806 RB_INSERT(chunk_tree_s
, &huge
, node
);
2809 huge_allocated
+= csize
;
2811 malloc_mutex_unlock(&chunks_mtx
);
2814 memset(ret
, 0xa5, csize
);
2816 memset(ret
, 0, csize
);
2821 /* Only handles large allocations that require more than chunk alignment. */
2823 huge_palloc(size_t alignment
, size_t size
)
2826 size_t alloc_size
, chunk_size
, offset
;
2830 * This allocation requires alignment that is even larger than chunk
2831 * alignment. This means that huge_malloc() isn't good enough.
2833 * Allocate almost twice as many chunks as are demanded by the size or
2834 * alignment, in order to assure the alignment can be achieved, then
2835 * unmap leading and trailing chunks.
2837 assert(alignment
>= chunksize
);
2839 chunk_size
= CHUNK_CEILING(size
);
2841 if (size
>= alignment
)
2842 alloc_size
= chunk_size
+ alignment
- chunksize
;
2844 alloc_size
= (alignment
<< 1) - chunksize
;
2846 /* Allocate a chunk node with which to track the chunk. */
2847 node
= base_chunk_node_alloc();
2851 ret
= chunk_alloc(alloc_size
);
2853 base_chunk_node_dealloc(node
);
2857 offset
= (uintptr_t)ret
& (alignment
- 1);
2858 assert((offset
& chunksize_mask
) == 0);
2859 assert(offset
< alloc_size
);
2861 /* Trim trailing space. */
2862 chunk_dealloc((void *)((uintptr_t)ret
+ chunk_size
), alloc_size
2867 /* Trim leading space. */
2868 chunk_dealloc(ret
, alignment
- offset
);
2870 ret
= (void *)((uintptr_t)ret
+ (alignment
- offset
));
2872 trailsize
= alloc_size
- (alignment
- offset
) - chunk_size
;
2873 if (trailsize
!= 0) {
2874 /* Trim trailing space. */
2875 assert(trailsize
< alloc_size
);
2876 chunk_dealloc((void *)((uintptr_t)ret
+ chunk_size
),
2881 /* Insert node into huge. */
2883 node
->size
= chunk_size
;
2885 malloc_mutex_lock(&chunks_mtx
);
2886 RB_INSERT(chunk_tree_s
, &huge
, node
);
2889 huge_allocated
+= chunk_size
;
2891 malloc_mutex_unlock(&chunks_mtx
);
2894 memset(ret
, 0xa5, chunk_size
);
2896 memset(ret
, 0, chunk_size
);
2902 huge_ralloc(void *ptr
, size_t size
, size_t oldsize
)
2906 /* Avoid moving the allocation if the size class would not change. */
2907 if (oldsize
> arena_maxclass
&&
2908 CHUNK_CEILING(size
) == CHUNK_CEILING(oldsize
)) {
2909 if (opt_junk
&& size
< oldsize
) {
2910 memset((void *)((uintptr_t)ptr
+ size
), 0x5a, oldsize
2912 } else if (opt_zero
&& size
> oldsize
) {
2913 memset((void *)((uintptr_t)ptr
+ oldsize
), 0, size
2919 if (CHUNK_ADDR2BASE(ptr
) == ptr
2921 && ((uintptr_t)ptr
< (uintptr_t)brk_base
2922 || (uintptr_t)ptr
>= (uintptr_t)brk_max
)
2925 chunk_node_t
*node
, key
;
2930 newcsize
= CHUNK_CEILING(size
);
2931 oldcsize
= CHUNK_CEILING(oldsize
);
2932 assert(oldcsize
!= newcsize
);
2933 if (newcsize
== 0) {
2934 /* size_t wrap-around */
2939 * Remove the old region from the tree now. If mremap()
2940 * returns the region to the system, other thread may
2941 * map it for same huge allocation and insert it to the
2942 * tree before we acquire the mutex lock again.
2944 malloc_mutex_lock(&chunks_mtx
);
2945 key
.chunk
= __DECONST(void *, ptr
);
2947 node
= RB_FIND(chunk_tree_s
, &huge
, &key
);
2948 assert(node
!= NULL
);
2949 assert(node
->chunk
== ptr
);
2950 assert(node
->size
== oldcsize
);
2951 RB_REMOVE(chunk_tree_s
, &huge
, node
);
2952 malloc_mutex_unlock(&chunks_mtx
);
2954 newptr
= mremap(ptr
, oldcsize
, NULL
, newcsize
,
2955 MAP_ALIGNED(chunksize_2pow
));
2956 if (newptr
== MAP_FAILED
) {
2957 /* We still own the old region. */
2958 malloc_mutex_lock(&chunks_mtx
);
2959 RB_INSERT(chunk_tree_s
, &huge
, node
);
2960 malloc_mutex_unlock(&chunks_mtx
);
2962 assert(CHUNK_ADDR2BASE(newptr
) == newptr
);
2964 /* Insert new or resized old region. */
2965 malloc_mutex_lock(&chunks_mtx
);
2966 node
->size
= newcsize
;
2967 node
->chunk
= newptr
;
2968 RB_INSERT(chunk_tree_s
, &huge
, node
);
2971 huge_allocated
+= newcsize
- oldcsize
;
2972 if (newcsize
> oldcsize
) {
2973 stats_chunks
.curchunks
+=
2974 (newcsize
- oldcsize
) / chunksize
;
2975 if (stats_chunks
.curchunks
>
2976 stats_chunks
.highchunks
)
2977 stats_chunks
.highchunks
=
2978 stats_chunks
.curchunks
;
2980 stats_chunks
.curchunks
-=
2981 (oldcsize
- newcsize
) / chunksize
;
2984 malloc_mutex_unlock(&chunks_mtx
);
2986 if (opt_junk
&& size
< oldsize
) {
2987 memset((void *)((uintptr_t)newptr
+ size
), 0x5a,
2989 } else if (opt_zero
&& size
> oldsize
) {
2990 memset((void *)((uintptr_t)newptr
+ oldsize
), 0,
2998 * If we get here, then size and oldsize are different enough that we
2999 * need to use a different size class. In that case, fall back to
3000 * allocating new space and copying.
3002 ret
= huge_malloc(size
);
3006 if (CHUNK_ADDR2BASE(ptr
) == ptr
) {
3007 /* The old allocation is a chunk. */
3009 memcpy(ret
, ptr
, size
);
3011 memcpy(ret
, ptr
, oldsize
);
3013 /* The old allocation is a region. */
3014 assert(oldsize
< size
);
3015 memcpy(ret
, ptr
, oldsize
);
3022 huge_dalloc(void *ptr
)
3027 malloc_mutex_lock(&chunks_mtx
);
3029 /* Extract from tree of huge allocations. */
3032 node
= RB_FIND(chunk_tree_s
, &huge
, &key
);
3033 assert(node
!= NULL
);
3034 assert(node
->chunk
== ptr
);
3036 RB_REMOVE(chunk_tree_s
, &huge
, node
);
3040 huge_allocated
-= node
->size
;
3043 malloc_mutex_unlock(&chunks_mtx
);
3048 memset(node
->chunk
, 0x5a, node
->size
);
3050 chunk_dealloc(node
->chunk
, node
->size
);
3052 base_chunk_node_dealloc(node
);
3056 imalloc(size_t size
)
3062 if (size
<= arena_maxclass
)
3063 ret
= arena_malloc(choose_arena(), size
);
3065 ret
= huge_malloc(size
);
3071 ipalloc(size_t alignment
, size_t size
)
3077 * Round size up to the nearest multiple of alignment.
3079 * This done, we can take advantage of the fact that for each small
3080 * size class, every object is aligned at the smallest power of two
3081 * that is non-zero in the base two representation of the size. For
3084 * Size | Base 2 | Minimum alignment
3085 * -----+----------+------------------
3087 * 144 | 10100000 | 32
3088 * 192 | 11000000 | 64
3090 * Depending on runtime settings, it is possible that arena_malloc()
3091 * will further round up to a power of two, but that never causes
3092 * correctness issues.
3094 ceil_size
= (size
+ (alignment
- 1)) & (-alignment
);
3096 * (ceil_size < size) protects against the combination of maximal
3097 * alignment and size greater than maximal alignment.
3099 if (ceil_size
< size
) {
3100 /* size_t overflow. */
3104 if (ceil_size
<= pagesize
|| (alignment
<= pagesize
3105 && ceil_size
<= arena_maxclass
))
3106 ret
= arena_malloc(choose_arena(), ceil_size
);
3111 * We can't achieve sub-page alignment, so round up alignment
3112 * permanently; it makes later calculations simpler.
3114 alignment
= PAGE_CEILING(alignment
);
3115 ceil_size
= PAGE_CEILING(size
);
3117 * (ceil_size < size) protects against very large sizes within
3118 * pagesize of SIZE_T_MAX.
3120 * (ceil_size + alignment < ceil_size) protects against the
3121 * combination of maximal alignment and ceil_size large enough
3122 * to cause overflow. This is similar to the first overflow
3123 * check above, but it needs to be repeated due to the new
3124 * ceil_size value, which may now be *equal* to maximal
3125 * alignment, whereas before we only detected overflow if the
3126 * original size was *greater* than maximal alignment.
3128 if (ceil_size
< size
|| ceil_size
+ alignment
< ceil_size
) {
3129 /* size_t overflow. */
3134 * Calculate the size of the over-size run that arena_palloc()
3135 * would need to allocate in order to guarantee the alignment.
3137 if (ceil_size
>= alignment
)
3138 run_size
= ceil_size
+ alignment
- pagesize
;
3141 * It is possible that (alignment << 1) will cause
3142 * overflow, but it doesn't matter because we also
3143 * subtract pagesize, which in the case of overflow
3144 * leaves us with a very large run_size. That causes
3145 * the first conditional below to fail, which means
3146 * that the bogus run_size value never gets used for
3147 * anything important.
3149 run_size
= (alignment
<< 1) - pagesize
;
3152 if (run_size
<= arena_maxclass
) {
3153 ret
= arena_palloc(choose_arena(), alignment
, ceil_size
,
3155 } else if (alignment
<= chunksize
)
3156 ret
= huge_malloc(ceil_size
);
3158 ret
= huge_palloc(alignment
, ceil_size
);
3161 assert(((uintptr_t)ret
& (alignment
- 1)) == 0);
3166 icalloc(size_t size
)
3170 if (size
<= arena_maxclass
) {
3171 ret
= arena_malloc(choose_arena(), size
);
3174 memset(ret
, 0, size
);
3177 * The virtual memory system provides zero-filled pages, so
3178 * there is no need to do so manually, unless opt_junk is
3179 * enabled, in which case huge_malloc() fills huge allocations
3182 ret
= huge_malloc(size
);
3187 memset(ret
, 0, size
);
3189 else if ((uintptr_t)ret
>= (uintptr_t)brk_base
3190 && (uintptr_t)ret
< (uintptr_t)brk_max
) {
3192 * This may be a re-used brk chunk. Therefore, zero
3195 memset(ret
, 0, size
);
3204 isalloc(const void *ptr
)
3207 arena_chunk_t
*chunk
;
3209 assert(ptr
!= NULL
);
3211 chunk
= (arena_chunk_t
*)CHUNK_ADDR2BASE(ptr
);
3214 assert(chunk
->arena
->magic
== ARENA_MAGIC
);
3216 ret
= arena_salloc(ptr
);
3218 chunk_node_t
*node
, key
;
3220 /* Chunk (huge allocation). */
3222 malloc_mutex_lock(&chunks_mtx
);
3224 /* Extract from tree of huge allocations. */
3225 key
.chunk
= __DECONST(void *, ptr
);
3227 node
= RB_FIND(chunk_tree_s
, &huge
, &key
);
3228 assert(node
!= NULL
);
3232 malloc_mutex_unlock(&chunks_mtx
);
3239 iralloc(void *ptr
, size_t size
)
3244 assert(ptr
!= NULL
);
3247 oldsize
= isalloc(ptr
);
3249 if (size
<= arena_maxclass
)
3250 ret
= arena_ralloc(ptr
, size
, oldsize
);
3252 ret
= huge_ralloc(ptr
, size
, oldsize
);
3260 arena_chunk_t
*chunk
;
3262 assert(ptr
!= NULL
);
3264 chunk
= (arena_chunk_t
*)CHUNK_ADDR2BASE(ptr
);
3267 arena_dalloc(chunk
->arena
, chunk
, ptr
);
3273 malloc_print_stats(void)
3276 if (opt_print_stats
) {
3277 char s
[UMAX2S_BUFSIZE
];
3278 _malloc_message("___ Begin malloc statistics ___\n", "", "",
3280 _malloc_message("Assertions ",
3287 _malloc_message("Boolean MALLOC_OPTIONS: ",
3288 opt_abort
? "A" : "a",
3289 opt_junk
? "J" : "j",
3290 opt_hint
? "H" : "h");
3291 _malloc_message(opt_utrace
? "PU" : "Pu",
3292 opt_sysv
? "V" : "v",
3293 opt_xmalloc
? "X" : "x",
3294 opt_zero
? "Z\n" : "z\n");
3296 _malloc_message("CPUs: ", size_t2s(ncpus
, s
), "\n", "");
3297 _malloc_message("Max arenas: ", size_t2s(narenas
, s
), "\n", "");
3298 _malloc_message("Pointer size: ", size_t2s(sizeof(void *), s
),
3300 _malloc_message("Quantum size: ", size_t2s(quantum
, s
), "\n", "");
3301 _malloc_message("Max small size: ", size_t2s(small_max
, s
), "\n",
3304 _malloc_message("Chunk size: ", size_t2s(chunksize
, s
), "", "");
3305 _malloc_message(" (2^", size_t2s((size_t)opt_chunk_2pow
, s
),
3310 size_t allocated
, mapped
;
3314 /* Calculate and print allocated/mapped stats. */
3317 for (i
= 0, allocated
= 0; i
< narenas
; i
++) {
3318 if (arenas
[i
] != NULL
) {
3319 malloc_mutex_lock(&arenas
[i
]->mtx
);
3321 arenas
[i
]->stats
.allocated_small
;
3323 arenas
[i
]->stats
.allocated_large
;
3324 malloc_mutex_unlock(&arenas
[i
]->mtx
);
3329 malloc_mutex_lock(&chunks_mtx
);
3330 allocated
+= huge_allocated
;
3331 mapped
= stats_chunks
.curchunks
* chunksize
;
3332 malloc_mutex_unlock(&chunks_mtx
);
3334 malloc_mutex_lock(&base_mtx
);
3335 mapped
+= base_mapped
;
3336 malloc_mutex_unlock(&base_mtx
);
3338 malloc_printf("Allocated: %zu, mapped: %zu\n",
3341 /* Print chunk stats. */
3343 chunk_stats_t chunks_stats
;
3345 malloc_mutex_lock(&chunks_mtx
);
3346 chunks_stats
= stats_chunks
;
3347 malloc_mutex_unlock(&chunks_mtx
);
3349 malloc_printf("chunks: nchunks "
3350 "highchunks curchunks\n");
3351 malloc_printf(" %13llu%13lu%13lu\n",
3352 chunks_stats
.nchunks
,
3353 chunks_stats
.highchunks
,
3354 chunks_stats
.curchunks
);
3357 /* Print chunk stats. */
3359 "huge: nmalloc ndalloc "
3360 "nralloc allocated\n");
3361 malloc_printf(" %12llu %12llu %12llu %12zu\n",
3362 huge_nmalloc
, huge_ndalloc
, huge_nralloc
,
3365 /* Print stats for each arena. */
3366 for (i
= 0; i
< narenas
; i
++) {
3368 if (arena
!= NULL
) {
3370 "\narenas[%u] @ %p\n", i
, arena
);
3371 malloc_mutex_lock(&arena
->mtx
);
3373 malloc_mutex_unlock(&arena
->mtx
);
3377 #endif /* #ifdef MALLOC_STATS */
3378 _malloc_message("--- End malloc statistics ---\n", "", "", "");
3383 * FreeBSD's pthreads implementation calls malloc(3), so the malloc
3384 * implementation has to take pains to avoid infinite recursion during
3391 if (malloc_initialized
== false)
3392 return (malloc_init_hard());
3398 malloc_init_hard(void)
3402 char buf
[PATH_MAX
+ 1];
3403 const char *opts
= "";
3406 malloc_mutex_lock(&init_lock
);
3407 if (malloc_initialized
) {
3409 * Another thread initialized the allocator before this one
3410 * acquired init_lock.
3412 malloc_mutex_unlock(&init_lock
);
3417 /* Get number of CPUs. */
3424 len
= sizeof(ncpus
);
3425 if (sysctl(mib
, 2, &ncpus
, &len
, (void *) 0, 0) == -1) {
3431 /* Get page size. */
3435 result
= sysconf(_SC_PAGESIZE
);
3436 assert(result
!= -1);
3437 pagesize
= (unsigned) result
;
3440 * We assume that pagesize is a power of 2 when calculating
3441 * pagesize_mask and pagesize_2pow.
3443 assert(((result
- 1) & result
) == 0);
3444 pagesize_mask
= result
- 1;
3445 pagesize_2pow
= ffs((int)result
) - 1;
3448 for (i
= 0; i
< 3; i
++) {
3449 /* Get runtime configuration. */
3452 if ((linklen
= readlink("/etc/malloc.conf", buf
,
3453 sizeof(buf
) - 1)) != -1) {
3455 * Use the contents of the "/etc/malloc.conf"
3456 * symbolic link's name.
3458 buf
[linklen
] = '\0';
3461 /* No configuration specified. */
3467 if ((opts
= getenv("MALLOC_OPTIONS")) != NULL
&&
3470 * Do nothing; opts is already initialized to
3471 * the value of the MALLOC_OPTIONS environment
3475 /* No configuration specified. */
3481 if (_malloc_options
!= NULL
) {
3483 * Use options that were compiled into the program.
3485 opts
= _malloc_options
;
3487 /* No configuration specified. */
3498 for (j
= 0; opts
[j
] != '\0'; j
++) {
3520 * Chunks always require at least one header
3521 * page, so chunks can never be smaller than
3524 if (opt_chunk_2pow
> pagesize_2pow
+ 1)
3528 if (opt_chunk_2pow
+ 1 <
3529 (int)(sizeof(size_t) << 3))
3533 opt_narenas_lshift
--;
3536 opt_narenas_lshift
++;
3539 opt_print_stats
= false;
3542 opt_print_stats
= true;
3545 if (opt_quantum_2pow
> QUANTUM_2POW_MIN
)
3549 if (opt_quantum_2pow
< pagesize_2pow
- 1)
3553 if (opt_small_max_2pow
> QUANTUM_2POW_MIN
)
3554 opt_small_max_2pow
--;
3557 if (opt_small_max_2pow
< pagesize_2pow
- 1)
3558 opt_small_max_2pow
++;
3573 opt_xmalloc
= false;
3589 _malloc_message(getprogname(),
3590 ": (malloc) Unsupported character in "
3591 "malloc options: '", cbuf
, "'\n");
3598 /* Take care to call atexit() only once. */
3599 if (opt_print_stats
) {
3600 /* Print statistics at exit. */
3601 atexit(malloc_print_stats
);
3604 /* Set variables according to the value of opt_small_max_2pow. */
3605 if (opt_small_max_2pow
< opt_quantum_2pow
)
3606 opt_small_max_2pow
= opt_quantum_2pow
;
3607 small_max
= (1 << opt_small_max_2pow
);
3609 /* Set bin-related variables. */
3610 bin_maxclass
= (pagesize
>> 1);
3611 assert(opt_quantum_2pow
>= TINY_MIN_2POW
);
3612 ntbins
= (unsigned)(opt_quantum_2pow
- TINY_MIN_2POW
);
3613 assert(ntbins
<= opt_quantum_2pow
);
3614 nqbins
= (unsigned)(small_max
>> opt_quantum_2pow
);
3615 nsbins
= (unsigned)(pagesize_2pow
- opt_small_max_2pow
- 1);
3617 /* Set variables according to the value of opt_quantum_2pow. */
3618 quantum
= (1 << opt_quantum_2pow
);
3619 quantum_mask
= quantum
- 1;
3621 small_min
= (quantum
>> 1) + 1;
3624 assert(small_min
<= quantum
);
3626 /* Set variables according to the value of opt_chunk_2pow. */
3627 chunksize
= (1LU << opt_chunk_2pow
);
3628 chunksize_mask
= chunksize
- 1;
3629 chunksize_2pow
= (unsigned)opt_chunk_2pow
;
3630 chunk_npages
= (unsigned)(chunksize
>> pagesize_2pow
);
3632 unsigned header_size
;
3634 header_size
= (unsigned)(sizeof(arena_chunk_t
) +
3635 (sizeof(arena_chunk_map_t
) * (chunk_npages
- 1)));
3636 arena_chunk_header_npages
= (header_size
>> pagesize_2pow
);
3637 if ((header_size
& pagesize_mask
) != 0)
3638 arena_chunk_header_npages
++;
3640 arena_maxclass
= chunksize
- (arena_chunk_header_npages
<<
3646 memset(&stats_chunks
, 0, sizeof(chunk_stats_t
));
3649 /* Various sanity checks that regard configuration. */
3650 assert(quantum
>= sizeof(void *));
3651 assert(quantum
<= pagesize
);
3652 assert(chunksize
>= pagesize
);
3653 assert(quantum
* 4 <= chunksize
);
3655 /* Initialize chunks data. */
3656 malloc_mutex_init(&chunks_mtx
);
3659 malloc_mutex_init(&brk_mtx
);
3661 brk_prev
= brk_base
;
3670 RB_INIT(&old_chunks
);
3672 /* Initialize base allocation data structures. */
3678 * Allocate a base chunk here, since it doesn't actually have to be
3679 * chunk-aligned. Doing this before allocating any other chunks allows
3680 * the use of space that would otherwise be wasted.
3682 base_pages_alloc(0);
3684 base_chunk_nodes
= NULL
;
3685 malloc_mutex_init(&base_mtx
);
3689 * For SMP systems, create four times as many arenas as there
3690 * are CPUs by default.
3692 opt_narenas_lshift
+= 2;
3695 /* Determine how many arenas to use. */
3697 if (opt_narenas_lshift
> 0) {
3698 if ((narenas
<< opt_narenas_lshift
) > narenas
)
3699 narenas
<<= opt_narenas_lshift
;
3701 * Make sure not to exceed the limits of what base_malloc()
3704 if (narenas
* sizeof(arena_t
*) > chunksize
)
3705 narenas
= (unsigned)(chunksize
/ sizeof(arena_t
*));
3706 } else if (opt_narenas_lshift
< 0) {
3707 if ((narenas
<< opt_narenas_lshift
) < narenas
)
3708 narenas
<<= opt_narenas_lshift
;
3709 /* Make sure there is at least one arena. */
3716 /* Allocate and initialize arenas. */
3717 arenas
= (arena_t
**)base_alloc(sizeof(arena_t
*) * narenas
);
3718 if (arenas
== NULL
) {
3719 malloc_mutex_unlock(&init_lock
);
3723 * Zero the array. In practice, this should always be pre-zeroed,
3724 * since it was just mmap()ed, but let's be sure.
3726 memset(arenas
, 0, sizeof(arena_t
*) * narenas
);
3729 * Initialize one arena here. The rest are lazily created in
3730 * arena_choose_hard().
3733 if (arenas
[0] == NULL
) {
3734 malloc_mutex_unlock(&init_lock
);
3738 malloc_mutex_init(&arenas_mtx
);
3740 malloc_initialized
= true;
3741 malloc_mutex_unlock(&init_lock
);
3746 * End general internal functions.
3748 /******************************************************************************/
3750 * Begin malloc(3)-compatible functions.
3758 if (malloc_init()) {
3764 if (opt_sysv
== false)
3772 ret
= imalloc(size
);
3777 _malloc_message(getprogname(),
3778 ": (malloc) Error in malloc(): out of memory\n", "",
3785 UTRACE(0, size
, ret
);
3790 posix_memalign(void **memptr
, size_t alignment
, size_t size
)
3798 /* Make sure that alignment is a large enough power of 2. */
3799 if (((alignment
- 1) & alignment
) != 0
3800 || alignment
< sizeof(void *)) {
3802 _malloc_message(getprogname(),
3803 ": (malloc) Error in posix_memalign(): "
3804 "invalid alignment\n", "", "");
3812 result
= ipalloc(alignment
, size
);
3815 if (result
== NULL
) {
3817 _malloc_message(getprogname(),
3818 ": (malloc) Error in posix_memalign(): out of memory\n",
3830 UTRACE(0, size
, result
);
3835 calloc(size_t num
, size_t size
)
3840 if (malloc_init()) {
3846 num_size
= num
* size
;
3847 if (num_size
== 0) {
3848 if ((opt_sysv
== false) && ((num
== 0) || (size
== 0)))
3855 * Try to avoid division here. We know that it isn't possible to
3856 * overflow during multiplication if neither operand uses any of the
3857 * most significant half of the bits in a size_t.
3859 } else if ((unsigned long long)((num
| size
) &
3860 ((unsigned long long)SIZE_T_MAX
<< (sizeof(size_t) << 2))) &&
3861 (num_size
/ size
!= num
)) {
3862 /* size_t overflow. */
3867 ret
= icalloc(num_size
);
3872 _malloc_message(getprogname(),
3873 ": (malloc) Error in calloc(): out of memory\n", "",
3880 UTRACE(0, num_size
, ret
);
3885 realloc(void *ptr
, size_t size
)
3890 if (opt_sysv
== false)
3901 assert(malloc_initialized
);
3903 ret
= iralloc(ptr
, size
);
3907 _malloc_message(getprogname(),
3908 ": (malloc) Error in realloc(): out of "
3909 "memory\n", "", "");
3918 ret
= imalloc(size
);
3922 _malloc_message(getprogname(),
3923 ": (malloc) Error in realloc(): out of "
3924 "memory\n", "", "");
3932 UTRACE(ptr
, size
, ret
);
3942 assert(malloc_initialized
);
3949 * End malloc(3)-compatible functions.
3951 /******************************************************************************/
3953 * Begin non-standard functions.
3957 malloc_usable_size(const void *ptr
)
3960 assert(ptr
!= NULL
);
3962 return (isalloc(ptr
));
3967 * End non-standard functions.
3969 /******************************************************************************/
3971 * Begin library-private functions, used by threading libraries for protection
3972 * of malloc during fork(). These functions are only called if the program is
3973 * running in threaded mode, so there is no need to check whether the program
3978 _malloc_prefork(void)
3982 /* Acquire all mutexes in a safe order. */
3984 malloc_mutex_lock(&arenas_mtx
);
3985 for (i
= 0; i
< narenas
; i
++) {
3986 if (arenas
[i
] != NULL
)
3987 malloc_mutex_lock(&arenas
[i
]->mtx
);
3990 malloc_mutex_lock(&base_mtx
);
3992 malloc_mutex_lock(&chunks_mtx
);
3996 _malloc_postfork(void)
4000 /* Release all mutexes, now that fork() has completed. */
4002 malloc_mutex_unlock(&chunks_mtx
);
4004 malloc_mutex_unlock(&base_mtx
);
4006 for (i
= 0; i
< narenas
; i
++) {
4007 if (arenas
[i
] != NULL
)
4008 malloc_mutex_unlock(&arenas
[i
]->mtx
);
4010 malloc_mutex_unlock(&arenas_mtx
);
4014 * End library-private functions.
4016 /******************************************************************************/