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 };