FPGDBMIDebugger: starting a parser for pascal expressions

git-svn-id: trunk@43196 -
This commit is contained in:
martin 2013-10-10 19:24:06 +00:00
parent 41d824bbe4
commit 3c36cadea0

View File

@ -5,12 +5,188 @@ unit FpGdbmiDebugger;
interface interface
uses uses
Classes, sysutils, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger, GDBMIMiscClasses, Classes, sysutils, math, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger,
GDBTypeInfo, maps, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst, LazLoggerBase, GDBMIMiscClasses, GDBTypeInfo, maps, LCLProc, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst,
LazLoggerProfiling; LazLoggerBase, LazLoggerProfiling;
type type
TFpGDBMIExpressionPart = class;
TFpGDBMIExpressionPartClass = class of TFpGDBMIExpressionPart;
{ TFpGDBMIExpression }
TFpGDBMIExpression = class
private
FError: String;
FTextExpression: String;
FExpressionPart: TFpGDBMIExpressionPart;
FValid: Boolean;
procedure Parse;
procedure SetError(AMsg: String);
function PosFromPChar(APChar: PChar): Integer;
protected
property ExpressionPart: TFpGDBMIExpressionPart read FExpressionPart;
public
constructor Create(ATextExpression: String);
destructor Destroy; override;
function DebugDump: String;
property Error: String read FError;
property Valid: Boolean read FValid;
end;
TFpGDBMIExpressionPartContainer = class;
TFpGDBMIExpressionPartBracket = class;
{ TFpGDBMIExpressionPart }
TFpGDBMIExpressionPart = class
private
FEndChar: PChar;
FParent: TFpGDBMIExpressionPartContainer;
FStartChar: PChar;
FExpression: TFpGDBMIExpression;
function GetSurroundingBracket: TFpGDBMIExpressionPartBracket;
function GetTopParent: TFpGDBMIExpressionPart;
procedure SetEndChar(AValue: PChar);
procedure SetParent(AValue: TFpGDBMIExpressionPartContainer);
procedure SetStartChar(AValue: PChar);
function GetText(AMaxLen: Integer=0): String;
procedure SetError(AMsg: String = '');
procedure SetError(APart: TFpGDBMIExpressionPart; AMsg: String = '');
protected
function DebugText(AIndent: String): String; virtual; // Self desc only
function DebugDump(AIndent: String): String; virtual;
protected
procedure Init; virtual;
Procedure ReplaceInParent(AReplacement: TFpGDBMIExpressionPart);
procedure DoHandleEndOfExpression; virtual;
function IsValidNextPart(APart: TFpGDBMIExpressionPart): Boolean; virtual;
function CanHaveBinaryOperatorAsNext: Boolean; virtual; // True
public
constructor Create(AExpression: TFpGDBMIExpression; AStartChar: PChar; AnEndChar: PChar = nil);
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; virtual;
procedure HandleEndOfExpression; virtual;
property StartChar: PChar read FStartChar write SetStartChar;
property EndChar: PChar read FEndChar write SetEndChar;
property Parent: TFpGDBMIExpressionPartContainer read FParent write SetParent;
property TopParent: TFpGDBMIExpressionPart read GetTopParent; // or self
property SurroundingBracket: TFpGDBMIExpressionPartBracket read GetSurroundingBracket; // incl self
end;
{ TFpGDBMIExpressionPartContainer }
TFpGDBMIExpressionPartContainer = class(TFpGDBMIExpressionPart)
private
FList: TList;
function GetCount: Integer;
function GetItems(AIndex: Integer): TFpGDBMIExpressionPart;
function GetLastItem: TFpGDBMIExpressionPart;
procedure SetItems(AIndex: Integer; AValue: TFpGDBMIExpressionPart);
procedure SetLastItem(AValue: TFpGDBMIExpressionPart);
protected
procedure Init; override;
function DebugDump(AIndent: String): String; override;
public
destructor Destroy; override;
function Add(APart: TFpGDBMIExpressionPart): Integer;
function IndexOf(APart: TFpGDBMIExpressionPart): Integer;
procedure Clear;
property Count: Integer read GetCount;
property Items[AIndex: Integer]: TFpGDBMIExpressionPart read GetItems write SetItems;
property LastItem: TFpGDBMIExpressionPart read GetLastItem write SetLastItem;
end;
{ TFpGDBMIExpressionPartIdentifer }
TFpGDBMIExpressionPartIdentifer = class(TFpGDBMIExpressionPartContainer)
// may >contain< "()" or "[]"
public
end;
TFpGDBMIExpressionPartBracket = class(TFpGDBMIExpressionPartContainer)
end;
{ TFpGDBMIExpressionPartRoundBracket }
TFpGDBMIExpressionPartRoundBracket = class(TFpGDBMIExpressionPartBracket)
private
FIsClosed: boolean;
FIsClosing: boolean;
protected
procedure Init; override;
procedure DoHandleEndOfExpression; override;
function CanHaveBinaryOperatorAsNext: Boolean; override;
public
procedure CloseBracket;
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override;
procedure HandleEndOfExpression; override;
property IsClosed: boolean read FIsClosed;
end;
{ TFpGDBMIExpressionPartOperator }
TFpGDBMIExpressionPartOperator = class(TFpGDBMIExpressionPartContainer)
private
FIsUnary: Boolean;
FPrecedence: Integer;
protected
function DebugText(AIndent: String): String; override;
function CanHaveBinaryOperatorAsNext: Boolean; override;
procedure DoHandleEndOfExpression; override;
public
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override;
function HandlePrevPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; virtual;
property IsUnary: Boolean read FIsUnary;
property Precedence: Integer read FPrecedence;
end;
{ TFpGDBMIExpressionPartUnaryOperator }
TFpGDBMIExpressionPartUnaryOperator = class(TFpGDBMIExpressionPartOperator)
protected
procedure Init; override;
public
end;
{ TFpGDBMIExpressionPartBinaryOperator }
TFpGDBMIExpressionPartBinaryOperator = class(TFpGDBMIExpressionPartOperator)
protected
procedure Init; override;
public
end;
{ TFpGDBMIExpressionPartOperatorAddressOf }
TFpGDBMIExpressionPartOperatorAddressOf = class(TFpGDBMIExpressionPartUnaryOperator) // @
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorUnaryPlusMinus }
TFpGDBMIExpressionPartOperatorUnaryPlusMinus = class(TFpGDBMIExpressionPartUnaryOperator) // + -
// Unary + -
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorPlusMinus }
TFpGDBMIExpressionPartOperatorPlusMinus = class(TFpGDBMIExpressionPartBinaryOperator) // + -
// Binary + -
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorMulDiv }
TFpGDBMIExpressionPartOperatorMulDiv = class(TFpGDBMIExpressionPartBinaryOperator) // * /
protected
procedure Init; override;
end;
TFpGDBMIDebugger = class; TFpGDBMIDebugger = class;
{ TFpGDBPTypeRequestCache } { TFpGDBPTypeRequestCache }
@ -96,6 +272,581 @@ type
procedure Cancel(const ASource: String); override; procedure Cancel(const ASource: String); override;
end; end;
{ TFpGDBMIExpressionPartRoundBracket }
procedure TFpGDBMIExpressionPartRoundBracket.Init;
begin
inherited Init;
FIsClosed := False;
FIsClosing := False;
end;
procedure TFpGDBMIExpressionPartRoundBracket.DoHandleEndOfExpression;
begin
if not IsClosed then begin
SetError('Bracket not closed');
exit;
end;
inherited DoHandleEndOfExpression;
end;
function TFpGDBMIExpressionPartRoundBracket.CanHaveBinaryOperatorAsNext: Boolean;
begin
Result := IsClosed;
end;
procedure TFpGDBMIExpressionPartRoundBracket.CloseBracket;
begin
FIsClosing := True;
if LastItem <> nil then
LastItem.HandleEndOfExpression;
FIsClosing := False;
FIsClosed := True;
end;
function TFpGDBMIExpressionPartRoundBracket.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart;
begin
if IsClosed then begin
Result := inherited HandleNextPart(APart);
exit;
end;
Result := Self;
if Count > 0 then begin
SetError('To many expressions');
exit;
end;
Result := APart;
Add(APart);
end;
procedure TFpGDBMIExpressionPartRoundBracket.HandleEndOfExpression;
begin
if not FIsClosing then
inherited HandleEndOfExpression;
end;
{ TFpGDBMIExpressionPartOperatorUnaryPlusMinus }
procedure TFpGDBMIExpressionPartOperatorUnaryPlusMinus.Init;
begin
FPrecedence := 1;
inherited Init;
end;
{ TFpGDBMIExpression }
procedure TFpGDBMIExpression.Parse;
var
CurPtr, EndPtr, TokenEndPtr: PChar;
CurPart, NewPart: TFpGDBMIExpressionPart;
procedure AddPart(AClass: TFpGDBMIExpressionPartClass);
begin
NewPart := AClass.Create(Self, CurPtr, TokenEndPtr-1);
end;
procedure AddPlusMinus;
begin
if (CurPart = nil) or (not CurPart.CanHaveBinaryOperatorAsNext)
then
AddPart(TFpGDBMIExpressionPartOperatorUnaryPlusMinus)
else
AddPart(TFpGDBMIExpressionPartOperatorPlusMinus);
end;
procedure AddConstChar;
begin
end;
procedure AddConstNumber;
begin
end;
procedure AddIdentifier;
begin
while TokenEndPtr^ in ['a'..'z', 'A'..'Z', '_', '0'..'9'] do
inc(TokenEndPtr);
// TODO: Check functions not, and, in, as, is ...
NewPart := TFpGDBMIExpressionPartIdentifer.Create(Self, CurPtr, TokenEndPtr-1);
end;
procedure CloseRounBracket;
begin
NewPart := CurPart.SurroundingBracket;
if NewPart = nil then begin
SetError('Closing bracket "(" found without opening')
end
else
if not (NewPart is TFpGDBMIExpressionPartRoundBracket) then begin
SetError('Mismatch bracket')
end
else begin
TFpGDBMIExpressionPartRoundBracket(NewPart).CloseBracket;
CurPart := nil;
end;
end;
begin
if FTextExpression = '' then
exit;
CurPtr := @FTextExpression[1];
EndPtr := CurPtr + length(FTextExpression);
CurPart := nil;
While (CurPtr < EndPtr) and FValid do begin
if CurPtr^ in [' ', #9, #10, #13] then begin
while (CurPtr^ in [' ', #9, #10, #13]) and (CurPtr < EndPtr) do
Inc(CurPtr);
continue;
end;
NewPart := nil;
TokenEndPtr := CurPtr + 1;
case CurPtr^ of
'@' : AddPart(TFpGDBMIExpressionPartOperatorAddressOf);
'+', '-' : AddPlusMinus;
'*', '/' : AddPart(TFpGDBMIExpressionPartOperatorMulDiv);
'(': AddPart(TFpGDBMIExpressionPartRoundBracket);
')': CloseRounBracket;
//'[': ;
//'''': AddConstChar;
//'0'..'9',
//'$', '%': AddConstNumber;
'a'..'z',
'A'..'Z', '_': AddIdentifier;
else begin
SetError(Format('Unexpected char ''%0:s'' at pos %1:s', [CurPtr^, PosFromPChar(CurPtr)])); // error
break;
end;
end;
if not FValid then
break;
assert(NewPart <> nil);
debugln('=================================');
DebugLn('NEWPART: '+NewPart.DebugText(''));
if CurPart = nil
then CurPart := NewPart
else CurPart := CurPart.HandleNextPart(NewPart);
DebugLn('CURPART: '+CurPart.DebugText(''));
CurPtr := TokenEndPtr;
end; // While CurPtr < EndPtr do begin
if CurPart <> nil then begin
CurPart.HandleEndOfExpression;
CurPart := CurPart.TopParent;
end
else
if Valid then
SetError('No Expression');
FExpressionPart := CurPart;
end;
procedure TFpGDBMIExpression.SetError(AMsg: String);
begin
FValid := False;
FError := AMsg;
end;
function TFpGDBMIExpression.PosFromPChar(APChar: PChar): Integer;
begin
Result := APChar - @FTextExpression[1] + 1;
end;
constructor TFpGDBMIExpression.Create(ATextExpression: String);
begin
FTextExpression := ATextExpression;
FValid := True;
Parse;
end;
destructor TFpGDBMIExpression.Destroy;
begin
FreeAndNil(FExpressionPart);
inherited Destroy;
end;
function TFpGDBMIExpression.DebugDump: String;
begin
Result := 'TFpGDBMIExpression: ' + FTextExpression + LineEnding +
'Valid: ' + dbgs(FValid) + ' Error: "' + FError + '"'+ LineEnding
;
if FExpressionPart <> nil then
Result := Result + FExpressionPart.DebugDump(' ');
end;
{ TFpGDBMIExpressionPartContainer }
function TFpGDBMIExpressionPartContainer.GetItems(AIndex: Integer): TFpGDBMIExpressionPart;
begin
Result := TFpGDBMIExpressionPart(FList[AIndex]);
end;
function TFpGDBMIExpressionPartContainer.GetLastItem: TFpGDBMIExpressionPart;
begin
if Count > 0 then
Result := Items[Count - 1]
else
Result := nil;
end;
procedure TFpGDBMIExpressionPartContainer.SetItems(AIndex: Integer;
AValue: TFpGDBMIExpressionPart);
begin
AValue.Parent := Self;
FList[AIndex] := AValue;
end;
procedure TFpGDBMIExpressionPartContainer.SetLastItem(AValue: TFpGDBMIExpressionPart);
begin
assert(Count >0);
Items[Count-1] := AValue;
end;
procedure TFpGDBMIExpressionPartContainer.Init;
begin
FList := TList.Create;
inherited Init;
end;
function TFpGDBMIExpressionPartContainer.DebugDump(AIndent: String): String;
var
i: Integer;
begin
Result := inherited DebugDump(AIndent);
for i := 0 to Count - 1 do
Result := Result + Items[i].DebugDump(AIndent+' ');
end;
function TFpGDBMIExpressionPartContainer.GetCount: Integer;
begin
Result := FList.Count;
end;
destructor TFpGDBMIExpressionPartContainer.Destroy;
begin
Clear;
FreeAndNil(FList);
inherited Destroy;
end;
function TFpGDBMIExpressionPartContainer.Add(APart: TFpGDBMIExpressionPart): Integer;
begin
APart.Parent := Self;
Result := FList.Add(APart);
end;
function TFpGDBMIExpressionPartContainer.IndexOf(APart: TFpGDBMIExpressionPart): Integer;
begin
Result := Count - 1;
while (Result >= 0) and (Items[Result] <> APart) do
dec(Result);
end;
procedure TFpGDBMIExpressionPartContainer.Clear;
begin
while Count > 0 do begin
Items[0].Free;
FList.Delete(0);
end;
end;
{ TFpGDBMIExpressionPart }
procedure TFpGDBMIExpressionPart.SetEndChar(AValue: PChar);
begin
if FEndChar = AValue then Exit;
FEndChar := AValue;
end;
function TFpGDBMIExpressionPart.GetTopParent: TFpGDBMIExpressionPart;
begin
Result := Self;
while Result.Parent <> nil do
Result := Result.Parent;
end;
function TFpGDBMIExpressionPart.GetSurroundingBracket: TFpGDBMIExpressionPartBracket;
var
tmp: TFpGDBMIExpressionPart;
begin
Result := nil;
tmp := Self;
while (tmp <> nil) and not(tmp is TFpGDBMIExpressionPartBracket) do
tmp := tmp.Parent;
if tmp <> nil then
Result := TFpGDBMIExpressionPartBracket(tmp);
end;
procedure TFpGDBMIExpressionPart.SetParent(AValue: TFpGDBMIExpressionPartContainer);
var
Old: TFpGDBMIExpressionPart;
begin
if FParent = AValue then Exit;
Old := FParent;
FParent := AValue;
end;
procedure TFpGDBMIExpressionPart.SetStartChar(AValue: PChar);
begin
if FStartChar = AValue then Exit;
FStartChar := AValue;
end;
function TFpGDBMIExpressionPart.GetText(AMaxLen: Integer): String;
var
Len: Integer;
begin
if FEndChar <> nil
then Len := FEndChar - FStartChar + 1
else Len := min(AMaxLen, 10);
if (AMaxLen > 0) and (Len > AMaxLen) then
Len := AMaxLen;
Result := Copy(FStartChar, 1, Len);
end;
procedure TFpGDBMIExpressionPart.SetError(AMsg: String);
begin
if AMsg = '' then
AMsg := 'Invalid Expression';
FExpression.SetError(Format('%0:s at %1:d: "%2:s"', [AMsg, FExpression.PosFromPChar(FStartChar), GetText(20)]));
end;
procedure TFpGDBMIExpressionPart.SetError(APart: TFpGDBMIExpressionPart; AMsg: String);
begin
if APart <> nil
then APart.SetError(AMsg)
else Self.SetError(AMsg);
end;
procedure TFpGDBMIExpressionPart.Init;
begin
//
end;
procedure TFpGDBMIExpressionPart.ReplaceInParent(AReplacement: TFpGDBMIExpressionPart);
var
i: Integer;
begin
if Parent = nil then exit;
i := Parent.IndexOf(Self);
Assert(i >= 0);
Parent.Items[i] := AReplacement;
Parent := nil;
end;
procedure TFpGDBMIExpressionPart.DoHandleEndOfExpression;
begin
//
end;
function TFpGDBMIExpressionPart.IsValidNextPart(APart: TFpGDBMIExpressionPart): Boolean;
begin
Result := True;
if (APart is TFpGDBMIExpressionPartOperator) and
(not TFpGDBMIExpressionPartOperator(APart).IsUnary)
then
Result := Result and CanHaveBinaryOperatorAsNext;
//TODO move
if (Parent <> nil) and (Parent is TFpGDBMIExpressionPartOperator) and
(not TFpGDBMIExpressionPartOperator(APart).IsUnary) and
(APart is TFpGDBMIExpressionPartOperator)
then
Result := False; //Result and CanHaveBinaryOperatorAsNext;
end;
function TFpGDBMIExpressionPart.CanHaveBinaryOperatorAsNext: Boolean;
begin
Result := True;
end;
function TFpGDBMIExpressionPart.DebugText(AIndent: String): String;
begin
Result := Format('%s%s at %d: "%s"',
[AIndent, ClassName, FExpression.PosFromPChar(FStartChar), GetText])
+ LineEnding;
end;
function TFpGDBMIExpressionPart.DebugDump(AIndent: String): String;
begin
Result := DebugText(AIndent);
end;
constructor TFpGDBMIExpressionPart.Create(AExpression: TFpGDBMIExpression; AStartChar: PChar;
AnEndChar: PChar);
begin
FExpression := AExpression;
FStartChar := AStartChar;
FEndChar := AnEndChar;
Init;
end;
function TFpGDBMIExpressionPart.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart;
begin
if (APart is TFpGDBMIExpressionPartOperator) and IsValidNextPart(APart) then begin
Result := TFpGDBMIExpressionPartOperator(APart).HandlePrevPart(Self);
exit;
end;
if Parent <> nil then begin
Result := Parent.HandleNextPart(APart);
exit;
end;
SetError(APart, 'Unexpected ');
APart.Free;
Result := Self;
end;
procedure TFpGDBMIExpressionPart.HandleEndOfExpression;
begin
DoHandleEndOfExpression;
if Parent <> nil then
Parent.HandleEndOfExpression;
end;
{ TFpGDBMIExpressionPartOperator }
function TFpGDBMIExpressionPartOperator.DebugText(AIndent: String): String;
begin
Result := inherited DebugText(AIndent);
while Result[Length(Result)] in [#10, #13] do SetLength(Result, Length(Result)-1);
Result := Result +
' IsUnary:' + dbgs(FIsUnary) +
' Precedence:' + dbgs(FPrecedence) +
LineEnding;
end;
function TFpGDBMIExpressionPartOperator.CanHaveBinaryOperatorAsNext: Boolean;
begin
if IsUnary then
Result := (Count = 1) and Items[0].CanHaveBinaryOperatorAsNext
else
Result := (Count = 2) and Items[1].CanHaveBinaryOperatorAsNext;
end;
procedure TFpGDBMIExpressionPartOperator.DoHandleEndOfExpression;
begin
if (IsUnary and (Count < 1)) or
(not IsUnary and (Count < 2))
then
SetError(Self, 'Not enough operands')
else
inherited DoHandleEndOfExpression;
end;
function TFpGDBMIExpressionPartOperator.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart;
begin
Result := Self;
if (IsUnary and (Count > 0)) or (Count > 1) then begin
Result := inherited HandleNextPart(APart);
exit;
end;
if not IsValidNextPart(APart) then begin
SetError(APart, 'Not possible after Operator '+GetText+': ');
APart.Free;
exit;
end;
Add(APart);
Result := APart;
end;
function TFpGDBMIExpressionPartOperator.HandlePrevPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart;
var
OpPart: TFpGDBMIExpressionPartOperator;
begin
Result := Self;
if IsUnary or // Unary has no previous // TODO deref ^
(Count > 0) or // Previous already set
(not APart.CanHaveBinaryOperatorAsNext) // can not have 2 operators follow each other
then begin
SetError(APart, 'Can not apply operator '+GetText+': ');
APart.Free;
Result := Self;
exit
end;
// precedence: 1 = highest
if APart is TFpGDBMIExpressionPartOperator then begin
OpPart := TFpGDBMIExpressionPartOperator(APart);
while true do begin
if OpPart.LastItem = nil then begin
SetError(APart, 'Internal parser error for operator '+GetText+': ');
APart.Free;
Result := Self;
exit
end;
if OpPart.Precedence > Self.Precedence then begin
if (OpPart.LastItem is TFpGDBMIExpressionPartOperator) and
(TFpGDBMIExpressionPartOperator(OpPart.LastItem).Precedence > Self.Precedence)
then begin
OpPart := TFpGDBMIExpressionPartOperator(OpPart.LastItem);
continue;
end;
// APart := OpPart.LastItem; break;
Add(OpPart.LastItem);
OpPart.LastItem := Self;
exit;
end;
break;
end;
end;
APart.ReplaceInParent(Self);
Add(APart);
end;
{ TFpGDBMIExpressionPartUnaryOperator }
procedure TFpGDBMIExpressionPartUnaryOperator.Init;
begin
FIsUnary := True;
inherited Init;
end;
{ TFpGDBMIExpressionPartBinaryOperator }
procedure TFpGDBMIExpressionPartBinaryOperator.Init;
begin
FIsUnary := False;
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorAddressOf }
procedure TFpGDBMIExpressionPartOperatorAddressOf.Init;
begin
FPrecedence := 1; // highest
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorPlusMinus }
procedure TFpGDBMIExpressionPartOperatorPlusMinus.Init;
begin
FPrecedence := 3;
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorMulDiv }
procedure TFpGDBMIExpressionPartOperatorMulDiv.Init;
begin
FPrecedence := 2;
inherited Init;
end;
{ TFpGDBPTypeRequestCache } { TFpGDBPTypeRequestCache }
constructor TFpGDBPTypeRequestCache.Create(ADebugger: TFpGDBMIDebugger); constructor TFpGDBPTypeRequestCache.Create(ADebugger: TFpGDBMIDebugger);