+ 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 -

.gitattributes

@@ -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

ide/fp.pas

@@ -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,

ide/fpdebug.pas

@@ -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,

ide/fpmake.pp

@@ -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]);
 

ide/fpregs.pas

@@ -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,

ide/fpviews.pas

@@ -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,

ide/gdbmicon.pas

@@ -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.

ide/gdbmiint.pas

@@ -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.

ide/gdbmiproc.pas

@@ -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.

ide/gdbmiwrap.pas

@@ -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.