{ $Id$ } { ---------------------------------------- Debugger.pp - Debugger base classes ---------------------------------------- @created(Wed Feb 25st WET 2001) @lastmod($Date$) @author(Marc Weustink ) This unit contains the base class definitions of the debugger. These classes are only definitions. Implemented debuggers should be derived from these. /*************************************************************************** * * * 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 Debugger; {$mode objfpc}{$H+} interface uses Classes, DBGWatch, DBGBreakpoint; type TDBGLocationRec = record Adress: Pointer; FuncName: String; SrcFile: String; SrcLine: Integer; end; TDBGCommand = (dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch); TDBGCommands = set of TDBGCommand; TDBGState = (dsNone, dsIdle, dsStop, dsPause, dsRun, dsError); (* Debugger states -------------------------------------------------------------------------- dsNone: The debug object is created, but no instance of an external debugger exists. Initial state, leave with Init, enter with Done dsIdle: The external debugger is started, but no filename (or no other params requred to start) were given. dsStop: (Optional) The execution of the target is stopped The external debugger is loaded and ready to (re)start the execution of the target. Breakpoints, wathes etc can be defined dsPause: De debugger has paused the target. Targer variables canbe examined dsRun: The target is running. dsError: Something unforseen has happened. A shutdown of the debugger is in most cases needed. -------------------------------------------------------------------------- *) TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object; TDBGCurrentLineEvent = procedure(Sender: TObject; const ALocation: TDBGLocationRec) of object; TDebugger = class(TObject) private FArguments: String; FBreakPoints: TDBGBreakPoints; FBreakPointGroups: TDBGBreakPointGroups; 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 CreateBreakPoints: TDBGBreakPoints; virtual; function CreateWatches: TDBGWatches; virtual; procedure DoCurrent(const ALocation: TDBGLocationRec); procedure DoDbgOutput(const AText: String); procedure DoOutput(const AText: String); procedure DoState; function GetCommands: TDBGCommands; function GetSupportedCommands: TDBGCommands; virtual; function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; virtual; abstract; // True if succesful procedure SetFileName(const AValue: String); virtual; procedure SetState(const AValue: TDBGState); public constructor Create; {virtual; Virtual constructor makes no sense} 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 SupportedCommands: TDBGCommands read GetSupportedCommands; // All available commands of the debugger property Arguments: String read FArguments write FArguments; // Arguments feed to the program property BreakPoints: TDBGBreakPoints read FBreakPoints; // list of all breakpoints property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpointgroups property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged property State: TDBGState read FState; // The current stete of the debugger property Watches: TDBGWatches read FWatches; // list of all watches localvars etc 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 } [], {dsIdle } [], {dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch], {dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch], {dsRun } [dcPause, dcStop, dcBreak, dcWatch], {dsError} [] ); { TDebugger } constructor TDebugger.Create; begin inherited Create; FOnState := nil; FOnCurrent := nil; FOnOutput := nil; FOnDbgOutput := nil; FState := dsNone; FArguments := ''; FFilename := ''; FBreakPoints := CreateBreakPoints; FWatches := CreateWatches; FBreakPointGroups := TDBGBreakPointGroups.Create; end; function TDebugger.CreateBreakPoints: TDBGBreakPoints; begin Result := TDBGBreakPoints.Create(Self, TDBGBreakPoint); end; function TDebugger.CreateWatches: TDBGWatches; begin Result := TDBGWatches.Create(Self, TDBGWatch); 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); begin if Assigned(FOnCurrent) then FOnCurrent(Self, ALocation); end; procedure TDebugger.DoDbgOutput(const AText: String); begin 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.GetCommands: TDBGCommands; begin Result := COMMANDMAP[State] * GetSupportedCommands; end; function TDebugger.GetState: TDBGState; begin Result := FState; end; function TDebugger.GetSupportedCommands: TDBGCommands; begin Result := []; end; procedure TDebugger.Init; begin SetState(dsIdle); end; 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 Commands then Result := RequestCommand(ACommand, AParams) else Result := False; end; procedure TDebugger.Run; begin ReqCmd(dcRun, []); end; procedure TDebugger.RunTo(const ASource: String; const ALine: Integer); begin ReqCmd(dcRunTo, [ASource, ALine]); end; procedure TDebugger.SetFileName(const AValue: String); begin if FFileName <> AValue then begin if FState in [dsRun, dsPause] then Stop; FFileName := AValue; if FFilename = '' then SetState(dsIdle) else SetState(dsStop); end; end; procedure TDebugger.SetState(const AValue: TDBGState); begin if AValue <> FState then begin FState := AValue; 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.7 2002/02/06 08:58:29 lazarus MG: fixed compiler warnings and asking to create non existing files Revision 1.6 2002/02/05 23:16:48 lazarus MWE: * Updated tebugger + Added debugger to IDE Revision 1.5 2001/11/12 19:28:23 lazarus MG: fixed create, virtual constructors makes no sense Revision 1.4 2001/11/06 23:59:13 lazarus MWE: + Initial breakpoint support + Added exeption handling on process.free 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 Revision 1.1 2001/02/28 22:09:15 lazarus MWE: * Renamed DBGDebugger to Debugger Revision 1.2 2001/02/25 16:44:57 lazarus MWE: + Added header and footer }