shithub: mc

ref: 21735ecc21f9086c786978dbcd9189bd7fbdba3b
dir: /alloc.myr/

use "die.use"
use "sys.use"
use "types.use"

pkg std =
	generic alloc	: (		-> @a*)
	generic free	: (v:@a*	-> void)

	generic mkslice	: (n : size	-> @a[,])
	generic freeslice: (sl : @a[,]	-> void)

	const bytealloc	: (sz:size	-> byte*)
	const bytefree	: (m:byte*, sz:size	-> void)
;;

/* null pointers */
const Zbyte	= 0 castto(byte*)
const Zslab	= 0 castto(slab*)
const Zchunk	= 0 castto(chunk*)

const Slabsz 	= 4096	/* on the systems this supports, anyways... */
const Cachemax	= 16	/* maximum number of slabs in the cache */
const Bucketmax	= 1024	/* Slabsz / 8; a balance. */
const Align	= 16	/* minimum allocation alignment */

var buckets	: bucket[32] /* excessive */
var initdone	: int

type bucket = struct
	sz	: size	/* aligned size */
	nper	: size	/* max number of elements per slab */
	slabs	: slab*	/* partially filled or free slabs */
	cache	: slab* /* cache of empty slabs, to prevent thrashing */
	ncache	: size  /* size of cache */
;;

type slab = struct
	next	: slab* /* the next slab on the chain */
	freehd	: chunk*	/* the nodes we're allocating */
	nfree	: size  /* the number of free nodes */
;;

type chunk = struct	/* NB: must be smaller than sizeof(slab) */
	next	: chunk*	/* the next chunk in the free list */
;;

generic alloc = {-> @a*
	-> bytealloc(sizeof(@a)) castto(@a*)
}

generic free = {v:@a* -> void
	bytefree(v castto(byte*), sizeof(@a))
}

generic mkslice = {n
	var p

	p = bytealloc(n*sizeof(@a)) castto(@a*)
	-> p[0,n]
}

generic freeslice = {sl
	-> bytefree(sl castto(byte*), sl.len * sizeof(@a))
}

const bytealloc = {sz
	var i
	var bkt

	if !initdone
		for i = 0; i < buckets.len && (Align << i) <= Bucketmax; i++
			bktinit(&buckets[i], Align << i)
		;;
		initdone = 1
	;;

	if (sz <= Bucketmax)
		bkt = &buckets[bktnum(sz)]
		-> bktalloc(bkt)
	else
		-> mmap(Zbyte, sz, Mprotrw, Mpriv | Manon, -1, 0)
	;;
}

const bytefree = {m, sz
	var bkt

	if (sz < Bucketmax)
		bkt = &buckets[bktnum(sz)]
		bktfree(bkt, m)
	else
		munmap(m, sz)
	;;
}

const bktinit = {b : bucket*, sz
	b.sz = align(sz, Align)
	b.nper = (Slabsz - sizeof(slab))/b.sz
	b.slabs = Zslab
	b.cache = Zslab
	b.ncache = 0
}

const mkslab = {bkt : bucket*
	var i
	var p
	var s
	var b
	var bnext
	var off /* offset of chunk head */

	if bkt.ncache > 0
		s = bkt.cache
		bkt.cache = s.next
		bkt.ncache--
	;;
	p = mmap(Zbyte, Slabsz, Mprotrw, Mpriv | Manon, -1, 0)
	if p == Mapbad
		die("Unable to mmap")
	;;

	s = p castto(slab*)
	s.nfree = bkt.nper
	/* skip past the slab header */
	off = align(sizeof(slab), Align)
	bnext = nextchunk(s castto(chunk*), off)
	s.freehd = bnext
	for i = 0; i < bkt.nper; i++
		b = bnext
		bnext = nextchunk(b, bkt.sz)
		b.next = bnext
	;;
	b.next = Zchunk
	-> s
}

const bktalloc = {bkt
	var s
	var b

	/* find a slab */
	s = bkt.slabs
	if s == Zslab
		s = mkslab(bkt)
		if s == Zslab
			die("No memory left")
		;;
		bkt.slabs = s
	;;

	/* grab the first chunk on the slab */
	b = s.freehd
	s.freehd = b.next
	s.nfree--
	if !s.nfree
		bkt.slabs = s.next
		s.next = Zslab
	;;

	-> b castto(byte*)
}

const bktfree = {bkt, m
	var s
	var b

	s = mtrunc(m, Slabsz) castto(slab*)
	b = m castto(chunk*)
	if s.nfree == 0
		s.next = bkt.slabs
		bkt.slabs = s
	elif s.nfree == bkt.nper
		if bkt.ncache < Cachemax
			s.next = bkt.cache
			bkt.cache = s
		else
			munmap(s castto(byte*), Slabsz)
		;;
	;;
	s.nfree++
	b.next = s.freehd
	s.freehd = b
}

const bktnum = {sz
	var i
	var bktsz

	bktsz = Align
	for i = 0; bktsz <= Bucketmax; i++
		if bktsz >= sz
			-> i
		;;
		bktsz *= 2
	;;
	die("Size does not match any buckets")
}

/* chunks are variable sizes, so we can't just take a slice */
const nextchunk = {b, sz
	-> ((b castto(intptr)) + sz) castto(chunk*)
}

const align = {v, align
	-> (v + align - 1) & ~(align - 1)
}

const mtrunc = {m, align
	-> ((m castto(intptr)) & ~(align - 1)) castto(byte*)
}