harec

[hare] Hare compiler, written in C11 for POSIX OSs
Log | Files | Refs | README | LICENSE

malloc.ha (4984B)


      1 // This is a simple memory allocator, based on Appel, Andrew W., and David A.
      2 // Naumann. "Verified sequential malloc/free." It is not thread-safe.
      3 //
      4 // Large allocations are handled with mmap.
      5 //
      6 // For small allocations, we set up 50 bins, where each bin is responsible for
      7 // 16 different allocation sizes (e.g. bin 1 handles allocations from 10 thru 26
      8 // bytes); except for the first and last bin, which are responsible for fewer
      9 // than 16 allocation sizes.
     10 //
     11 // Each bin is 1MiB (BIGBLOCK) in size. We ceil the allocation size to the
     12 // largest size supported for this bin, then break the bin up into smaller
     13 // blocks. Each block is structured as [{sz: size, data..., link: *void}...];
     14 // where sz is the size of this (small) block, data is is set aside for the
     15 // user's actual allocation, and link is a pointer to the next bin's data field.
     16 //
     17 // In short, a bin for a particular size is pre-filled with all allocations of
     18 // that size, and the first word of each allocation is set to a pointer to the
     19 // next allocation. As such, malloc becomes:
     20 //
     21 // 1. Look up bin; pre-fill if not already allocated
     22 // 2. Let p = bin; bin = *bin; return p
     23 //
     24 // Then, free is simply:
     25 // 1. Look up bin
     26 // 2. *p = bin;
     27 // 3. bin = p;
     28 //
     29 // Note that over time this can cause the ordering of the allocations in each
     30 // bin to become non-continuous. This has no consequences for performance or
     31 // correctness.
     32 
     33 def ALIGN: size = 2;
     34 def WORD: size = size(size);
     35 def WASTE: size = WORD * ALIGN - WORD;
     36 def BIGBLOCK: size = (2 << 16) * WORD;
     37 
     38 let bins: [50]nullable *void = [null...];
     39 
     40 fn bin2size(b: size) size = ((b + 1) * ALIGN - 1) * WORD;
     41 
     42 fn size2bin(s: size) size = {
     43 	assert(s <= bin2size(len(bins) - 1), "Size exceeds maximum for bin");
     44 	return (s + (WORD * (ALIGN - 1) - 1)) / (WORD * ALIGN);
     45 };
     46 
     47 let nalloc: int = 0;
     48 let nfree: int = 0;
     49 
     50 @fini fn fini() void = assert(nalloc == nfree);
     51 
     52 // Allocates n bytes of memory and returns a pointer to them, or null if there
     53 // is insufficient memory.
     54 export fn malloc(n: size) nullable *void = {
     55 	if (n == 0) return null;
     56 	let r = if (n > bin2size(len(bins) - 1)) malloc_large(n)
     57 		else malloc_small(n);
     58 	nalloc += 1;
     59 	return r;
     60 };
     61 
     62 fn malloc_large(n: size) nullable *void = {
     63 	let p = segmalloc(n + WASTE + WORD);
     64 	if (p == null) {
     65 		return null;
     66 	};
     67 	let bsize = (p: uintptr + WASTE: uintptr): *[1]size;
     68 	bsize[0] = n;
     69 	return (p: uintptr + WASTE: uintptr + WORD: uintptr): nullable *void;
     70 };
     71 
     72 fn malloc_small(n: size) nullable *void = {
     73 	const b = size2bin(n);
     74 	let p = bins[b];
     75 	if (p == null) {
     76 		p = fill_bin(b);
     77 		if (p != null) {
     78 			bins[b] = p;
     79 		};
     80 	};
     81 	return if (p != null) {
     82 		let q = *(p: **void);
     83 		bins[b] = q;
     84 		yield p;
     85 	} else null;
     86 };
     87 
     88 fn fill_bin(b: size) nullable *void = {
     89 	const s = bin2size(b);
     90 	let p = segmalloc(BIGBLOCK);
     91 	return if (p == null) null else list_from_block(s, p: uintptr);
     92 };
     93 
     94 fn list_from_block(s: size, p: uintptr) nullable *void = {
     95 	const nblocks = (BIGBLOCK - WASTE) / (s + WORD);
     96 
     97 	let q = p + WASTE: uintptr; // align q+WORD
     98 	for (let j = 0z; j != nblocks - 1; j += 1) {
     99 		let sz = q: *size;
    100 		let useralloc = q + WORD: uintptr; // aligned
    101 		let next = (useralloc + s: uintptr + WORD: uintptr): *void;
    102 		*sz = s;
    103 		*(useralloc: **void) = next;
    104 		q += s: uintptr + WORD: uintptr;
    105 	};
    106 
    107 	// Terminate last block:
    108 	(q: *[1]size)[0] = s;
    109 	*((q + 1: uintptr): *nullable *void) = null;
    110 
    111 	// Return first block:
    112 	return (p + WASTE: uintptr + WORD: uintptr): *void;
    113 };
    114 
    115 // Frees a pointer previously allocated with [[malloc]].
    116 export @symbol("rt.free") fn free_(_p: nullable *void) void = {
    117 	if (_p != null) {
    118 		nfree += 1;
    119 		let p = _p: *void;
    120 		let bsize = (p: uintptr - size(size): uintptr): *[1]size;
    121 		let s = bsize[0];
    122 		if (s <= bin2size(len(bins) - 1)) free_small(p, s)
    123 		else free_large(p, s);
    124 	};
    125 };
    126 
    127 fn free_large(_p: *void, s: size) void = {
    128 	let p = (_p: uintptr - (WASTE: uintptr + WORD: uintptr)): *void;
    129 	let r = segfree(p, s + WASTE + WORD);
    130 	assert(r == 0, "free: munmap failed");
    131 };
    132 
    133 fn free_small(p: *void, s: size) void = {
    134 	let b = size2bin(s);
    135 	let q = bins[b];
    136 	*(p: *nullable *void) = q;
    137 	bins[b] = p;
    138 };
    139 
    140 // Changes the allocation size of a pointer to n bytes. If n is smaller than
    141 // the prior allocation, it is truncated; otherwise the allocation is expanded
    142 // and the values of the new bytes are undefined. May return a different pointer
    143 // than the one given if there is insufficient space to expand the pointer
    144 // in-place. Returns null if there is insufficient memory to support the
    145 // request.
    146 export fn realloc(_p: nullable *void, n: size) nullable *void = {
    147 	if (n == 0) {
    148 		free_(_p);
    149 		return null;
    150 	} else if (_p == null) {
    151 		return malloc(n);
    152 	};
    153 
    154 	let p = _p: *void;
    155 	let bsize = (p: uintptr - size(size): uintptr): *size;
    156 	let s = *bsize;
    157 	if (s >= n) {
    158 		return p;
    159 	};
    160 
    161 	if (n < bin2size(len(bins) - 1) && size2bin(n) == size2bin(s)) {
    162 		return p;
    163 	};
    164 
    165 	let new = malloc(n);
    166 	if (new != null) {
    167 		memcpy(new: *void, p, s);
    168 		free(p);
    169 	};
    170 
    171 	return new;
    172 };