mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 05:00:07 +02:00
+ initial implementation of GDB/MI (without LibGDB!) support for the text mode
IDE. Tested under Linux (Fedora 21 - x86_64, GDB 7.8.2). It is still disabled by default on all platforms. To enable it, build a snapshot with: FPMAKEOPT="--ignoreinvalidoption --GDBMI=1" Known issue: the GDB window in the IDE causes crashes, so don't open it :) (for debugging purposes, set the environment variable FPIDE_GDBLOG=1 when running the IDE and it will log everything in gdblog.txt) git-svn-id: trunk@29716 -
This commit is contained in:
nickysn
parent
3650991d90
commit
a939ea06b6
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -915,6 +915,10 @@ ide/fputils.pas svneol=native#text/plain
|
||||
ide/fpvars.pas svneol=native#text/plain
|
||||
ide/fpviews.pas svneol=native#text/plain
|
||||
ide/fpw32.rc -text
|
||||
ide/gdbmicon.pas svneol=native#text/plain
|
||||
ide/gdbmiint.pas svneol=native#text/plain
|
||||
ide/gdbmiproc.pas svneol=native#text/plain
|
||||
ide/gdbmiwrap.pas svneol=native#text/plain
|
||||
ide/globdir.inc svneol=native#text/plain
|
||||
ide/gplprog.pt -text
|
||||
ide/gplunit.pt -text
|
||||
|
||||
@ -63,7 +63,11 @@ uses
|
||||
Dos,Objects,
|
||||
BrowCol,Version,
|
||||
{$ifndef NODEBUG}
|
||||
gdbint,
|
||||
{$ifdef GDBMI}
|
||||
gdbmiint,
|
||||
{$else GDBMI}
|
||||
gdbint,
|
||||
{$endif GDBMI}
|
||||
{$endif NODEBUG}
|
||||
FVConsts,
|
||||
Drivers,Views,App,Dialogs,HistList,
|
||||
|
||||
@ -26,7 +26,11 @@ uses
|
||||
{$endif Windows}
|
||||
Objects,Dialogs,Drivers,Views,
|
||||
{$ifndef NODEBUG}
|
||||
GDBCon,GDBInt,
|
||||
{$ifdef GDBMI}
|
||||
GDBMICon,GDBMIInt,
|
||||
{$else GDBMI}
|
||||
GDBCon,GDBInt,
|
||||
{$endif GDBMI}
|
||||
{$endif NODEBUG}
|
||||
Menus,
|
||||
WViews,WEditor,
|
||||
|
||||
@ -9,6 +9,7 @@ uses
|
||||
|
||||
const
|
||||
NoGDBOption: boolean = false;
|
||||
GDBMIOption: boolean = false;
|
||||
|
||||
procedure ide_check_gdb_availability(Sender: TObject);
|
||||
|
||||
@ -75,7 +76,12 @@ begin
|
||||
P := sender as TPackage;
|
||||
with installer do
|
||||
begin
|
||||
if not (NoGDBOption) then
|
||||
if GDBMIOption then
|
||||
begin
|
||||
BuildEngine.log(vlCommand, 'Compiling IDE with GDB/MI debugger support, LibGDB is not needed');
|
||||
P.Options.Add('-dGDBMI');
|
||||
end
|
||||
else if not (NoGDBOption) then
|
||||
begin
|
||||
// Detection of GDB.
|
||||
GDBLibDir := DetectLibGDBDir;
|
||||
@ -141,11 +147,15 @@ Var
|
||||
begin
|
||||
AddCustomFpmakeCommandlineOption('CompilerTarget','Target CPU for the IDE''s compiler');
|
||||
AddCustomFpmakeCommandlineOption('NoGDB','If value=1 or ''Y'', no GDB support');
|
||||
AddCustomFpmakeCommandlineOption('GDBMI','If value=1 or ''Y'', builds IDE with GDB/MI support (no need for LibGDB)');
|
||||
With Installer do
|
||||
begin
|
||||
s := GetCustomFpmakeCommandlineOptionValue('NoGDB');
|
||||
if (s='1') or (s='Y') then
|
||||
NoGDBOption := true;
|
||||
s := GetCustomFpmakeCommandlineOptionValue('GDBMI');
|
||||
if (s='1') or (s='Y') then
|
||||
GDBMIOption := true;
|
||||
s :=GetCustomFpmakeCommandlineOptionValue('CompilerTarget');
|
||||
if s <> '' then
|
||||
CompilerTarget:=StringToCPU(s)
|
||||
@ -163,7 +173,7 @@ begin
|
||||
P.Dependencies.Add('chm');
|
||||
{ This one is only needed if DEBUG is set }
|
||||
P.Dependencies.Add('regexpr');
|
||||
if not (NoGDBOption) then
|
||||
if not (NoGDBOption) and not (GDBMIOption) then
|
||||
P.Dependencies.Add('gdbint',AllOSes-AllAmigaLikeOSes);
|
||||
P.Dependencies.Add('graph',[go32v2]);
|
||||
|
||||
|
||||
@ -212,7 +212,11 @@ implementation
|
||||
uses
|
||||
Strings,
|
||||
{$ifndef NODEBUG}
|
||||
GDBCon,GDBInt,
|
||||
{$ifdef GDBMI}
|
||||
GDBMICon, GDBMIInt,
|
||||
{$else GDBMI}
|
||||
GDBCon,GDBInt,
|
||||
{$endif GDBMI}
|
||||
{$endif NODEBUG}
|
||||
App,Menus,
|
||||
WViews,WEditor,
|
||||
|
||||
@ -557,7 +557,11 @@ uses
|
||||
fpintf, { superseeds version_string of version unit }
|
||||
{$endif USE_EXTERNAL_COMPILER}
|
||||
{$ifndef NODEBUG}
|
||||
gdbint,
|
||||
{$ifdef GDBMI}
|
||||
gdbmiint,
|
||||
{$else GDBMI}
|
||||
gdbint,
|
||||
{$endif GDBMI}
|
||||
{$endif NODEBUG}
|
||||
{$ifdef VESA}Vesa,{$endif}
|
||||
FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompil,FPHelp,
|
||||
|
||||
186
ide/gdbmicon.pas
Normal file
186
ide/gdbmicon.pas
Normal file
@ -0,0 +1,186 @@
|
||||
{
|
||||
Copyright (c) 2015 by Nikolay Nikolov
|
||||
Copyright (c) 1998 by Peter Vreman
|
||||
|
||||
This is a replacement for GDBCon, implemented on top of GDB/MI,
|
||||
instead of LibGDB. This allows integration of GDB/MI support in the
|
||||
text mode IDE.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit gdbmicon;
|
||||
|
||||
{$MODE fpc}{$H-}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
gdbmiint, gdbmiwrap;
|
||||
|
||||
type
|
||||
TGDBController = object(TGDBInterface)
|
||||
protected
|
||||
start_break_number: LongInt;
|
||||
in_command: LongInt;
|
||||
|
||||
procedure CommandBegin(const s: string); virtual;
|
||||
procedure CommandEnd(const s: string); virtual;
|
||||
|
||||
public
|
||||
constructor Init;
|
||||
destructor Done;
|
||||
|
||||
procedure Command(const s: string);
|
||||
procedure Reset; virtual;
|
||||
{ tracing }
|
||||
procedure StartTrace;
|
||||
procedure Run; virtual;
|
||||
procedure TraceStep;
|
||||
procedure TraceNext;
|
||||
procedure TraceStepI;
|
||||
procedure TraceNextI;
|
||||
procedure Continue; virtual;
|
||||
function LoadFile(var fn: string): Boolean;
|
||||
procedure SetDir(const s: string);
|
||||
procedure SetArgs(const s: string);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure UnixDir(var s : string);
|
||||
var i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i]='\' then
|
||||
{$ifdef win32}
|
||||
{ Don't touch at '\ ' used to escapes spaces in windows file names PM }
|
||||
if (i=length(s)) or (s[i+1]<>' ') then
|
||||
{$endif win32}
|
||||
s[i]:='/';
|
||||
{$ifdef win32}
|
||||
{$ifndef USE_MINGW_GDB}
|
||||
{ for win32 we should convert e:\ into //e/ PM }
|
||||
if (length(s)>2) and (s[2]=':') and (s[3]='/') then
|
||||
s:=CygDrivePrefix+'/'+s[1]+copy(s,3,length(s));
|
||||
{$endif USE_MINGW_GDB}
|
||||
{$endif win32}
|
||||
end;
|
||||
|
||||
constructor TGDBController.Init;
|
||||
begin
|
||||
inherited Init;
|
||||
end;
|
||||
|
||||
destructor TGDBController.Done;
|
||||
begin
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
procedure TGDBController.CommandBegin(const s: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBController.Command(const s: string);
|
||||
begin
|
||||
Inc(in_command);
|
||||
CommandBegin(s);
|
||||
GDBOutputBuf.Reset;
|
||||
GDBErrorBuf.Reset;
|
||||
i_gdb_command(s);
|
||||
CommandEnd(s);
|
||||
Dec(in_command);
|
||||
end;
|
||||
|
||||
procedure TGDBController.CommandEnd(const s: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBController.Reset;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBController.StartTrace;
|
||||
begin
|
||||
Command('-break-insert -t PASCALMAIN');
|
||||
start_break_number := GDB.ResultRecord.Parameters['bkpt'].AsTuple['number'].AsLongInt;
|
||||
Run;
|
||||
end;
|
||||
|
||||
procedure TGDBController.Run;
|
||||
begin
|
||||
UserScreen;
|
||||
Command('-exec-run');
|
||||
WaitForProgramStop;
|
||||
end;
|
||||
|
||||
procedure TGDBController.TraceStep;
|
||||
begin
|
||||
UserScreen;
|
||||
Command('-exec-step');
|
||||
WaitForProgramStop;
|
||||
end;
|
||||
|
||||
procedure TGDBController.TraceNext;
|
||||
begin
|
||||
UserScreen;
|
||||
Command('-exec-next');
|
||||
WaitForProgramStop;
|
||||
end;
|
||||
|
||||
procedure TGDBController.TraceStepI;
|
||||
begin
|
||||
UserScreen;
|
||||
Command('-exec-step-instruction');
|
||||
WaitForProgramStop;
|
||||
end;
|
||||
|
||||
procedure TGDBController.TraceNextI;
|
||||
begin
|
||||
UserScreen;
|
||||
Command('-exec-next-instruction');
|
||||
WaitForProgramStop;
|
||||
end;
|
||||
|
||||
procedure TGDBController.Continue;
|
||||
begin
|
||||
UserScreen;
|
||||
Command('-exec-continue');
|
||||
WaitForProgramStop;
|
||||
end;
|
||||
|
||||
function TGDBController.LoadFile(var fn: string): Boolean;
|
||||
var
|
||||
cmd: string;
|
||||
begin
|
||||
getdir(0,cmd);
|
||||
UnixDir(cmd);
|
||||
Command('-environment-cd ' + cmd);
|
||||
GDBOutputBuf.Reset;
|
||||
GDBErrorBuf.Reset;
|
||||
UnixDir(fn);
|
||||
Command('-file-exec-and-symbols ' + fn);
|
||||
LoadFile := True;
|
||||
end;
|
||||
|
||||
procedure TGDBController.SetDir(const s: string);
|
||||
var
|
||||
hs: string;
|
||||
begin
|
||||
hs:=s;
|
||||
UnixDir(hs);
|
||||
Command('-environment-cd ' + hs);
|
||||
end;
|
||||
|
||||
procedure TGDBController.SetArgs(const s: string);
|
||||
begin
|
||||
Command('-exec-arguments ' + s);
|
||||
end;
|
||||
|
||||
end.
|
||||
449
ide/gdbmiint.pas
Normal file
449
ide/gdbmiint.pas
Normal file
@ -0,0 +1,449 @@
|
||||
{
|
||||
Copyright (c) 2015 by Nikolay Nikolov
|
||||
Copyright (c) 1998 by Peter Vreman
|
||||
|
||||
This is a replacement for GDBInt, implemented on top of GDB/MI,
|
||||
instead of LibGDB. This allows integration of GDB/MI support in the
|
||||
text mode IDE.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit gdbmiint;
|
||||
|
||||
{$MODE fpc}{$H-}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
gdbmiwrap;
|
||||
|
||||
type
|
||||
CORE_ADDR = PtrInt;
|
||||
|
||||
PPFrameEntry = ^PFrameEntry;
|
||||
PFrameEntry = ^TFrameEntry;
|
||||
TFrameEntry = object
|
||||
private
|
||||
procedure Reset;
|
||||
procedure Clear;
|
||||
public
|
||||
file_name: PChar;
|
||||
function_name: PChar;
|
||||
args: PChar;
|
||||
line_number: LongInt;
|
||||
address: PtrInt;
|
||||
constructor Init;
|
||||
destructor Done;
|
||||
end;
|
||||
|
||||
TGDBBuffer = object
|
||||
private
|
||||
buf: PChar;
|
||||
size, idx: LongInt;
|
||||
procedure Resize(nsize: LongInt);
|
||||
procedure Append(p: PChar);
|
||||
procedure LAppend(p: PChar; len: LongInt);
|
||||
public
|
||||
constructor Init;
|
||||
destructor Done;
|
||||
procedure Reset;
|
||||
end;
|
||||
|
||||
TGDBInterface = object
|
||||
private
|
||||
user_screen_shown: Boolean;
|
||||
frame_size: LongInt;
|
||||
protected
|
||||
GDB: TGDBWrapper;
|
||||
|
||||
procedure i_gdb_command(const S: string);
|
||||
procedure WaitForProgramStop;
|
||||
procedure ProcessResponse;
|
||||
public
|
||||
GDBErrorBuf: TGDBBuffer;
|
||||
GDBOutputBuf: TGDBBuffer;
|
||||
got_error: Boolean;
|
||||
reset_command: Boolean;
|
||||
Debuggee_started: Boolean;
|
||||
{ frames and frame info while recording a frame }
|
||||
frames: PPFrameEntry;
|
||||
frame_count: LongInt;
|
||||
command_level,
|
||||
stop_breakpoint_number: LongInt;
|
||||
signal_name: PChar;
|
||||
signal_string: PChar;
|
||||
current_pc: CORE_ADDR;
|
||||
last_breakpoint_number: LongInt;
|
||||
switch_to_user: Boolean;
|
||||
|
||||
{ init }
|
||||
constructor Init;
|
||||
destructor Done;
|
||||
{ from gdbcon }
|
||||
function GetOutput: PChar;
|
||||
function GetError: PChar;
|
||||
{ Lowlevel }
|
||||
function error: Boolean;
|
||||
function error_num: LongInt;
|
||||
function get_current_frame: PtrInt;
|
||||
function set_current_frame(level: LongInt): Boolean;
|
||||
procedure clear_frames;
|
||||
{ Highlevel }
|
||||
procedure DebuggerScreen;
|
||||
procedure UserScreen;
|
||||
procedure FlushAll; virtual;
|
||||
function Query(question: PChar; args: PChar): LongInt; virtual;
|
||||
{ Hooks }
|
||||
procedure DoSelectSourceline(const fn: string; line: LongInt); virtual;
|
||||
procedure DoStartSession; virtual;
|
||||
procedure DoBreakSession; virtual;
|
||||
procedure DoEndSession(code: LongInt); virtual;
|
||||
procedure DoUserSignal; virtual;
|
||||
procedure DoDebuggerScreen; virtual;
|
||||
procedure DoUserScreen; virtual;
|
||||
function AllowQuit: Boolean; virtual;
|
||||
end;
|
||||
|
||||
const
|
||||
use_gdb_file: Boolean = False;
|
||||
|
||||
var
|
||||
gdb_file: Text;
|
||||
|
||||
function GDBVersion: string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
strings;
|
||||
|
||||
constructor TFrameEntry.Init;
|
||||
begin
|
||||
Reset;
|
||||
end;
|
||||
|
||||
destructor TFrameEntry.Done;
|
||||
begin
|
||||
Clear;
|
||||
end;
|
||||
|
||||
procedure TFrameEntry.Reset;
|
||||
begin
|
||||
file_name := nil;
|
||||
function_name := nil;
|
||||
args := nil;
|
||||
line_number := 0;
|
||||
address := 0;
|
||||
end;
|
||||
|
||||
procedure TFrameEntry.Clear;
|
||||
begin
|
||||
if Assigned(file_name) then
|
||||
StrDispose(file_name);
|
||||
if Assigned(function_name) then
|
||||
StrDispose(function_name);
|
||||
if Assigned(args) then
|
||||
StrDispose(args);
|
||||
Reset;
|
||||
end;
|
||||
|
||||
const
|
||||
BlockSize = 2048;
|
||||
|
||||
constructor TGDBBuffer.Init;
|
||||
begin
|
||||
buf := nil;
|
||||
size := 0;
|
||||
Resize(BlockSize);
|
||||
Reset;
|
||||
end;
|
||||
|
||||
destructor TGDBBuffer.Done;
|
||||
begin
|
||||
if Assigned(buf) then
|
||||
FreeMem(buf, size);
|
||||
end;
|
||||
|
||||
procedure TGDBBuffer.Reset;
|
||||
begin
|
||||
idx := 0;
|
||||
buf[0] := #0;
|
||||
end;
|
||||
|
||||
procedure TGDBBuffer.Resize(nsize: LongInt);
|
||||
var
|
||||
np: PChar;
|
||||
begin
|
||||
nsize := ((nsize + BlockSize - 1) div BlockSize) * BlockSize;
|
||||
GetMem(np, nsize);
|
||||
if Assigned(buf) then
|
||||
begin
|
||||
Move(buf^, np^, size);
|
||||
FreeMem(buf, size);
|
||||
end;
|
||||
buf := np;
|
||||
size := nsize;
|
||||
end;
|
||||
|
||||
procedure TGDBBuffer.Append(p: PChar);
|
||||
var
|
||||
len: LongInt;
|
||||
begin
|
||||
if not Assigned(p) then
|
||||
exit;
|
||||
len := StrLen(p);
|
||||
LAppend(p, len);
|
||||
end;
|
||||
|
||||
procedure TGDBBuffer.LAppend(p: PChar; len: LongInt);
|
||||
begin
|
||||
if not Assigned(p) then
|
||||
exit;
|
||||
if (len + idx + 1) > size then
|
||||
Resize(len + idx + 1);
|
||||
Move(p^, buf[idx], len);
|
||||
Inc(idx, len);
|
||||
buf[idx] := #0;
|
||||
end;
|
||||
|
||||
constructor TGDBInterface.Init;
|
||||
begin
|
||||
GDBErrorBuf.Init;
|
||||
GDBOutputBuf.Init;
|
||||
GDB := TGDBWrapper.Create;
|
||||
command_level := 0;
|
||||
end;
|
||||
|
||||
destructor TGDBInterface.Done;
|
||||
begin
|
||||
GDB.Free;
|
||||
GDBErrorBuf.Done;
|
||||
GDBOutputBuf.Done;
|
||||
end;
|
||||
|
||||
function TGDBInterface.GetOutput: PChar;
|
||||
begin
|
||||
GetOutput := GDBOutputBuf.buf;
|
||||
end;
|
||||
|
||||
function TGDBInterface.GetError: PChar;
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
p := GDBErrorBuf.buf;
|
||||
if (p^=#0) and got_error then
|
||||
GetError := PChar(PtrInt(GDBOutputBuf.buf) + GDBOutputBuf.idx)
|
||||
else
|
||||
GetError := p;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.i_gdb_command(const S: string);
|
||||
var
|
||||
prev_stop_breakpoint_number: LongInt;
|
||||
I: LongInt;
|
||||
begin
|
||||
Inc(command_level);
|
||||
got_error := False;
|
||||
if command_level = 1 then
|
||||
prev_stop_breakpoint_number := 0
|
||||
else
|
||||
prev_stop_breakpoint_number := stop_breakpoint_number;
|
||||
GDB.Command(S);
|
||||
for I := 0 to GDB.ConsoleStream.Count - 1 do
|
||||
GDBOutputBuf.Append(PChar(GDB.ConsoleStream[I]));
|
||||
ProcessResponse;
|
||||
Dec(command_level);
|
||||
stop_breakpoint_number := prev_stop_breakpoint_number;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.WaitForProgramStop;
|
||||
var
|
||||
Line: LongInt;
|
||||
begin
|
||||
GDB.WaitForProgramStop;
|
||||
if not GDB.Alive then
|
||||
begin
|
||||
DebuggerScreen;
|
||||
current_pc := 0;
|
||||
Debuggee_started := False;
|
||||
exit;
|
||||
end;
|
||||
ProcessResponse;
|
||||
case GDB.ExecAsyncOutput.Parameters['reason'].AsString of
|
||||
'breakpoint-hit':
|
||||
begin
|
||||
stop_breakpoint_number := GDB.ExecAsyncOutput.Parameters['bkptno'].AsLongInt;
|
||||
DebuggerScreen;
|
||||
Debuggee_started := True;
|
||||
DoSelectSourceLine(GDB.ExecAsyncOutput.Parameters['frame'].AsTuple['fullname'].AsString, GDB.ExecAsyncOutput.Parameters['frame'].AsTuple['line'].AsLongInt);
|
||||
end;
|
||||
'end-stepping-range':
|
||||
begin
|
||||
DebuggerScreen;
|
||||
Debuggee_started := True;
|
||||
current_pc := GDB.ExecAsyncOutput.Parameters['frame'].AsTuple['addr'].AsPtrInt;
|
||||
DoSelectSourceLine(GDB.ExecAsyncOutput.Parameters['frame'].AsTuple['fullname'].AsString, GDB.ExecAsyncOutput.Parameters['frame'].AsTuple['line'].AsLongInt);
|
||||
end;
|
||||
'exited':
|
||||
begin
|
||||
DebuggerScreen;
|
||||
current_pc := 0;
|
||||
Debuggee_started := False;
|
||||
DoEndSession(GDB.ExecAsyncOutput.Parameters['exit-code'].AsLongInt);
|
||||
end;
|
||||
'exited-normally':
|
||||
begin
|
||||
DebuggerScreen;
|
||||
current_pc := 0;
|
||||
Debuggee_started := False;
|
||||
DoEndSession(0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.ProcessResponse;
|
||||
var
|
||||
NAO: TGDBMI_AsyncOutput;
|
||||
Code: LongInt;
|
||||
begin
|
||||
for NAO in GDB.NotifyAsyncOutput do
|
||||
begin
|
||||
if NAO.AsyncClass = 'breakpoint-created' then
|
||||
begin
|
||||
// Writeln('BREAKPOINT created!');
|
||||
Val(NAO.Parameters['bkpt'].AsTuple['number'].AsString, last_breakpoint_number, Code);
|
||||
// Writeln('last_breakpoint_number=', last_breakpoint_number);
|
||||
// if Assigned(NAO.Parameters['bkpt'].AsTuple['file']) then
|
||||
// Writeln('file = ', NAO.Parameters['bkpt'].AsTuple['file'].AsString);
|
||||
// Readln;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGDBInterface.error: Boolean;
|
||||
begin
|
||||
error := got_error or not GDB.Alive;
|
||||
end;
|
||||
|
||||
function TGDBInterface.error_num: LongInt;
|
||||
begin
|
||||
error_num := 0; { TODO }
|
||||
end;
|
||||
|
||||
function TGDBInterface.get_current_frame: PtrInt;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TGDBInterface.set_current_frame(level: LongInt): Boolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.clear_frames;
|
||||
var
|
||||
I: LongInt;
|
||||
begin
|
||||
for I := 0 to frame_size - 1 do
|
||||
Dispose(frames[I], Done);
|
||||
if Assigned(frames) then
|
||||
begin
|
||||
FreeMem(frames, SizeOf(Pointer) * frame_size);
|
||||
frames := nil;
|
||||
end;
|
||||
frame_count := 0;
|
||||
frame_size := 0;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DebuggerScreen;
|
||||
begin
|
||||
if user_screen_shown then
|
||||
DoDebuggerScreen;
|
||||
user_screen_shown := False;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.UserScreen;
|
||||
begin
|
||||
if switch_to_user then
|
||||
begin
|
||||
if not user_screen_shown then
|
||||
DoUserScreen;
|
||||
user_screen_shown := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.FlushAll;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TGDBInterface.Query(question: PChar; args: PChar): LongInt;
|
||||
begin
|
||||
Query := 0;
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoSelectSourceline(const fn: string; line: LongInt);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoStartSession;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoBreakSession;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoEndSession(code: LongInt);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoUserSignal;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoDebuggerScreen;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBInterface.DoUserScreen;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TGDBInterface.AllowQuit: Boolean;
|
||||
begin
|
||||
AllowQuit := True;
|
||||
end;
|
||||
|
||||
var
|
||||
CachedGDBVersion: string;
|
||||
|
||||
function GDBVersion: string;
|
||||
var
|
||||
GDB: TGDBWrapper;
|
||||
begin
|
||||
if CachedGDBVersion <> '' then
|
||||
begin
|
||||
GDBVersion := CachedGDBVersion;
|
||||
exit;
|
||||
end;
|
||||
GDBVersion := '';
|
||||
GDB := TGDBWrapper.Create;
|
||||
GDB.Command('-gdb-version');
|
||||
if GDB.ConsoleStream.Count > 0 then
|
||||
GDBVersion := GDB.ConsoleStream[0];
|
||||
if (GDBVersion <> '') and (GDBVersion[Length(GDBVersion)]=#10) then
|
||||
Delete(GDBVersion, Length(GDBVersion), 1);
|
||||
GDB.Free;
|
||||
CachedGDBVersion := GDBVersion;
|
||||
if GDBVersion = '' then
|
||||
GDBVersion := 'GDB missing or does not work';
|
||||
end;
|
||||
|
||||
begin
|
||||
CachedGDBVersion := '';
|
||||
end.
|
||||
136
ide/gdbmiproc.pas
Normal file
136
ide/gdbmiproc.pas
Normal file
@ -0,0 +1,136 @@
|
||||
{
|
||||
Copyright (c) 2015 by Nikolay Nikolov
|
||||
|
||||
This unit implements a class, which launches gdb in GDB/MI mode
|
||||
and allows sending textual commands to it and receiving the response
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit GDBMIProc;
|
||||
|
||||
{$MODE objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Process;
|
||||
|
||||
type
|
||||
TGDBProcess = class
|
||||
private
|
||||
FProcess: TProcess;
|
||||
FDebugLog: TextFile;
|
||||
|
||||
function IsAlive: Boolean;
|
||||
procedure GDBWrite(const S: string);
|
||||
procedure DebugLn(const S: string);
|
||||
procedure DebugErrorLn(const S: string);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function GDBReadLn: string;
|
||||
procedure GDBWriteLn(const S: string);
|
||||
property Alive: Boolean read IsAlive;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
DebugLogEnabled: Boolean = False;
|
||||
GdbProgramName: string = 'gdb';
|
||||
|
||||
function TGDBProcess.IsAlive: Boolean;
|
||||
begin
|
||||
Result := Assigned(FProcess) and FProcess.Running;
|
||||
end;
|
||||
|
||||
function TGDBProcess.GDBReadLn: string;
|
||||
var
|
||||
C: Char;
|
||||
begin
|
||||
Result := '';
|
||||
while FProcess.Running do
|
||||
begin
|
||||
FProcess.Output.Read(C, 1);
|
||||
if C = #10 then
|
||||
begin
|
||||
DebugLn(Result);
|
||||
exit;
|
||||
end;
|
||||
Result := Result + C;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TGDBProcess.Create;
|
||||
begin
|
||||
if DebugLogEnabled then
|
||||
begin
|
||||
AssignFile(FDebugLog, 'gdblog.txt');
|
||||
Rewrite(FDebugLog);
|
||||
CloseFile(FDebugLog);
|
||||
end;
|
||||
FProcess := TProcess.Create(nil);
|
||||
FProcess.Options := [poUsePipes, poStdErrToOutput];
|
||||
FProcess.Executable := GdbProgramName;
|
||||
FProcess.Parameters.Add('--interpreter=mi');
|
||||
try
|
||||
FProcess.Execute;
|
||||
except
|
||||
on e: Exception do
|
||||
begin
|
||||
DebugErrorLn('Could not start GDB: ' + e.Message);
|
||||
FreeAndNil(FProcess);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TGDBProcess.Destroy;
|
||||
begin
|
||||
FProcess.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGDBProcess.DebugLn(const S: string);
|
||||
begin
|
||||
if DebugLogEnabled then
|
||||
begin
|
||||
Append(FDebugLog);
|
||||
Writeln(FDebugLog, S);
|
||||
CloseFile(FDebugLog);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGDBProcess.DebugErrorLn(const S: string);
|
||||
begin
|
||||
DebugLn('ERROR: ' + S);
|
||||
end;
|
||||
|
||||
procedure TGDBProcess.GDBWrite(const S: string);
|
||||
begin
|
||||
FProcess.Input.Write(S[1], Length(S));
|
||||
end;
|
||||
|
||||
procedure TGDBProcess.GDBWriteln(const S: string);
|
||||
begin
|
||||
if not IsAlive then
|
||||
begin
|
||||
DebugErrorLn('Trying to send command to a dead GDB: ' + S);
|
||||
exit;
|
||||
end;
|
||||
DebugLn(S);
|
||||
GDBWrite(S + #10);
|
||||
end;
|
||||
|
||||
begin
|
||||
if GetEnvironmentVariable('FPIDE_GDBLOG') = '1' then
|
||||
DebugLogEnabled := True;
|
||||
if GetEnvironmentVariable('FPIDE_GDBPROG') <> '' then
|
||||
GdbProgramName := GetEnvironmentVariable('FPIDE_GDBPROG');
|
||||
end.
|
||||
449
ide/gdbmiwrap.pas
Normal file
449
ide/gdbmiwrap.pas
Normal file
@ -0,0 +1,449 @@
|
||||
{
|
||||
Copyright (c) 2015 by Nikolay Nikolov
|
||||
|
||||
This unit provides a wrapper around GDB and implements parsing of
|
||||
the GDB/MI command result records.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit gdbmiwrap;
|
||||
|
||||
{$MODE objfpc}{$H+}
|
||||
{$ASSERTIONS on}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, GDBMIProc;
|
||||
|
||||
type
|
||||
TGDBMI_TupleValue = class;
|
||||
TGDBMI_ListValue = class;
|
||||
TGDBMI_Value = class
|
||||
function AsString: string;
|
||||
function AsLongInt: LongInt;
|
||||
function AsPtrInt: PtrInt;
|
||||
function AsTuple: TGDBMI_TupleValue;
|
||||
function AsList: TGDBMI_ListValue;
|
||||
end;
|
||||
|
||||
{ "C string\n" }
|
||||
TGDBMI_StringValue = class(TGDBMI_Value)
|
||||
FStringValue: string;
|
||||
public
|
||||
constructor Create(const S: string);
|
||||
property StringValue: string read FStringValue;
|
||||
end;
|
||||
|
||||
(* {...} or [...] *)
|
||||
TGDBMI_TupleOrListValue = class(TGDBMI_Value)
|
||||
private
|
||||
FNames: array of string;
|
||||
FValues: array of TGDBMI_Value;
|
||||
function GetValue(const AName: string): TGDBMI_Value;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Add(AName: string; AValue: TGDBMI_Value);
|
||||
function HasNames: Boolean;
|
||||
function IsEmpty: Boolean;
|
||||
property Values [const AName: string]: TGDBMI_Value read GetValue; default;
|
||||
end;
|
||||
|
||||
(* {} or {variable=value,variable=value,variable=value} *)
|
||||
TGDBMI_TupleValue = class(TGDBMI_TupleOrListValue)
|
||||
end;
|
||||
|
||||
{ [] or [value,value,value] or [variable=value,variable=value,variable=value] }
|
||||
TGDBMI_ListValue = class(TGDBMI_TupleOrListValue)
|
||||
end;
|
||||
|
||||
TGDBMI_AsyncOutput = class
|
||||
FAsyncClass: string;
|
||||
FParameters: TGDBMI_TupleValue;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
property AsyncClass: string read FAsyncClass write FAsyncClass;
|
||||
property Parameters: TGDBMI_TupleValue read FParameters;
|
||||
end;
|
||||
|
||||
TGDBMI_AsyncOutput_List = array of TGDBMI_AsyncOutput;
|
||||
|
||||
TGDBWrapper = class
|
||||
private
|
||||
FProcess: TGDBProcess;
|
||||
FRawResponse: TStringList;
|
||||
FConsoleStream: TStringList;
|
||||
FExecAsyncOutput: TGDBMI_AsyncOutput;
|
||||
FResultRecord: TGDBMI_AsyncOutput;
|
||||
|
||||
function IsAlive: Boolean;
|
||||
procedure ReadResponse;
|
||||
public
|
||||
NotifyAsyncOutput: TGDBMI_AsyncOutput_List;
|
||||
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Command(S: string);
|
||||
procedure WaitForProgramStop;
|
||||
property RawResponse: TStringList read FRawResponse;
|
||||
property ConsoleStream: TStringList read FConsoleStream;
|
||||
property ExecAsyncOutput: TGDBMI_AsyncOutput read FExecAsyncOutput;
|
||||
property ResultRecord: TGDBMI_AsyncOutput read FResultRecord write FResultRecord;
|
||||
property Alive: Boolean read IsAlive;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TGDBMI_Value.AsString: string;
|
||||
begin
|
||||
Result := (self as TGDBMI_StringValue).StringValue;
|
||||
end;
|
||||
|
||||
function TGDBMI_Value.AsLongInt: LongInt;
|
||||
begin
|
||||
Result := StrToInt(AsString);
|
||||
end;
|
||||
|
||||
function TGDBMI_Value.AsPtrInt: PtrInt;
|
||||
begin
|
||||
{$ifdef CPU64}
|
||||
Result := StrToInt64(AsString);
|
||||
{$else}
|
||||
Result := StrToInt(AsString);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function TGDBMI_Value.AsTuple: TGDBMI_TupleValue;
|
||||
begin
|
||||
Result := self as TGDBMI_TupleValue;
|
||||
end;
|
||||
|
||||
function TGDBMI_Value.AsList: TGDBMI_ListValue;
|
||||
begin
|
||||
Result := self as TGDBMI_ListValue;
|
||||
end;
|
||||
|
||||
constructor TGDBMI_StringValue.Create(const S: string);
|
||||
begin
|
||||
FStringValue := S;
|
||||
end;
|
||||
|
||||
destructor TGDBMI_TupleOrListValue.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGDBMI_TupleOrListValue.Clear;
|
||||
var
|
||||
I: LongInt;
|
||||
begin
|
||||
SetLength(FNames, 0);
|
||||
for I := Low(FValues) to High(FValues) do
|
||||
FreeAndNil(FValues[I]);
|
||||
SetLength(FValues, 0);
|
||||
end;
|
||||
|
||||
procedure TGDBMI_TupleOrListValue.Add(AName: string; AValue: TGDBMI_Value);
|
||||
begin
|
||||
Assert(AValue <> nil);
|
||||
Assert(IsEmpty or (HasNames = (AName <> '')));
|
||||
if AName <> '' then
|
||||
begin
|
||||
SetLength(FNames, Length(FNames) + 1);
|
||||
FNames[Length(FNames) - 1] := AName;
|
||||
end;
|
||||
SetLength(FValues, Length(FValues) + 1);
|
||||
FValues[Length(FValues) - 1] := AValue;
|
||||
end;
|
||||
|
||||
function TGDBMI_TupleOrListValue.HasNames: Boolean;
|
||||
begin
|
||||
Result := Length(FNames) > 0;
|
||||
end;
|
||||
|
||||
function TGDBMI_TupleOrListValue.IsEmpty: Boolean;
|
||||
begin
|
||||
Result := Length(FValues) = 0;
|
||||
end;
|
||||
|
||||
function TGDBMI_TupleOrListValue.GetValue(const AName: string): TGDBMI_Value;
|
||||
var
|
||||
I: LongInt;
|
||||
begin
|
||||
for I := Low(FNames) to High(FNames) do
|
||||
if FNames[I] = AName then
|
||||
begin
|
||||
Result := FValues[I];
|
||||
exit;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
constructor TGDBMI_AsyncOutput.Create;
|
||||
begin
|
||||
FParameters := TGDBMI_TupleValue.Create;
|
||||
end;
|
||||
|
||||
destructor TGDBMI_AsyncOutput.Destroy;
|
||||
begin
|
||||
FParameters.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGDBMI_AsyncOutput.Clear;
|
||||
begin
|
||||
AsyncClass := '';
|
||||
Parameters.Clear;
|
||||
end;
|
||||
|
||||
function ParseCString(const CStr: string; var NextCharPos: LongInt): string;
|
||||
begin
|
||||
if (NextCharPos <= Length(CStr)) and (CStr[NextCharPos] = '"') then
|
||||
Inc(NextCharPos);
|
||||
Result := '';
|
||||
while NextCharPos <= Length(CStr) do
|
||||
begin
|
||||
if CStr[NextCharPos] = '"' then
|
||||
begin
|
||||
Inc(NextCharPos);
|
||||
exit;
|
||||
end
|
||||
else if CStr[NextCharPos] = '\' then
|
||||
begin
|
||||
Inc(NextCharPos);
|
||||
if NextCharPos <= Length(CStr) then
|
||||
case CStr[NextCharPos] of
|
||||
'''': Result := Result + '''';
|
||||
'"': Result := Result + '"';
|
||||
'n': Result := Result + #10;
|
||||
'r': Result := Result + #13;
|
||||
't': Result := Result + #9;
|
||||
'v': Result := Result + #11;
|
||||
'b': Result := Result + #8;
|
||||
'f': Result := Result + #12;
|
||||
'a': Result := Result + #7;
|
||||
'\': Result := Result + '\';
|
||||
'?': Result := Result + '?';
|
||||
{\0, \000, \xhhh}
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := Result + CStr[NextCharPos];
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseIdentifier(const S: string; var NextCharPos: LongInt): string;
|
||||
begin
|
||||
Result := '';
|
||||
while (NextCharPos <= Length(S)) and (S[NextCharPos] in ['A'..'Z', 'a'..'z', '0'..'9', '-']) do
|
||||
begin
|
||||
Result := Result + S[NextCharPos];
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseValue(const S: string; var NextCharPos: LongInt): TGDBMI_Value;
|
||||
var
|
||||
CStr: string;
|
||||
Tuple: TGDBMI_TupleValue;
|
||||
List: TGDBMI_ListValue;
|
||||
|
||||
Name: string;
|
||||
Value: TGDBMI_Value;
|
||||
begin
|
||||
Assert(NextCharPos <= Length(S));
|
||||
case S[NextCharPos] of
|
||||
'"':
|
||||
begin
|
||||
CStr := ParseCString(S, NextCharPos);
|
||||
Result := TGDBMI_StringValue.Create(CStr);
|
||||
end;
|
||||
'{':
|
||||
begin
|
||||
Inc(NextCharPos);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Tuple := TGDBMI_TupleValue.Create;
|
||||
Result := Tuple;
|
||||
while (NextCharPos <= Length(S)) and (S[NextCharPos] <> '}') do
|
||||
begin
|
||||
Name := ParseIdentifier(S, NextCharPos);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Assert(S[NextCharPos] = '=');
|
||||
Inc(NextCharPos);
|
||||
Value := ParseValue(S, NextCharPos);
|
||||
Tuple.Add(Name, Value);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Assert(S[NextCharPos] in [',', '}']);
|
||||
if S[NextCharPos] = ',' then
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
if (NextCharPos <= Length(S)) and (S[NextCharPos] = '}') then
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
'[':
|
||||
begin
|
||||
Inc(NextCharPos);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
List := TGDBMI_ListValue.Create;
|
||||
Result := List;
|
||||
if S[NextCharPos] in ['"', '{', '['] then
|
||||
begin
|
||||
{ list of values, no names }
|
||||
while (NextCharPos <= Length(S)) and (S[NextCharPos] <> ']') do
|
||||
begin
|
||||
Value := ParseValue(S, NextCharPos);
|
||||
List.Add('', Value);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Assert(S[NextCharPos] in [',', ']']);
|
||||
if S[NextCharPos] = ',' then
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ list of name=value pairs (like a tuple) }
|
||||
while (NextCharPos <= Length(S)) and (S[NextCharPos] <> ']') do
|
||||
begin
|
||||
Name := ParseIdentifier(S, NextCharPos);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Assert(S[NextCharPos] = '=');
|
||||
Inc(NextCharPos);
|
||||
Value := ParseValue(S, NextCharPos);
|
||||
List.Add(Name, Value);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Assert(S[NextCharPos] in [',', ']']);
|
||||
if S[NextCharPos] = ',' then
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
end;
|
||||
if (NextCharPos <= Length(S)) and (S[NextCharPos] = ']') then
|
||||
Inc(NextCharPos);
|
||||
end;
|
||||
else
|
||||
Assert(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ParseAsyncOutput(const S: string; AsyncOutput: TGDBMI_AsyncOutput; var NextCharPos: LongInt);
|
||||
var
|
||||
Name: string;
|
||||
Value: TGDBMI_Value;
|
||||
begin
|
||||
AsyncOutput.Clear;
|
||||
AsyncOutput.AsyncClass := ParseIdentifier(S, NextCharPos);
|
||||
while NextCharPos <= Length(S) do
|
||||
begin
|
||||
Assert(S[NextCharPos] = ',');
|
||||
Inc(NextCharPos);
|
||||
Name := ParseIdentifier(S, NextCharPos);
|
||||
Assert(NextCharPos <= Length(S));
|
||||
Assert(S[NextCharPos] = '=');
|
||||
Inc(NextCharPos);
|
||||
Value := ParseValue(S, NextCharPos);
|
||||
AsyncOutput.Parameters.Add(Name, Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGDBWrapper.IsAlive: Boolean;
|
||||
begin
|
||||
Result := Assigned(FProcess) and FProcess.Alive;
|
||||
end;
|
||||
|
||||
procedure TGDBWrapper.ReadResponse;
|
||||
var
|
||||
S: string;
|
||||
I: LongInt;
|
||||
NextCharPos: LongInt;
|
||||
NAO: TGDBMI_AsyncOutput;
|
||||
begin
|
||||
FRawResponse.Clear;
|
||||
FConsoleStream.Clear;
|
||||
for I := Low(NotifyAsyncOutput) to High(NotifyAsyncOutput) do
|
||||
FreeAndNil(NotifyAsyncOutput[I]);
|
||||
SetLength(NotifyAsyncOutput, 0);
|
||||
if not FProcess.Alive then
|
||||
exit;
|
||||
repeat
|
||||
S := FProcess.GDBReadLn;
|
||||
FRawResponse.Add(S);
|
||||
if Length(S) >= 1 then
|
||||
case S[1] of
|
||||
'~':
|
||||
begin
|
||||
NextCharPos := 2;
|
||||
FConsoleStream.Add(ParseCString(S, NextCharPos));
|
||||
end;
|
||||
'*':
|
||||
begin
|
||||
NextCharPos := 2;
|
||||
ParseAsyncOutput(S, ExecAsyncOutput, NextCharPos);
|
||||
end;
|
||||
'^':
|
||||
begin
|
||||
NextCharPos := 2;
|
||||
ParseAsyncOutput(S, ResultRecord, NextCharPos);
|
||||
end;
|
||||
'=':
|
||||
begin
|
||||
NextCharPos := 2;
|
||||
NAO := TGDBMI_AsyncOutput.Create;
|
||||
try
|
||||
ParseAsyncOutput(S, NAO, NextCharPos);
|
||||
SetLength(NotifyAsyncOutput, Length(NotifyAsyncOutput) + 1);
|
||||
NotifyAsyncOutput[Length(NotifyAsyncOutput) - 1] := NAO;
|
||||
NAO := nil;
|
||||
finally
|
||||
NAO.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until (S = '(gdb) ') or (S = '(gdb)') or not FProcess.Alive;
|
||||
end;
|
||||
|
||||
constructor TGDBWrapper.Create;
|
||||
begin
|
||||
FRawResponse := TStringList.Create;
|
||||
FConsoleStream := TStringList.Create;
|
||||
FProcess := TGDBProcess.Create;
|
||||
FExecAsyncOutput := TGDBMI_AsyncOutput.Create;
|
||||
FResultRecord := TGDBMI_AsyncOutput.Create;
|
||||
ReadResponse;
|
||||
end;
|
||||
|
||||
destructor TGDBWrapper.Destroy;
|
||||
begin
|
||||
if Alive then
|
||||
Command('-gdb-exit');
|
||||
FProcess.Free;
|
||||
FResultRecord.Free;
|
||||
FExecAsyncOutput.Free;
|
||||
FConsoleStream.Free;
|
||||
FRawResponse.Free;
|
||||
end;
|
||||
|
||||
procedure TGDBWrapper.Command(S: string);
|
||||
begin
|
||||
FProcess.GDBWriteLn(S);
|
||||
ReadResponse;
|
||||
end;
|
||||
|
||||
procedure TGDBWrapper.WaitForProgramStop;
|
||||
begin
|
||||
repeat
|
||||
ReadResponse;
|
||||
until (ExecAsyncOutput.AsyncClass = 'stopped') or not FProcess.Alive;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user