From a939ea06b6fe6c95de4f4098b8de7e7bf65e3a6a Mon Sep 17 00:00:00 2001 From: nickysn Date: Mon, 16 Feb 2015 01:07:37 +0000 Subject: [PATCH] + 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 | 4 + ide/fp.pas | 6 +- ide/fpdebug.pas | 6 +- ide/fpmake.pp | 14 +- ide/fpregs.pas | 6 +- ide/fpviews.pas | 6 +- ide/gdbmicon.pas | 186 +++++++++++++++++++ ide/gdbmiint.pas | 449 ++++++++++++++++++++++++++++++++++++++++++++++ ide/gdbmiproc.pas | 136 ++++++++++++++ ide/gdbmiwrap.pas | 449 ++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 1256 insertions(+), 6 deletions(-) create mode 100644 ide/gdbmicon.pas create mode 100644 ide/gdbmiint.pas create mode 100644 ide/gdbmiproc.pas create mode 100644 ide/gdbmiwrap.pas diff --git a/.gitattributes b/.gitattributes index 9bba39b021..76ef2ce2a1 100644 --- a/.gitattributes +++ b/.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 diff --git a/ide/fp.pas b/ide/fp.pas index f1de80bf15..37918c4a62 100644 --- a/ide/fp.pas +++ b/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, diff --git a/ide/fpdebug.pas b/ide/fpdebug.pas index 6222d44999..d5ebe8f5a2 100644 --- a/ide/fpdebug.pas +++ b/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, diff --git a/ide/fpmake.pp b/ide/fpmake.pp index 162a85fa95..e2712e8e77 100644 --- a/ide/fpmake.pp +++ b/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]); diff --git a/ide/fpregs.pas b/ide/fpregs.pas index b4fff2c4ac..d7bc1669ab 100644 --- a/ide/fpregs.pas +++ b/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, diff --git a/ide/fpviews.pas b/ide/fpviews.pas index e1d8ce457d..50c0df9884 100644 --- a/ide/fpviews.pas +++ b/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, diff --git a/ide/gdbmicon.pas b/ide/gdbmicon.pas new file mode 100644 index 0000000000..01b3c1655b --- /dev/null +++ b/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. diff --git a/ide/gdbmiint.pas b/ide/gdbmiint.pas new file mode 100644 index 0000000000..f471bd0c9b --- /dev/null +++ b/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. diff --git a/ide/gdbmiproc.pas b/ide/gdbmiproc.pas new file mode 100644 index 0000000000..7123bdd93c --- /dev/null +++ b/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. diff --git a/ide/gdbmiwrap.pas b/ide/gdbmiwrap.pas new file mode 100644 index 0000000000..e91686daae --- /dev/null +++ b/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.