MWE: First steps of a debugger.

git-svn-id: trunk@388 -

.gitattributes

@@ -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

debugger/cmdlinedebugger.pp

@@ -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.
+
+
+}

debugger/dbgbreakpoint.pp

@@ -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 
+    constructor Create;
-                  read GetItem write SetItem; default;
+    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(
+constructor TDBGBreakPointGroups.Create; 
-  const AnIndex: Integer): TDBGBreakPointGroup;
 begin
-  Result:=nil;
+  inherited Create(TDBGBreakPointGroup);
 end;
 
-procedure TDBGBreakPointGroups.SetItem(const AnIndex: Integer; 
+function TDBGBreakPointGroups.GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
-  const Value: 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
 

debugger/dbgoutputform.lrc

@@ -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
+  );

debugger/dbgoutputform.pp

@@ -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.
+
+}

debugger/dbgwatch.pp

@@ -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;
+    FEnabled: Boolean;
-    FName: String;
+    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 Enabled: Boolean read FEnabled write SetEnabled;
-    property Value: String read FValue write SetValue;
+    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 
+    constructor Create;
-                 read GetItem write SetItem; default;
+    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
 

debugger/debugger.pp

@@ -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,
+  TDBGLocationRec = record
-    dcfRunTo, dcfJumpto, dcfBreak);
+    Adress: Pointer;
-  TDBGState = (dsStop, dsPause, dsRun, dsError);
+    FuncName: String;
+    SrcFile: String;
+    SrcLine: Integer;
+  end;
 
-  TDBGCurrentLineEvent = procedure(Sender: TObject; const AFilename: String;
+  TDBGCommand = (dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak);
-    const ALine: Integer) of object;
+  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;
+    FFileName: String;                              
-    FOnState: TNotifyEvent;
+    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
+    constructor Create; virtual;
-    procedure Done; virtual;                         // Kills external debugger
+    destructor Destroy; override;
-    procedure Run; virtual;                          // Starts / continues debugging
+    
-    procedure Pause; virtual;                        // Stops running
+    procedure Init; virtual;                         // Initializes the debugger
-    procedure Stop; virtual;                         // quit debugging
+    procedure Done; virtual;                         // Kills the debugger
-    procedure StepOver; virtual;
+    procedure Run;                                   // Starts / continues debugging
-    procedure StepInto; virtual;
+    procedure Pause;                                 // Stops running
-    procedure RunTo(const AFilename: String; const ALine: Integer); virtual;        // Executes til a certain point
+    procedure Stop;                                  // quit debugging
-    procedure JumpTo(const AFilename: String; const ALine: Integer); virtual;       // No execute, only set exec point
+    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 Flags: TDBGCommands read GetFlags;                                // All available commands of the debugger
-    property State: TDBGState read GetDBGState;
+    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;
 
-
+procedure TDebugger.DoCurrent(const ALocation: TDBGLocationRec);
-function TDebugger.GetDBGState: TDBGState;
 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
 

debugger/gdbdebugger.pp

@@ -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.
+
+
+}

debugger/tdbgoutputform.lfm

@@ -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

debugger/test/debugtest.pp

@@ -0,0 +1,14 @@
+program debugtest;
+
+{$mode objfpc}
+{$H+}
+
+
+uses
+  Classes, Forms, DebugTestForm;
+
+begin
+   Application.Initialize; 
+   Application.CreateForm(TDebugTestForm, DebugTestForm1);
+   Application.Run;
+end.

debugger/test/debugtestform.lrc

@@ -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
+  );

debugger/test/debugtestform.pp

@@ -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.
+
+}

debugger/test/examples/testcntr.pp

@@ -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.  

debugger/test/tdebugtesttorm.lfm

@@ -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

ide/main.pp

@@ -220,8 +220,7 @@ type
     
     // Debugger Events
     procedure OnDebuggerChangeState(Sender: TObject);
-    procedure OnDebuggerCurrentLine(Sender: TObject; const AFilename: String;
+    procedure OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
-                               const ALine: Integer);
                                
     // MessagesView Events
     procedure MessagesViewSelectionChanged(sender : TObject);
@@ -3471,20 +3470,23 @@ begin
   end;
 end;
 
-procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject; 
+procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
-  const AFilename: String;  const ALine: Integer);
 // 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);
+    ALocation.SrcLine - (ActiveSrcEdit.EditorComponent.LinesInWindow div 2);
-  ActiveSrcEdit.ErrorLine:=ALine;
+  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