{$MODE FPC}
{$MODESWITCH ADVANCEDRECORDS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
unit dansibuffer;

interface

type
TAnsiEnumerator = record
private
  FCurrent: PAnsiChar;
  FTail: PAnsiChar;
  function GetCurrent: AnsiChar; inline;
public
  procedure Init(S: PAnsiChar; L: SizeUInt);
  procedure Done; inline;
  function MoveNext: Boolean; inline;
  property Current: AnsiChar read GetCurrent;
end;

PAnsiBuffer = ^TAnsiBuffer;
TAnsiBuffer = packed record
private const
  PREFFERED_OBJECT_SIZE = 32;
  SMALL_BUFFER_SIZE = PREFFERED_OBJECT_SIZE - SizeOf(SizeUInt);
private type
  TFields = packed record
    case SizeUInt of
      0: (SmallBuf: array[0 .. SMALL_BUFFER_SIZE - 1] of Byte);
      1: (Data: PAnsiChar; Capacity: SizeUInt);
  end;
private
  //FData: PAnsiChar;
  FLength: SizeUInt;
  // Actual size of allocated data
  //FCapacity: SizeUInt;
  // For small buffer optimization
  //FSmallBuf: array[0 .. SMALL_BUFFER_SIZE - 1] of Byte;
  F: TFields;
  // Tries to allocate data and saves result to FData
  function TryAllocateData(Length: SizeUInt): Boolean; inline;
  // Deallocates Data, assumes FData is a pointer to allocated heap memory
  procedure DeallocateData; inline;
  // Reallocates data and saves result to FData, ssumes FData is a pointer to
  // allocated heap memory
  function TryReAllocateData(NewLength: SizeUInt): Boolean; inline;
  // Returns how many memory allocate if allocation needed
  function GrowStrategy(PreviousLength: SizeUInt): SizeUInt; inline;

  function GetTail: PAnsiChar; inline;
  function GetChar(Index: PtrUInt): AnsiChar; inline;
  procedure SetChar(Index: PtrUInt; C: AnsiChar); inline;

  function GetData: PAnsiChar; inline;
  function GetLength: SizeUInt; inline;
  function GetCapacity: SizeUInt; inline;
public
  // Pseudo constructors and destructor
  procedure Init; overload;
  procedure Init(Data: PAnsiChar; Length: SizeUInt); overload;
  procedure Init(Data, DataEnd: PAnsiChar); overload;
  procedure Init(P: PAnsiChar); overload;
  procedure Init(const A: array of AnsiChar); overload;
  procedure Init(constref Other: TAnsiBuffer); overload;
  procedure Done; inline;

  // Equivalent to S.Done; S.Init(...), but tries to save allocated memory
  procedure ReInit; overload;
  procedure ReInit(Data: PAnsiChar; Length: SizeUInt); overload;
  procedure ReInit(Data, DataEnd: PAnsiChar); overload;
  procedure ReInit(P: PAnsiChar); inline; overload;
  procedure ReInit(const A: array of AnsiChar); inline; overload;
  procedure ReInit(Length: SizeUInt); inline; overload;
  procedure ReInit(constref Other: TAnsiBuffer); inline; overload;

  // Moves data from Self to Other. Sets Self to ''.
  // Both Self and Other must be constructed
  procedure MoveTo(var Other: TAnsiBuffer);

  // Set string length
  procedure SetLength(NewLength: SizeUInt); inline;

  // Reserves memory for Capacity
  procedure Reserve(Capacity: SizeUInt);

  // Returns enumerator (for for-in loops support)
  function GetEnumerator: TAnsiEnumerator; inline;

  // Converts to AnsiString
  function ToString: AnsiString; inline;

  // Checks if the string has no characters, i.e. whether Length=0
  function IsEmpty: Boolean; inline;

  // Checks if the string uses allocated memory
  function IsInHeap: Boolean; inline;

  property Data: PAnsiChar read GetData;
  property Length: SizeUInt read FLength;
  property Capacity: SizeUInt read GetCapacity;
  property Tail: PAnsiChar read GetTail;
  property Chars[Index: SizeUInt]: AnsiChar read GetChar write SetChar; default;
end;

//
//  AnsiMove
//
//      Moves data from Src to Dst. Sets Src to ''.
//
procedure AnsiMove(constref Src: TAnsiBuffer; var Dst: TAnsiBuffer); inline;

implementation

{$IF SizeOf(TAnsiBuffer) <> TAnsiBuffer.PREFFERED_OBJECT_SIZE}
  {$ERROR SizeOf(TAnsiBuffer) must be equal to PREFFERED_OBJECT_SIZE}
{$ENDIF}

procedure TAnsiEnumerator.Init(S: PAnsiChar; L: SizeUInt);
begin
  FCurrent := S - 1;
  FTail := S + L;
end;

procedure TAnsiEnumerator.Done;
begin
end;

function TAnsiEnumerator.GetCurrent: AnsiChar;
begin
  Result := FCurrent^;
end;

function TAnsiEnumerator.MoveNext: Boolean;
begin
  Inc(FCurrent);
  Result := FCurrent < FTail;
end;

function TAnsiBuffer.TryAllocateData(Length: SizeUInt): Boolean;
begin
  F.Data := GetMem(Length);
  F.Capacity := Length;
  Result := F.Data <> nil;
end;

procedure TAnsiBuffer.DeallocateData;
begin
  FreeMem(F.Data);
end;

function TAnsiBuffer.TryReAllocateData(NewLength: SizeUInt): Boolean;
begin
  F.Data := ReAllocMem(Pointer(F.Data), NewLength);
  //FreeMem(FData);
  //FData := GetMem(NewLength);
  F.Capacity := NewLength;
  Result := F.Data <> nil;
end;

function TAnsiBuffer.GrowStrategy(PreviousLength: SizeUInt): SizeUInt;
begin
  Result := PreviousLength shl 1;
end;

function TAnsiBuffer.GetTail: PAnsiChar;
begin
  Result := GetData + FLength;
end;

function TAnsiBuffer.GetChar(Index: PtrUInt): AnsiChar;
begin
  Result := GetData[Index - 1];
end;

procedure TAnsiBuffer.SetChar(Index: PtrUInt; C: AnsiChar);
begin
  GetData[Index - 1] := C;
end;

function TAnsiBuffer.GetData: PAnsiChar;
begin
  if IsInHeap then begin
    Result := F.Data;
  end else
    Result := @F.SmallBuf[0];
end;

function TAnsiBuffer.GetLength: SizeUInt;
begin
  Result := FLength;
end;

function TAnsiBuffer.GetCapacity: SizeUInt;
begin
  if IsInHeap then begin
    Result := F.Capacity;
  end else
    Result := SMALL_BUFFER_SIZE;
end;

procedure TAnsiBuffer.Init;
begin
  Init(nil, 0);
end;

procedure TAnsiBuffer.Init(Data: PAnsiChar; Length: SizeUInt);
begin
  if Length = 0 then begin
    FLength := 0;
    Exit;
  end;
  if Length <= SMALL_BUFFER_SIZE then begin
    Move(Data^, F.SmallBuf[0], Length);
    FLength := Length;
    Exit;
  end;
  if not TryAllocateData(Length) then
    Exit;
  FLength := Length;
  Move(Data^, F.Data^, Length);
end;

procedure TAnsiBuffer.Init(Data, DataEnd: PAnsiChar);
begin
  Init(Data, DataEnd - Data);
end;

procedure TAnsiBuffer.Init(P: PAnsiChar);
begin
  Init(P, StrLen(P));
end;

procedure TAnsiBuffer.Init(const A: array of AnsiChar);
begin
  if (System.Length(A) > 0) and (A[System.High(A)] = #0) then begin
    Init(@A[0], System.Length(A) - 1);
  end else
    Init(@A[0], System.Length(A));
end;

procedure TAnsiBuffer.Init(constref Other: TAnsiBuffer);
begin
  Init(Other.Data, Other.Length);
end;

procedure TAnsiBuffer.Done;
begin
  if IsInHeap then begin
    DeallocateData;
    F.Data := nil;
    FLength := 0;
  end else begin
    F.Data := nil;
    FLength := 0;
  end;
end;

procedure TAnsiBuffer.ReInit; overload;
begin
  ReInit(nil, 0);
end;

procedure TAnsiBuffer.ReInit(Data: PAnsiChar; Length: SizeUInt);
begin
  if Length = 0 then begin
    Done;
    Exit;
  end;
  if IsInHeap then begin
    // Memory allocated
    if Length <= SMALL_BUFFER_SIZE then begin
      FreeMem(F.Data);
      if Data <> nil then
        Move(Data^, F.SmallBuf[0], Length);
      FLength := Length;
      Exit;
    end;
    if Length <= F.Capacity then begin
      if Data <> nil then
        Move(Data^, F.Data^, Length);
      FLength := Length;
      Exit;
    end;
    if not TryReAllocateData(GrowStrategy(Length)) then
      Exit;
    if Data <> nil then
      Move(Data^, F.Data^, Length);
    FLength := Length;
  end else begin
    if Length <= SMALL_BUFFER_SIZE then begin
      if Data <> nil then
        Move(Data^, F.SmallBuf[0], Length);
      FLength := Length;
      Exit;
    end;
    if not TryAllocateData(Length) then
      Exit;
    if Data <> nil then
      Move(Data^, F.Data^, Length);
    FLength := Length;
  end;
end;

procedure TAnsiBuffer.ReInit(Data, DataEnd: PAnsiChar);
begin
  ReInit(Data, DataEnd - Data);
end;

procedure TAnsiBuffer.ReInit(P: PAnsiChar);
begin
  ReInit(P, StrLen(P));
end;

procedure TAnsiBuffer.ReInit(const A: array of AnsiChar);
begin
  if (System.Length(A) > 0) and (A[System.High(A)] = #0) then begin
    ReInit(@A[0], System.Length(A) - 1);
  end else
    ReInit(@A[0], System.Length(A));
end;

procedure TAnsiBuffer.ReInit(Length: SizeUInt);
begin
  ReInit(nil, Length);
end;

procedure TAnsiBuffer.ReInit(constref Other: TAnsiBuffer);
begin
  ReInit(Other.Data, Other.Length);
end;

procedure TAnsiBuffer.MoveTo(var Other: TAnsiBuffer);
begin
  if Other.IsInHeap then
    FreeMem(Other.F.Data);
  Move(Self, Other, SizeOf(TAnsiBuffer));
  FLength := 0;
end;

procedure TAnsiBuffer.SetLength(NewLength: SizeUInt);
begin
  Reserve(NewLength);
  FLength := NewLength;
end;

procedure TAnsiBuffer.Reserve(Capacity: SizeUInt);
begin
  if IsInHeap then begin
    if Capacity <= F.Capacity then
      Exit;
    if not TryReAllocateData(GrowStrategy(Capacity)) then
      Exit;
  end else begin
    if Capacity <= SMALL_BUFFER_SIZE then
      Exit;
    TryAllocateData(GrowStrategy(Capacity));
  end;
end;

function TAnsiBuffer.GetEnumerator: TAnsiEnumerator;
begin
  Result.FCurrent := Data - 1;
  Result.FTail := Tail;
end;

function TAnsiBuffer.ToString: AnsiString;
begin
  SetString(Result, Data, Length);
end;

function TAnsiBuffer.IsEmpty: Boolean;
begin
  Result := FLength = 0;
end;

function TAnsiBuffer.IsInHeap: Boolean;
begin
  // Result := FData <> @FSmallBuf[0];
  Result := FLength > SMALL_BUFFER_SIZE;
end;

procedure AnsiMove(constref Src: TAnsiBuffer; var Dst: TAnsiBuffer);
begin
  Src.MoveTo(Dst);
end;

end.
