mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
ide/gdbmiint.pas: Add init_count field,
New Set_debuggee_started method to update init_count properly. ide/gdbmicon.ppas and packages/gdbint/src/gdbcon.pp: Add PrintCommand and PrintFormattedCommand methods to allow using of mi command for fpdebug unit TDebugController.GetValue method packages/gdbint/src/gdbcon.pp: Add InternalGetValue method, that uses previous code from fpdebug GetValue method git-svn-id: trunk@30043 -
This commit is contained in:
pierre
parent
9f9ab082da
commit
36086cc183
@ -687,6 +687,8 @@ begin
|
||||
if not LoadFile(f) then
|
||||
begin
|
||||
HasExe:=false;
|
||||
if GetError<>'' then
|
||||
f:=GetError;
|
||||
MessageBox(#3'Failed to load file '#13#3+f,nil,mfOKbutton);
|
||||
exit;
|
||||
end;
|
||||
@ -1209,41 +1211,8 @@ begin
|
||||
end;
|
||||
|
||||
function TDebugController.GetValue(Const expr : string) : pchar;
|
||||
var
|
||||
p,p2,p3 : pchar;
|
||||
begin
|
||||
if WindowWidth<>-1 then
|
||||
Command('set width 0xffffffff');
|
||||
Command('p '+expr);
|
||||
p:=GetOutput;
|
||||
p3:=nil;
|
||||
if assigned(p) and (p[strlen(p)-1]=#10) then
|
||||
begin
|
||||
p3:=p+strlen(p)-1;
|
||||
p3^:=#0;
|
||||
end;
|
||||
if assigned(p) then
|
||||
p2:=strpos(p,'=')
|
||||
else
|
||||
p2:=nil;
|
||||
if assigned(p2) then
|
||||
p:=p2+1;
|
||||
while p^ in [' ',TAB] do
|
||||
inc(p);
|
||||
{ get rid of type }
|
||||
if p^ = '(' then
|
||||
p:=strpos(p,')')+1;
|
||||
while p^ in [' ',TAB] do
|
||||
inc(p);
|
||||
if assigned(p) then
|
||||
GetValue:=StrNew(p)
|
||||
else
|
||||
GetValue:=StrNew(GetError);
|
||||
if assigned(p3) then
|
||||
p3^:=#10;
|
||||
got_error:=false;
|
||||
if WindowWidth<>-1 then
|
||||
Command('set width '+IntToStr(WindowWidth));
|
||||
GetValue:=PrintCommand(expr);
|
||||
end;
|
||||
|
||||
function TDebugController.GetFramePointer : CORE_ADDR;
|
||||
@ -1252,8 +1221,7 @@ var
|
||||
p : longint;
|
||||
begin
|
||||
{$ifdef FrameNameKnown}
|
||||
Command('p /d '+FrameName);
|
||||
st:=strpas(GetOutput);
|
||||
st:=strpas(PrintFormattedCommand(FrameName,pfdecimal));
|
||||
p:=pos('=',st);
|
||||
while (p<length(st)) and (st[p+1] in [' ',#9]) do
|
||||
inc(p);
|
||||
@ -1495,8 +1463,7 @@ begin
|
||||
(PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
|
||||
(PB^.typ<>bt_address) then
|
||||
begin
|
||||
Command('p '+GetStr(PB^.Name));
|
||||
S:=GetPChar(GetOutput);
|
||||
S:=PrintCommand(GetStr(PB^.Name));
|
||||
got_error:=false;
|
||||
If Pos('=',S)>0 then
|
||||
S:=Copy(S,Pos('=',S)+1,255);
|
||||
@ -2898,15 +2865,14 @@ procedure TWatch.Get_new_value;
|
||||
|
||||
function GetValue(var s : string) : boolean;
|
||||
begin
|
||||
Debugger^.command('p '+s);
|
||||
s:=Debugger^.PrintCommand(s);
|
||||
if not Debugger^.Error then
|
||||
begin
|
||||
s:=StrPas(Debugger^.GetOutput);
|
||||
GetValue:=true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
s:=StrPas(Debugger^.GetError);
|
||||
// Is always done now s:=StrPas(Debugger^.GetError);
|
||||
GetValue:=false;
|
||||
{ do not open a messagebox for such errors }
|
||||
Debugger^.got_error:=false;
|
||||
|
||||
@ -27,6 +27,7 @@ uses
|
||||
type
|
||||
TBreakpointFlags = set of (bfTemporary, bfHardware);
|
||||
TWatchpointType = (wtWrite, wtReadWrite, wtRead);
|
||||
TPrintFormatType = (pfbinary, pfdecimal, pfhexadecimal, pfoctal, pfnatural);
|
||||
|
||||
TGDBController = object(TGDBInterface)
|
||||
private
|
||||
@ -63,6 +64,9 @@ type
|
||||
function GetIntRegister(const RegName: string; var Value: Int64): Boolean;
|
||||
function GetIntRegister(const RegName: string; var Value: UInt32): Boolean;
|
||||
function GetIntRegister(const RegName: string; var Value: Int32): Boolean;
|
||||
{ print }
|
||||
function PrintCommand(const expr : string): pchar;
|
||||
function PrintFormattedCommand(const expr : string; Format : TPrintFormatType): pchar;
|
||||
{ breakpoints }
|
||||
function BreakpointInsert(const location: string; BreakpointFlags: TBreakpointFlags): LongInt;
|
||||
function WatchpointInsert(const location: string; WatchpointType: TWatchpointType): LongInt;
|
||||
@ -281,6 +285,30 @@ begin
|
||||
Value := Int32(U32Value);
|
||||
end;
|
||||
|
||||
|
||||
{ print }
|
||||
function TGDBController.PrintCommand(const expr : string): pchar;
|
||||
begin
|
||||
Command('-var-evaluate-expression '+expr);
|
||||
if GDB.ResultRecord.Success then
|
||||
PrintCommand:=strnew(pchar(GDB.ResultRecord.Parameters['value'].AsString))
|
||||
else
|
||||
PrintCommand:=strnew(GetError);
|
||||
end;
|
||||
|
||||
const
|
||||
PrintFormatName : Array[TPrintFormatType] of string[11] =
|
||||
('binary', 'decimal', 'hexadecimal', 'octal', 'natural');
|
||||
|
||||
function TGDBController.PrintFormattedCommand(const expr : string; Format : TPrintFormatType): pchar;
|
||||
begin
|
||||
Command('-var-evaluate-expression -f '+PrintFormatName[Format]+' '+expr);
|
||||
if GDB.ResultRecord.Success then
|
||||
PrintFormattedCommand:=strnew(pchar(GDB.ResultRecord.Parameters['value'].AsString))
|
||||
else
|
||||
PrintFormattedCommand:=strnew(GetError);
|
||||
end;
|
||||
|
||||
function TGDBController.BreakpointInsert(const location: string; BreakpointFlags: TBreakpointFlags): LongInt;
|
||||
var
|
||||
Options: string = '';
|
||||
|
||||
@ -73,6 +73,7 @@ type
|
||||
got_error: Boolean;
|
||||
reset_command: Boolean;
|
||||
Debuggee_started: Boolean;
|
||||
init_count : longint;
|
||||
{ frames and frame info while recording a frame }
|
||||
frames: PPFrameEntry;
|
||||
frame_count: LongInt;
|
||||
@ -89,6 +90,7 @@ type
|
||||
function GetOutput: PChar;
|
||||
function GetError: PChar;
|
||||
{ Lowlevel }
|
||||
procedure Set_debuggee_started;
|
||||
function error: Boolean;
|
||||
function error_num: LongInt;
|
||||
function get_current_frame: PtrInt;
|
||||
@ -225,6 +227,8 @@ begin
|
||||
GDBOutputBuf.Init;
|
||||
GDB := TGDBWrapper.Create;
|
||||
command_level := 0;
|
||||
Debuggee_started:=false;
|
||||
init_count:=0;
|
||||
{$ifdef DEBUG}
|
||||
output_raw:=true;
|
||||
{$else}
|
||||
@ -263,6 +267,15 @@ begin
|
||||
GetError := p;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.Set_debuggee_started;
|
||||
begin
|
||||
if not Debuggee_started then
|
||||
begin
|
||||
inc(init_count);
|
||||
Debuggee_started:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.i_gdb_command(const S: string);
|
||||
var
|
||||
I: LongInt;
|
||||
@ -369,7 +382,7 @@ Ignore:
|
||||
make sure we have read all parameters that we need to local variables before that }
|
||||
DebuggerScreen;
|
||||
|
||||
Debuggee_started := True;
|
||||
set_debuggee_started;
|
||||
current_pc := Addr;
|
||||
if not DoSelectSourceLine(FileName, LineNumber, BreakpointNo) then
|
||||
begin
|
||||
|
||||
@ -27,6 +27,7 @@ uses
|
||||
type
|
||||
TBreakpointFlags = set of (bfTemporary, bfHardware);
|
||||
TWatchpointType = (wtWrite, wtReadWrite, wtRead);
|
||||
TPrintFormatType = (pfbinary, pfdecimal, pfhexadecimal, pfoctal, pfnatural);
|
||||
|
||||
PGDBController=^TGDBController;
|
||||
TGDBController=object(TGDBInterface)
|
||||
@ -57,6 +58,10 @@ type
|
||||
function GetIntRegister(const RegName: string; var Value: Int64): Boolean;
|
||||
function GetIntRegister(const RegName: string; var Value: UInt32): Boolean;
|
||||
function GetIntRegister(const RegName: string; var Value: Int32): Boolean;
|
||||
{ print }
|
||||
function InternalGetValue(Const expr : string) : pchar;
|
||||
function PrintCommand(const expr : string): pchar;
|
||||
function PrintFormattedCommand(const expr : string; Format : TPrintFormatType): pchar;
|
||||
{ breakpoints }
|
||||
function BreakpointInsert(const location: string; BreakpointFlags: TBreakpointFlags): LongInt;
|
||||
function WatchpointInsert(const location: string; WatchpointType: TWatchpointType): LongInt;
|
||||
@ -397,6 +402,89 @@ begin
|
||||
Value := Int32(U32Value);
|
||||
end;
|
||||
|
||||
{ print }
|
||||
|
||||
function TGDBController.InternalGetValue(Const expr : string) : pchar;
|
||||
var
|
||||
p,p2,p3 : pchar;
|
||||
st : string;
|
||||
WindowWidth : longint;
|
||||
begin
|
||||
Command('show width');
|
||||
p:=GetOutput;
|
||||
|
||||
p3:=nil;
|
||||
if assigned(p) and (p[strlen(p)-1]=#10) then
|
||||
begin
|
||||
p3:=p+strlen(p)-1;
|
||||
p3^:=#0;
|
||||
end;
|
||||
if assigned(p) then
|
||||
p2:=strpos(p,' in a line is ')
|
||||
else
|
||||
p2:=nil;
|
||||
if assigned(p2) then
|
||||
p:=p2+length(' in a line is ');
|
||||
while p^ in [' ',#9] do
|
||||
inc(p);
|
||||
p3:=strpos(p,'.');
|
||||
if assigned(p3) then
|
||||
p3^:=#0;
|
||||
WindowWidth:=-1;
|
||||
val(strpas(p),WindowWidth);
|
||||
if WindowWidth<>-1 then
|
||||
Command('set width 0xffffffff');
|
||||
Command('p '+expr);
|
||||
p:=GetOutput;
|
||||
p3:=nil;
|
||||
if assigned(p) and (p[strlen(p)-1]=#10) then
|
||||
begin
|
||||
p3:=p+strlen(p)-1;
|
||||
p3^:=#0;
|
||||
end;
|
||||
if assigned(p) then
|
||||
p2:=strpos(p,'=')
|
||||
else
|
||||
p2:=nil;
|
||||
if assigned(p2) then
|
||||
p:=p2+1;
|
||||
while p^ in [' ',#9] do
|
||||
inc(p);
|
||||
{ get rid of type }
|
||||
if p^ = '(' then
|
||||
p:=strpos(p,')')+1;
|
||||
while p^ in [' ',#9] do
|
||||
inc(p);
|
||||
if assigned(p) then
|
||||
InternalGetValue:=StrNew(p)
|
||||
else
|
||||
InternalGetValue:=StrNew(GetError);
|
||||
if assigned(p3) then
|
||||
p3^:=#10;
|
||||
got_error:=false;
|
||||
if WindowWidth<>-1 then
|
||||
begin
|
||||
str(WindowWidth,st);
|
||||
Command('set width '+St);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TGDBController.PrintCommand(const expr : string): pchar;
|
||||
begin
|
||||
PrintCommand:=InternalGetValue(expr);
|
||||
end;
|
||||
|
||||
const
|
||||
PrintFormatName : Array[TPrintFormatType] of string[11] =
|
||||
(' /b ', ' /d ', ' /x ', ' /o ', '');
|
||||
|
||||
function TGDBController.PrintFormattedCommand(const expr : string; Format : TPrintFormatType): pchar;
|
||||
begin
|
||||
PrintFormattedCommand:=InternalGetValue(PrintFormatName[Format]+expr);
|
||||
end;
|
||||
|
||||
|
||||
function TGDBController.BreakpointInsert(const location: string; BreakpointFlags: TBreakpointFlags): LongInt;
|
||||
var
|
||||
Prefix: string = '';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user