MWE:

+ Added callstack object and dialog
  + Added checks to see if debugger = nil
  + Added dbgutils

git-svn-id: trunk@1654 -

.gitattributes

@@ -53,9 +53,12 @@ components/synedit/synhighlighterxml.pas svneol=native#text/pascal
 components/synedit/syntextdrawer.pp svneol=native#text/pascal
 debugger/breakpointsdlg.lrs svneol=native#text/pascal
 debugger/breakpointsdlg.pp svneol=native#text/pascal
+debugger/callstackdlg.lrs svneol=native#text/pascal
+debugger/callstackdlg.pp svneol=native#text/pascal
 debugger/cmdlinedebugger.pp svneol=native#text/pascal
 debugger/dbgoutputform.lrs svneol=native#text/pascal
 debugger/dbgoutputform.pp svneol=native#text/pascal
+debugger/dbgutils.pp svneol=native#text/pascal
 debugger/debugger.pp svneol=native#text/pascal
 debugger/debuggerdlg.pp svneol=native#text/pascal
 debugger/gdbdebugger.pp svneol=native#text/pascal
@@ -63,6 +66,7 @@ debugger/gdbmidebugger.pp svneol=native#text/pascal
 debugger/localsdlg.lrs svneol=native#text/pascal
 debugger/localsdlg.pp svneol=native#text/pascal
 debugger/tbreakpointsdlg.lfm svneol=native#text/plain
+debugger/tcallstackdlg.lfm svneol=native#text/plain
 debugger/tdbgoutputform.lfm svneol=native#text/plain
 debugger/test/debugtest.pp svneol=native#text/pascal
 debugger/test/debugtestform.lrs svneol=native#text/pascal
@@ -185,9 +189,7 @@ ide/splash.lrs svneol=native#text/pascal
 ide/splash.pp svneol=native#text/pascal
 ide/sysvaruseroverridedlg.pas svneol=native#text/pascal
 ide/tcolumndlg1.lfm svneol=native#text/plain
-ide/tinsertwatch.lfm svneol=native#text/plain
 ide/transfermacros.pp svneol=native#text/pascal
-ide/twatchesdlg.lfm svneol=native#text/plain
 ide/uniteditor.pp svneol=native#text/pascal
 ide/unitinfodlg.pp svneol=native#text/pascal
 ide/viewforms1.lrs svneol=native#text/pascal

debugger/callstackdlg.lrs

@@ -0,0 +1,8 @@
+  LazarusResources.Add('TCallStackDlg','FORMDATA',
+    'TPF0'#13'TCallStackDlg'#12'CallStackDlg'#4'Left'#3'g'#1#3'Top'#2'~'#5'Wid'
+    +'th'#3#244#1#6'Height'#3#200#0#7'Caption'#6#9'CallStack'#0#9'TListView'#11
+    +'lvCallStack'#4'Left'#2#0#3'Top'#2#0#5'Width'#3#228#1#6'Height'#3#200#0#5
+    +'Align'#7#8'alClient'#7'Columns'#14#1#7'Caption'#6#6'Source'#5'Width'#3
+    +#150#0#0#1#7'Caption'#6#4'Line'#5'Width'#2'2'#0#1#7'Caption'#6#8'Function'
+    +#5'Width'#3','#1#0#0#11'MultiSelect'#8#9'ViewStyle'#7#8'vsReport'#0#0#0
+  );

debugger/callstackdlg.pp

@@ -0,0 +1,124 @@
+{ $Id$ }
+{               ----------------------------------------------  
+                 callstackdlg.pp  -  Overview of the callstack 
+                ---------------------------------------------- 
+ 
+ @created(Sun Apr 28th WET 2002)
+ @lastmod($Date$)
+ @author(Marc Weustink <marc@@dommelstein.net>)                       
+
+ This unit contains the Call Stack debugger dialog.
+ 
+ 
+/*************************************************************************** 
+ *                                                                         * 
+ *   This program is free software; you can redistribute it and/or modify  * 
+ *   it under the terms of the GNU General Public License as published by  * 
+ *   the Free Software Foundation; either version 2 of the License, or     * 
+ *   (at your option) any later version.                                   * 
+ *                                                                         * 
+ ***************************************************************************/ 
+} 
+unit CallStackDlg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  LResources, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ComCtrls, Debugger, DebuggerDlg;
+
+type
+  TCallStackDlg = class(TDebuggerDlg)
+    lvCallStack: TListView;
+  private  
+    procedure CallStackChanged(Sender: TObject);
+  protected
+    procedure SetDebugger(const ADebugger: TDebugger); override;
+  public
+  published         
+    // publish some properties until fpcbug #1888 is fixed
+    property Top;
+    property Left;
+    property Width; 
+    property Height; 
+    property Caption;
+  end;
+
+
+implementation
+
+{ TCallStackDlg }
+
+procedure TCallStackDlg.CallStackChanged(Sender: TObject);
+var
+  n, m: Integer;                               
+  Item: TListItem;
+  S: String;   
+  Entry: TDBGCallStackEntry;
+begin       
+  // Reuse entries, so add and remove only                    
+  // Remove unneded
+  for n := lvCallStack.Items.Count - 1 downto Debugger.CallStack.Count do
+    lvCallStack.Items.Delete(n);
+
+  // Add needed
+  for n := lvCallStack.Items.Count to Debugger.CallStack.Count - 1 do
+  begin
+    Item := lvCallStack.Items.Add;
+    Item.SubItems.Add('');
+    Item.SubItems.Add('');
+  end;
+
+  for n := 0 to lvCallStack.Items.Count - 1 do  
+  begin
+    Item := lvCallStack.Items[n];
+    Entry := Debugger.CallStack.Entries[n];
+    Item.Caption := Entry.Source;
+    Item.SubItems[0] := IntToStr(Entry.Line);
+    S := '';
+    for m := 0 to Entry.ArgumentCount - 1 do
+    begin
+      if S <> '' 
+      then S := S + ', ';
+      S := S + Entry.ArgumentValues[m];
+    end;                               
+    if S <> ''
+    then S := '(' + S + ')';
+    Item.SubItems[1] := Entry.FunctionName + S;
+  end;                                 
+end;
+
+procedure TCallStackDlg.SetDebugger(const ADebugger: TDebugger); 
+begin
+  if ADebugger <> Debugger
+  then begin
+    if Debugger <> nil
+    then begin
+      Debugger.CallStack.OnChange := nil;
+    end;
+    inherited;
+    if Debugger <> nil
+    then begin
+      Debugger.CallStack.OnChange := @CallStackChanged;
+      CallStackChanged(Debugger.CallStack);
+    end;
+  end
+  else inherited;
+end;
+
+initialization
+  {$I callstackdlg.lrs}
+
+end.
+
+{ =============================================================================
+  $Log$
+  Revision 1.1  2002/04/30 15:57:39  lazarus
+  MWE:
+    + Added callstack object and dialog
+    + Added checks to see if debugger = nil
+    + Added dbgutils
+
+}

debugger/cmdlinedebugger.pp

@@ -60,17 +60,6 @@ type
 
 procedure SendBreak(const AHandle: Integer);
 
-function GetLine(var ABuffer: String): String;
-function StripLN(const ALine: String): String;
-function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
-
-const
-{$IFDEF WIN32}
-  LINE_END = #13#10;
-{$ELSE}
-  LINE_END = #10;
-{$ENDIF}
-
 implementation
 
 uses
@@ -81,7 +70,7 @@ uses
    Unix,
  {$ENDIF}     
 {$ENDIF}
-  SysUtils, Forms;
+  SysUtils, Forms, DBGUtils;
   
 //////////////////////////////////////////////////
 //       Needs to go to proper include
@@ -153,75 +142,6 @@ end;
   
 //////////////////////////////////////////////////
 
-//////////////////////////////////////////////////
-//           Tools and utilities
-//          
-//////////////////////////////////////////////////
-function GetLine(var ABuffer: String): String;
-var
-  idx: Integer;
-begin
-  idx := Pos(#10, ABuffer);
-  if idx = 0
-  then Result := ''
-  else begin
-    Result := Copy(ABuffer, 1, idx);
-    Delete(ABuffer, 1, idx);
-  end;
-end;
-
-function StripLN(const ALine: String): String;
-var
-  idx: Integer;
-begin
-  idx := Pos(#10, ALine);
-  if idx = 0
-  then begin
-    idx := Pos(#13, ALine);
-    if idx = 0
-    then begin
-      Result := ALine;
-      Exit;
-    end;
-  end
-  else begin
-    if (idx > 1)
-    and (ALine[idx - 1] = #13)
-    then Dec(idx);
-  end;
-  Result := Copy(ALine, 1, idx - 1);
-end;           
-
-function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
-var
-  idx: Integer;
-begin                  
-  if ASkipTo <> ''
-  then begin
-    idx := Pos(ASkipTo, ASource);
-    if idx = 0 
-    then begin
-      Result := '';
-      Exit;
-    end;
-    Delete(ASource, 1, idx + Length(ASkipTo) - 1);
-  end;
-  if AnEnd = ''
-  then idx := 0
-  else idx := Pos(AnEnd, ASource);
-  if idx = 0 
-  then begin
-    Result := ASource;
-    ASource := '';
-  end
-  else begin
-    Result := Copy(ASource, 1, idx - 1);
-    Delete(ASource, 1, idx - 1);
-  end;
-end;
-
-//////////////////////////////////////////////////
-
 { TCmdLineDebugger }
 
 constructor TCmdLineDebugger.Create(const AExternalDebugger: String);
@@ -413,7 +333,7 @@ begin
     FDbgProcess.Input.Write(LINE_END, 1);
   end
   else begin
-    WriteLN('[TCmdLineDebugger.SendCmdLn] Process stopped running when sending: <', ACommand, '>');
+    WriteLN('[TCmdLineDebugger.SendCmdLn] Unable to send <', ACommand, '>. No process running.');
     SetState(dsError);
   end;
 end;
@@ -431,6 +351,12 @@ end;
 end.
 { =============================================================================
   $Log$
+  Revision 1.10  2002/04/30 15:57:39  lazarus
+  MWE:
+    + Added callstack object and dialog
+    + Added checks to see if debugger = nil
+    + Added dbgutils
+
   Revision 1.9  2002/04/24 20:42:29  lazarus
   MWE:
     + Added watches

debugger/dbgutils.pp

@@ -0,0 +1,113 @@
+{ $Id$ }
+{                   -------------------------------------------
+                     dbgutils.pp  -  Debugger utility routines
+                    -------------------------------------------
+
+ @created(Sun Apr 28st WET 2002)
+ @lastmod($Date$)
+ @author(Marc Weustink <marc@@dommelstein.net>)
+
+ This unit contains a collection of debugger support routines.
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+}
+unit DBGUtils;
+
+{$mode objfpc}{$H+}
+
+interface 
+
+function GetLine(var ABuffer: String): String;
+function StripLN(const ALine: String): String;
+function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
+
+const
+{$IFDEF WIN32}
+  LINE_END = #13#10;
+{$ELSE}
+  LINE_END = #10;
+{$ENDIF}
+
+implementation
+
+function GetLine(var ABuffer: String): String;
+var
+  idx: Integer;
+begin
+  idx := Pos(#10, ABuffer);
+  if idx = 0
+  then Result := ''
+  else begin
+    Result := Copy(ABuffer, 1, idx);
+    Delete(ABuffer, 1, idx);
+  end;
+end;
+
+function StripLN(const ALine: String): String;
+var
+  idx: Integer;
+begin
+  idx := Pos(#10, ALine);
+  if idx = 0
+  then begin
+    idx := Pos(#13, ALine);
+    if idx = 0
+    then begin
+      Result := ALine;
+      Exit;
+    end;
+  end
+  else begin
+    if (idx > 1)
+    and (ALine[idx - 1] = #13)
+    then Dec(idx);
+  end;
+  Result := Copy(ALine, 1, idx - 1);
+end;           
+
+function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
+var
+  idx: Integer;
+begin                  
+  if ASkipTo <> ''
+  then begin
+    idx := Pos(ASkipTo, ASource);
+    if idx = 0 
+    then begin
+      Result := '';
+      Exit;
+    end;
+    Delete(ASource, 1, idx + Length(ASkipTo) - 1);
+  end;
+  if AnEnd = ''
+  then idx := 0
+  else idx := Pos(AnEnd, ASource);
+  if idx = 0 
+  then begin
+    Result := ASource;
+    ASource := '';
+  end
+  else begin
+    Result := Copy(ASource, 1, idx - 1);
+    Delete(ASource, 1, idx - 1);
+  end;
+end;
+
+
+end.
+{ =============================================================================
+  $Log$
+  Revision 1.1  2002/04/30 15:57:39  lazarus
+  MWE:
+    + Added callstack object and dialog
+    + Added checks to see if debugger = nil
+    + Added dbgutils
+
+}

debugger/debugger.pp

@@ -94,7 +94,6 @@ type
   TDBGBreakPointClass = class of TDBGBreakPoint;
   TDBGBreakPoint = class(TCollectionItem)
   private
-    FDebugger: TDebugger;  // reference to our debugger
     FGroup: TDBGBreakPointGroup;
     FValid: Boolean;
     FEnabled: Boolean;
@@ -106,6 +105,7 @@ type
     FActions: TDBGBreakPointActions;
     FDisableGroupList: TList;
     FEnableGroupList: TList;                                  
+    function  GetDebugger: TDebugger;
     procedure SetActions(const AValue: TDBGBreakPointActions);
     procedure SetEnabled(const AValue: Boolean);
     procedure SetExpression(const AValue: String);
@@ -121,7 +121,7 @@ type
     procedure SetHitCount(const AValue: Integer);
     procedure SetLocation(const ASource: String; const ALine: Integer); virtual;
     procedure SetValid(const AValue: Boolean);
-    property  Debugger: TDebugger read FDebugger;
+    property  Debugger: TDebugger read GetDebugger;
   public
     procedure AddDisableGroup(const AGroup: TDBGBreakPointGroup);
     procedure AddEnableGroup(const AGroup: TDBGBreakPointGroup);
@@ -209,10 +209,10 @@ type
   TDBGWatchClass = class of TDBGWatch;
   TDBGWatch = class(TCollectionItem)
   private
-    FDebugger: TDebugger;  // reference to our debugger
     FEnabled: Boolean;
     FExpression: String;
     FValid: Boolean;
+    function  GetDebugger: TDebugger;
     procedure SetEnabled(const AValue: Boolean);
     procedure SetExpression(const AValue: String);
   protected
@@ -223,7 +223,7 @@ type
     function  GetValue: String; virtual;
     function  GetValid: Boolean; virtual;
     procedure SetValid(const AValue: Boolean);
-    property  Debugger: TDebugger read FDebugger;
+    property  Debugger: TDebugger read GetDebugger;
   public
     constructor Create(ACollection: TCollection); override;
     property Enabled: Boolean read FEnabled write SetEnabled;
@@ -283,6 +283,52 @@ type
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
 
+  TDBGCallStackEntry = class(TObject)
+  private
+    FIndex: Integer;
+    FAdress: Pointer;
+    FFunctionName: String;
+    FLine: Integer;
+    FArguments: TStrings;
+    FSource: String;
+    function GetArgumentCount: Integer; 
+    function GetArgumentName(const AnIndex: Integer): String;
+    function GetArgumentValue(const AnIndex: Integer): String;
+  protected
+  public
+    constructor Create(const AIndex:Integer; const AnAdress: Pointer; const AnArguments: TStrings; const AFunctionName: String; const ASource: String; const ALine: Integer);
+    destructor Destroy; override;
+    property Adress: Pointer read FAdress;
+    property ArgumentCount: Integer read GetArgumentCount; 
+    property ArgumentNames[const AnIndex: Integer]: String read GetArgumentName;
+    property ArgumentValues[const AnIndex: Integer]: String read GetArgumentValue;
+    property FunctionName: String read FFunctionName;
+    property Source: String read FSource;
+    property Line: Integer read FLine;
+  end;
+
+  TDBGCallStack = class(TObject)
+  private
+    FDebugger: TDebugger;  // reference to our debugger
+    FEntries: TList;       // list of created entries
+    FOldState: TDBGState;  // records the previous debugger state 
+    FOnChange: TNotifyEvent;
+    procedure Clear;
+    function GetStackEntry(const AIndex: Integer): TDBGCallStackEntry;
+  protected
+    procedure DoChange;
+    function CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry; virtual; 
+    procedure DoStateChange; virtual;
+    function GetCount: Integer; virtual;
+    property Debugger: TDebugger read FDebugger;
+  public   
+    function Count: Integer;
+    constructor Create(const ADebugger: TDebugger); 
+    destructor Destroy; override;
+    property Entries[const AIndex: Integer]: TDBGCallStackEntry read GetStackEntry;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  end;
+
   TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
   TDBGCurrentLineEvent = procedure(Sender: TObject; const ALocation: TDBGLocationRec) of object;
   TDBGExceptionEvent = procedure(Sender: TObject; const AExceptionID: Integer; const AExceptionText: String) of object;
@@ -297,6 +343,7 @@ type
     FFileName: String;
     FLocals: TDBGLocals;
     FState: TDBGState;
+    FCallStack: TDBGCallStack;
     FWatches: TDBGWatches;
     FOnCurrent: TDBGCurrentLineEvent;
     FOnException: TDBGExceptionEvent;
@@ -309,6 +356,7 @@ type
   protected
     function  CreateBreakPoints: TDBGBreakPoints; virtual;
     function  CreateLocals: TDBGLocals; virtual;
+    function  CreateCallStack: TDBGCallStack; virtual;
     function  CreateWatches: TDBGWatches; virtual;
     procedure DoCurrent(const ALocation: TDBGLocationRec);
     procedure DoDbgOutput(const AText: String);
@@ -344,6 +392,7 @@ type
     property BreakPoints: TDBGBreakPoints read FBreakPoints;                     // list of all breakpoints
     property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups;      // list of all breakpointgroups
     property Commands: TDBGCommands read GetCommands;                            // All current available commands of the debugger
+    property CallStack: TDBGCallStack read FCallStack;
     property ExitCode: Integer read FExitCode;
     property ExternalDebugger: String read FExternalDebugger;
     property FileName: String read FFileName write SetFileName;                  // The name of the exe to be debugged
@@ -360,7 +409,7 @@ type
 implementation
 
 uses
-  SysUtils;
+  SysUtils, DBGUtils;
 
 const
   COMMANDMAP: array[TDBGState] of TDBGCommands = (
@@ -394,6 +443,7 @@ begin
   FExternalDebugger := AExternalDebugger;
   FBreakPoints := CreateBreakPoints;
   FLocals := CreateLocals;
+  FCallStack := CreateCallStack;
   FWatches := CreateWatches;
   FBreakPointGroups := TDBGBreakPointGroups.Create;
   FExitCode := 0;
@@ -404,6 +454,11 @@ begin
   Result := TDBGBreakPoints.Create(Self, TDBGBreakPoint);
 end;
 
+function TDebugger.CreateCallStack: TDBGCallStack; 
+begin
+  Result := TDBGCallStack.Create(Self);
+end;
+
 function TDebugger.CreateLocals: TDBGLocals;
 begin
   Result := TDBGLocals.Create(Self);
@@ -425,8 +480,16 @@ begin
   if FState <> dsNone
   then Done;
 
-  FBreakPointGroups.Free;
+  FBreakPoints.FDebugger := nil;
-  FWatches.Free;
+  FLocals.FDebugger := nil;
+  FCallStack.FDebugger := nil;
+  FWatches.FDebugger := nil;
+
+  FreeAndNil(FBreakPoints);
+  FreeAndNil(FBreakPointGroups);
+  FreeAndNil(FLocals);     
+  FreeAndNil(FCallStack);
+  FreeAndNil(FWatches);
   inherited;
 end;
 
@@ -558,6 +621,7 @@ begin
     FState := AValue;
     FBreakpoints.DoStateChange;
     FLocals.DoStateChange;
+    FCallStack.DoStateChange;
     FWatches.DoStateChange;
     DoState;
   end;
@@ -622,7 +686,6 @@ begin
   FGroup := nil;
   FFirstRun := True;
   FActions := [bpaStop];
-  FDebugger := TDBGBreakPoints(ACollection).FDebugger;
   FDisableGroupList := TList.Create;
   FEnableGroupList := TList.Create;
 end;
@@ -694,6 +757,11 @@ begin
     TDBGBreakPointGroup(FDisableGroupList[n]).Enabled := True;
 end;
 
+function  TDBGBreakPoint.GetDebugger: TDebugger;
+begin
+  Result := TDBGBreakPoints(Collection).FDebugger;
+end;
+
 procedure TDBGBreakPoint.RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
 begin
   if AGroup = nil then Exit;
@@ -814,9 +882,9 @@ end;
 
 constructor TDBGBreakPoints.Create(const ADebugger: TDebugger; const ABreakPointClass: TDBGBreakPointClass);
 begin
-  inherited Create(ABreakPointClass);
   FDebugger := ADebugger;
   FNotificationList := TList.Create;
+  inherited Create(ABreakPointClass);
 end;
 
 destructor TDBGBreakPoints.Destroy;
@@ -1020,7 +1088,6 @@ constructor TDBGWatch.Create(ACollection: TCollection);
 begin
   inherited Create(ACollection);
   FEnabled := False;
-  FDebugger := TDBGWatches(ACollection).FDebugger;
 end;
 
 procedure TDBGWatch.DoEnableChange;
@@ -1037,6 +1104,11 @@ procedure TDBGWatch.DoStateChange;
 begin    
 end;
 
+function TDBGWatch.GetDebugger: TDebugger;
+begin
+  Result := TDBGWatches(Collection).FDebugger;
+end;
+
 function TDBGWatch.GetValid: Boolean;
 begin
   Result := False;
@@ -1252,10 +1324,139 @@ begin
   if FRefCount = 0 then Free;
 end;
 
+{ =========================================================================== }
+{ TDBGCallStackEntry }
+{ =========================================================================== }
+
+constructor TDBGCallStackEntry.Create(const AIndex: Integer; const AnAdress: Pointer; const AnArguments: TStrings; const AFunctionName: String; const ASource: String; const ALine: Integer);
+begin
+  inherited Create;   
+  FIndex := AIndex;
+  FAdress := AnAdress;
+  FArguments := TStringlist.Create;
+  FArguments.Assign(AnArguments);
+  FFunctionName := AFunctionName;
+  FSource := ASource;
+  FLine := ALine;
+end;
+
+destructor TDBGCallStackEntry.Destroy;
+begin
+  inherited;
+  FreeAndNil(FArguments);
+end;
+
+function TDBGCallStackEntry.GetArgumentCount: Integer; 
+begin
+  Result := FArguments.Count;
+end;
+
+function TDBGCallStackEntry.GetArgumentName(const AnIndex: Integer): String;
+begin
+  Result := FArguments.Names[AnIndex];
+end;
+
+function TDBGCallStackEntry.GetArgumentValue(const AnIndex: Integer): String;
+begin                        
+  Result := FArguments[AnIndex];
+  Result := GetPart('=', '', Result);
+end;
+
+{ =========================================================================== }
+{ TDBGCallStack }
+{ =========================================================================== }
+
+procedure TDBGCallStack.Clear;
+var
+  n:Integer;
+begin
+  for n := 0 to FEntries.Count - 1 do 
+    TObject(FEntries[n]).Free;
+    
+  FEntries.Clear;  
+end;
+
+function TDBGCallStack.Count: Integer;
+begin
+  if  (FDebugger <> nil) 
+  and (FDebugger.State = dsPause)
+  then Result := GetCount
+  else Result := 0;
+end;
+
+constructor TDBGCallStack.Create(const ADebugger: TDebugger);
+begin
+  FDebugger := ADebugger;
+  FEntries := TList.Create;
+  FOldState := FDebugger.State;
+  inherited Create;
+end;
+
+function TDBGCallStack.CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry; 
+begin
+  Result := nil;
+end;
+
+destructor TDBGCallStack.Destroy;
+begin
+  Clear;
+  inherited;
+  FreeAndNil(FEntries);
+end;
+
+procedure TDBGCallStack.DoChange; 
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TDBGCallStack.DoStateChange; 
+begin
+  if FDebugger.State = dsPause
+  then DoChange
+  else begin
+    if FOldState = dsPause
+    then begin 
+      Clear;
+      DoChange;
+    end;
+  end;          
+  FOldState := FDebugger.State;
+end;
+
+function TDBGCallStack.GetCount: Integer;
+begin
+  Result := 0;
+end;
+
+function TDBGCallStack.GetStackEntry(const AIndex: Integer): TDBGCallStackEntry;
+var
+  n: Integer;
+begin
+  if (AIndex < 0) 
+  or (AIndex >= Count)
+  then raise EInvalidOperation.CreateFmt('Index out of range (%d)', [AIndex]);
+  
+  for n := 0 to FEntries.Count - 1 do
+  begin
+    Result := TDBGCallStackEntry(FEntries[n]);
+    if Result.FIndex = AIndex 
+    then Exit;
+  end;
+  
+  Result := CreateStackEntry(AIndex);
+  if Result <> nil 
+  then FEntries.Add(Result);
+end;
 
 end.
 { =============================================================================
   $Log$
+  Revision 1.14  2002/04/30 15:57:39  lazarus
+  MWE:
+    + Added callstack object and dialog
+    + Added checks to see if debugger = nil
+    + Added dbgutils
+
   Revision 1.13  2002/04/24 20:42:29  lazarus
   MWE:
     + Added watches

debugger/gdbmidebugger.pp

@@ -68,6 +68,7 @@ type
     function  ChangeFileName: Boolean; override;
     function  CreateBreakPoints: TDBGBreakPoints; override;
     function  CreateLocals: TDBGLocals; override;
+    function  CreateCallStack: TDBGCallStack; override;
     function  CreateWatches: TDBGWatches; override;
     function  GetSupportedCommands: TDBGCommands; override;
     function  RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
@@ -86,7 +87,7 @@ type
 implementation
 
 uses
-  SysUtils, Dialogs;
+  SysUtils, Dialogs, DBGUtils;
 
 type
   TGDBMIBreakPoint = class(TDBGBreakPoint)
@@ -136,6 +137,18 @@ type
     constructor Create(ACollection: TCollection); override;
   end;
   
+  TGDBMICallStack = class(TDBGCallStack)
+  private
+    FCount: Integer;  // -1 means uninitialized
+  protected
+    function CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry; override; 
+    procedure DoStateChange; override;
+    function GetCount: Integer; override;
+  public
+    constructor Create(const ADebugger: TDebugger); 
+  end;
+
+
 function CreateValueList(AResultValues: String): TStringList;
 var
   n: Integer;
@@ -264,6 +277,11 @@ begin
   Result := TDBGBreakPoints.Create(Self, TGDBMIBreakPoint);
 end;
 
+function TGDBMIDebugger.CreateCallStack: TDBGCallStack; 
+begin
+  Result := TGDBMICallStack.Create(Self);
+end;
+
 function TGDBMIDebugger.CreateLocals: TDBGLocals;
 begin
   Result := TGDBMILocals.Create(Self);
@@ -782,7 +800,8 @@ end;
 
 destructor TGDBMIBreakPoint.Destroy;
 begin
-  if FBreakID <> 0
+  if  (FBreakID <> 0)
+  and (Debugger <> nil)
   then begin
     TGDBMIDebugger(Debugger).ExecuteCommand('-break-delete %d', [FBreakID]);
   end;
@@ -798,7 +817,9 @@ procedure TGDBMIBreakPoint.DoEnableChange;
 const
   CMD: array[Boolean] of String = ('disable', 'enable');
 begin
-  if FBreakID = 0 then Exit;
+  if (FBreakID = 0) 
+  or (Debugger = nil)
+  then Exit;
 
   TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d', [CMD[Enabled], FBreakID]);
 end;
@@ -830,6 +851,8 @@ var
   ResultList, BkptList: TStringList;
   ResultState: TDBGState;
 begin
+  if Debugger = nil then Exit;
+  
   TGDBMIDebugger(Debugger).ExecuteCommand('-break-insert %s:%d', [Source, Line], True, ResultState, S);
   ResultList := CreateValueList(S);
   BkptList := CreateValueList(ResultList.Values['bkpt']);
@@ -845,6 +868,7 @@ end;
 procedure TGDBMIBreakPoint.SetLocation(const ASource: String; const ALine: Integer);
 begin
   inherited;
+  if Debugger = nil then Exit;
   if TGDBMIDebugger(Debugger).State in [dsStop, dsPause, dsIdle]
   then SetBreakpoint;
 end;
@@ -874,7 +898,8 @@ end;
 
 function TGDBMILocals.Count: Integer;
 begin
-  if Debugger.State = dsPause
+  if  (Debugger <> nil)
+  and (Debugger.State = dsPause)
   then begin
     LocalsNeeded;
     Result := FLocals.Count;
@@ -898,7 +923,8 @@ end;
 
 procedure TGDBMILocals.DoStateChange;
 begin
-  if Debugger.State = dsPause
+  if  (Debugger <> nil)
+  and (Debugger.State = dsPause)
   then begin
     DoChange;
   end
@@ -910,7 +936,8 @@ end;
 
 function TGDBMILocals.GetName(const AnIndex: Integer): String;
 begin
-  if Debugger.State = dsPause
+  if  (Debugger <> nil)
+  and (Debugger.State = dsPause)
   then begin
     LocalsNeeded;
     Result := FLocals.Names[AnIndex];
@@ -920,7 +947,8 @@ end;
 
 function TGDBMILocals.GetValue(const AnIndex: Integer): String;
 begin
-  if Debugger.State = dsPause
+  if  (Debugger <> nil)
+  and (Debugger.State = dsPause)
   then begin
     LocalsNeeded;
     Result := FLocals[AnIndex];
@@ -934,6 +962,7 @@ var
   S: String;
   List: TStrings;
 begin
+  if Debugger = nil then Exit;
   if not FLocalsValid
   then begin
     TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-locals 1', S);
@@ -967,6 +996,8 @@ end;
 
 procedure TGDBMIWatch.DoStateChange;
 begin
+  if Debugger = nil then Exit;
+
   if Debugger.State in [dsPause, dsStop]
   then FEvaluated := False;
   if Debugger.State = dsPause then Changed(False);
@@ -975,6 +1006,7 @@ end;
 procedure TGDBMIWatch.EvaluationNeeded;
 begin
   if FEvaluated then Exit;
+  if Debugger = nil then Exit;
 
   if (Debugger.State in [dsPause, dsStop])
   and Enabled
@@ -989,7 +1021,8 @@ end;
 
 function TGDBMIWatch.GetValue: String;
 begin
-  if (Debugger.State in [dsStop, dsPause])
+  if  (Debugger <> nil)
+  and (Debugger.State in [dsStop, dsPause])
   and Enabled
   then begin
     EvaluationNeeded;
@@ -1004,9 +1037,102 @@ begin
   Result := inherited GetValid;
 end;
 
+{ =========================================================================== }
+{ TGDBMICallStack }
+{ =========================================================================== }
+
+constructor TGDBMICallStack.Create(const ADebugger: TDebugger); 
+begin
+  FCount := -1;
+  inherited;
+end;
+
+function TGDBMICallStack.CreateStackEntry(const AIndex: Integer): TDBGCallStackEntry;
+var                 
+  n: Integer;
+  S: String;
+  Arguments, ArgList, List: TStrings;
+begin
+  if Debugger = nil then Exit;
+
+  Arguments := TStringList.Create;
+  TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-arguments 1 %d %d', [AIndex, AIndex], S);
+  List := CreateValueList(S);   
+  S := List.Values['stack-args'];
+  FreeAndNil(List);
+  List := CreateValueList(S);
+  S := List.Values['frame']; // all arguments
+  FreeAndNil(List);
+  List := CreateValueList(S);   
+  S := List.Values['args'];
+  FreeAndNil(List);
+  
+  ArgList := CreateValueList(S);
+  for n := 0 to ArgList.Count - 1 do
+  begin
+    List := CreateValueList(ArgList[n]);
+    Arguments.Add(List.Values['name'] + '=' + List.Values['value']);
+    FreeAndNil(List);
+  end;
+  FreeAndNil(ArgList);
+  
+  TGDBMIDebugger(Debugger).ExecuteCommand('-stack-list-frames %d %d', [AIndex, AIndex], S);
+  List := CreateValueList(S);   
+  S := List.Values['stack'];
+  FreeAndNil(List);
+  List := CreateValueList(S);   
+  S := List.Values['frame'];
+  FreeAndNil(List);
+  List := CreateValueList(S);   
+  Result := TDBGCallStackEntry.Create(
+    AIndex, 
+    Pointer(StrToIntDef(List.Values['addr'], 0)),
+    Arguments,
+    List.Values['func'],
+    List.Values['file'],
+    StrToIntDef(List.Values['line'], 0)
+  );
+  
+  FreeAndNil(List);
+  Arguments.Free;
+end;
+
+procedure TGDBMICallStack.DoStateChange; 
+begin
+  if Debugger.State <> dsPause 
+  then FCount := -1;    
+  inherited;
+end;
+
+function TGDBMICallStack.GetCount: Integer;
+var
+  S: String;
+  List: TStrings;
+begin
+  if FCount = -1 
+  then begin
+    if Debugger = nil 
+    then FCount := 0
+    else begin
+      TGDBMIDebugger(Debugger).ExecuteCommand('-stack-info-depth', S);
+      List := CreateValueList(S);
+      FCount := StrToIntDef(List.Values['depth'], 0);
+      FreeAndNil(List);
+    end;
+  end;
+  
+  Result := FCount;
+end;
+
 end.
 { =============================================================================
   $Log$
+  Revision 1.6  2002/04/30 15:57:40  lazarus
+  MWE:
+    + Added callstack object and dialog
+    + Added checks to see if debugger = nil
+    + Added dbgutils
+
   Revision 1.5  2002/04/24 20:42:29  lazarus
   MWE:
     + Added watches

debugger/tcallstackdlg.lfm

@@ -0,0 +1,29 @@
+object CallStackDlg: TCallStackDlg
+  Left = 359
+  Top = 126
+  Width = 500
+  Height = 200
+  Caption = 'CallStack'
+  object lvCallStack: TListView
+    Left = 0
+    Top = 0
+    Width = 484
+    Height = 200
+    Align = alClient
+    Columns = <
+      item
+        Caption = 'Source'
+        Width = 150
+      end
+      item
+        Caption = 'Line'
+        Width = 50
+      end
+      item
+        Caption = 'Function'
+        Width = 300
+      end>
+    MultiSelect = False
+    ViewStyle = vsReport
+  end
+end 

debugger/test/debugtestform.pp

@@ -25,7 +25,8 @@ interface
 
 uses
   Classes, Graphics, Controls, Forms, Dialogs, LResources,
-  Buttons, StdCtrls, Debugger, DbgOutputForm, BreakpointsDlg, LocalsDlg, WatchesDlg;
+  Buttons, StdCtrls, Debugger, DbgOutputForm, BreakpointsDlg, 
+  LocalsDlg, WatchesDlg, CallStackDlg;
 
 
 type
@@ -80,6 +81,7 @@ type
     FBreakpointDlg: TBreakpointsDlg;
     FLocalsDlg: TLocalsDlg;
     FWatchesDlg: TWatchesDlg;
+    FCallStackDlg: TCallStackDlg;
     FDummy: Boolean;
     procedure DBGState(Sender: TObject);
     procedure DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
@@ -136,6 +138,9 @@ begin
 
   FOutputForm := TDBGOutputForm.Create(Application);
   FOutputForm.Show;
+  
+  FCallStackDlg := TCallStackDlg.Create(Application);
+  FCallStackDlg.Show;
 end;
 
 procedure TDebugTestForm.FormDestroy(Sender: TObject);
@@ -145,7 +150,7 @@ begin
     FLocalsDlg.Debugger := nil;
     FWatchesDlg.Debugger := nil;
     FOutputForm.Debugger := nil;
-    FWatchesDlg.Debugger := nil;
+    FCallStackDlg.Debugger := nil;
   except
     on Exception do;
   end;
@@ -168,7 +173,7 @@ begin
     FLocalsDlg.Debugger := FDebugger;
     FWatchesDlg.Debugger := FDebugger;
     FOutputForm.Debugger := FDebugger;
-    FWatchesDlg.Debugger := FDebugger;
+    FCallStackDlg.Debugger := FDebugger;   
   end;
   FDebugger.Init;
   FDebugger.FileName := txtFileName.Text;
@@ -318,6 +323,12 @@ initialization
 end.
 { =============================================================================
   $Log$
+  Revision 1.8  2002/04/30 15:57:40  lazarus
+  MWE:
+    + Added callstack object and dialog
+    + Added checks to see if debugger = nil
+    + Added dbgutils
+
   Revision 1.7  2002/04/24 20:42:29  lazarus
   MWE:
     + Added watches

ide/debugmanager.pas

@@ -35,7 +35,7 @@ uses
   ProjectDefs, BaseDebugManager, MainBar, DebuggerDlg;
   
 type
-  TDebugDialogType = (ddtOutput, ddtBreakpoints, ddtWatches, ddtLocals);
+  TDebugDialogType = (ddtOutput, ddtBreakpoints, ddtWatches, ddtLocals, ddtCallStack);
 
   TDebugManager = class(TBaseDebugManager)
     // Menu events
@@ -87,7 +87,8 @@ implementation
 
 uses
   Menus,
-  Watchesdlg, BreakPointsdlg, LocalsDlg, DBGOutputForm, GDBMIDebugger;
+  Watchesdlg, BreakPointsdlg, LocalsDlg, DBGOutputForm, GDBMIDebugger, 
+  CallStackDlg;
 
  
 //-----------------------------------------------------------------------------
@@ -253,7 +254,7 @@ end;
 procedure TDebugManager.ViewDebugDialog(const ADialogType: TDebugDialogType);
 const
   DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = (
-    TDbgOutputForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg
+    TDbgOutputForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg, TCallStackDlg
   );
 begin
   if FDialogs[ADialogType] = nil
@@ -331,6 +332,8 @@ begin
     itmViewBreakPoints.Tag := Ord(ddtBreakPoints);
     itmViewLocals.OnClick := @mnuViewDebugDialogClick;
     itmViewLocals.Tag := Ord(ddtLocals);
+    itmViewCallStack.OnClick := @mnuViewDebugDialogClick;
+    itmViewCallStack.Tag := Ord(ddtCallStack);
     itmViewDebugOutput.OnClick := @mnuViewDebugDialogClick;
     itmViewDebugOutput.Tag := Ord(ddtOutput);
   end;
@@ -351,6 +354,7 @@ begin
     itmViewBreakpoints.ShortCut := CommandToShortCut(ecToggleBreakPoints);
     itmViewDebugOutput.ShortCut := CommandToShortCut(ecToggleDebuggerOut);
     itmViewLocals.ShortCut := CommandToShortCut(ecToggleLocals);
+    itmViewCallStack.ShortCut := CommandToShortCut(ecToggleCallStack);
   end;
 end;
 

ide/tinsertwatch.lfm

@@ -1,112 +0,0 @@
-object TINSERTWATCH
-  CAPTION = 'Watch Properties'
-  COLOR = -2147483633
-  CLIENTHEIGHT = 200
-  CLIENTWIDTH = 420
-  POSITION = poscreencenter
-  HEIGHT = 200
-  WIDTH = 420
-  object lblExpression: TLABEL
-    CAPTION = 'Expression:'
-    FONT.COLOR = -2147483640
-    LEFT = 15
-    HEIGHT = 17
-    TOP = 20
-    WIDTH = 65
-  end
-  object edtExpression: TEDIT
-    LEFT = 105
-    TOP = 17
-    WIDTH = 300
-  end
-  object lblRepCount: TLABEL
-    CAPTION = 'Repeat Count:'
-    FONT.COLOR = -2147483640
-    LEFT = 15
-    HEIGHT = 17
-    TOP = 45
-    WIDTH = 80
-  end
-  object edtRepCount: TEDIT
-    TEXT = '0'
-    LEFT = 105
-    TOP = 42
-    WIDTH = 60
-  end
-  object lblDigits: TLABEL
-    CAPTION = 'Digits:'
-    FONT.COLOR = -2147483640
-    LEFT = 175
-    HEIGHT = 17
-    TOP = 45
-    WIDTH = 40
-  end
-  object edtDigits: TEDIT
-    TEXT = '0'
-    LEFT = 225
-    TOP = 45
-    WIDTH = 180
-  end
-  object cbEnabled: TCHECKBOX
-    CAPTION = 'Enabled'
-    STATE = cbchecked
-    DRAGCURSOR = 0
-    TABORDER = 0
-    LEFT = 15
-    TOP = 65
-    WIDTH = 60
-  end
-  object cbAllowFunc: TCHECKBOX
-    CAPTION = 'Allow Function Calls'
-    DRAGCURSOR = 0
-    TABORDER = 0
-    LEFT = 105
-    TOP = 65
-  end
-  object Style: TRADIOGROUP
-    CAPTION = 'Style'
-    ITEMINDEX = 7
-    ITEMS.Strings = (
-      'Character'
-      'String'
-      'Decimal'
-      'Hexadecimal'
-      'Floating Point'
-      'Pointer'
-      'Record/Structure'
-      'Default'
-      'Memory Dump'
-    )
-    COLUMNS = 3
-    LEFT = 15
-    HEIGHT = 70
-    TOP = 90
-    WIDTH = 390
-  end
-  object TBUTTON
-    MODALRESULT = 1
-    CAPTION = 'OK'
-    FONT.COLOR = -2147483640
-    LEFT = 170
-    HEIGHT = 25
-    TOP = 170
-    WIDTH = 75
-  end
-  object TBUTTON
-    MODALRESULT = 2
-    CAPTION = 'Cancel'
-    FONT.COLOR = -2147483640
-    LEFT = 250
-    HEIGHT = 25
-    TOP = 170
-    WIDTH = 75
-  end
-  object TBUTTON
-    CAPTION = 'Help'
-    FONT.COLOR = -2147483640
-    LEFT = 330
-    HEIGHT = 25
-    TOP = 170
-    WIDTH = 75
-  end
-end

ide/twatchesdlg.lfm

@@ -1,21 +0,0 @@
-object WatchesDlg: TWATCHESDLG
-  CAPTION = 'Watches'
-  COLOR = -2147483633
-  CLIENTHEIGHT = 100
-  CLIENTWIDTH = 250
-  POSITION = poscreencenter
-  LEFT = 515
-  HEIGHT = 100
-  TOP = 462
-  WIDTH = 250
-  object ListBox1: TLISTBOX
-    ALIGN = alclient
-    BORDERSTYLE = bssingle
-    ONKEYPRESS = nil
-    ONKEYDOWN = nil
-    LEFT = 1
-    HEIGHT = 25
-    TOP = 1
-    WIDTH = 100
-  end
-end