mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 13:50:06 +02:00
MWE: First steps of a debugger.
git-svn-id: trunk@388 -
This commit is contained in:
lazarus
parent
6241105b36
commit
36964ad845
8
.gitattributes
vendored
8
.gitattributes
vendored
@ -39,9 +39,17 @@ components/synedit/synhighlightercpp.pp svneol=native#text/pascal
|
||||
components/synedit/synhighlighterhtml.pp svneol=native#text/pascal
|
||||
components/synedit/synhighlighterpas.pp svneol=native#text/pascal
|
||||
components/synedit/syntextdrawer.pp svneol=native#text/pascal
|
||||
debugger/cmdlinedebugger.pp svneol=native#text/pascal
|
||||
debugger/dbgbreakpoint.pp svneol=native#text/pascal
|
||||
debugger/dbgoutputform.pp svneol=native#text/pascal
|
||||
debugger/dbgwatch.pp svneol=native#text/pascal
|
||||
debugger/debugger.pp svneol=native#text/pascal
|
||||
debugger/gdbdebugger.pp svneol=native#text/pascal
|
||||
debugger/tdbgoutputform.lfm svneol=native#text/plain
|
||||
debugger/test/debugtest.pp svneol=native#text/pascal
|
||||
debugger/test/debugtestform.pp svneol=native#text/pascal
|
||||
debugger/test/examples/testcntr.pp svneol=native#text/pascal
|
||||
debugger/test/tdebugtesttorm.lfm svneol=native#text/plain
|
||||
designer/abstractcompiler.pp svneol=native#text/pascal
|
||||
designer/abstracteditor.pp svneol=native#text/pascal
|
||||
designer/abstractfilesystem.pp svneol=native#text/pascal
|
||||
|
||||
309
debugger/cmdlinedebugger.pp
Normal file
309
debugger/cmdlinedebugger.pp
Normal file
@ -0,0 +1,309 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------------
|
||||
CMDLineDebugger.pp - Debugger class for
|
||||
commandline debuggers
|
||||
----------------------------------------------
|
||||
|
||||
@created(Wed Feb 28st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
||||
|
||||
This unit contains the Commandline debugger class for external commandline
|
||||
debuggers.
|
||||
|
||||
|
||||
/***************************************************************************
|
||||
* *
|
||||
* 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 CmdLineDebugger;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Process, Debugger{, strmlsnr};
|
||||
|
||||
type
|
||||
TCmdLineDebugger = class(TDebugger)
|
||||
private
|
||||
FTargetProcess: TProcess; // The target process to be debugged
|
||||
FDbgProcess: TProcess; // The process used to call the debugger
|
||||
|
||||
FTargetOutputBuf: String; // Tempbuffer for process output
|
||||
FOutputLines: TStringList; // Debugger output
|
||||
|
||||
procedure GetOutput;
|
||||
protected
|
||||
WaitPrompt: String; // Prompt to wait for
|
||||
procedure CreateDebugProcess(const AName: String);
|
||||
procedure CreateTargetProcess(const AName: String);
|
||||
procedure KillTargetProcess;
|
||||
procedure SendCmdLn(const ACommand: String; const AGetOutput: Boolean); overload;
|
||||
procedure SendCmdLn(const ACommand: String; Values: array of const; const AGetOutput: Boolean); overload;
|
||||
property TargetProcess: TProcess read FTargetProcess;
|
||||
property DebugProcess: TProcess read FDbgProcess;
|
||||
property OutputLines: TStringList read FOutputLines;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
procedure TestCmd(const ACommand: String); // For internal debugging purposes
|
||||
end;
|
||||
|
||||
procedure SendBreak(const AHandle: Integer);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Linux,
|
||||
SysUtils, Forms;
|
||||
|
||||
//////////////////////////////////////////////////
|
||||
// Needs to go to proper include
|
||||
// Platform dependent
|
||||
//////////////////////////////////////////////////
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: SendBreak
|
||||
Params: AHandle THe handle of the proces tosend break to
|
||||
Returns:
|
||||
------------------------------------------------------------------------------}
|
||||
procedure SendBreak(const AHandle: Integer);
|
||||
begin
|
||||
if AHandle <> 0
|
||||
then Kill(AHandle, SIGINT);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: WaitForHandles
|
||||
Params: AHandles: A set of handles to wait for (max 32)
|
||||
Returns: BitArray of handles set, 0 when an error ocoured
|
||||
------------------------------------------------------------------------------}
|
||||
function WaitForHandles(const AHandles: array of Integer): Integer;
|
||||
var
|
||||
n, R, Max, Count: Integer;
|
||||
TimeOut: Integer;
|
||||
FDSWait, FDS: TFDSet;
|
||||
begin
|
||||
Result := 0;
|
||||
Max := 0;
|
||||
Count := High(AHandles);
|
||||
if Count < 0 then Exit;
|
||||
if Count > 31 then Count := 31;
|
||||
FD_ZERO(FDS);
|
||||
|
||||
for n := 0 to Count do
|
||||
begin
|
||||
if Max < AHandles[n] then Max := AHandles[n];
|
||||
if AHandles[n] <> 0
|
||||
then FD_Set(AHandles[n], FDS);
|
||||
end;
|
||||
|
||||
repeat
|
||||
FDSWait := FDS;
|
||||
TimeOut := 10;
|
||||
R := Select(Max + 1, @FDSWait, nil, nil, TimeOut);
|
||||
Application.ProcessMessages;
|
||||
until R <> 0;
|
||||
|
||||
if R > 0
|
||||
then begin
|
||||
for n := 0 to Count do
|
||||
if (AHandles[n] <> 0)
|
||||
and (FD_ISSET(AHandles[n], FDSWait))
|
||||
then begin
|
||||
Result := Result or 1 shl n;
|
||||
Dec(R);
|
||||
if R=0 then Break;
|
||||
end;
|
||||
end;
|
||||
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 Result := ''
|
||||
else begin
|
||||
if (idx > 1)
|
||||
and (ALine[idx - 1] = #13)
|
||||
then Dec(idx);
|
||||
Result := Copy(ALine, 1, idx - 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
//////////////////////////////////////////////////
|
||||
|
||||
{ TCmdLineDebugger }
|
||||
|
||||
constructor TCmdLineDebugger.Create;
|
||||
begin
|
||||
FDbgProcess := nil;
|
||||
FTargetProcess := nil;
|
||||
FOutputLines := TStringList.Create;
|
||||
FTargetOutputBuf := '';
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.CreateDebugProcess(const AName:String);
|
||||
begin
|
||||
if FDbgProcess = nil
|
||||
then begin
|
||||
FDbgProcess := TProcess.Create(AName, [poUsePipes, poNoConsole, poExecuteOnCreate]);
|
||||
WriteLn('[TCmdLineDebugger] Debug PID: ', FDbgProcess.Handle);
|
||||
GetOutput;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.CreateTargetProcess(const AName:String);
|
||||
begin
|
||||
// TODO: Better cleanup
|
||||
FTargetProcess.Free;
|
||||
FTargetProcess := TProcess.Create(AName, [poUsePipes, poNoConsole, poExecuteOnCreate, poRunSuspended]);
|
||||
WriteLN('[TCmdLineDebugger] Target PID = ', FTargetProcess.Handle);
|
||||
end;
|
||||
|
||||
destructor TCmdLineDebugger.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
FDbgProcess.Free;
|
||||
FTargetProcess.Free;
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.GetOutput;
|
||||
function ReadData(const AStream: TStream; var ABuffer: String): Integer;
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
SetLength(S, 1024);
|
||||
Result := AStream.Read(S[1], 1024);
|
||||
if Result > 0
|
||||
then begin
|
||||
SetLength(S, Result);
|
||||
ABuffer := ABuffer + S;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
OutputBuf: String;
|
||||
Line: String;
|
||||
OutHandle: Integer;
|
||||
WaitSet: Integer;
|
||||
Count: Integer;
|
||||
begin
|
||||
WriteLN('[GetOutput] Enter');
|
||||
|
||||
if (FTargetProcess = nil)
|
||||
then OutHandle := 0
|
||||
else OutHandle := FTargetProcess.Output.Handle;
|
||||
|
||||
OutputBuf := '';
|
||||
Line := '';
|
||||
OutputLines.Clear;
|
||||
repeat
|
||||
WaitSet := WaitForHandles([FDbgProcess.Output.Handle, OutHandle]);
|
||||
if WaitSet = 0
|
||||
then begin
|
||||
WriteLN('[Getoutput] Error waiting ');
|
||||
SetState(dsError);
|
||||
Break;
|
||||
end;
|
||||
|
||||
if ((WaitSet and 1) <> 0) and (FDbgProcess <> nil)
|
||||
then begin
|
||||
Count := ReadData(FDbgProcess.Output, OutputBuf);
|
||||
if Count > 0
|
||||
then while True do
|
||||
begin
|
||||
Line := GetLine(OutputBuf);
|
||||
if Line = '' then Break;
|
||||
Line := StripLN(Line);
|
||||
if Line <> '' then FOutputLines.Add(Line);
|
||||
DoDbgOutput(Line);
|
||||
end;
|
||||
end;
|
||||
|
||||
if ((WaitSet and 2) <> 0) and (FTargetProcess <> nil)
|
||||
then begin
|
||||
Count := ReadData(FTargetProcess.Output, FTargetOutputBuf);
|
||||
if Count > 0
|
||||
then while True do
|
||||
begin
|
||||
Line := StripLN(GetLine(FTargetOutputBuf));
|
||||
if Line = '' then Break;
|
||||
DoOutput(Line);
|
||||
end;
|
||||
end;
|
||||
until OutputBuf = WaitPrompt;
|
||||
|
||||
WriteLN('[GetOutput] Leave');
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.KillTargetProcess;
|
||||
begin
|
||||
FTargetProcess.Terminate(0);
|
||||
FTargetProcess.WaitOnExit;
|
||||
FTargetProcess.Free;
|
||||
FTargetProcess:= nil;
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; const AGetOutput: Boolean); overload;
|
||||
const
|
||||
LF = #10;
|
||||
begin
|
||||
if FDbgProcess <> nil
|
||||
then begin
|
||||
WriteLN(Format('[TCmdLineDebugger.SendCmd] CMD: <%s>', [ACommand]));
|
||||
FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
|
||||
FDbgProcess.Input.Write(LF, 1);
|
||||
if AGetOutput
|
||||
then GetOutput;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; Values: array of const; const AGetOutput: Boolean);
|
||||
begin
|
||||
SendCmdLn(Format(ACommand, Values), AGetOutput);
|
||||
end;
|
||||
|
||||
procedure TCmdLineDebugger.TestCmd(const ACommand: String);
|
||||
begin
|
||||
SendCmdLn(ACommand, True);
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.1 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
|
||||
}
|
||||
@ -5,7 +5,7 @@
|
||||
|
||||
@created(Wed Feb 25st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
This unit contains the class definitions of the
|
||||
Breakpoints used by the debugger
|
||||
@ -58,30 +58,40 @@ type
|
||||
property Valid: Boolean read FValid write SetValid;
|
||||
end;
|
||||
|
||||
TDBGBreakPointGroup = class(TCollection)
|
||||
TDBGBreakPoints = class(TCollection)
|
||||
private
|
||||
function GetItem(const AnIndex: Integer): TDBGBreakPoint;
|
||||
procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
property Items[const AnIndex: Integer]: TDBGBreakPoint read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
TDBGBreakPointGroup = class(TCollectionItem)
|
||||
private
|
||||
FEnabled: Boolean;
|
||||
FName: String;
|
||||
function GetItem(const AnIndex: Integer): TDBGBreakPoint;
|
||||
FBreakpoints: TDBGBreakPoints;
|
||||
procedure SetEnabled(const AValue: Boolean);
|
||||
procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
|
||||
procedure SetName(const AValue: String);
|
||||
protected
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
property Breakpoints: TDBGBreakPoints read FBreakpoints;
|
||||
property Enabled: Boolean read FEnabled write SetEnabled;
|
||||
property Items[const AnIndex: Integer]: TDBGBreakPoint
|
||||
read GetItem write SetItem; default;
|
||||
property Name: String read FName write SetName;
|
||||
end;
|
||||
|
||||
TDBGBreakPointGroups = class(TCollection)
|
||||
private
|
||||
function GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
|
||||
procedure SetItem(const AnIndex: Integer; const Value: TDBGBreakPointGroup);
|
||||
procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
|
||||
protected
|
||||
public
|
||||
property Items[const AnIndex: Integer]: TDBGBreakPointGroup
|
||||
read GetItem write SetItem; default;
|
||||
constructor Create;
|
||||
property Items[const AnIndex: Integer]: TDBGBreakPointGroup read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
|
||||
@ -130,11 +140,31 @@ begin
|
||||
FValid := AValue;
|
||||
end;
|
||||
|
||||
{ TDBGBreakPoints }
|
||||
|
||||
constructor TDBGBreakPoints.Create;
|
||||
begin
|
||||
inherited Create(TDBGBreakPoint);
|
||||
end;
|
||||
|
||||
function TDBGBreakPoints.GetItem(const AnIndex: Integer): TDBGBreakPoint;
|
||||
begin
|
||||
Result := TDBGBreakPoint(inherited GetItem(AnIndex));
|
||||
end;
|
||||
|
||||
procedure TDBGBreakPoints.SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
|
||||
begin
|
||||
end;
|
||||
|
||||
{ TDBGBreakPointGroup }
|
||||
|
||||
function TDBGBreakPointGroup.GetItem(const AnIndex: Integer): TDBGBreakPoint;
|
||||
constructor TDBGBreakPointGroup.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
end;
|
||||
|
||||
destructor TDBGBreakPointGroup.Destroy;
|
||||
begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TDBGBreakPointGroup.SetEnabled(const AValue: Boolean);
|
||||
@ -142,11 +172,6 @@ begin
|
||||
FEnabled := AValue;
|
||||
end;
|
||||
|
||||
procedure TDBGBreakPointGroup.SetItem(const AnIndex: Integer;
|
||||
const AValue: TDBGBreakPoint);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TDBGBreakPointGroup.SetName(const AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
@ -154,20 +179,26 @@ end;
|
||||
|
||||
{ TDBGBreakPointGroups }
|
||||
|
||||
function TDBGBreakPointGroups.GetItem(
|
||||
const AnIndex: Integer): TDBGBreakPointGroup;
|
||||
constructor TDBGBreakPointGroups.Create;
|
||||
begin
|
||||
Result:=nil;
|
||||
inherited Create(TDBGBreakPointGroup);
|
||||
end;
|
||||
|
||||
procedure TDBGBreakPointGroups.SetItem(const AnIndex: Integer;
|
||||
const Value: TDBGBreakPointGroup);
|
||||
function TDBGBreakPointGroups.GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
|
||||
begin
|
||||
Result := TDBGBreakPointGroup(inherited GetItem(AnIndex));
|
||||
end;
|
||||
|
||||
procedure TDBGBreakPointGroups.SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
|
||||
begin
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.4 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
Revision 1.3 2001/10/18 13:01:31 lazarus
|
||||
MG: fixed speedbuttons numglyphs>1 and started IDE debugging
|
||||
|
||||
|
||||
7
debugger/dbgoutputform.lrc
Normal file
7
debugger/dbgoutputform.lrc
Normal file
@ -0,0 +1,7 @@
|
||||
LazarusResources.Add('TDbgOutputForm','FORMDATA',
|
||||
'TPF0'#14'TDbgOutputForm'#13'DbgOutputForm'#7'CAPTION'#6#12'Debug output'#8
|
||||
+'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#4'LEFT'#3#239#0
|
||||
+#6'HEIGHT'#3#150#0#3'TOP'#3#161#0#5'WIDTH'#3','#1#0#5'TMemo'#9'txtOutput'
|
||||
+#4'Left'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'a'
|
||||
+'lClient'#0#0#0
|
||||
);
|
||||
75
debugger/dbgoutputform.pp
Normal file
75
debugger/dbgoutputform.pp
Normal file
@ -0,0 +1,75 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------
|
||||
dbgoutputform.pp - Shows target output
|
||||
----------------------------------------
|
||||
|
||||
@created(Wed Feb 25st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* 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 dbgoutputform;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Graphics, Controls, Forms, Dialogs, LResources,
|
||||
Buttons, StdCtrls, Debugger;
|
||||
|
||||
type
|
||||
TDbgOutputForm = class(TForm)
|
||||
txtOutput: TMemo;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
private
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
public
|
||||
procedure AddText(const AText: String);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TDbgOutputForm.AddText(const AText: String);
|
||||
begin
|
||||
txtOutput.Lines.Add(AText);
|
||||
end;
|
||||
|
||||
procedure TDbgOutputForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
txtOutput.Lines.Clear;
|
||||
end;
|
||||
|
||||
procedure TDbgOutputForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TDbgOutputForm.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
|
||||
// Not yet through resources
|
||||
txtOutput.Scrollbars := ssBoth;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I dbgoutputform.lrc}
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.1 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
}
|
||||
@ -5,7 +5,7 @@
|
||||
|
||||
@created(Wed Feb 25st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
This unit contains the class definitions of the
|
||||
Watches used by the debugger
|
||||
@ -31,56 +31,87 @@ uses
|
||||
type
|
||||
TDBGWatch = class(TCollectionItem)
|
||||
private
|
||||
FValue: String;
|
||||
FName: String;
|
||||
FEnabled: Boolean;
|
||||
FExpression: String;
|
||||
FOnChange: TNotifyEvent;
|
||||
function GetValid: Boolean;
|
||||
function GetValue: String;
|
||||
procedure SetEnabled(const AValue: Boolean);
|
||||
procedure SetExpression(const AValue: String);
|
||||
procedure SetValue(const AValue: String);
|
||||
procedure SetName(const AValue: String);
|
||||
protected
|
||||
public
|
||||
property Name: String read FName write SetName;
|
||||
property Value: String read FValue write SetValue;
|
||||
property Enabled: Boolean read FEnabled write SetEnabled;
|
||||
property Expression: String read FExpression write SetExpression;
|
||||
property Valid: Boolean read GetValid;
|
||||
property Value: String read GetValue write SetValue;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
|
||||
TDBGWatches = class(TCollection)
|
||||
private
|
||||
function GetItem(const AnIndex: Integer): TDBGWatch;
|
||||
procedure SetItem(const AnIndex: Integer; const Value: TDBGWatch);
|
||||
procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
|
||||
protected
|
||||
public
|
||||
property Items[const AnIndex: Integer]: TDBGWatch
|
||||
read GetItem write SetItem; default;
|
||||
constructor Create;
|
||||
property Items[const AnIndex: Integer]: TDBGWatch read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDBGWatch }
|
||||
|
||||
procedure TDBGWatch.SetName(const AValue: String);
|
||||
function TDBGWatch.GetValid: Boolean;
|
||||
begin
|
||||
FName := AValue;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TDBGWatch.GetValue: String;
|
||||
begin
|
||||
if Valid
|
||||
then begin
|
||||
end
|
||||
else Result := '<invalid>';
|
||||
end;
|
||||
|
||||
procedure TDBGWatch.SetEnabled(const AValue: Boolean);
|
||||
begin
|
||||
FEnabled := AValue;
|
||||
end;
|
||||
|
||||
procedure TDBGWatch.SetExpression(const AValue: String);
|
||||
begin
|
||||
FExpression := AValue;
|
||||
end;
|
||||
|
||||
procedure TDBGWatch.SetValue(const AValue: String);
|
||||
begin
|
||||
FValue := AValue;
|
||||
end;
|
||||
|
||||
{ TDBGWatches }
|
||||
|
||||
function TDBGWatches.GetItem(const AnIndex: Integer): TDBGWatch;
|
||||
constructor TDBGWatches.Create;
|
||||
begin
|
||||
Result:=nil
|
||||
inherited Create(TDBGWatch);
|
||||
end;
|
||||
|
||||
procedure TDBGWatches.SetItem(const AnIndex: Integer; const Value: TDBGWatch);
|
||||
function TDBGWatches.GetItem(const AnIndex: Integer): TDBGWatch;
|
||||
begin
|
||||
Result := TDBGWatch(inherited GetItem(AnIndex));
|
||||
end;
|
||||
|
||||
procedure TDBGWatches.SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
|
||||
begin
|
||||
inherited SetItem(AnIndex, AValue);
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.4 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
Revision 1.3 2001/10/18 13:01:31 lazarus
|
||||
MG: fixed speedbuttons numglyphs>1 and started IDE debugging
|
||||
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------
|
||||
DBGDebugger.pp - Debugger base classes
|
||||
Debugger.pp - Debugger base classes
|
||||
----------------------------------------
|
||||
|
||||
@created(Wed Feb 25st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
This unit contains the base class definitions of the debugger. These
|
||||
classes are only definitions. Implemented debuggers should be
|
||||
@ -30,102 +30,218 @@ uses
|
||||
Classes, DBGWatch, DBGBreakpoint;
|
||||
|
||||
type
|
||||
TDBGCommandFlags = set of (dcfRun, dcfPause, dcfStop, dcfStepOver, dcfStepInto,
|
||||
dcfRunTo, dcfJumpto, dcfBreak);
|
||||
TDBGState = (dsStop, dsPause, dsRun, dsError);
|
||||
TDBGLocationRec = record
|
||||
Adress: Pointer;
|
||||
FuncName: String;
|
||||
SrcFile: String;
|
||||
SrcLine: Integer;
|
||||
end;
|
||||
|
||||
TDBGCurrentLineEvent = procedure(Sender: TObject; const AFilename: String;
|
||||
const ALine: Integer) of object;
|
||||
TDBGCommand = (dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak);
|
||||
TDBGCommands = set of TDBGCommand;
|
||||
TDBGState = (dsNone, dsIdle, dsStop, dsPause, dsRun, dsError);
|
||||
|
||||
TDebugger = class
|
||||
TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
|
||||
TDBGCurrentLineEvent = procedure(Sender: TObject; const ALocation: TDBGLocationRec) of object;
|
||||
|
||||
TDebugger = class(TObject)
|
||||
private
|
||||
FFileName: String;
|
||||
FArguments: String;
|
||||
FBreakPointGroups: TDBGBreakPointGroups;
|
||||
FOnCurrent: TDBGCurrentLineEvent;
|
||||
FOnState: TNotifyEvent;
|
||||
FFileName: String;
|
||||
FState: TDBGState;
|
||||
FWatches: TDBGWatches;
|
||||
FOnCurrent: TDBGCurrentLineEvent;
|
||||
FOnOutput: TDBGOutputEvent;
|
||||
FOnDbgOutput: TDBGOutputEvent;
|
||||
FOnState: TNotifyEvent;
|
||||
function GetState: TDBGState;
|
||||
function ReqCmd(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
|
||||
protected
|
||||
function GetDBGState: TDBGState; virtual;
|
||||
procedure DoCurrent(const ALocation: TDBGLocationRec);
|
||||
procedure DoDbgOutput(const AText: String);
|
||||
procedure DoOutput(const AText: String);
|
||||
procedure DoState;
|
||||
function GetFlags: TDBGCommands; virtual;
|
||||
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; virtual; abstract; // True if succesful
|
||||
procedure SetFileName(const Value: String); virtual;
|
||||
function GetFlags: TDBGCommandFlags; virtual;
|
||||
procedure SetState(const Value: TDBGState);
|
||||
public
|
||||
procedure Init; virtual; // Initializes external debugger
|
||||
procedure Done; virtual; // Kills external debugger
|
||||
procedure Run; virtual; // Starts / continues debugging
|
||||
procedure Pause; virtual; // Stops running
|
||||
procedure Stop; virtual; // quit debugging
|
||||
procedure StepOver; virtual;
|
||||
procedure StepInto; virtual;
|
||||
procedure RunTo(const AFilename: String; const ALine: Integer); virtual; // Executes til a certain point
|
||||
procedure JumpTo(const AFilename: String; const ALine: Integer); virtual; // No execute, only set exec point
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Init; virtual; // Initializes the debugger
|
||||
procedure Done; virtual; // Kills the debugger
|
||||
procedure Run; // Starts / continues debugging
|
||||
procedure Pause; // Stops running
|
||||
procedure Stop; // quit debugging
|
||||
procedure StepOver;
|
||||
procedure StepInto;
|
||||
procedure RunTo(const ASource: String; const ALine: Integer); virtual; // Executes til a certain point
|
||||
procedure JumpTo(const ASource: String; const ALine: Integer); virtual; // No execute, only set exec point
|
||||
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
|
||||
property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpoints
|
||||
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
|
||||
property Flags: TDBGCommandFlags read GetFlags; // All available commands of the debugger
|
||||
property State: TDBGState read GetDBGState;
|
||||
property Flags: TDBGCommands read GetFlags; // All available commands of the debugger
|
||||
property State: TDBGState read FState; // The current stete of the debugger
|
||||
property Watches: TDBGWatches read FWatches; // list of all watches localvars etc
|
||||
property OnState: TNotifyEvent read FOnState write FOnState; // Fires when the current state of the debugger changes
|
||||
property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent; // Passes info about the current line being debugged
|
||||
property OnState: TNotifyEvent read FOnState write FOnState; // Fires when the current state of the debugger changes
|
||||
property OnOutput: TDBGOutputEvent read FOnOutput write FOnOutput; // Passes all output of the debugged target
|
||||
property OnDbgOutput: TDBGOutputEvent read FOnDbgOutput write FOnDbgOutput;// Passes all debuggeroutput
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
const
|
||||
COMMANDMAP: array[TDBGState] of TDBGCommands = (
|
||||
{dsNone } [dcBreak],
|
||||
{dsIdle } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak],
|
||||
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak],
|
||||
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak],
|
||||
{dsRun } [dcPause, dcStop, dcBreak],
|
||||
{dsError} []
|
||||
);
|
||||
|
||||
{ TDebugger }
|
||||
|
||||
constructor TDebugger.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FOnState := nil;
|
||||
FOnCurrent := nil;
|
||||
FOnOutput := nil;
|
||||
FOnDbgOutput := nil;
|
||||
FState := dsNone;
|
||||
FArguments := '';
|
||||
FFilename := '';
|
||||
FBreakPointGroups := TDBGBreakPointGroups.Create;
|
||||
FWatches := TDBGWatches.Create;
|
||||
end;
|
||||
|
||||
destructor TDebugger.Destroy;
|
||||
begin
|
||||
// don't call events
|
||||
FOnState := nil;
|
||||
FOnCurrent := nil;
|
||||
FOnOutput := nil;
|
||||
FOnDbgOutput := nil;
|
||||
|
||||
if FState <> dsNone
|
||||
then Done;
|
||||
|
||||
FBreakPointGroups.Free;
|
||||
FWatches.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDebugger.Done;
|
||||
begin
|
||||
SetState(dsNone);
|
||||
end;
|
||||
|
||||
|
||||
function TDebugger.GetDBGState: TDBGState;
|
||||
procedure TDebugger.DoCurrent(const ALocation: TDBGLocationRec);
|
||||
begin
|
||||
Result:=dsStop;
|
||||
if Assigned(FOnCurrent) then FOnCurrent(Self, ALocation);
|
||||
end;
|
||||
|
||||
function TDebugger.GetFlags: TDBGCommandFlags;
|
||||
procedure TDebugger.DoDbgOutput(const AText: String);
|
||||
begin
|
||||
Result:=[dcfStop];
|
||||
if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText);
|
||||
end;
|
||||
|
||||
procedure TDebugger.DoOutput(const AText: String);
|
||||
begin
|
||||
if Assigned(FOnOutput) then FOnOutput(Self, AText);
|
||||
end;
|
||||
|
||||
procedure TDebugger.DoState;
|
||||
begin
|
||||
if Assigned(FOnState) then FOnState(Self);
|
||||
end;
|
||||
|
||||
function TDebugger.GetState: TDBGState;
|
||||
begin
|
||||
Result := FState;
|
||||
end;
|
||||
|
||||
function TDebugger.GetFlags: TDBGCommands;
|
||||
begin
|
||||
Result := [];
|
||||
end;
|
||||
|
||||
procedure TDebugger.Init;
|
||||
begin
|
||||
SetState(dsIdle);
|
||||
end;
|
||||
|
||||
procedure TDebugger.JumpTo(const AFilename: String; const ALine: Integer);
|
||||
procedure TDebugger.JumpTo(const ASource: String; const ALine: Integer);
|
||||
begin
|
||||
ReqCmd(dcJumpTo, [ASource, ALine]);
|
||||
end;
|
||||
|
||||
procedure TDebugger.Pause;
|
||||
begin
|
||||
ReqCmd(dcPause, []);
|
||||
end;
|
||||
|
||||
function TDebugger.ReqCmd(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
|
||||
begin
|
||||
if FState = dsNone then Init;
|
||||
if ACommand in (COMMANDMAP[FState] * Flags)
|
||||
then Result := RequestCommand(ACommand, AParams)
|
||||
else Result := False;
|
||||
end;
|
||||
|
||||
procedure TDebugger.Run;
|
||||
begin
|
||||
ReqCmd(dcRun, []);
|
||||
end;
|
||||
|
||||
procedure TDebugger.RunTo(const AFilename: String; const ALine: Integer);
|
||||
procedure TDebugger.RunTo(const ASource: String; const ALine: Integer);
|
||||
begin
|
||||
ReqCmd(dcRunTo, [ASource, ALine]);
|
||||
end;
|
||||
|
||||
procedure TDebugger.SetFileName(const Value: String);
|
||||
begin
|
||||
FFileName := Value;
|
||||
end;
|
||||
|
||||
procedure TDebugger.SetState(const Value: TDBGState);
|
||||
begin
|
||||
if Value <> FState
|
||||
then begin
|
||||
FState := Value;
|
||||
DoState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugger.StepInto;
|
||||
begin
|
||||
ReqCmd(dcStepInto, []);
|
||||
end;
|
||||
|
||||
procedure TDebugger.StepOver;
|
||||
begin
|
||||
ReqCmd(dcStepOver, []);
|
||||
end;
|
||||
|
||||
procedure TDebugger.Stop;
|
||||
begin
|
||||
ReqCmd(dcStop, []);
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.3 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
Revision 1.2 2001/10/18 13:01:31 lazarus
|
||||
MG: fixed speedbuttons numglyphs>1 and started IDE debugging
|
||||
|
||||
|
||||
264
debugger/gdbdebugger.pp
Normal file
264
debugger/gdbdebugger.pp
Normal file
@ -0,0 +1,264 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------------
|
||||
GDBDebugger.pp - Debugger class forGDB
|
||||
----------------------------------------------
|
||||
|
||||
@created(Wed Feb 28st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
||||
|
||||
This unit contains the Commandline debugger class for the GDB
|
||||
debugger.
|
||||
|
||||
|
||||
/***************************************************************************
|
||||
* *
|
||||
* 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 GDBDebugger;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Process, Debugger, CmdLineDebugger;
|
||||
|
||||
type
|
||||
|
||||
TGDBDebugger = class(TCmdLineDebugger)
|
||||
private
|
||||
procedure GDBRun;
|
||||
procedure GDBPause;
|
||||
procedure GDBStop;
|
||||
procedure GDBStepOver;
|
||||
procedure GDBStepInto;
|
||||
procedure GDBRunTo(const ASource: String; const ALine: Integer);
|
||||
procedure GDBJumpTo(const ASource: String; const ALine: Integer);
|
||||
procedure RunCommand(const ACommand: String);
|
||||
function GetGDBState: TDBGState;
|
||||
function GetLocation: TDBGLocationRec;
|
||||
protected
|
||||
function GetFlags: TDBGCommands; override;
|
||||
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Init; override; // Initializes external debugger
|
||||
procedure Done; override; // Kills external debugger
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
{ TGDBDebugger }
|
||||
|
||||
constructor TGDBDebugger.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TGDBDebugger.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.Done;
|
||||
begin
|
||||
if State = dsRun then GDBPause;
|
||||
SendCmdLn('quit', False);
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBJumpTo(const ASource: String; const ALine: Integer);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBPause;
|
||||
begin
|
||||
SendBreak(TargetProcess.Handle);
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBRun;
|
||||
var
|
||||
loc: TDBGLocationRec;
|
||||
dState: TDBGState;
|
||||
begin
|
||||
case State of
|
||||
dsIdle, dsStop: begin
|
||||
CreateTargetProcess(FileName);
|
||||
|
||||
SendCmdLn('file %s', [FileName], True);
|
||||
SendCmdLn('attach %d', [TargetProcess.Handle], True);
|
||||
|
||||
TargetProcess.Resume;
|
||||
SetState(dsRun);
|
||||
|
||||
repeat
|
||||
SendCmdLn('cont', True);
|
||||
loc := GetLocation;
|
||||
dState := GetGDBState;
|
||||
until ((loc.FuncName <> 'HEAP') and (loc.FuncName <> '_start')) or (dState <> dsPause);
|
||||
DoCurrent(loc);
|
||||
SetState(dState);
|
||||
end;
|
||||
dsPause: begin
|
||||
RunCommand('cont');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBRunTo(const ASource: String; const ALine: Integer);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBStepInto;
|
||||
begin
|
||||
RunCommand('step');
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBStepOver;
|
||||
begin
|
||||
RunCommand('next');
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.GDBStop;
|
||||
var
|
||||
dState: TDBGState;
|
||||
begin
|
||||
if State = dsRun
|
||||
then begin
|
||||
GDBPause;
|
||||
// wait till pause is executed
|
||||
SendCmdLn('', True);
|
||||
end;
|
||||
|
||||
dState := GetGDBState;
|
||||
if dState = dsRun
|
||||
then Exit;
|
||||
|
||||
if dState = dsPause
|
||||
then begin
|
||||
SendCmdLn('kill', True);
|
||||
dState := GetGDBState;
|
||||
end;
|
||||
if dState = dsStop
|
||||
then KillTargetProcess;
|
||||
SetState(dState);
|
||||
end;
|
||||
|
||||
function TGDBDebugger.GetFlags: TDBGCommands;
|
||||
begin
|
||||
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak]
|
||||
end;
|
||||
|
||||
function TGDBDebugger.GetGDBState: TDBGState;
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
SendCmdLn('info program', True);
|
||||
S := OutputLines.Text;
|
||||
if Pos('stopped', S) > 0
|
||||
then Result := dsPause
|
||||
else if Pos('not being run', S) > 0
|
||||
then Result := dsStop
|
||||
else Result := dsNone;
|
||||
end;
|
||||
|
||||
function TGDBDebugger.GetLocation: TDBGLocationRec;
|
||||
var
|
||||
n, idx: Integer;
|
||||
NoSrc: Boolean;
|
||||
S: String;
|
||||
begin
|
||||
Result.Adress := nil;
|
||||
Result.FuncName := '';
|
||||
Result.SrcFile := '';
|
||||
Result.SrcLine := -1;
|
||||
|
||||
SendCmdLn('info frame', True);
|
||||
for n := 0 to OutputLines.Count - 1 do
|
||||
begin
|
||||
S := OutputLines[n];
|
||||
idx := Pos('eip = 0x', S);
|
||||
if idx = 0 then Continue;
|
||||
|
||||
// Get addr
|
||||
Delete(S, 1, idx + 7);
|
||||
idx := Pos('in', S);
|
||||
if idx = 0 then Break;
|
||||
Result.Adress := Pointer(StrToIntDef('$' + Copy(S, 1, idx - 2), 0));
|
||||
|
||||
// get function
|
||||
Delete(S, 1, idx + 2);
|
||||
idx := Pos(' (', S);
|
||||
NoSrc := (idx = 0);
|
||||
if NoSrc
|
||||
then idx := Pos(';',S);
|
||||
Result.FuncName := Copy(S, 1, idx - 1);
|
||||
if NoSrc then Break;
|
||||
|
||||
// getsource info
|
||||
Delete(S, 1, idx + 1);
|
||||
idx := Pos(':', S);
|
||||
if idx = 0 then Break;
|
||||
Result.SrcFile := Copy(S, 1, idx - 1);
|
||||
Delete(S, 1, idx);
|
||||
idx := Pos(')', S);
|
||||
if idx = 0 then Break;
|
||||
Result.SrcLine := StrToIntDef(Copy(S, 1, idx - 1), 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.Init;
|
||||
begin
|
||||
WaitPrompt := '(gdb) ';
|
||||
if DebugProcess = nil
|
||||
then begin
|
||||
CreateDebugProcess('/usr/bin/gdb -silent');
|
||||
SendCmdLn('', True);
|
||||
end;
|
||||
SendCmdLn('set confirm off', True);
|
||||
inherited Init;
|
||||
end;
|
||||
|
||||
function TGDBDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
|
||||
begin
|
||||
case ACommand of
|
||||
dcRun: GDBRun;
|
||||
dcPause: GDBPause;
|
||||
dcStop: GDBStop;
|
||||
dcStepOver: GDBStepOver;
|
||||
dcStepInto: GDBStepInto;
|
||||
dcRunTo: GDBRunTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
|
||||
dcJumpto: GDBJumpTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TGDBDebugger.RunCommand(const ACommand: String);
|
||||
begin
|
||||
SetState(dsRun);
|
||||
SendCmdLn(ACommand, True);
|
||||
DoCurrent(GetLocation);
|
||||
SetState(GetGDBState);
|
||||
end;
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.1 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
|
||||
}
|
||||
16
debugger/tdbgoutputform.lfm
Normal file
16
debugger/tdbgoutputform.lfm
Normal file
@ -0,0 +1,16 @@
|
||||
object DbgOutputForm: TDbgOutputForm
|
||||
CAPTION = 'Debug output'
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LEFT = 239
|
||||
HEIGHT = 150
|
||||
TOP = 161
|
||||
WIDTH = 300
|
||||
object txtOutput: TMemo
|
||||
Left = 8
|
||||
Top = 104
|
||||
Width = 600
|
||||
Height = 150
|
||||
Align = alClient
|
||||
end
|
||||
end
|
||||
14
debugger/test/debugtest.pp
Normal file
14
debugger/test/debugtest.pp
Normal file
@ -0,0 +1,14 @@
|
||||
program debugtest;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
|
||||
uses
|
||||
Classes, Forms, DebugTestForm;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TDebugTestForm, DebugTestForm1);
|
||||
Application.Run;
|
||||
end.
|
||||
32
debugger/test/debugtestform.lrc
Normal file
32
debugger/test/debugtestform.lrc
Normal file
@ -0,0 +1,32 @@
|
||||
LazarusResources.Add('TDebugTestForm','FORMDATA',
|
||||
'TPF0'#14'TDebugTestForm'#13'DebugTestForm'#7'CAPTION'#6#13'DebugTestForm'
|
||||
+#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#4'LEFT'#3#239
|
||||
+#0#6'HEIGHT'#3','#1#3'TOP'#3#161#0#5'WIDTH'#3'l'#2#0#7'TBUTTON'#7'cmdInit'
|
||||
+#7'CAPTION'#6#4'Init'#4'LEFT'#2#10#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2
|
||||
+'2'#7'OnClick'#7#12'cmdInitClick'#0#0#7'TBUTTON'#7'cmdDone'#7'CAPTION'#6#4
|
||||
+'Done'#4'LEFT'#2'F'#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7
|
||||
+#12'cmdDoneClick'#0#0#7'TBUTTON'#6'cmdRun'#7'CAPTION'#6#3'Run'#4'LEFT'#3
|
||||
+#130#0#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#11'cmdRunCl'
|
||||
+'ick'#0#0#7'TBUTTON'#8'cmdPause'#7'CAPTION'#6#5'Pause'#4'LEFT'#3#190#0#6
|
||||
+'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#13'cmdPauseClick'#0
|
||||
+#0#7'TBUTTON'#7'cmdStop'#7'CAPTION'#6#4'Stop'#4'LEFT'#3#250#0#6'HEIGHT'#2
|
||||
+#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#12'cmdStopClick'#0#0#7'TBUTTO'
|
||||
+'N'#7'cmdStep'#7'CAPTION'#6#4'Step'#4'LEFT'#3'6'#1#6'HEIGHT'#2#25#3'TOP'#2
|
||||
+''''#5'WIDTH'#2'2'#7'OnClick'#7#12'cmdStepClick'#0#0#7'TBUTTON'#11'cmdSte'
|
||||
+'pInto'#7'CAPTION'#6#9'Step into'#4'LEFT'#3'r'#1#6'HEIGHT'#2#25#3'TOP'#2
|
||||
+''''#5'WIDTH'#2'2'#7'OnClick'#7#16'cmdStepIntoClick'#0#0#6'TLabel'#8'lblS'
|
||||
+'tate'#4'Left'#2#8#3'Top'#2'h'#5'WIDTH'#2'2'#0#0#6'TLabel'#9'lblAdress'#4
|
||||
+'Left'#2':'#3'Top'#2'h'#5'WIDTH'#2'd'#0#0#6'TLabel'#9'lblSource'#4'Left'#3
|
||||
+#166#0#3'Top'#2'h'#5'WIDTH'#2'd'#0#0#6'TLabel'#7'lblLine'#4'Left'#3#18#1#3
|
||||
+'Top'#2'h'#5'WIDTH'#2'd'#0#0#6'TLabel'#7'lblFunc'#4'Left'#3'~'#1#3'Top'#2
|
||||
+'h'#5'WIDTH'#2'd'#0#0#5'TMemo'#6'txtLog'#4'Left'#2#8#3'Top'#3#132#0#5'Wid'
|
||||
+'th'#3'X'#2#6'Height'#3#150#0#0#0#7'TButton'#10'cmdCommand'#4'Left'#3#252
|
||||
+#0#3'Top'#2'G'#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#3'CMD'#7'OnClick'
|
||||
+#7#15'cmdCommandClick'#0#0#7'TButton'#8'cmdCLear'#4'Left'#3'9'#1#3'Top'#2
|
||||
+'G'#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#5'Clear'#7'OnClick'#7#13'cm'
|
||||
+'dClearClick'#0#0#5'TEdit'#10'txtCommand'#4'Left'#2#8#3'Top'#2'H'#5'Width'
|
||||
+#3#237#0#6'Height'#2#24#4'Text'#6#0#0#0#6'TLabel'#11'lblFileName'#4'Left'
|
||||
+#2#8#3'Top'#2#8#5'WIDTH'#2'F'#7'Caption'#6#9'Filename:'#0#0#5'TEdit'#11't'
|
||||
+'xtFileName'#4'Left'#2'F'#3'Top'#2#8#5'Width'#3'%'#1#6'Height'#2#24#4'Tex'
|
||||
+'t'#6#0#0#0#0
|
||||
);
|
||||
236
debugger/test/debugtestform.pp
Normal file
236
debugger/test/debugtestform.pp
Normal file
@ -0,0 +1,236 @@
|
||||
{ $Id$ }
|
||||
{ ----------------------------------------
|
||||
debugtestform.pp - Debugger test app
|
||||
----------------------------------------
|
||||
|
||||
@created(Wed Feb 25st WET 2001)
|
||||
@lastmod($Date$)
|
||||
@author(Marc Weustink <marc@@dommelstein.net>)
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* 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 debugtestform;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Graphics, Controls, Forms, Dialogs, LResources,
|
||||
Buttons, StdCtrls, Debugger, DbgOutputForm;
|
||||
|
||||
type
|
||||
TDebugTestForm = class(TForm)
|
||||
cmdInit : TButton;
|
||||
cmdDone : TButton;
|
||||
cmdRun : TButton;
|
||||
cmdPause : TButton;
|
||||
cmdStop : TButton;
|
||||
cmdStep : TButton;
|
||||
cmdStepInto : TButton;
|
||||
lblFileName: TLabel;
|
||||
lblAdress: TLabel;
|
||||
lblSource: TLabel;
|
||||
lblLine: TLabel;
|
||||
lblFunc: TLabel;
|
||||
lblState: TLabel;
|
||||
txtLog: TMemo;
|
||||
cmdCommand: TButton;
|
||||
cmdClear: TButton;
|
||||
txtCommand: TEdit;
|
||||
txtFileName: TEdit;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure cmdInitClick(Sender: TObject);
|
||||
procedure cmdDoneClick(Sender: TObject);
|
||||
procedure cmdRunClick(Sender: TObject);
|
||||
procedure cmdPauseClick(Sender: TObject);
|
||||
procedure cmdStopClick(Sender: TObject);
|
||||
procedure cmdStepClick(Sender: TObject);
|
||||
procedure cmdStepIntoClick(Sender: TObject);
|
||||
procedure cmdCommandClick(Sender: TObject);
|
||||
procedure cmdClearClick(Sender: TObject);
|
||||
private
|
||||
FDebugger: TDebugger;
|
||||
FOutputForm: TDBGOutputForm;
|
||||
procedure DBGState(Sender: TObject);
|
||||
procedure DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
|
||||
procedure DBGOutput(Sender: TObject; const AText: String);
|
||||
procedure DBGTargetOutput(Sender: TObject; const AText: String);
|
||||
procedure OutputFormDestroy(Sender: TObject);
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
var
|
||||
DebugTestForm1: TDebugTestForm;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
GDBDebugger;
|
||||
|
||||
procedure TDebugTestForm.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
|
||||
// Not yet through resources
|
||||
txtLog.Scrollbars := ssBoth;
|
||||
end;
|
||||
|
||||
destructor TDebugTestForm.Destroy;
|
||||
begin
|
||||
// This shouldn't be needed, but the OnDestroy event isn't called
|
||||
inherited;
|
||||
FormDestroy(Self);
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
txtLog.Lines.Clear;
|
||||
FDebugger := nil;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FDebugger.Free;
|
||||
FDebugger := nil;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdInitClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger = nil
|
||||
then begin
|
||||
FDebugger := TGDBDebugger.Create;
|
||||
FDebugger.OnDbgOutput := @DBGOutput;
|
||||
FDebugger.OnOutput := @DBGTargetOutput;
|
||||
FDebugger.OnCurrent := @DBGCurrent;
|
||||
FDebugger.OnState := @DBGState;
|
||||
|
||||
FOutputForm := TDBGOutputForm.Create(nil);
|
||||
FOutputForm.OnDestroy := @OutputFormDestroy;
|
||||
FOutputForm.Show;
|
||||
end;
|
||||
FDebugger.Init;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdDoneClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger <> nil
|
||||
then begin
|
||||
FDebugger.Done;
|
||||
FDebugger.Free;
|
||||
FDebugger := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdRunClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger <> nil
|
||||
then begin
|
||||
FDebugger.FileName := txtFileName.Text;
|
||||
FDebugger.Run;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdPauseClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger <> nil
|
||||
then begin
|
||||
FDebugger.Pause;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdStepClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger <> nil
|
||||
then begin
|
||||
FDebugger.StepOver;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdStepIntoClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger <> nil
|
||||
then begin
|
||||
FDebugger.StepInto;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdStopClick(Sender: TObject);
|
||||
begin
|
||||
if FDebugger <> nil
|
||||
then begin
|
||||
FDebugger.Stop;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdCommandClick(Sender: TObject);
|
||||
begin
|
||||
TGDBDebugger(FDebugger).TestCmd(txtCommand.Text);
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.cmdClearClick(Sender: TObject);
|
||||
begin
|
||||
txtLog.Lines.Clear;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.OutputFormDestroy(Sender: TObject);
|
||||
begin
|
||||
FOutputForm := nil;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.DBGOutput(Sender: TObject; const AText: String);
|
||||
begin
|
||||
txtLog.Lines.Add(AText);
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.DBGTargetOutput(Sender: TObject; const AText: String);
|
||||
begin
|
||||
if FOutputForm <> nil
|
||||
then FOutputForm.AddText(AText);
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
|
||||
begin
|
||||
lblAdress.Caption := Format('$%p', [ALocation.Adress]);
|
||||
lblSource.Caption := ALocation.SrcFile;
|
||||
lblLine.Caption := IntToStr(ALocation.SrcLine);
|
||||
lblFunc.Caption := ALocation.FuncName;
|
||||
end;
|
||||
|
||||
procedure TDebugTestForm.DBGState(Sender: TObject);
|
||||
begin
|
||||
case FDebugger.State of
|
||||
dsNone :lblState.Caption := 'dsNone ';
|
||||
dsIdle :lblState.Caption := 'dsIdle ';
|
||||
dsStop :lblState.Caption := 'dsStop ';
|
||||
dsPause:lblState.Caption := 'dsPause';
|
||||
dsRun :lblState.Caption := 'dsRun ';
|
||||
dsError:lblState.Caption := 'dsError';
|
||||
else
|
||||
lblState.Caption := '?';
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I debugtestform.lrc}
|
||||
|
||||
end.
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.1 2001/11/05 00:12:51 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
}
|
||||
24
debugger/test/examples/testcntr.pp
Normal file
24
debugger/test/examples/testcntr.pp
Normal file
@ -0,0 +1,24 @@
|
||||
program testcntr;
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
var
|
||||
m, n, x : Cardinal;
|
||||
time: TDateTime;
|
||||
begin
|
||||
m :=0;
|
||||
x := 0;
|
||||
while x < 3 do
|
||||
begin
|
||||
repeat
|
||||
Write(Format('[%.10d] ', [m]));
|
||||
Inc(m);
|
||||
for n := 0 to 79 do Write('.');
|
||||
WriteLN;
|
||||
until m mod 10 = 0;
|
||||
time := now;
|
||||
while (now - time) * SecsPerDay < 10 do;
|
||||
inc(x);
|
||||
end;
|
||||
end.
|
||||
132
debugger/test/tdebugtesttorm.lfm
Normal file
132
debugger/test/tdebugtesttorm.lfm
Normal file
@ -0,0 +1,132 @@
|
||||
object DebugTestForm: TDebugTestForm
|
||||
CAPTION = 'DebugTestForm'
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LEFT = 239
|
||||
HEIGHT = 300
|
||||
TOP = 161
|
||||
WIDTH = 620
|
||||
object cmdInit: TBUTTON
|
||||
CAPTION = 'Init'
|
||||
LEFT = 10
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdInitClick
|
||||
end
|
||||
object cmdDone: TBUTTON
|
||||
CAPTION = 'Done'
|
||||
LEFT = 70
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdDoneClick
|
||||
end
|
||||
object cmdRun: TBUTTON
|
||||
CAPTION = 'Run'
|
||||
LEFT = 130
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdRunClick
|
||||
end
|
||||
object cmdPause: TBUTTON
|
||||
CAPTION = 'Pause'
|
||||
LEFT = 190
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdPauseClick
|
||||
end
|
||||
object cmdStop: TBUTTON
|
||||
CAPTION = 'Stop'
|
||||
LEFT = 250
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdStopClick
|
||||
end
|
||||
object cmdStep: TBUTTON
|
||||
CAPTION = 'Step'
|
||||
LEFT = 310
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdStepClick
|
||||
end
|
||||
object cmdStepInto: TBUTTON
|
||||
CAPTION = 'Step into'
|
||||
LEFT = 370
|
||||
HEIGHT = 25
|
||||
TOP = 39
|
||||
WIDTH = 50
|
||||
OnClick = cmdStepIntoClick
|
||||
end
|
||||
object lblState: TLabel
|
||||
Left = 8
|
||||
Top = 104
|
||||
WIDTH = 50
|
||||
end
|
||||
object lblAdress: TLabel
|
||||
Left = 58
|
||||
Top = 104
|
||||
WIDTH = 100
|
||||
end
|
||||
object lblSource: TLabel
|
||||
Left = 166
|
||||
Top = 104
|
||||
WIDTH = 100
|
||||
end
|
||||
object lblLine: TLabel
|
||||
Left = 274
|
||||
Top = 104
|
||||
WIDTH = 100
|
||||
end
|
||||
object lblFunc: TLabel
|
||||
Left = 382
|
||||
Top = 104
|
||||
WIDTH = 100
|
||||
end
|
||||
object txtLog: TMemo
|
||||
Left = 8
|
||||
Top = 132
|
||||
Width = 600
|
||||
Height = 150
|
||||
end
|
||||
object cmdCommand: TButton
|
||||
Left = 252
|
||||
Top = 71
|
||||
Width = 50
|
||||
Height = 25
|
||||
Caption = 'CMD'
|
||||
OnClick = cmdCommandClick
|
||||
end
|
||||
object cmdCLear: TButton
|
||||
Left = 313
|
||||
Top = 71
|
||||
Width = 50
|
||||
Height = 25
|
||||
Caption = 'Clear'
|
||||
OnClick = cmdClearClick
|
||||
end
|
||||
object txtCommand: TEdit
|
||||
Left = 8
|
||||
Top = 72
|
||||
Width = 237
|
||||
Height = 24
|
||||
Text = ''
|
||||
end
|
||||
object lblFileName: TLabel
|
||||
Left = 8
|
||||
Top = 8
|
||||
WIDTH = 70
|
||||
Caption = 'Filename:'
|
||||
end
|
||||
object txtFileName: TEdit
|
||||
Left = 70
|
||||
Top = 8
|
||||
Width = 293
|
||||
Height = 24
|
||||
Text = ''
|
||||
end
|
||||
end
|
||||
26
ide/main.pp
26
ide/main.pp
@ -220,8 +220,7 @@ type
|
||||
|
||||
// Debugger Events
|
||||
procedure OnDebuggerChangeState(Sender: TObject);
|
||||
procedure OnDebuggerCurrentLine(Sender: TObject; const AFilename: String;
|
||||
const ALine: Integer);
|
||||
procedure OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
|
||||
|
||||
// MessagesView Events
|
||||
procedure MessagesViewSelectionChanged(sender : TObject);
|
||||
@ -3471,20 +3470,23 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject;
|
||||
const AFilename: String; const ALine: Integer);
|
||||
procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
|
||||
// debugger paused program due to pause or error
|
||||
// -> show the current execution line in editor
|
||||
var ActiveSrcEdit: TSourceEditor;
|
||||
// if SrcLine = -1 then no source is available
|
||||
var
|
||||
ActiveSrcEdit: TSourceEditor;
|
||||
begin
|
||||
if (Sender<>TheDebugger) or (Sender=nil) then exit;
|
||||
if DoOpenEditorFile(AFilename,false)<>mrOk then exit;
|
||||
//TODO: Show assembler window if no source can be found.
|
||||
if ALocation.SrcLine = -1 then Exit;
|
||||
if DoOpenEditorFile(ALocation.SrcFile, false) <> mrOk then exit;
|
||||
ActiveSrcEdit:=SourceNoteBook.GetActiveSE;
|
||||
if ActiveSrcEdit=nil then exit;
|
||||
ActiveSrcEdit.EditorComponent.CaretXY:=Point(1,ALine);
|
||||
ActiveSrcEdit.EditorComponent.CaretXY:=Point(1, ALocation.SrcLine);
|
||||
ActiveSrcEdit.EditorComponent.TopLine:=
|
||||
ALine-(ActiveSrcEdit.EditorComponent.LinesInWindow div 2);
|
||||
ActiveSrcEdit.ErrorLine:=ALine;
|
||||
ALocation.SrcLine - (ActiveSrcEdit.EditorComponent.LinesInWindow div 2);
|
||||
ActiveSrcEdit.ErrorLine:=ALocation.SrcLine;
|
||||
end;
|
||||
|
||||
function TMainIDE.SomethingOfProjectIsModified: boolean;
|
||||
@ -4380,6 +4382,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.134 2001/11/05 00:12:50 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
Revision 1.133 2001/11/03 08:37:34 lazarus
|
||||
MG: fixed errorline showing, resource adding and published var editing and added make cleanall
|
||||
|
||||
@ -9007,6 +9012,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.134 2001/11/05 00:12:50 lazarus
|
||||
MWE: First steps of a debugger.
|
||||
|
||||
Revision 1.133 2001/11/03 08:37:34 lazarus
|
||||
MG: fixed errorline showing, resource adding and published var editing and added make cleanall
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user