123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963 |
- #include <features.h>
- #include <stddef.h>
- #include <unistd.h>
- #include <errno.h>
- #include <string.h>
- #include <malloc.h>
- #include <stdlib.h>
- #include <sys/mman.h>
- #include <bits/uClibc_mutex.h>
- __UCLIBC_MUTEX_EXTERN(__malloc_lock)
- #if defined __UCLIBC_HAS_THREADS__ && !defined __UCLIBC_HAS_LINUXTHREADS__
- attribute_hidden
- #endif
- ;
- #define __MALLOC_LOCK __UCLIBC_MUTEX_LOCK(__malloc_lock)
- #define __MALLOC_UNLOCK __UCLIBC_MUTEX_UNLOCK(__malloc_lock)
- #ifndef MALLOC_ALIGNMENT
- #define MALLOC_ALIGNMENT (2 * (sizeof(size_t)))
- #endif
- #define MALLOC_ALIGN_MASK (MALLOC_ALIGNMENT - 1)
- #ifndef TRIM_FASTBINS
- #define TRIM_FASTBINS 0
- #endif
- #ifndef MORECORE
- #define MORECORE sbrk
- #endif
- #ifndef MORECORE_FAILURE
- #define MORECORE_FAILURE (-1)
- #endif
- #ifndef MORECORE_CONTIGUOUS
- #define MORECORE_CONTIGUOUS 1
- #endif
- #ifndef MMAP_AS_MORECORE_SIZE
- #define MMAP_AS_MORECORE_SIZE (1024 * 1024)
- #endif
- #ifndef malloc_getpagesize
- # include <unistd.h>
- # define malloc_getpagesize sysconf(_SC_PAGESIZE)
- #else
- # define malloc_getpagesize (4096)
- #endif
- #ifndef M_MXFAST
- #define M_MXFAST 1
- #endif
- #ifndef DEFAULT_MXFAST
- #define DEFAULT_MXFAST 64
- #endif
- #define M_TRIM_THRESHOLD -1
- #ifndef DEFAULT_TRIM_THRESHOLD
- #define DEFAULT_TRIM_THRESHOLD (256 * 1024)
- #endif
- #define M_TOP_PAD -2
- #ifndef DEFAULT_TOP_PAD
- #define DEFAULT_TOP_PAD (0)
- #endif
- #define M_MMAP_THRESHOLD -3
- #ifndef DEFAULT_MMAP_THRESHOLD
- #define DEFAULT_MMAP_THRESHOLD (256 * 1024)
- #endif
- #define M_MMAP_MAX -4
- #ifndef DEFAULT_MMAP_MAX
- #define DEFAULT_MMAP_MAX (65536)
- #endif
- #include <fcntl.h>
- #include <sys/mman.h>
- #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
- #define MAP_ANONYMOUS MAP_ANON
- #endif
- #ifdef __ARCH_USE_MMU__
- # define _MAP_UNINITIALIZED 0
- #else
- # define _MAP_UNINITIALIZED MAP_UNINITIALIZED
- #endif
- #define MMAP(addr, size, prot) \
- (mmap((addr), (size), (prot), MAP_PRIVATE|MAP_ANONYMOUS|_MAP_UNINITIALIZED, 0, 0))
- struct malloc_chunk {
- size_t prev_size;
- size_t size;
- struct malloc_chunk* fd;
- struct malloc_chunk* bk;
- };
- typedef struct malloc_chunk* mchunkptr;
- #define chunk2mem(p) ((void*)((char*)(p) + 2*(sizeof(size_t))))
- #define mem2chunk(mem) ((mchunkptr)((char*)(mem) - 2*(sizeof(size_t))))
- #define MIN_CHUNK_SIZE (sizeof(struct malloc_chunk))
- #define MINSIZE \
- (unsigned long)(((MIN_CHUNK_SIZE+MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK))
- #define aligned_OK(m) (((unsigned long)((m)) & (MALLOC_ALIGN_MASK)) == 0)
- #define REQUEST_OUT_OF_RANGE(req) \
- ((unsigned long)(req) >= \
- (unsigned long)(size_t)(-2 * MINSIZE))
- #define request2size(req) \
- (((req) + (sizeof(size_t)) + MALLOC_ALIGN_MASK < MINSIZE) ? \
- MINSIZE : \
- ((req) + (sizeof(size_t)) + MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK)
- #define checked_request2size(req, sz) \
- if (REQUEST_OUT_OF_RANGE(req)) { \
- __set_errno(ENOMEM); \
- return 0; \
- } \
- (sz) = request2size(req);
- #define PREV_INUSE 0x1
- #define prev_inuse(p) ((p)->size & PREV_INUSE)
- #define IS_MMAPPED 0x2
- #define chunk_is_mmapped(p) ((p)->size & IS_MMAPPED)
- #define SIZE_BITS (PREV_INUSE|IS_MMAPPED)
- #define chunksize(p) ((p)->size & ~(SIZE_BITS))
- #define next_chunk(p) ((mchunkptr)( ((char*)(p)) + ((p)->size & ~PREV_INUSE) ))
- #define prev_chunk(p) ((mchunkptr)( ((char*)(p)) - ((p)->prev_size) ))
- #define chunk_at_offset(p, s) ((mchunkptr)(((char*)(p)) + (s)))
- #define inuse(p)\
- ((((mchunkptr)(((char*)(p))+((p)->size & ~PREV_INUSE)))->size) & PREV_INUSE)
- #define set_inuse(p)\
- ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size |= PREV_INUSE
- #define clear_inuse(p)\
- ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size &= ~(PREV_INUSE)
- #define inuse_bit_at_offset(p, s)\
- (((mchunkptr)(((char*)(p)) + (s)))->size & PREV_INUSE)
- #define set_inuse_bit_at_offset(p, s)\
- (((mchunkptr)(((char*)(p)) + (s)))->size |= PREV_INUSE)
- #define clear_inuse_bit_at_offset(p, s)\
- (((mchunkptr)(((char*)(p)) + (s)))->size &= ~(PREV_INUSE))
- #define set_head_size(p, s) ((p)->size = (((p)->size & PREV_INUSE) | (s)))
- #define set_head(p, s) ((p)->size = (s))
- #define set_foot(p, s) (((mchunkptr)((char*)(p) + (s)))->prev_size = (s))
- typedef struct malloc_chunk* mbinptr;
- #define bin_at(m, i) ((mbinptr)((char*)&((m)->bins[(i)<<1]) - ((sizeof(size_t))<<1)))
- #define next_bin(b) ((mbinptr)((char*)(b) + (sizeof(mchunkptr)<<1)))
- #define first(b) ((b)->fd)
- #define last(b) ((b)->bk)
- #define unlink(P, BK, FD) { \
- FD = P->fd; \
- BK = P->bk; \
- if (FD->bk != P || BK->fd != P) \
- abort(); \
- FD->bk = BK; \
- BK->fd = FD; \
- }
- #define NBINS 96
- #define NSMALLBINS 32
- #define SMALLBIN_WIDTH 8
- #define MIN_LARGE_SIZE 256
- #define in_smallbin_range(sz) \
- ((unsigned long)(sz) < (unsigned long)MIN_LARGE_SIZE)
- #define smallbin_index(sz) (((unsigned)(sz)) >> 3)
- #define bin_index(sz) \
- ((in_smallbin_range(sz)) ? smallbin_index(sz) : __malloc_largebin_index(sz))
- #define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE
- #define unsorted_chunks(M) (bin_at(M, 1))
- #define initial_top(M) (unsorted_chunks(M))
- #define BINMAPSHIFT 5
- #define BITSPERMAP (1U << BINMAPSHIFT)
- #define BINMAPSIZE (NBINS / BITSPERMAP)
- #define idx2block(i) ((i) >> BINMAPSHIFT)
- #define idx2bit(i) ((1U << ((i) & ((1U << BINMAPSHIFT)-1))))
- #define mark_bin(m,i) ((m)->binmap[idx2block(i)] |= idx2bit(i))
- #define unmark_bin(m,i) ((m)->binmap[idx2block(i)] &= ~(idx2bit(i)))
- #define get_binmap(m,i) ((m)->binmap[idx2block(i)] & idx2bit(i))
- typedef struct malloc_chunk* mfastbinptr;
- #define fastbin_index(sz) ((((unsigned int)(sz)) >> 3) - 2)
- #define MAX_FAST_SIZE 80
- #define NFASTBINS (fastbin_index(request2size(MAX_FAST_SIZE))+1)
- #define FASTBIN_CONSOLIDATION_THRESHOLD \
- ((unsigned long)(DEFAULT_TRIM_THRESHOLD) >> 1)
- #define ANYCHUNKS_BIT (1U)
- #define have_anychunks(M) (((M)->max_fast & ANYCHUNKS_BIT))
- #define set_anychunks(M) ((M)->max_fast |= ANYCHUNKS_BIT)
- #define clear_anychunks(M) ((M)->max_fast &= ~ANYCHUNKS_BIT)
- #define FASTCHUNKS_BIT (2U)
- #define have_fastchunks(M) (((M)->max_fast & FASTCHUNKS_BIT))
- #define set_fastchunks(M) ((M)->max_fast |= (FASTCHUNKS_BIT|ANYCHUNKS_BIT))
- #define clear_fastchunks(M) ((M)->max_fast &= ~(FASTCHUNKS_BIT))
- #define set_max_fast(M, s) \
- (M)->max_fast = (((s) == 0)? SMALLBIN_WIDTH: request2size(s)) | \
- ((M)->max_fast & (FASTCHUNKS_BIT|ANYCHUNKS_BIT))
- #define get_max_fast(M) \
- ((M)->max_fast & ~(FASTCHUNKS_BIT | ANYCHUNKS_BIT))
- #define MORECORE_CONTIGUOUS_BIT (1U)
- #define contiguous(M) \
- (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT))
- #define noncontiguous(M) \
- (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT) == 0)
- #define set_contiguous(M) \
- ((M)->morecore_properties |= MORECORE_CONTIGUOUS_BIT)
- #define set_noncontiguous(M) \
- ((M)->morecore_properties &= ~MORECORE_CONTIGUOUS_BIT)
- struct malloc_state {
-
- size_t max_fast;
-
- mfastbinptr fastbins[NFASTBINS];
-
- mchunkptr top;
-
- mchunkptr last_remainder;
-
- mchunkptr bins[NBINS * 2];
-
- unsigned int binmap[BINMAPSIZE+1];
-
- unsigned long trim_threshold;
- size_t top_pad;
- size_t mmap_threshold;
-
- int n_mmaps;
- int n_mmaps_max;
- int max_n_mmaps;
-
- unsigned int pagesize;
-
- unsigned int morecore_properties;
-
- size_t mmapped_mem;
- size_t sbrked_mem;
- size_t max_sbrked_mem;
- size_t max_mmapped_mem;
- size_t max_total_mem;
- };
- typedef struct malloc_state *mstate;
- extern struct malloc_state __malloc_state attribute_hidden;
- #define get_malloc_state() (&(__malloc_state))
- void __malloc_consolidate(mstate) attribute_hidden;
- #ifndef __UCLIBC_MALLOC_DEBUGGING__
- #define check_chunk(P)
- #define check_free_chunk(P)
- #define check_inuse_chunk(P)
- #define check_remalloced_chunk(P,N)
- #define check_malloced_chunk(P,N)
- #define check_malloc_state()
- #define assert(x) ((void)0)
- #else
- #define check_chunk(P) __do_check_chunk(P)
- #define check_free_chunk(P) __do_check_free_chunk(P)
- #define check_inuse_chunk(P) __do_check_inuse_chunk(P)
- #define check_remalloced_chunk(P,N) __do_check_remalloced_chunk(P,N)
- #define check_malloced_chunk(P,N) __do_check_malloced_chunk(P,N)
- #define check_malloc_state() __do_check_malloc_state()
- extern void __do_check_chunk(mchunkptr p) attribute_hidden;
- extern void __do_check_free_chunk(mchunkptr p) attribute_hidden;
- extern void __do_check_inuse_chunk(mchunkptr p) attribute_hidden;
- extern void __do_check_remalloced_chunk(mchunkptr p, size_t s) attribute_hidden;
- extern void __do_check_malloced_chunk(mchunkptr p, size_t s) attribute_hidden;
- extern void __do_check_malloc_state(void) attribute_hidden;
- #include <assert.h>
- #endif
|