unit dflash_stackallocator;

{$MODE FPC}
{$MODESWITCH ADVANCEDRECORDS}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

type
PStackAllocator = ^TStackAllocator;
TStackAllocator = record
public const
  PAGE_SIZE = 1024 * 1024;
public type
  PPage = ^TPage;
  TPage = record
  private
    Prev: PPage;
    Buffer: array[0 .. PAGE_SIZE - 1] of Byte;
  end;
private
  Cur: Pointer;
  BufEnd: Pointer;
  PageSize: SizeUInt;
  Page: PPage;
  LastPtr: Pointer;
  LastSize: SizeUInt;
end;

procedure saInit(Stack: PStackAllocator; PageSize: SizeUInt = TStackAllocator.PAGE_SIZE);
procedure saDone(Stack: PStackAllocator);
function saGetMem(Stack: PStackAllocator; Size: SizeUInt): Pointer;
procedure saFreeMem(Stack: PStackAllocator; Ptr: Pointer);

implementation

procedure saInit(Stack: PStackAllocator; PageSize: SizeUInt = TStackAllocator.PAGE_SIZE);
begin
  Stack^.Cur := nil;
  Stack^.BufEnd := nil;
  Stack^.PageSize := PageSize;
  Stack^.Page := nil;
  Stack^.LastPtr := nil;
  Stack^.LastSize := 0;
end;

procedure saDone(Stack: PStackAllocator);
var
  Page, Next: TStackAllocator.PPage;
begin
  Page := Stack^.Page;
  while Page <> nil do begin
    Next := Page^.Prev;
    FreeMem(Page);
    Page := Next;
  end;
  Stack^.Page := nil;
end;

function saGetMem(Stack: PStackAllocator; Size: SizeUInt): Pointer;
var
  Page: TStackAllocator.PPage;
begin
  if Size > Stack^.BufEnd - Stack^.Cur then begin
    if Size > Stack^.PageSize then begin
      Page := GetMem(Size + SizeOf(TStackAllocator.PPage));
      Result := @Page^.Buffer[0];
      if Stack^.Page <> nil then begin
        Page^.Prev := Stack^.Page^.Prev;
        Stack^.Page^.Prev := Page;
      end else begin
        Page^.Prev := nil;
        Stack^.Page := Page;
      end;
      Exit;
    end;
    Page := GetMem(SizeOf(TStackAllocator.TPage));
    Page^.Prev := Stack^.Page;
    Stack^.Page := Page;
    Stack^.Cur := @Page^.Buffer[0];
    Stack^.BufEnd := @Page^.Buffer[0] + Stack^.PageSize;
  end;
  Result := Stack^.Cur;
  Inc(Stack^.Cur, Size);
  Stack^.LastPtr := Result;
  Stack^.LastSize := Size;
end;

procedure saFreeMem(Stack: PStackAllocator; Ptr: Pointer);
begin
  if Ptr = Stack^.LastPtr then begin
    Dec(Stack^.Cur, Stack^.LastSize);
  end;
end;

end.
