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

FPGDBMIDebugger: use parser for pascal expressions

Browse Source 
git-svn-id: trunk@43221 -
This commit is contained in:
martin 2013-10-12 15:34:49 +00:00
parent b69a88bc85
commit 8ae328f260
1 changed files with 141 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

272
debugger/fpgdbmidebugger.pp
View File

@ -13,6 +13,19 @@ type
TFpGDBMIDebugger = class; TFpGDBMIDebugger = class;
{ TFpGDBMIPascalExpression }
TFpGDBMIPascalExpression = class(TFpPascalExpression)
private
FThreadId: Integer;
FStackFrame: Integer;
FDebugger: TFpGDBMIDebugger;
protected
function GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol; override;
public
constructor Create(ATextExpression: String; ADebugger: TFpGDBMIDebugger; AThreadId, AStackFrame: Integer);
end;
{ TFpGDBPTypeRequestCache } { TFpGDBPTypeRequestCache }
TFpGDBPTypeRequestCache = class(TGDBPTypeRequestCache) TFpGDBPTypeRequestCache = class(TGDBPTypeRequestCache)
@ -43,7 +56,6 @@ type
procedure GetCurrentContext(out AThreadId, AStackFrame: Integer); procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr; function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
procedure AddToGDBMICache(AThreadId, AStackFrame: Integer; AnIdent: TDbgSymbol);
function CreateTypeRequestCache: TGDBPTypeRequestCache; override; function CreateTypeRequestCache: TGDBPTypeRequestCache; override;
public public
class function Caption: String; override; class function Caption: String; override;
@ -70,7 +82,7 @@ type
protected protected
function FpDebugger: TFpGDBMIDebugger; function FpDebugger: TFpGDBMIDebugger;
//procedure DoStateChange(const AOldState: TDBGState); override; //procedure DoStateChange(const AOldState: TDBGState); override;
procedure InternalRequestData(AWatchValue: TCurrentWatchValue); override; //procedure InternalRequestData(AWatchValue: TCurrentWatchValue); override;
public public
//constructor Create(const ADebugger: TDebugger); //constructor Create(const ADebugger: TDebugger);
//destructor Destroy; override; //destructor Destroy; override;
@ -96,6 +108,31 @@ type
procedure Cancel(const ASource: String); override; procedure Cancel(const ASource: String); override;
end; end;
{ TFpGDBMIPascalExpression }
function TFpGDBMIPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol;
var
Loc: TDBGPtr;
begin
Result := nil;
if FDebugger.HasDwarf then begin
if AnIdent <> '' then begin
Loc := FDebugger.GetLocationForContext(FThreadId, FStackFrame);
if (Loc <> 0) then
Result := FDebugger.FDwarfInfo.FindIdentifier(Loc, AnIdent);
end;
end;
end;
constructor TFpGDBMIPascalExpression.Create(ATextExpression: String;
ADebugger: TFpGDBMIDebugger; AThreadId, AStackFrame: Integer);
begin
FDebugger := ADebugger;
FThreadId := AStackFrame;
FStackFrame := AStackFrame;
inherited Create(ATextExpression);
end;
{ TFpGDBPTypeRequestCache } { TFpGDBPTypeRequestCache }
constructor TFpGDBPTypeRequestCache.Create(ADebugger: TFpGDBMIDebugger); constructor TFpGDBPTypeRequestCache.Create(ADebugger: TFpGDBMIDebugger);
@ -107,40 +144,123 @@ end;
function TFpGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer; function TFpGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer;
ARequest: TGDBPTypeRequest): Integer; ARequest: TGDBPTypeRequest): Integer;
const
GdbCmdPType = 'ptype ';
GdbCmdWhatIs = 'whatis ';
procedure MaybeAdd(AType: TGDBCommandRequestType; AQuery, AAnswer: String);
var
AReq: TGDBPTypeRequest;
begin
AReq.ReqType := AType;
AReq.Request := AQuery;
if IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
AReq.Result := ParseTypeFromGdb(AAnswer);
Add(AThreadId, AStackFrame, AReq);
debugln(['TFpGDBMIDebugger.AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame, ' >> ', AAnswer]);
end;
end;
procedure AddType(ASourceExpr: string; ATypeIdent: TDbgDwarfTypeIdentifier; AnIsPointer: Boolean);
var
TypeName: String;
IsPointerPointer: Boolean;
IsPointerType: Boolean;
begin
if (ASourceExpr = '') or (ATypeIdent = nil) then exit;
IsPointerType := ATypeIdent.IsPointerType;
if IsPointerType then begin
ATypeIdent := ATypeIdent.PointedToType;
if ATypeIdent = nil then exit;
IsPointerPointer := AnIsPointer or ATypeIdent.IsPointerType;
while (ATypeIdent <> nil) and ATypeIdent.IsPointerType do
ATypeIdent := ATypeIdent.PointedToType;
if ATypeIdent = nil then exit;
end;
TypeName := ATypeIdent.IdentifierName;
if ATypeIdent.IsBaseType then begin
if IsPointerType then begin
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = ^%s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = ^%s', [TypeName]));
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr);
if IsPointerPointer then begin
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = ^%s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = ^%s', [TypeName]));
end
else begin
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = %s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [TypeName]));
end;
end
else begin
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [TypeName]));
end;
end;
end;
var var
IdentName: String; IdentName: String;
Loc: TDBGPtr; Loc: TDBGPtr;
Ident: TDbgSymbol; Ident: TDbgSymbol;
PasExpr: TFpGDBMIPascalExpression;
PasType: TFpPasExprType;
TypeIdent: TDbgDwarfTypeIdentifier;
begin begin
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest); Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
if (Result > 0) or FInIndexOf then if (Result >= 0) or FInIndexOf then
exit; exit;
FInIndexOf := True; FInIndexOf := True;
PasExpr := nil;
try try
if FDebugger.HasDwarf and (ARequest.ReqType = gcrtPType) then begin DebugLn('############### '+ARequest.Request);
if copy(ARequest.Request, 1, 6) = 'ptype ' then if copy(ARequest.Request, 1, 6) = 'ptype ' then
IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request))) IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request)))
else else
if copy(ARequest.Request, 1, 7) = 'whatis ' then if copy(ARequest.Request, 1, 7) = 'whatis ' then
IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request))); IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request)));
if IdentName <> '' then begin PasExpr := TFpGDBMIPascalExpression.Create(IdentName, FDebugger, AThreadId, AStackFrame);
Loc := FDebugger.GetLocationForContext(AThreadId, AStackFrame); PasType := PasExpr.ResultType;
if (Loc <> 0) then begin
Ident := FDebugger.FDwarfInfo.FindIdentifier(Loc, IdentName); case PasType.Kind of
if Ident <> nil then begin ptkValueDbgType: begin
FDebugger.AddToGDBMICache(AThreadId, AStackFrame, Ident); AddType(IdentName, PasType.DbgType, False);
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
end;
ptkPointerToValueDbgType: begin
AddType(IdentName, PasType.DbgType, True);
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest); Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
end; end;
ReleaseRefAndNil(Ident);
end;
end; end;
end;
finally finally
PasExpr.Free;
FInIndexOf := False; FInIndexOf := False;
end; end;
(*
ptype i
~"type = LONGINT\n"
whatis i
~"type = LONGINT\n"
ptype @i
~"type = ^LONGINT\n"
ptype (@i)^
~"type = LONGINT\n"
whatis @i
~"type = ^LONGINT\n"
*)
end; end;
{ TFPGDBMIWatches } { TFPGDBMIWatches }
@ -150,27 +270,6 @@ begin
Result := TFpGDBMIDebugger(Debugger); Result := TFpGDBMIDebugger(Debugger);
end; end;
procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TCurrentWatchValue);
var
Loc: TDBGPtr;
Ident: TDbgSymbol;
begin
//if FpDebugger.HasDwarf then begin
// Loc := FpDebugger.GetLocationForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
//
// if (Loc <> 0) then begin
// Ident := FpDebugger.FDwarfInfo.FindIdentifier(Loc, AWatchValue.Watch.Expression);
//
// if Ident <> nil then
// FpDebugger.AddToGDBMICache(AWatchValue.ThreadId, AWatchValue.StackFrame, Ident);
//
// ReleaseRefAndNil(Ident);
// end;
//end;
inherited InternalRequestData(AWatchValue);
end;
{ TFpGDBMILineInfo } { TFpGDBMILineInfo }
function TFpGDBMILineInfo.FpDebugger: TFpGDBMIDebugger; function TFpGDBMILineInfo.FpDebugger: TFpGDBMIDebugger;
@ -296,18 +395,7 @@ var
CurThread, CurStack: Integer; CurThread, CurStack: Integer;
begin begin
if HasDwarf and (ACommand = dcEvaluate) then begin if HasDwarf and (ACommand = dcEvaluate) then begin
//GetCurrentContext(CurThread, CurStack); // String(AParams[0].VAnsiString)
//Loc := GetLocationForContext(CurThread, CurStack);
//
//if (Loc <> 0) then begin
// Ident := FDwarfInfo.FindIdentifier(Loc, String(AParams[0].VAnsiString));
//
// if Ident <> nil then
// AddToGDBMICache(CurThread, CurStack, Ident);
//
// ReleaseRefAndNil(Ident);
//end;
// //EvalFlags := []; // //EvalFlags := [];
// //if high(AParams) >= 3 then // //if high(AParams) >= 3 then
// // EvalFlags := TDBGEvaluateFlags(AParams[3].VInteger); // // EvalFlags := TDBGEvaluateFlags(AParams[3].VInteger);
@ -322,22 +410,17 @@ end;
procedure TFpGDBMIDebugger.GetCurrentContext(out AThreadId, AStackFrame: Integer); procedure TFpGDBMIDebugger.GetCurrentContext(out AThreadId, AStackFrame: Integer);
begin begin
if (AThreadId <= 0) and CurrentThreadIdValid then begin if CurrentThreadIdValid then begin
AThreadId := CurrentThreadId; AThreadId := CurrentThreadId;
AStackFrame := 0;
if CurrentStackFrameValid then
AStackFrame := CurrentStackFrame
else
AStackFrame := 0;
end end
else else begin
if (AThreadId <= 0) and (not CurrentThreadIdValid) then begin
AThreadId := 1; AThreadId := 1;
AStackFrame := 0; AStackFrame := 0;
end
else
if (AStackFrame < 0) and (CurrentStackFrameValid) then begin
AStackFrame := CurrentStackFrame;
end
else
if (AStackFrame < 0) and (not CurrentStackFrameValid) then begin
AStackFrame := 0;
end; end;
end; end;
@ -389,79 +472,6 @@ type
property InformationEntry; property InformationEntry;
end; end;
procedure TFpGDBMIDebugger.AddToGDBMICache(AThreadId, AStackFrame: Integer;
AnIdent: TDbgSymbol);
const
GdbCmdPType = 'ptype ';
GdbCmdWhatIs = 'whatis ';
procedure MaybeAdd(AType: TGDBCommandRequestType; AQuery, AAnswer: String);
var
AReq: TGDBPTypeRequest;
begin
AReq.ReqType := AType;
AReq.Request := AQuery;
if TypeRequestCache.IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
AReq.Result := ParseTypeFromGdb(AAnswer);
TypeRequestCache.Add(AThreadId, AStackFrame, AReq);
debugln(['TFpGDBMIDebugger.AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame, ' >> ', AAnswer]);
end;
end;
var
TypeIdent: TDbgDwarfTypeIdentifier;
VarName, TypeName: String;
AReq: TGDBPTypeRequest;
IsPointer: Boolean;
begin
(* Simulate gdb answers *)
//TypeRequestCache
if AnIdent is TDbgDwarfValueIdentifier then begin
VarName := TDbgDwarfValueIdentifier(AnIdent).IdentifierName;
TypeIdent := TDbgDwarfValueIdentifier(AnIdent).TypeInfo;
if TypeIdent = nil then exit;
TypeName := TypeIdent.IdentifierName;
IsPointer := TypeIdent.IsPointerType;
while (TypeIdent <> nil) and TypeIdent.IsPointerType do
TypeIdent := TypeIdent.PointedToType;
if TypeIdent = nil then exit;
if TGDBMIDwarfTypeIdentifier(TypeIdent).IsBaseType then begin
if IsPointer then begin
MaybeAdd(gcrtPType, GdbCmdPType + VarName, Format('type = ^%s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + VarName, Format('type = ^%s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdPType + GDBMIMaybeApplyBracketsToExpr(VarName) + '^',
Format('type = %s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + GDBMIMaybeApplyBracketsToExpr(VarName) + '^',
Format('type = %s', [TypeName]));
end
else begin
MaybeAdd(gcrtPType, GdbCmdPType + VarName, Format('type = %s', [TypeName]));
MaybeAdd(gcrtPType, GdbCmdWhatIs + VarName, Format('type = %s', [TypeName]));
end;
end;
end;
(*
ptype i
~"type = LONGINT\n"
whatis i
~"type = LONGINT\n"
ptype @i
~"type = ^LONGINT\n"
ptype (@i)^
~"type = LONGINT\n"
whatis @i
~"type = ^LONGINT\n"
*)
end;
function TFpGDBMIDebugger.CreateTypeRequestCache: TGDBPTypeRequestCache; function TFpGDBMIDebugger.CreateTypeRequestCache: TGDBPTypeRequestCache;
begin begin
Result := TFpGDBPTypeRequestCache.Create(Self); Result := TFpGDBPTypeRequestCache.Create(Self);