{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
unit dstringpool;

interface

uses
  dstrings;

type
TStringPool = object
public const
  DEFAULT_PAGE_SIZE = 16 * 256;
private
  FPos: PAnsiChar;
  FFinish: PAnsiChar;
  FPageSize: LongInt;
  FPageHeader: Pointer; // private data
  FClientMemory: Boolean;
public
  procedure Init(PageSize: LongInt = DEFAULT_PAGE_SIZE);
  procedure Init(ClientPtr: Pointer;
                 ClientLength: SizeInt);
  procedure Done;
  function Append(const S: TAnsiView; out Res: TAnsiView): Boolean;
  //function Append(const S: array of AnsiChar; out Res: TAnsiView): Boolean; inline;
end;

implementation

type
PPageHeader = ^TPageHeader;
TPageHeader = record
  Start: Pointer;
  Previous: Pointer;
end;

procedure TStringPool.Init(PageSize: LongInt = DEFAULT_PAGE_SIZE);
begin
  FPos := nil;
  FFinish := nil;
  FPageSize := PageSize;
  FPageHeader := nil;
  FClientMemory := False;
end;

procedure TStringPool.Init(ClientPtr: Pointer; ClientLength: SizeInt);
begin
  FPos := ClientPtr;
  FFinish := FPos + ClientLength;
  FPageSize := 0;
  FPageHeader := nil;
  FClientMemory := True;
end;

procedure TStringPool.Done;
var
  NextHeader: PPageHeader;
begin
  if not FClientMemory then begin
    while FPageHeader <> nil do begin
      NextHeader := PPageHeader(FPageHeader)^.Previous;
      FreeMem(PPageHeader(FPageHeader)^.Start);
      FPageHeader := NextHeader;
    end;
  end;
end;

function TryExtend(var StringPool: TStringPool; NewSize: SizeInt): Boolean;
label
  _Exit;
var
  SavedReturnNilIfGrowHeapFails: Boolean;
  NewPage: Pointer;
  S: LongInt;
  NewHeader: PPageHeader;
begin
  if StringPool.FClientMemory then
    Exit(False);

  SavedReturnNilIfGrowHeapFails := ReturnNilIfGrowHeapFails;
  ReturnNilIfGrowHeapFails := True;

  S := NewSize + StringPool.FPageSize;
  NewPage := GetMem(S + SizeOf(TPageHeader));
  if NewPage = nil then begin
    S := NewSize;
    NewPage := GetMem(S + SizeOf(TPageHeader));
  end;
  if NewPage = nil then begin
    Result := False;
    goto _Exit;
  end;

  NewHeader := PPageHeader(PByte(NewPage) + S);
  NewHeader^.Start := NewPage;
  NewHeader^.Previous := StringPool.FPageHeader;
  StringPool.FPageHeader := NewHeader;
  StringPool.FPos := PAnsiChar(NewPage);
  StringPool.FFinish := PAnsiChar(NewHeader);
  Result := True;

_Exit:
  ReturnNilIfGrowHeapFails := SavedReturnNilIfGrowHeapFails;
end;

function TStringPool.Append(const S: TAnsiView; out Res: TAnsiView): Boolean;
begin
  Res.Data := FPos + S.Length;
  if PAnsiChar(Res.Data) > FFinish then begin
    Result := TryExtend(Self, S.Length);
    if not Result then
      Exit;
  end else begin
    Result := True;
  end;
  Res.Data := FPos;
  Res.Length := S.Length;
  Move(S.Data^, Res.Data^, Res.Length);
  Inc(FPos, S.Length);
end;

//function TStringPool.Append(const S: array of AnsiChar; out Res: TAnsiView): Boolean;
//begin
//  Result := Append(AnsiView(S), Res);
//end;

end.
