paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 03:56:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPGDBMIDebugger: starting a parser for pascal expressions / moved to package fpdebug

Browse Source 
git-svn-id: trunk@43207 -
This commit is contained in:
martin 2013-10-11 15:24:55 +00:00
parent 5f20810780
commit 5289d90d94
5 changed files with 926 additions and 879 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1238,6 +1238,7 @@ components/fpdebug/fpimgreaderelf.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderelftypes.pas svneol=native#text/pascal components/fpdebug/fpimgreaderelftypes.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderwinpe.pas svneol=native#text/pascal components/fpdebug/fpimgreaderwinpe.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderwinpetypes.pas svneol=native#text/pascal components/fpdebug/fpimgreaderwinpetypes.pas svneol=native#text/pascal
components/fpdebug/fppascalparser.pas svneol=native#text/pascal
components/fpdebug/test/asmtest.lpi svneol=native#text/plain components/fpdebug/test/asmtest.lpi svneol=native#text/plain
components/fpdebug/test/asmtest.lpr svneol=native#text/pascal components/fpdebug/test/asmtest.lpr svneol=native#text/pascal
components/fpdebug/test/asmtestunit.lfm svneol=native#text/plain components/fpdebug/test/asmtestunit.lfm svneol=native#text/plain

13
components/fpdebug/fpdebug.lpk
View File

@ -3,6 +3,7 @@
<Package Version="4"> <Package Version="4">
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Name Value="fpdebug"/> <Name Value="fpdebug"/>
<Author Value="Lazarus Team"/>
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
@ -20,9 +21,11 @@
Based on: Based on:
1) FPDebug by Marc Weustink 1) FPDebug by Marc Weustink
2) Duby by Dmitry Boyarintsev"/> 2) Duby by Dmitry Boyarintsev
Extended by Martin Friebe"/>
<License Value="GPL"/> <License Value="GPL"/>
<Files Count="13"> <Files Count="14">
<Item1> <Item1>
<Filename Value="fpdbgclasses.pp"/> <Filename Value="fpdbgclasses.pp"/>
<UnitName Value="FpDbgClasses"/> <UnitName Value="FpDbgClasses"/>
@ -73,8 +76,12 @@ Based on:
</Item12> </Item12>
<Item13> <Item13>
<Filename Value="fpimgreaderbase.pas"/> <Filename Value="fpimgreaderbase.pas"/>
<UnitName Value="fpimgreaderbase"/> <UnitName Value="FpImgReaderBase"/>
</Item13> </Item13>
<Item14>
<Filename Value="fppascalparser.pas"/>
<UnitName Value="fppascalparser"/>
</Item14>
</Files> </Files>
<Type Value="RunAndDesignTime"/> <Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">

2
components/fpdebug/fpdebug.pas
View File

@ -9,7 +9,7 @@ interface
uses uses
FpDbgClasses, FpDbgDisasX86, FpDbgDwarf, FpDbgDwarfConst, FpDbgLoader, FpDbgPETypes, FpDbgClasses, FpDbgDisasX86, FpDbgDwarf, FpDbgDwarfConst, FpDbgLoader, FpDbgPETypes,
FpDbgSymbols, FpDbgUtil, FpDbgWinExtra, FpImgReaderWinPE, FpImgReaderElf, FpDbgSymbols, FpDbgUtil, FpDbgWinExtra, FpImgReaderWinPE, FpImgReaderElf,
FpImgReaderElfTypes, FpImgReaderBase, LazarusPackageIntf; FpImgReaderElfTypes, FpImgReaderBase, FpPascalParser, LazarusPackageIntf;
implementation implementation

913
components/fpdebug/fppascalparser.pas Normal file
View File

@ -0,0 +1,913 @@
{
---------------------------------------------------------------------------
FpPascalParser.pas - Native Freepascal debugger - Parse pascal expressions
---------------------------------------------------------------------------
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit FpPascalParser;
{$mode objfpc}{$H+}
interface
uses
Classes, sysutils, math, LCLProc, FpDbgDwarf, LazLoggerBase;
type
TFpGDBMIExpressionPart = class;
TFpGDBMIExpressionPartContainer = class;
TFpGDBMIExpressionPartBracket = class;
TFpGDBMIExpressionPartOperator = class;
TFpGDBMIExpressionPartClass = class of TFpGDBMIExpressionPart;
TFpGDBMIExpressionPartBracketClass = class of TFpGDBMIExpressionPartBracket;
{ 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;
{ 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 IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; virtual;
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; virtual;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; virtual;
function CanHaveOperatorAsNext: 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)
public
end;
{ TFpGDBMIExpressionPartBracket }
TFpGDBMIExpressionPartBracket = class(TFpGDBMIExpressionPartContainer)
private
FIsClosed: boolean;
FIsClosing: boolean;
protected
procedure Init; override;
procedure DoHandleEndOfExpression; override;
function CanHaveOperatorAsNext: Boolean; override;
public
procedure CloseBracket;
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override;
procedure HandleEndOfExpression; override;
property IsClosed: boolean read FIsClosed;
end;
{ TFpGDBMIExpressionPartRoundBracket }
TFpGDBMIExpressionPartRoundBracket = class(TFpGDBMIExpressionPartBracket)
end;
{ TFpGDBMIExpressionPartOperator }
TFpGDBMIExpressionPartOperator = class(TFpGDBMIExpressionPartContainer)
private
FPrecedence: Integer;
protected
function DebugText(AIndent: String): String; override;
function CanHaveOperatorAsNext: Boolean; override;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; override;
function HasAllOperands: Boolean; virtual; abstract;
function MaybeAddLeftOperand(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
procedure DoHandleEndOfExpression; override;
public
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override;
property Precedence: Integer read FPrecedence;
end;
{ TFpGDBMIExpressionPartUnaryOperator }
TFpGDBMIExpressionPartUnaryOperator = class(TFpGDBMIExpressionPartOperator)
protected
function HasAllOperands: Boolean; override;
public
end;
{ TFpGDBMIExpressionPartBinaryOperator }
TFpGDBMIExpressionPartBinaryOperator = class(TFpGDBMIExpressionPartOperator)
protected
function HasAllOperands: Boolean; override;
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; override;
public
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; override;
end;
{ TFpGDBMIExpressionPartOperatorAddressOf }
TFpGDBMIExpressionPartOperatorAddressOf = class(TFpGDBMIExpressionPartUnaryOperator) // @
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorMakeRef }
TFpGDBMIExpressionPartOperatorMakeRef = class(TFpGDBMIExpressionPartUnaryOperator) // ^TTYpe
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorDeRef }
TFpGDBMIExpressionPartOperatorDeRef = class(TFpGDBMIExpressionPartUnaryOperator) // ptrval^
protected
procedure Init; override;
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; override;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
override;
// IsValidAfterPart: same as binary op
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; 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;
{ TFpGDBMIExpressionPartOperatorMemberOf }
TFpGDBMIExpressionPartOperatorMemberOf = class(TFpGDBMIExpressionPartBinaryOperator) // struct.member
protected
procedure Init; override;
end;
implementation
{ TFpGDBMIExpressionPartOperatorMemberOf }
procedure TFpGDBMIExpressionPartOperatorMemberOf.Init;
begin
FPrecedence := 0;
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorMakeRef }
procedure TFpGDBMIExpressionPartOperatorMakeRef.Init;
begin
FPrecedence := 1;
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorDeRef }
procedure TFpGDBMIExpressionPartOperatorDeRef.Init;
begin
FPrecedence := 1;
inherited Init;
end;
function TFpGDBMIExpressionPartOperatorDeRef.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
begin
Result := MaybeAddLeftOperand(APrevPart, AResult);
end;
function TFpGDBMIExpressionPartOperatorDeRef.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
begin
Result := Self;
end;
function TFpGDBMIExpressionPartOperatorDeRef.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean;
begin
Result := inherited IsValidAfterPart(APrevPart);
if not Result then
exit;
Result := APrevPart.CanHaveOperatorAsNext;
// BinaryOperator...
// foo
// Identifer
// "Identifer" can hane a binary-op next. But it must be applied to the parent.
// So it is not valid here.
// If new operator has a higher precedence, it go down to the child again and replace it
if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpGDBMIExpressionPartOperator) then
Result := False;
end;
{ TFpGDBMIExpressionPartRoundBracket }
procedure TFpGDBMIExpressionPartBracket.Init;
begin
inherited Init;
FIsClosed := False;
FIsClosing := False;
end;
procedure TFpGDBMIExpressionPartBracket.DoHandleEndOfExpression;
begin
if not IsClosed then begin
SetError('Bracket not closed');
exit;
end;
inherited DoHandleEndOfExpression;
end;
function TFpGDBMIExpressionPartBracket.CanHaveOperatorAsNext: Boolean;
begin
Result := IsClosed;
end;
procedure TFpGDBMIExpressionPartBracket.CloseBracket;
begin
FIsClosing := True;
if LastItem <> nil then
LastItem.HandleEndOfExpression;
FIsClosing := False;
FIsClosed := True;
end;
function TFpGDBMIExpressionPartBracket.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 TFpGDBMIExpressionPartBracket.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.CanHaveOperatorAsNext)
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 HandleDot;
begin
while TokenEndPtr^ = '.' do
inc(TokenEndPtr);
case TokenEndPtr - CurPtr of
1: AddPart(TFpGDBMIExpressionPartOperatorMemberOf);
//2: ; // ".."
else SetError('Failed parsing ...');
end;
end;
procedure AddRefOperator;
begin
if (CurPart = nil) or (not CurPart.CanHaveOperatorAsNext)
then AddPart(TFpGDBMIExpressionPartOperatorMakeRef)
else AddPart(TFpGDBMIExpressionPartOperatorDeRef);
end;
procedure CloseBracket(ABracketClass: TFpGDBMIExpressionPartBracketClass);
begin
NewPart := CurPart.SurroundingBracket;
if NewPart = nil then begin
SetError('Closing bracket found without opening')
end
else
if not (NewPart is ABracketClass) then begin
SetError('Mismatch bracket')
end
else begin
TFpGDBMIExpressionPartBracket(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);
'^': AddRefOperator;
'.': HandleDot;
'+', '-' : AddPlusMinus;
'*', '/' : AddPart(TFpGDBMIExpressionPartOperatorMulDiv);
'(': AddPart(TFpGDBMIExpressionPartRoundBracket);
')': CloseBracket(TFpGDBMIExpressionPartRoundBracket);
//'[': ;
//'''': 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);
if CurPart = nil
then CurPart := NewPart
else CurPart := CurPart.HandleNextPart(NewPart);
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 := APart.IsValidAfterPart(Self);
end;
function TFpGDBMIExpressionPart.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean;
begin
Result := True;
end;
function TFpGDBMIExpressionPart.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
begin
Result := False;
end;
function TFpGDBMIExpressionPart.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
begin
Result := Self;
end;
function TFpGDBMIExpressionPart.CanHaveOperatorAsNext: 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
Result := APart;
if APart.MaybeHandlePrevPart(Self, Result) then
exit;
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 + ' Precedence:' + dbgs(FPrecedence) +
LineEnding;
end;
function TFpGDBMIExpressionPartOperator.CanHaveOperatorAsNext: Boolean;
begin
Result := HasAllOperands and LastItem.CanHaveOperatorAsNext;
end;
function TFpGDBMIExpressionPartOperator.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
begin
Result := Self;
if (not HasAllOperands) or (LastItem = nil) then begin
Result := nil;
exit
end;
// precedence: 1 = highest
if Precedence > AnOperator.Precedence then
Result := LastItem.FindLeftSideOperandByPrecedence(AnOperator);
end;
function TFpGDBMIExpressionPartOperator.MaybeAddLeftOperand(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
var
ALeftSide: TFpGDBMIExpressionPart;
begin
Result := APrevPart.IsValidNextPart(Self);
if not Result then
exit;
AResult := Self;
if (Count > 0) or // Previous already set
(not APrevPart.CanHaveOperatorAsNext) // can not have 2 operators follow each other
then begin
SetError(APrevPart, 'Can not apply operator '+GetText+': ');
APrevPart.Free;
exit;
end;
ALeftSide := APrevPart.FindLeftSideOperandByPrecedence(Self);
if ALeftSide = nil then begin
SetError(Self, 'Internal parser error for operator '+GetText+': ');
APrevPart.Free;
exit;
end;
ALeftSide.ReplaceInParent(Self);
Add(ALeftSide);
end;
procedure TFpGDBMIExpressionPartOperator.DoHandleEndOfExpression;
begin
if not HasAllOperands then
SetError(Self, 'Not enough operands')
else
inherited DoHandleEndOfExpression;
end;
function TFpGDBMIExpressionPartOperator.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart;
begin
Result := Self;
if HasAllOperands 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;
{ TFpGDBMIExpressionPartUnaryOperator }
function TFpGDBMIExpressionPartUnaryOperator.HasAllOperands: Boolean;
begin
Result := Count = 1;
end;
{ TFpGDBMIExpressionPartBinaryOperator }
function TFpGDBMIExpressionPartBinaryOperator.HasAllOperands: Boolean;
begin
Result := Count = 2;
end;
function TFpGDBMIExpressionPartBinaryOperator.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean;
begin
Result := inherited IsValidAfterPart(APrevPart);
if not Result then
exit;
Result := APrevPart.CanHaveOperatorAsNext;
// BinaryOperator...
// foo
// Identifer
// "Identifer" can hane a binary-op next. But it must be applied to the parent.
// So it is not valid here.
// If new operator has a higher precedence, it go down to the child again and replace it
if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpGDBMIExpressionPartOperator) then
Result := False;
end;
function TFpGDBMIExpressionPartBinaryOperator.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
begin
Result := MaybeAddLeftOperand(APrevPart, AResult);
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;
end.

876
debugger/fpgdbmidebugger.pp
View File

@ -7,227 +7,10 @@ interface
uses uses
Classes, sysutils, math, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger, Classes, sysutils, math, FpDbgClasses, GDBMIDebugger, BaseDebugManager, Debugger,
GDBMIMiscClasses, GDBTypeInfo, maps, LCLProc, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst, GDBMIMiscClasses, GDBTypeInfo, maps, LCLProc, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst,
LazLoggerBase, LazLoggerProfiling; LazLoggerBase, LazLoggerProfiling, FpPascalParser;
type type
TFpGDBMIExpressionPart = class;
TFpGDBMIExpressionPartContainer = class;
TFpGDBMIExpressionPartBracket = class;
TFpGDBMIExpressionPartOperator = class;
TFpGDBMIExpressionPartClass = class of TFpGDBMIExpressionPart;
TFpGDBMIExpressionPartBracketClass = class of TFpGDBMIExpressionPartBracket;
{ 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;
{ 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 IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; virtual;
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; virtual;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; virtual;
function CanHaveOperatorAsNext: 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)
public
end;
{ TFpGDBMIExpressionPartBracket }
TFpGDBMIExpressionPartBracket = class(TFpGDBMIExpressionPartContainer)
private
FIsClosed: boolean;
FIsClosing: boolean;
protected
procedure Init; override;
procedure DoHandleEndOfExpression; override;
function CanHaveOperatorAsNext: Boolean; override;
public
procedure CloseBracket;
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override;
procedure HandleEndOfExpression; override;
property IsClosed: boolean read FIsClosed;
end;
{ TFpGDBMIExpressionPartRoundBracket }
TFpGDBMIExpressionPartRoundBracket = class(TFpGDBMIExpressionPartBracket)
end;
{ TFpGDBMIExpressionPartOperator }
TFpGDBMIExpressionPartOperator = class(TFpGDBMIExpressionPartContainer)
private
FPrecedence: Integer;
protected
function DebugText(AIndent: String): String; override;
function CanHaveOperatorAsNext: Boolean; override;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; override;
function HasAllOperands: Boolean; virtual; abstract;
function MaybeAddLeftOperand(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
procedure DoHandleEndOfExpression; override;
public
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override;
property Precedence: Integer read FPrecedence;
end;
{ TFpGDBMIExpressionPartUnaryOperator }
TFpGDBMIExpressionPartUnaryOperator = class(TFpGDBMIExpressionPartOperator)
protected
function HasAllOperands: Boolean; override;
public
end;
{ TFpGDBMIExpressionPartBinaryOperator }
TFpGDBMIExpressionPartBinaryOperator = class(TFpGDBMIExpressionPartOperator)
protected
function HasAllOperands: Boolean; override;
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; override;
public
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; override;
end;
{ TFpGDBMIExpressionPartOperatorAddressOf }
TFpGDBMIExpressionPartOperatorAddressOf = class(TFpGDBMIExpressionPartUnaryOperator) // @
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorMakeRef }
TFpGDBMIExpressionPartOperatorMakeRef = class(TFpGDBMIExpressionPartUnaryOperator) // ^TTYpe
protected
procedure Init; override;
end;
{ TFpGDBMIExpressionPartOperatorDeRef }
TFpGDBMIExpressionPartOperatorDeRef = class(TFpGDBMIExpressionPartUnaryOperator) // ptrval^
protected
procedure Init; override;
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; override;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
override;
// IsValidAfterPart: same as binary op
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; 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;
{ TFpGDBMIExpressionPartOperatorMemberOf }
TFpGDBMIExpressionPartOperatorMemberOf = class(TFpGDBMIExpressionPartBinaryOperator) // struct.member
protected
procedure Init; override;
end;
TFpGDBMIDebugger = class; TFpGDBMIDebugger = class;
{ TFpGDBPTypeRequestCache } { TFpGDBPTypeRequestCache }
@ -313,663 +96,6 @@ type
procedure Cancel(const ASource: String); override; procedure Cancel(const ASource: String); override;
end; end;
{ TFpGDBMIExpressionPartOperatorMemberOf }
procedure TFpGDBMIExpressionPartOperatorMemberOf.Init;
begin
FPrecedence := 0;
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorMakeRef }
procedure TFpGDBMIExpressionPartOperatorMakeRef.Init;
begin
FPrecedence := 1;
inherited Init;
end;
{ TFpGDBMIExpressionPartOperatorDeRef }
procedure TFpGDBMIExpressionPartOperatorDeRef.Init;
begin
FPrecedence := 1;
inherited Init;
end;
function TFpGDBMIExpressionPartOperatorDeRef.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
begin
Result := MaybeAddLeftOperand(APrevPart, AResult);
end;
function TFpGDBMIExpressionPartOperatorDeRef.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
begin
Result := Self;
end;
function TFpGDBMIExpressionPartOperatorDeRef.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean;
begin
Result := inherited IsValidAfterPart(APrevPart);
if not Result then
exit;
Result := APrevPart.CanHaveOperatorAsNext;
// BinaryOperator...
// foo
// Identifer
// "Identifer" can hane a binary-op next. But it must be applied to the parent.
// So it is not valid here.
// If new operator has a higher precedence, it go down to the child again and replace it
if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpGDBMIExpressionPartOperator) then
Result := False;
end;
{ TFpGDBMIExpressionPartRoundBracket }
procedure TFpGDBMIExpressionPartBracket.Init;
begin
inherited Init;
FIsClosed := False;
FIsClosing := False;
end;
procedure TFpGDBMIExpressionPartBracket.DoHandleEndOfExpression;
begin
if not IsClosed then begin
SetError('Bracket not closed');
exit;
end;
inherited DoHandleEndOfExpression;
end;
function TFpGDBMIExpressionPartBracket.CanHaveOperatorAsNext: Boolean;
begin
Result := IsClosed;
end;
procedure TFpGDBMIExpressionPartBracket.CloseBracket;
begin
FIsClosing := True;
if LastItem <> nil then
LastItem.HandleEndOfExpression;
FIsClosing := False;
FIsClosed := True;
end;
function TFpGDBMIExpressionPartBracket.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 TFpGDBMIExpressionPartBracket.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.CanHaveOperatorAsNext)
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 HandleDot;
begin
while TokenEndPtr^ = '.' do
inc(TokenEndPtr);
case TokenEndPtr - CurPtr of
1: AddPart(TFpGDBMIExpressionPartOperatorMemberOf);
//2: ; // ".."
else SetError('Failed parsing ...');
end;
end;
procedure AddRefOperator;
begin
if (CurPart = nil) or (not CurPart.CanHaveOperatorAsNext)
then AddPart(TFpGDBMIExpressionPartOperatorMakeRef)
else AddPart(TFpGDBMIExpressionPartOperatorDeRef);
end;
procedure CloseBracket(ABracketClass: TFpGDBMIExpressionPartBracketClass);
begin
NewPart := CurPart.SurroundingBracket;
if NewPart = nil then begin
SetError('Closing bracket found without opening')
end
else
if not (NewPart is ABracketClass) then begin
SetError('Mismatch bracket')
end
else begin
TFpGDBMIExpressionPartBracket(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);
'^': AddRefOperator;
'.': HandleDot;
'+', '-' : AddPlusMinus;
'*', '/' : AddPart(TFpGDBMIExpressionPartOperatorMulDiv);
'(': AddPart(TFpGDBMIExpressionPartRoundBracket);
')': CloseBracket(TFpGDBMIExpressionPartRoundBracket);
//'[': ;
//'''': 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);
if CurPart = nil
then CurPart := NewPart
else CurPart := CurPart.HandleNextPart(NewPart);
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 := APart.IsValidAfterPart(Self);
end;
function TFpGDBMIExpressionPart.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean;
begin
Result := True;
end;
function TFpGDBMIExpressionPart.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
begin
Result := False;
end;
function TFpGDBMIExpressionPart.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
begin
Result := Self;
end;
function TFpGDBMIExpressionPart.CanHaveOperatorAsNext: 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
Result := APart;
if APart.MaybeHandlePrevPart(Self, Result) then
exit;
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 + ' Precedence:' + dbgs(FPrecedence) +
LineEnding;
end;
function TFpGDBMIExpressionPartOperator.CanHaveOperatorAsNext: Boolean;
begin
Result := HasAllOperands and LastItem.CanHaveOperatorAsNext;
end;
function TFpGDBMIExpressionPartOperator.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart;
begin
Result := Self;
if (not HasAllOperands) or (LastItem = nil) then begin
Result := nil;
exit
end;
// precedence: 1 = highest
if Precedence > AnOperator.Precedence then
Result := LastItem.FindLeftSideOperandByPrecedence(AnOperator);
end;
function TFpGDBMIExpressionPartOperator.MaybeAddLeftOperand(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
var
ALeftSide: TFpGDBMIExpressionPart;
begin
Result := APrevPart.IsValidNextPart(Self);
if not Result then
exit;
AResult := Self;
if (Count > 0) or // Previous already set
(not APrevPart.CanHaveOperatorAsNext) // can not have 2 operators follow each other
then begin
SetError(APrevPart, 'Can not apply operator '+GetText+': ');
APrevPart.Free;
exit;
end;
ALeftSide := APrevPart.FindLeftSideOperandByPrecedence(Self);
if ALeftSide = nil then begin
SetError(Self, 'Internal parser error for operator '+GetText+': ');
APrevPart.Free;
exit;
end;
ALeftSide.ReplaceInParent(Self);
Add(ALeftSide);
end;
procedure TFpGDBMIExpressionPartOperator.DoHandleEndOfExpression;
begin
if not HasAllOperands then
SetError(Self, 'Not enough operands')
else
inherited DoHandleEndOfExpression;
end;
function TFpGDBMIExpressionPartOperator.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart;
begin
Result := Self;
if HasAllOperands 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;
{ TFpGDBMIExpressionPartUnaryOperator }
function TFpGDBMIExpressionPartUnaryOperator.HasAllOperands: Boolean;
begin
Result := Count = 1;
end;
{ TFpGDBMIExpressionPartBinaryOperator }
function TFpGDBMIExpressionPartBinaryOperator.HasAllOperands: Boolean;
begin
Result := Count = 2;
end;
function TFpGDBMIExpressionPartBinaryOperator.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean;
begin
Result := inherited IsValidAfterPart(APrevPart);
if not Result then
exit;
Result := APrevPart.CanHaveOperatorAsNext;
// BinaryOperator...
// foo
// Identifer
// "Identifer" can hane a binary-op next. But it must be applied to the parent.
// So it is not valid here.
// If new operator has a higher precedence, it go down to the child again and replace it
if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpGDBMIExpressionPartOperator) then
Result := False;
end;
function TFpGDBMIExpressionPartBinaryOperator.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean;
begin
Result := MaybeAddLeftOperand(APrevPart, AResult);
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);