~sircmpwn/hare

hare/rt/malloc.ha -rw-r--r-- 4.7 KiB
ea90e6dfEyal Sawady unix::umask: don't return an error 9 hours ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
// This is a simple memory allocator, based on Appel, Andrew W., and David A.
// Naumann. "Verified sequential malloc/free." It is not thread-safe.
//
// Large allocations are handled with mmap.
//
// For small allocations, we set up 50 bins, where each bin is responsible for
// 16 different allocation sizes (e.g. bin 1 handles allocations from 10 thru 26
// bytes); except for the first and last bin, which are responsible for fewer
// than 16 allocation sizes.
//
// Each bin is 1MiB (BIGBLOCK) in size. We ceil the allocation size to the
// largest size supported for this bin, then break the bin up into smaller
// blocks. Each block is structured as [{sz: size, data..., link: *void}...];
// where sz is the size of this (small) block, data is is set aside for the
// user's actual allocation, and link is a pointer to the next bin's data field.
//
// In short, a bin for a particular size is pre-filled with all allocations of
// that size, and the first word of each allocation is set to a pointer to the
// next allocation. As such, malloc becomes:
//
// 1. Look up bin; pre-fill if not already allocated
// 2. Let p = bin; bin = *bin; return p
//
// Then, free is simply:
// 1. Look up bin
// 2. *p = bin;
// 3. bin = p;
//
// Note that over time this can cause the ordering of the allocations in each
// bin to become non-continuous. This has no consequences for performance or
// correctness.

def ALIGN: size = 2;
def WORD: size = size(size);
def WASTE: size = WORD * ALIGN - WORD;
def BIGBLOCK: size = (2 << 16) * WORD;

let bins: [50]nullable *void = [null...];

fn bin2size(b: size) size = ((b + 1) * ALIGN - 1) * WORD;

fn size2bin(s: size) size = {
	assert(s <= bin2size(len(bins) - 1), "Size exceeds maximum for bin");
	return (s + (WORD * (ALIGN - 1) - 1)) / (WORD * ALIGN);
};

// Allocates n bytes of memory and returns a pointer to them, or null if there
// is insufficient memory.
export fn malloc(n: size) nullable *void = {
	return if (n == 0) null
		else if (n > bin2size(len(bins) - 1)) malloc_large(n)
		else malloc_small(n);
};

fn malloc_large(n: size) nullable *void = {
	let p = segmalloc(n + WASTE + WORD);
	if (p == null) {
		return null;
	};
	let bsize = (p: uintptr + WASTE: uintptr): *[1]size;
	bsize[0] = n;
	return (p: uintptr + WASTE: uintptr + WORD: uintptr): nullable *void;
};

fn malloc_small(n: size) nullable *void = {
	const b = size2bin(n);
	let p = bins[b];
	if (p == null) {
		p = fill_bin(b);
		if (p != null) {
			bins[b] = p;
		};
	};
	return if (p != null) {
		let q = *(p: **void);
		bins[b] = q;
		yield p;
	} else null;
};

fn fill_bin(b: size) nullable *void = {
	const s = bin2size(b);
	let p = segmalloc(BIGBLOCK);
	return if (p == null) null else list_from_block(s, p: uintptr);
};

fn list_from_block(s: size, p: uintptr) nullable *void = {
	const nblocks = (BIGBLOCK - WASTE) / (s + WORD);

	let q = p + WASTE: uintptr; // align q+WORD
	for (let j = 0z; j != nblocks - 1; j += 1) {
		let sz = q: *size;
		let useralloc = q + WORD: uintptr; // aligned
		let next = (useralloc + s: uintptr + WORD: uintptr): *void;
		*sz = s;
		*(useralloc: **void) = next;
		q += s: uintptr + WORD: uintptr;
	};

	// Terminate last block:
	(q: *[1]size)[0] = s;
	*((q + 1: uintptr): *nullable *void) = null;

	// Return first block:
	return (p + WASTE: uintptr + WORD: uintptr): *void;
};

// Frees a pointer previously allocated with [[malloc]].
export @symbol("rt.free") fn free_(_p: nullable *void) void = {
	if (_p != null) {
		let p = _p: *void;
		let bsize = (p: uintptr - size(size): uintptr): *[1]size;
		let s = bsize[0];
		if (s <= bin2size(len(bins) - 1)) free_small(p, s)
		else free_large(p, s);
	};
};

fn free_large(_p: *void, s: size) void = {
	let p = (_p: uintptr - (WASTE: uintptr + WORD: uintptr)): *void;
	segfree(p, s + WASTE + WORD);
};

fn free_small(p: *void, s: size) void = {
	let b = size2bin(s);
	let q = bins[b];
	*(p: *nullable *void) = q;
	bins[b] = p;
};

// Changes the allocation size of a pointer to n bytes. If n is smaller than
// the prior allocation, it is truncated; otherwise the allocation is expanded
// and the values of the new bytes are undefined. May return a different pointer
// than the one given if there is insufficient space to expand the pointer
// in-place. Returns null if there is insufficient memory to support the
// request.
export fn realloc(_p: nullable *void, n: size) nullable *void = {
	if (n == 0) {
		free_(_p);
		return null;
	} else if (_p == null) {
		return malloc(n);
	};

	let p = _p: *void;
	let bsize = (p: uintptr - size(size): uintptr): *size;
	let s = *bsize;
	if (s >= n) {
		return p;
	};

	if (n < bin2size(len(bins) - 1) && size2bin(n) == size2bin(s)) {
		return p;
	};

	let new = malloc(n);
	if (new != null) {
		memcpy(new: *void, p, s);
		free(p);
	};

	return new;
};