From 06faefdcf7ecbaa19c9ac25bc33aadea0eb7fc3e Mon Sep 17 00:00:00 2001 From: lazarus Date: Tue, 30 Apr 2002 15:57:40 +0000 Subject: [PATCH] MWE: + Added callstack object and dialog + Added checks to see if debugger = nil + Added dbgutils git-svn-id: trunk@1654 - --- .gitattributes | 6 +- debugger/callstackdlg.lrs | 8 ++ debugger/callstackdlg.pp | 124 ++++++++++++++++++ debugger/cmdlinedebugger.pp | 90 ++----------- debugger/dbgutils.pp | 113 +++++++++++++++++ debugger/debugger.pp | 223 +++++++++++++++++++++++++++++++-- debugger/gdbmidebugger.pp | 142 +++++++++++++++++++-- debugger/tcallstackdlg.lfm | 29 +++++ debugger/test/debugtestform.pp | 17 ++- ide/debugmanager.pas | 10 +- ide/tinsertwatch.lfm | 112 ----------------- ide/twatchesdlg.lfm | 21 ---- 12 files changed, 653 insertions(+), 242 deletions(-) create mode 100644 debugger/callstackdlg.lrs create mode 100644 debugger/callstackdlg.pp create mode 100644 debugger/dbgutils.pp create mode 100644 debugger/tcallstackdlg.lfm delete mode 100644 ide/tinsertwatch.lfm delete mode 100644 ide/twatchesdlg.lfm diff --git a/.gitattributes b/.gitattributes index 999efc40db..213f39d4f0 100644 --- a/.gitattributes +++ b/.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 diff --git a/debugger/callstackdlg.lrs b/debugger/callstackdlg.lrs new file mode 100644 index 0000000000..fe5ef1fe02 --- /dev/null +++ b/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 + ); diff --git a/debugger/callstackdlg.pp b/debugger/callstackdlg.pp new file mode 100644 index 0000000000..374aed6224 --- /dev/null +++ b/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 ) + + 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 + +} \ No newline at end of file diff --git a/debugger/cmdlinedebugger.pp b/debugger/cmdlinedebugger.pp index af856c0be3..509431b09c 100644 --- a/debugger/cmdlinedebugger.pp +++ b/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 diff --git a/debugger/dbgutils.pp b/debugger/dbgutils.pp new file mode 100644 index 0000000000..84b18aa0b9 --- /dev/null +++ b/debugger/dbgutils.pp @@ -0,0 +1,113 @@ +{ $Id$ } +{ ------------------------------------------- + dbgutils.pp - Debugger utility routines + ------------------------------------------- + + @created(Sun Apr 28st WET 2002) + @lastmod($Date$) + @author(Marc Weustink ) + + 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 + +} \ No newline at end of file diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 2b66f1f724..08fa4336fa 100644 --- a/debugger/debugger.pp +++ b/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; @@ -105,7 +104,8 @@ type FFirstRun: Boolean; FActions: TDBGBreakPointActions; FDisableGroupList: TList; - FEnableGroupList: 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; - FWatches.Free; + FBreakPoints.FDebugger := nil; + 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 diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 4ddd8a6e76..244396380d 100644 --- a/debugger/gdbmidebugger.pp +++ b/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) @@ -135,6 +136,18 @@ type public 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 @@ -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 diff --git a/debugger/tcallstackdlg.lfm b/debugger/tcallstackdlg.lfm new file mode 100644 index 0000000000..ecd50d7f1f --- /dev/null +++ b/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 diff --git a/debugger/test/debugtestform.pp b/debugger/test/debugtestform.pp index d5d9d8766a..a207b66ec6 100644 --- a/debugger/test/debugtestform.pp +++ b/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 diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index b68ff4a4dc..a593145876 100644 --- a/ide/debugmanager.pas +++ b/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; diff --git a/ide/tinsertwatch.lfm b/ide/tinsertwatch.lfm deleted file mode 100644 index f2dcf95355..0000000000 --- a/ide/tinsertwatch.lfm +++ /dev/null @@ -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 diff --git a/ide/twatchesdlg.lfm b/ide/twatchesdlg.lfm deleted file mode 100644 index 18c9531bf2..0000000000 --- a/ide/twatchesdlg.lfm +++ /dev/null @@ -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