constant FREE_MAGIC $FAEE;
constant ALLOC_MAGIC $A10C;

constant FB_MAGIC 0;
constant FB_PREV 1;
constant FB_NEXT 2;
constant FB_SIZE 3;
constant FB__SIZE (4*2);

constant AB_MAGIC 0;
constant AB_SIZE 1;
constant AB__SIZE (2*2);

global mem_top = 0;
global mem_bottom = 0;
global mem_firstfree = 0;

! Initialise the heap manager, given a value for TOP. It's assumed that the
! heap will stretch to HIMEM.

[ mem_init bottom top;
	mem_bottom = bottom;
	mem_top = top;
	! Create a free chunk spanning the length of the block.
	mem_firstfree = mem_bottom;
	mem_firstfree-->FB_MAGIC = FREE_MAGIC;
	mem_firstfree-->FB_PREV = 0;
	mem_firstfree-->FB_NEXT = 0;
	mem_firstfree-->FB_SIZE = mem_top - mem_bottom;
];

! Zero a block of memory.

[ mem_zero ptr size;
	while (size)
	{
		(ptr++)->0 = 0;
		size--;
	}
];

! Remove a node from the list.

[ mem_node_remove p;
	if (p == mem_firstfree)
		mem_firstfree = p-->FB_NEXT;
	if (p-->FB_PREV)
		p-->FB_PREV-->FB_NEXT = p-->FB_NEXT;
	if (p-->FB_NEXT)
		p-->FB_NEXT-->FB_PREV = p-->FB_PREV;
];

! Try and allocate a block.

[ mem_alloc size p;
	! Add space for the AB_ header.

	size = size + AB__SIZE;

	! This block will eventually have to be a FB, once it's freed. So it
	! has to be big enough for the FB_ structure.

	if (size < FB__SIZE)
		size = FB__SIZE;
	
	! Iterate through the list trying to find a free chunk large enough.

	p = mem_firstfree;
	while ((p ~= 0) && (p-->FB_SIZE < size))
	{
		p = p-->FB_NEXT;
	}

	if (p == 0)
	{
		! No sufficiently large chunk could be found.
		return 0;
	}

	! Can the block be shrunk, or is there not enough room?

	if ((p-->FB_SIZE - size) < FB__SIZE)
	{
		! Yes; remove the node completely.
		size = p-->FB_SIZE;
		mem_node_remove(p);
	}
	else
	{
		! No. Instead of removing the node, we shrink it 
		p-->FB_SIZE = p-->FB_SIZE - size;
		p = p + p-->FB_SIZE;
	}

	! Initialise the allocated node.

	mem_zero(p, size);
	p-->AB_MAGIC = ALLOC_MAGIC;
	p-->AB_SIZE = size;

	return p+AB__SIZE;
];

! Try to free a block.

[ mem_free p  q;
	! Adjust the pointer to point to the alloc node itself.
	p = p - AB__SIZE;

#ifdef DEBUG;
	! Check the magic number.
	if (p-->AB_MAGIC ~= ALLOC_MAGIC)
	{
		print "Trying to free invalid node ", p, "!^";
		print "Magic was "; phex(p-->AB_MAGIC, 4);
		print " when it should have been "; phex(ALLOC_MAGIC, 4);
		print ".^";
		return;
	}
#endif;

	! Turn the alloc node into a free node.

	q = p-->AB_SIZE;
#ifdef DEBUG;
	memset(p, $55, q);
#endif;
	p-->FB_MAGIC = FREE_MAGIC;
	p-->FB_NEXT = mem_firstfree;
	p-->FB_PREV = 0;
	p-->FB_SIZE = q;
	if (mem_firstfree)
		mem_firstfree-->FB_PREV = p;
	mem_firstfree = p;

	! Right. We've successfully freed the block; p points to the FB
	! structure.
	!
	! Unfortunately, they way we use memory leads to lots of
	! fragmentation, which is bad. So we need to find out if we can coalesce
	! with the block immediately afterwards.

	if ((p+q)-->0 ~= FREE_MAGIC)
	{
		! Nothing coalescable.
		return;
	}

	! Change the size of our block to encompass the next block...

	p-->FB_SIZE = q + (p+q)-->FB_SIZE;

	! ...and remove the next block from the free list.

	mem_node_remove(p+q);
];

! Get amount of free memory.

[ mem_countfree p size;
	size = 0;
	p = mem_firstfree;
	while (p ~= 0)
	{
		size = size + p-->FB_SIZE;
		p = p-->FB_NEXT;
	}
	return size;
];

! Get total amount of memory.

[ mem_counttotal;
	return (mem_top - mem_bottom);
];
	
! Get amount of used memory.

[ mem_countused;
	return mem_counttotal() - mem_countfree();
];

#ifdef DEBUG;
! Dump the free list.

[ mem_show_free_list p;
	print "Free list start^";
	p = mem_firstfree;
	while (p ~= 0)
	{
		print "  node ", p, " prev=", p-->FB_PREV, " next=", p-->FB_NEXT;
		print " size=", p-->FB_SIZE;
		if (p-->FB_MAGIC ~= FREE_MAGIC)
			print " invalid magic";
		print "^";
		p = p-->FB_NEXT;
	}
	print "Free list end; used=", mem_countused(), " total=", mem_counttotal(), "^";
];

#endif;

