+ implemented gdb/mi backtraces

git-svn-id: trunk@29736 -

ide/fpdebug.pas

@@ -3539,12 +3539,10 @@ end;
         exit;
       DeskTop^.Lock;
       Clear;
-      { forget all old frames }
-      Debugger^.clear_frames;
 
       if Debugger^.WindowWidth<>-1 then
         Debugger^.Command('set width 0xffffffff');
-      Debugger^.Command('backtrace');
+      Debugger^.Backtrace;
       { generate list }
       { all is in tframeentry }
       for i:=0 to Debugger^.frame_count-1 do

ide/gdbmicon.pas

@@ -50,6 +50,7 @@ type
     procedure Continue; virtual;
     procedure UntilReturn; virtual;
     procedure SetTBreak(tbreakstring : string);
+    procedure Backtrace;
     function LoadFile(var fn: string): Boolean;
     procedure SetDir(const s: string);
     procedure SetArgs(const s: string);
@@ -57,10 +58,12 @@ type
 
 implementation
 
+uses
 {$ifdef Windows}
-  uses
-    Windebug;
+  Windebug,
 {$endif Windows}
+  strings;
+
 procedure UnixDir(var s : string);
 var i : longint;
 begin
@@ -173,6 +176,36 @@ begin
   TBreakNumber := GDB.ResultRecord.Parameters['bkpt'].AsTuple['number'].AsLongInt;
 end;
 
+procedure TGDBController.Backtrace;
+var
+  FrameList: TGDBMI_ListValue;
+  I: LongInt;
+begin
+  { forget all old frames }
+  clear_frames;
+
+  Command('-stack-list-frames');
+  if not GDB.ResultRecord.Success then
+    exit;
+
+  FrameList := GDB.ResultRecord.Parameters['stack'].AsList;
+  frame_count := FrameList.Count;
+  frames := AllocMem(SizeOf(PFrameEntry) * frame_count);
+  for I := 0 to frame_count - 1 do
+    frames[I] := New(PFrameEntry, Init);
+  for I := 0 to FrameList.Count - 1 do
+  begin
+    frames[I]^.address := FrameList.ValueAt[I].AsTuple['addr'].AsPtrInt;
+    frames[I]^.level := FrameList.ValueAt[I].AsTuple['level'].AsLongInt;
+    if Assigned(FrameList.ValueAt[I].AsTuple['line']) then
+      frames[I]^.line_number := FrameList.ValueAt[I].AsTuple['line'].AsLongInt;
+    if Assigned(FrameList.ValueAt[I].AsTuple['func']) then
+      frames[I]^.function_name := StrNew(PChar(FrameList.ValueAt[I].AsTuple['func'].AsString));
+    if Assigned(FrameList.ValueAt[I].AsTuple['fullname']) then
+      frames[I]^.file_name := StrNew(PChar(FrameList.ValueAt[I].AsTuple['fullname'].AsString));
+  end;
+end;
+
 function TGDBController.LoadFile(var fn: string): Boolean;
 var
   cmd: string;

ide/gdbmiint.pas

@@ -39,6 +39,7 @@ type
     args: PChar;
     line_number: LongInt;
     address: PtrInt;
+    level : longint;
     constructor Init;
     destructor Done;
   end;
@@ -59,7 +60,6 @@ type
   TGDBInterface = object
   private
     user_screen_shown: Boolean;
-    frame_size: LongInt;
   protected
     GDB: TGDBWrapper;
 
@@ -147,6 +147,7 @@ begin
   args := nil;
   line_number := 0;
   address := 0;
+  level := 0;
 end;
 
 procedure TFrameEntry.Clear;
@@ -229,6 +230,7 @@ end;
 
 destructor TGDBInterface.Done;
 begin
+  clear_frames;
   GDB.Free;
   GDBErrorBuf.Done;
   GDBOutputBuf.Done;
@@ -358,15 +360,14 @@ procedure TGDBInterface.clear_frames;
 var
   I: LongInt;
 begin
-  for I := 0 to frame_size - 1 do
+  for I := 0 to frame_count - 1 do
     Dispose(frames[I], Done);
   if Assigned(frames) then
   begin
-    FreeMem(frames, SizeOf(Pointer) * frame_size);
+    FreeMem(frames, SizeOf(Pointer) * frame_count);
     frames := nil;
   end;
   frame_count := 0;
-  frame_size := 0;
 end;
 
 procedure TGDBInterface.DebuggerScreen;

ide/gdbmiwrap.pas

@@ -63,6 +63,12 @@ type
 
   { [] or [value,value,value] or [variable=value,variable=value,variable=value] }
   TGDBMI_ListValue = class(TGDBMI_TupleOrListValue)
+  private
+    function GetCount: LongInt;
+    function GetValueAt(AIndex: LongInt): TGDBMI_Value;
+  public
+    property Count: LongInt read GetCount;
+    property ValueAt [AIndex: LongInt]: TGDBMI_Value read GetValueAt;
   end;
 
   TGDBMI_AsyncOutput = class
@@ -76,6 +82,11 @@ type
     property Parameters: TGDBMI_TupleValue read FParameters;
   end;
 
+  TGDBMI_ResultRecord = class(TGDBMI_AsyncOutput)
+  public
+    function Success: Boolean;
+  end;
+
   TGDBMI_AsyncOutput_List = array of TGDBMI_AsyncOutput;
 
   TGDBWrapper = class
@@ -84,7 +95,7 @@ type
     FRawResponse: TStringList;
     FConsoleStream: TStringList;
     FExecAsyncOutput: TGDBMI_AsyncOutput;
-    FResultRecord: TGDBMI_AsyncOutput;
+    FResultRecord: TGDBMI_ResultRecord;
 
     function IsAlive: Boolean;
     procedure ReadResponse;
@@ -98,7 +109,7 @@ type
     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 ResultRecord: TGDBMI_ResultRecord read FResultRecord write FResultRecord;
     property Alive: Boolean read IsAlive;
   end;
 
@@ -190,6 +201,17 @@ begin
   Result := nil;
 end;
 
+function TGDBMI_ListValue.GetCount: LongInt;
+begin
+  Result := Length(FValues);
+end;
+
+function TGDBMI_ListValue.GetValueAt(AIndex: LongInt): TGDBMI_Value;
+begin
+  Assert((AIndex >= Low(FValues)) and (AIndex <= High(FValues)));
+  Result := FValues[AIndex];
+end;
+
 constructor TGDBMI_AsyncOutput.Create;
 begin
   FParameters := TGDBMI_TupleValue.Create;
@@ -207,6 +229,12 @@ begin
   Parameters.Clear;
 end;
 
+function TGDBMI_ResultRecord.Success: Boolean;
+begin
+  { according to the GDB docs, 'done' and 'running' should be treated identically by clients }
+  Result := (AsyncClass='done') or (AsyncClass='running');
+end;
+
 function ParseCString(const CStr: string; var NextCharPos: LongInt): string;
 begin
   if (NextCharPos <= Length(CStr)) and (CStr[NextCharPos] = '"') then
@@ -418,7 +446,7 @@ begin
   FConsoleStream := TStringList.Create;
   FProcess := TGDBProcess.Create;
   FExecAsyncOutput := TGDBMI_AsyncOutput.Create;
-  FResultRecord := TGDBMI_AsyncOutput.Create;
+  FResultRecord := TGDBMI_ResultRecord.Create;
   ReadResponse;
 end;
 

packages/gdbint/src/gdbcon.pp

@@ -50,6 +50,7 @@ type
     procedure Continue;virtual;
     procedure UntilReturn;virtual;
     procedure SetTBreak(tbreakstring : string);
+    procedure Backtrace;
     { needed for dos because newlines are only #10 (PM) }
     procedure WriteErrorBuf;
     procedure WriteOutputBuf;
@@ -309,6 +310,14 @@ begin
   TBreakNumber:=Last_breakpoint_number;
 end;
 
+procedure TGDBController.Backtrace;
+begin
+  { forget all old frames }
+  clear_frames;
+
+  Command('backtrace');
+end;
+
 
 procedure TGDBController.ClearSymbols;
 begin

packages/gdbint/src/gdbint.pp

@@ -1876,6 +1876,7 @@ begin
   args:=nil;
   line_number:=0;
   address:=0;
+  level:=0;
 end;
 
 procedure tframeentry.clear;