Unit HEAP;

interface
var
	HEAP_TOP:word; // memory occupied by heap
	HEAP_SIZE:word; // heap size
	_mem:array[0..0] of byte;

procedure HEAP_Init(baseAdr,size:word);
function HEAP_Allocate(size:word):word;
function HEAP_GetAddr(hptr:word):word;
function HEAP_GetSize(hptr:word):word;
procedure HEAP_Release(hptr:word);
function HEAP_FreeMem():word;

implementation
const
	HEAP_MAX = 256; // maximum of heap entrys

var
	_heap_offsets:array[0..HEAP_MAX-1] of word;
	_heap_sizes:array[0..HEAP_MAX-1] of word;

function HEAP_Allocate(size:word):word;
var
	i,_heap_entry:word;

begin
	if (size=0) or (size>HEAP_SIZE) then
	begin
		result:=$ffff; exit;
	end;
	// find first free entry in heap_pointers list
	for i:=0 to HEAP_MAX-1 do
		if (_heap_offsets[i]=$ffff) then
			_heap_entry:=i;

	// store HEAP_TOP in entry
	_heap_offsets[_heap_entry]:=HEAP_TOP;
	// store reserved size
	_heap_sizes[_heap_entry]:=size;

	// return heap entry
	result:=_heap_entry;

	// incrace HEAP_TOP
	HEAP_TOP:=HEAP_TOP+size;
end;

function HEAP_GetAddr(hptr:word):word;
begin
	if (hptr<>$ffff) then
		result:=_heap_offsets[hptr]
	else
		result:=$ffff;
end;

function HEAP_GetSize(hptr:word):word;
begin
	if (hptr<>$ffff) then
		result:=_heap_sizes[hptr]
	else
		result:=0;
end;

procedure HEAP_Release(hptr:word);
var
	c,adr,size:word;

begin
	// get entry address
	adr:=_heap_offsets[hptr];
	size:=_heap_sizes[hptr];
	// keep from releasing the free pointer
	if (adr=$ffff) then exit;

	if (adr+size<HEAP_TOP) then
	begin
		// search the heap for addresses greater than or equal to the pointer to be released (its address)
		for c:=0 to HEAP_SIZE-1 do
			if (_heap_offsets[c]>=adr) then
				_heap_offsets[c]:=_heap_offsets[c]-size;
	// shift heap move data up the heap, freeing up heap memory
		move(@_mem[adr+size],@_mem[adr],size);
	end;

	_heap_offsets[hptr]:=$ffff;
	HEAP_TOP:=HEAP_TOP-size;
end;

function HEAP_FreeMem:word;
begin
	result:=HEAP_SIZE-HEAP_TOP;
end;

procedure HEAP_Init(baseAdr,size:word);
begin
	_mem:=pointer(baseAdr);
	HEAP_SIZE:=size;
	fillchar(@_mem,size,$ff);
	fillchar(@_heap_offsets,HEAP_MAX*2,$FF);
	fillchar(@_heap_sizes,HEAP_MAX*2,$FF);
end;

end.