paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-07 13:20:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Initial implementation of assembler dialog

Browse Source 
git-svn-id: trunk@17735 -
This commit is contained in:
marc 2008-12-09 01:39:31 +00:00
parent 5f91ba3d20
commit 598126853c
10 changed files with 373 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
debugger/cmdlinedebugger.pp
View File

@ -42,6 +42,9 @@ uses
Classes, Process, FileUtil, Debugger, LCLProc, Forms, LazConf, DBGUtils;
type
{ TCmdLineDebugger }
TCmdLineDebugger = class(TDebugger)
private
FDbgProcess: TProcess; // The process used to call the debugger
@ -54,6 +57,7 @@ type
protected
function CreateDebugProcess(const AOptions: String): Boolean;
procedure Flush; // Flushes output buffer
function GetWaiting: Boolean; override;
function ReadLine: String; overload;
function ReadLine(const APeek: Boolean): String; overload;
procedure SendCmdLn(const ACommand: String); overload;
@ -255,6 +259,11 @@ begin
Result := (FDbgProcess <> nil) and FDbgProcess.Running;
end;
function TCmdLineDebugger.GetWaiting: Boolean;
begin
Result := FReading;
end;
function TCmdLineDebugger.ReadLine: String;
begin
Result := ReadLine(False);

26
debugger/debugger.pp
View File

@ -64,7 +64,8 @@ type
dcEvaluate,
dcModify,
dcEnvironment,
dcSetStackFrame
dcSetStackFrame,
dcDisassemble
);
TDBGCommands = set of TDBGCommand;
@ -1087,6 +1088,7 @@ type
function GetCommands: TDBGCommands;
function GetSupportedCommands: TDBGCommands; virtual;
function GetTargetWidth: Byte; virtual;
function GetWaiting: Boolean; virtual;
function RequestCommand(const ACommand: TDBGCommand;
const AParams: array of const): Boolean;
virtual; abstract; // True if succesful
@ -1118,6 +1120,8 @@ type
function Evaluate(const AExpression: String; var AResult: String): Boolean; // Evaluates the given expression, returns true if valid
function Modify(const AExpression, AValue: String): Boolean; // Modifies the given expression, returns true if valid
function Disassemble(AAddr: TDbgPtr; ABackward: Boolean;
out ANextAddr: TDbgPtr; out ADump, AStatement: String): Boolean;
public
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
@ -1138,6 +1142,7 @@ type
property State: TDBGState read FState; // The current state of the debugger
property SupportedCommands: TDBGCommands read GetSupportedCommands; // All available commands of the debugger
property TargetWidth: Byte read GetTargetWidth; // Currently only 32 or 64
property Waiting: Boolean read GetWaiting; // Set when the debugger is wating for a command to complete
property Watches: TDBGWatches read FWatches; // list of all watches etc
property WorkingDir: String read FWorkingDir write FWorkingDir; // The working dir of the exe being debugged
// Events
@ -1164,7 +1169,8 @@ const
'Evaluate',
'Modify',
'Environment',
'SetStackFrame'
'SetStackFrame',
'Disassemble'
);
DBGStateNames: array[TDBGState] of string = (
@ -1203,7 +1209,8 @@ const
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch,
dcEvaluate, dcEnvironment],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak,
dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment, dcSetStackFrame],
dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment, dcSetStackFrame,
dcDisassemble],
{dsInit } [],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment],
{dsError} [dcStop]
@ -1394,6 +1401,11 @@ begin
inherited;
end;
function TDebugger.Disassemble(AAddr: TDbgPtr; ABackward: Boolean; out ANextAddr: TDbgPtr; out ADump, AStatement: String): Boolean;
begin
Result := ReqCmd(dcDisassemble, [AAddr, ABackward, @ANextAddr, @ADump, @AStatement]);
end;
procedure TDebugger.Done;
begin
SetState(dsNone);
@ -1471,8 +1483,7 @@ begin
FCurEnvironment.Assign(FEnvironment);
end;
function TDebugger.Evaluate(const AExpression: String;
var AResult: String): Boolean;
function TDebugger.Evaluate(const AExpression: String; var AResult: String): Boolean;
begin
Result := ReqCmd(dcEvaluate, [AExpression, @AResult]);
end;
@ -1524,6 +1535,11 @@ begin
Result := SizeOf(PtrInt)*8;
end;
function TDebugger.GetWaiting: Boolean;
begin
Result := False;
end;
procedure TDebugger.Init;
begin
FExitCode := 0;

227
debugger/gdbmidebugger.pp
View File

@ -38,7 +38,7 @@ interface
uses
Classes, SysUtils, LCLProc, Dialogs, LazConf, DBGUtils, Debugger,
FileUtil, CmdLineDebugger, GDBTypeInfo,
FileUtil, CmdLineDebugger, GDBTypeInfo, Maps,
{$IFdef MSWindows}
Windows,
{$ENDIF}
@ -112,6 +112,8 @@ type
FInExecuteCount: Integer;
FDebuggerFlags: TGDBMIDebuggerFlags;
FCurrentStackFrame: Integer;
FAsmCache: TTypedMap;
FAsmCacheIter: TTypedMapIterator;
// GDB info (move to ?)
FGDBVersion: String;
@ -137,6 +139,8 @@ type
function GDBStepInto: Boolean;
function GDBRunTo(const ASource: String; const ALine: Integer): Boolean;
function GDBJumpTo(const ASource: String; const ALine: Integer): Boolean;
function GDBDisassemble(AAddr: TDbgPtr; ABackward: Boolean;
out ANextAddr: TDbgPtr; out ADump, AStatement: String): Boolean;
procedure CallStackSetCurrent(AIndex: Integer);
// ---
@ -187,6 +191,7 @@ type
function ParseInitialization: Boolean; virtual;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
procedure ClearCommandQueue;
procedure DoState(const OldState: TDBGState); override;
property TargetPID: Integer read FTargetPID;
public
class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
@ -215,6 +220,12 @@ type
ValueLen: Integer;
end;
TGDBMIAsmLine = record
Dump: String;
Statement: String;
Next: TDbgPtr;
end;
{ TGDBMINameValueList }
TGDBMINameValueList = Class(TObject)
private
@ -779,6 +790,8 @@ begin
FTargetPID := 0;
FTargetFlags := [];
FDebuggerFlags := [];
FAsmCache := TTypedMap.Create(itu8, TypeInfo(TGDBMIAsmLine));
FAsmCacheIter := TTypedMapIterator.Create(FAsmCache);
{$IFdef MSWindows}
InitWin32;
@ -822,6 +835,8 @@ begin
inherited;
ClearCommandQueue;
FreeAndNil(FCommandQueue);
FreeAndNil(FAsmCacheIter);
FreeAndNil(FAsmCache);
end;
procedure TGDBMIDebugger.Done;
@ -831,6 +846,14 @@ begin
inherited Done;
end;
procedure TGDBMIDebugger.DoState(const OldState: TDBGState);
begin
if State in [dsStop, dsError]
then FAsmCache.Clear;
inherited DoState(OldState);
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
const AFlags: TGDBMICmdFlags): Boolean;
var
@ -1097,6 +1120,186 @@ begin
until false;
end;
function TGDBMIDebugger.GDBDisassemble(AAddr: TDbgPtr; ABackward: Boolean; out ANextAddr: TDbgPtr; out ADump, AStatement: String): Boolean;
var
R: TGDBMIExecResult;
S: String;
n, line, offset: Integer;
count: Cardinal;
DumpList, AsmList, InstList: TGDBMINameValueList;
Item: PGDBMINameValue;
Addr, AddrStop: TDbgPtr;
AsmLine: TGDBMIAsmLine;
begin
if FAsmCacheIter.Locate(AAddr)
then begin
repeat
FAsmCacheIter.GetData(AsmLine);
if not ABackward then Break;
if AsmLine.Next > AAddr
then FAsmCacheIter.Previous;
until FAsmCacheIter.BOM or (AsmLine.Next <= AAddr);
if not ABackward
then begin
ANextAddr := AsmLine.Next;
ADump := AsmLine.Dump;
AStatement := AsmLine.Statement;
Exit(True);
end;
if AsmLine.Next = AAddr
then begin
FAsmCacheIter.GetID(ANextAddr);
ADump := AsmLine.Dump;
AStatement := AsmLine.Statement;
Exit(True);
end;
end
else begin
// position before the first address requested
if ABackward and not FAsmCacheIter.BOM
then FAsmCacheIter.Previous;
end;
InstList := nil;
if ABackward
then begin
// we need to get the line before this one
// try if we have some statement nearby
if not FAsmCacheIter.BOM
then begin
FAsmCacheIter.GetId(Addr);
// limit amout of retrieved adreses to 128
if Addr < AAddr - 128
then Addr := 0;
end
else Addr := 0;
if Addr = 0
then begin
// no starting point, see if we have an offset into a function
ExecuteCommand('-data-disassemble -s %u -e %u -- 0', [AAddr-1, AAddr], [cfIgnoreError, cfExternal], R);
if R.State <> dsError
then begin
AsmList := TGDBMINameValueList.Create(R, ['asm_insns']);
if AsmList.Count > 0
then begin
Item := AsmList.Items[0];
InstList := TGDBMINameValueList.Create('');
InstList.Init(Item^.NamePtr, Item^.NameLen);
if TryStrToInt(Unquote(InstList.Values['offset']), offset)
then Addr := AAddr - Offset - 1;
end;
FreeAndNil(AsmList);
end;
end;
if Addr = 0
then begin
// no nice startingpoint found, just start to disassemble 64 bytes before it
// and hope that when we started in the middle of an instruction it get
// sorted out.
Addr := AAddr - 64;
end;
// always include existing addr since we need this one to calculate the "nextaddr"
// of the previos record (the record we requested)
AddrStop := AAddr + 1;
end
else begin
// stupid, gdb doesn't support linecount when disassembling from memory
// So we guess 32 here, that should give at least 2 lines on a CISC arch.
// On RISC we can do with less (future)
Addr := AAddr;
AddrStop := AAddr + 31;
end;
ExecuteCommand('-data-disassemble -s %u -e %u -- 0', [Addr, AddrStop], [cfIgnoreError, cfExternal], R);
if R.State = dsError
then begin
InstList.Free;
Exit(False);
end;
AsmList := TGDBMINameValueList.Create(R, ['asm_insns']);
if AsmList.Count < 2
then begin
AsmList.Free;
InstList.Free;
Exit(False);
end;
if InstList = nil
then InstList := TGDBMINameValueList.Create('');
Item := AsmList.Items[0];
InstList.Init(Item^.NamePtr, Item^.NameLen);
AsmLine.Next := StrToIntDef(Unquote(InstList.Values['address']), 0);
for line := 1 to AsmList.Count - 1 do
begin
Addr := AsmLine.Next;
AsmLine.Statement := Unquote(InstList.Values['inst']);
Item := AsmList.Items[line];
InstList.Init(Item^.NamePtr, Item^.NameLen);
AsmLine.Next := StrToIntDef(Unquote(InstList.Values['address']), 0);
AsmLine.Dump := '';
// check for cornercase when memory cycles
Count := AsmLine.Next - Addr;
if Count <= 32
then begin
// retrieve instuction bytes
ExecuteCommand('-data-read-memory %u x 1 1 %u', [Addr, Count], [cfIgnoreError, cfExternal], R);
if R.State <> dsError
then begin
S := '';
DumpList := TGDBMINameValueList.Create(R, ['memory']);
if DumpList.Count > 0
then begin
// get first (and only) memory part
Item := DumpList.Items[0];
DumpList.Init(Item^.NamePtr, Item^.NameLen);
// get data
DumpList.SetPath(['data']);
// now loop through elements
for n := 0 to DumpList.Count - 1 do
begin
S := S + Copy(DumpList.GetString(n), 4, 2);
end;
AsmLine.Dump := S;
end;
end;
FreeAndNil(DumpList);
end;
if FAsmCache.HasId(Addr)
then FAsmCache.SetData(Addr, AsmLine)
else FAsmCache.Add(Addr, AsmLine);
if (ABackward and (AsmLine.Next = AAddr))
or (not ABackward and (Addr = AAddr))
then begin
if ABackward
then ANextAddr := Addr
else ANextAddr := AsmLine.Next;
ADump := AsmLine.Dump;
AStatement := AsmLine.Statement;
Result := True;
end;
end;
FreeAndNil(InstList);
FreeAndNil(AsmList);
end;
function TGDBMIDebugger.GDBEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
var
S: String;
@ -1555,7 +1758,7 @@ function TGDBMIDebugger.GetSupportedCommands: TDBGCommands;
begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto,
dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment,
dcSetStackFrame];
dcSetStackFrame, dcDisassemble];
end;
function TGDBMIDebugger.GetTargetWidth: Byte;
@ -2220,15 +2423,17 @@ end;
function TGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
begin
case ACommand of
dcRun: Result := GDBRun;
dcPause: Result := GDBPause(False);
dcStop: Result := GDBStop;
dcStepOver: Result := GDBStepOver;
dcStepInto: Result := GDBStepInto;
dcRunTo: Result := GDBRunTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
dcJumpto: Result := GDBJumpTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
dcEvaluate: Result := GDBEvaluate(String(APArams[0].VAnsiString), String(APArams[1].VPointer^));
dcEnvironment: Result := GDBEnvironment(String(APArams[0].VAnsiString), AParams[1].VBoolean);
dcRun: Result := GDBRun;
dcPause: Result := GDBPause(False);
dcStop: Result := GDBStop;
dcStepOver: Result := GDBStepOver;
dcStepInto: Result := GDBStepInto;
dcRunTo: Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
dcJumpto: Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
dcEvaluate: Result := GDBEvaluate(String(AParams[0].VAnsiString), String(AParams[1].VPointer^));
dcEnvironment: Result := GDBEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean);
dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^),
String(AParams[3].VPointer^), String(AParams[4].VPointer^));
end;
end;

204
ide/debugmanager.pas
View File

@ -40,9 +40,9 @@ uses
MemCheck,
{$ENDIF}
Classes, SysUtils, Forms, Controls, Dialogs, Menus, FileUtil, LCLProc,
Laz_XMLCfg,
Laz_XMLCfg,
{ for Get/SetForegroundWindow }
LCLType, LCLIntf,
LCLType, LCLIntf,
SynEdit, CodeCache, CodeToolManager,
MenuIntf, IDECommands, LazIDEIntf, ProjectIntf,
LazConf,
@ -52,7 +52,7 @@ uses
MainBar, MainIntf, MainBase, BaseBuildManager,
SourceMarks,
DebuggerDlg, Watchesdlg, BreakPointsdlg, LocalsDlg, WatchPropertyDlg,
CallStackDlg, EvaluateDlg, RegistersDlg, {AssemblerDlg,} DBGOutputForm,
CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DBGOutputForm,
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger,
BaseDebugManager;
@ -65,9 +65,10 @@ type
ddtLocals,
ddtCallStack,
ddtEvaluate,
ddtRegisters
ddtRegisters,
ddtAssembler
);
{ TDebugManager }
TDebugManager = class(TBaseDebugManager)
@ -79,12 +80,10 @@ type
function OnSrcNotebookAddWatchesAtCursor(Sender: TObject): boolean;
// Debugger events
procedure OnDebuggerChangeState(ADebugger: TDebugger; OldState: TDBGState);
procedure OnDebuggerCurrentLine(Sender: TObject;
const ALocation: TDBGLocationRec);
procedure OnDebuggerOutput(Sender: TObject; const AText: String);
procedure OnDebuggerException(Sender: TObject; const AExceptionClass: String;
const AExceptionText: String);
procedure DebuggerChangeState(ADebugger: TDebugger; OldState: TDBGState);
procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure DebuggerOutput(Sender: TObject; const AText: String);
procedure DebuggerException(Sender: TObject; const AExceptionClass, AExceptionText: String);
// Dialog events
procedure DebugDialogDestroy(Sender: TObject);
@ -93,14 +92,16 @@ type
FBreakPointGroups: TIDEBreakPointGroups;
FDialogs: array[TDebugDialogType] of TDebuggerDlg;
FPrevShownWindow: HWND;
// keep track of the last reported location
FCurrentLocation: TDBGLocationRec;
// When a source file is not found, the user can choose one
// here are all choices stored
FUserSourceFiles: TStringList;
// when the debug output log is not open, store the debug log internally
FHiddenDebugOutputLog: TStringList;
procedure SetDebugger(const ADebugger: TDebugger);
// Breakpoint routines
@ -119,6 +120,7 @@ type
procedure InitCallStackDlg;
procedure InitEvaluateDlg;
procedure InitRegistersDlg;
procedure InitAssemblerDlg;
procedure FreeDebugger;
procedure ResetDebugger;
@ -168,7 +170,7 @@ type
function ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult; override;
function ShowWatchProperties(const AWatch: TIDEWatch): TModalresult; override;
end;
implementation
@ -176,9 +178,9 @@ implementation
const
DebugDlgIDEWindow: array[TDebugDialogType] of TNonModalIDEWindow = (
nmiwDbgOutput, nmiwBreakPoints, nmiwWatches, nmiwLocals, nmiwCallStack,
nmiwEvaluate, nmiwRegisters
nmiwEvaluate, nmiwRegisters, nmiwAssembler
);
type
TManagedBreakPoint = class(TIDEBreakPoint)
private
@ -212,7 +214,7 @@ type
procedure SetLocation(const ASource: String; const ALine: Integer); override;
property SourceMark: TSourceMark read FSourceMark write SetSourceMark;
end;
TManagedBreakPoints = class(TIDEBreakPoints)
private
FMaster: TDBGBreakPoints;
@ -225,7 +227,7 @@ type
constructor Create(const AManager: TDebugManager);
property Master: TDBGBreakPoints read FMaster write SetMaster;
end;
TManagedWatch = class(TIDEWatch)
private
FMaster: TDBGWatch;
@ -257,7 +259,7 @@ type
destructor Destroy; override;
property Master: TDBGWatches read FMaster write SetMaster;
end;
{ TManagedLocals }
TManagedLocals = class(TIDELocals)
@ -386,7 +388,7 @@ end;
function TManagedCallStack.InternalGetEntry(AIndex: Integer): TCallStackEntry;
begin
Assert(FMaster <> nil);
Result := FMaster.Entries[AIndex];
end;
@ -457,7 +459,7 @@ begin
else DoNotify := False;
FMaster := AMaster;
if FMaster <> nil
then begin
FMaster.OnChange := @LocalsChanged;
@ -786,7 +788,7 @@ var
n: Integer;
begin
if FMaster = AValue then Exit;
FMaster := AValue;
if FMaster = nil
then begin
@ -1081,7 +1083,7 @@ begin
end;
end;
end;
if (not FilenameIsAbsolute(SrcFile)) then begin
AnUnitInfo:=Project1.FindFile(SrcFile,[pfsfOnlyEditorFiles]);
if AnUnitInfo<>nil then begin
@ -1118,7 +1120,7 @@ begin
FUserSourceFiles.Insert(0, SrcFile);
end;
if SrcFile<>''
then begin
Filename:=SrcFile;
@ -1127,7 +1129,7 @@ begin
end;
procedure TDebugManager.mnuViewDebugDialogClick(Sender: TObject);
begin
begin
ViewDebugDialog(TDebugDialogType((Sender as TIDEMenuItem).Tag));
end;
@ -1158,7 +1160,7 @@ begin
if (Watches.Find(WatchVar) = nil)
and (Watches.Add(WatchVar) = nil)
then Exit;
Result:=true;
end;
@ -1166,13 +1168,12 @@ end;
// Debugger events
//-----------------------------------------------------------------------------
procedure TDebugManager.OnDebuggerException(Sender: TObject;
const AExceptionClass: String; const AExceptionText: String);
procedure TDebugManager.DebuggerException(Sender: TObject; const AExceptionClass, AExceptionText: String);
var
msg: String;
begin
if Destroying then exit;
if AExceptionText = ''
then
msg := Format('Project %s raised exception class ''%s''.',
@ -1184,7 +1185,7 @@ begin
MessageDlg('Error', msg, mtError,[mbOk],0);
end;
procedure TDebugManager.OnDebuggerOutput(Sender: TObject; const AText: String);
procedure TDebugManager.DebuggerOutput(Sender: TObject; const AText: String);
begin
if Destroying then exit;
if FDialogs[ddtOutput] <> nil then
@ -1199,7 +1200,7 @@ begin
end;
end;
procedure TDebugManager.OnDebuggerChangeState(ADebugger: TDebugger;
procedure TDebugManager.DebuggerChangeState(ADebugger: TDebugger;
OldState: TDBGState);
const
// dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError
@ -1218,7 +1219,7 @@ begin
if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting) then
exit;
if FDebugger.State=dsError
then begin
Include(FManagerStates,dmsDebuggerObjectBroken);
@ -1240,8 +1241,8 @@ begin
if (FDebugger.State in [dsRun])
then begin
// hide IDE during run
if EnvironmentOptions.HideIDEOnRun
and (MainIDE.ToolStatus=itDebugger) then
if EnvironmentOptions.HideIDEOnRun
and (MainIDE.ToolStatus=itDebugger) then
MainIDE.HideIDE;
if FPrevShownWindow <> 0 then
begin
@ -1250,14 +1251,14 @@ begin
end;
end
else begin
if (OldState in [dsRun]) then
if (OldState in [dsRun]) then
begin
MainIDE.UnhideIDE;
FPrevShownWindow := GetForegroundWindow;
Application.BringToFront;
end;
end;
// unmark execution line
if (FDebugger.State <> dsPause)
and (SourceNotebook <> nil)
@ -1267,7 +1268,7 @@ begin
then Editor.ExecutionLine := -1;
end;
case FDebugger.State of
case FDebugger.State of
dsError: begin
DebugLn('Ooops, the debugger entered the error state');
MessageDlg(lisDebuggerError,
@ -1283,15 +1284,17 @@ begin
Format(lisExecutionStoppedOn, [#13#13]),
mtInformation, [mbOK],0);
end;
FDebugger.FileName := '';
FDebugger.FileName := '';
if FDialogs[ddtAssembler] <> nil
then TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(nil, 0);
end;
end;
end;
end;
procedure TDebugManager.OnDebuggerCurrentLine(Sender: TObject;
const ALocation: TDBGLocationRec);
procedure TDebugManager.DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
// debugger paused program due to pause or error
// -> show the current execution line in editor
// if SrcLine < 1 then no source is available
@ -1306,49 +1309,65 @@ begin
if (Sender<>FDebugger) or (Sender=nil) then exit;
if Destroying then exit;
SrcFile:=ALocation.SrcFile;
SrcLine:=ALocation.SrcLine;
FCurrentLocation := ALocation;
SrcFile := ALocation.SrcFile;
SrcLine := ALocation.SrcLine;
//TODO: Show assembler window if no source can be found.
if SrcLine < 1
then begin
MessageDlg(lisExecutionPaused,
Format(lisExecutionPausedAdress, [#13#13,
HexStr(ALocation.Address, FDebugger.TargetWidth div 4), #13,
ALocation.FuncName, #13, ALocation.SrcFile, #13#13#13, #13]),
mtInformation, [mbOK],0);
ViewDebugDialog(ddtAssembler);
// jump to the deepest stack frame with debugging info
i:=0;
while (i<FDebugger.CallStack.Count) do begin
StackEntry:=FDebugger.CallStack.Entries[i];
if StackEntry.Line>0 then begin
SrcLine:=StackEntry.Line;
SrcFile:=StackEntry.Source;
break;
if FDialogs[ddtAssembler] = nil
then begin
// TODO: change into assemblerview failure
MessageDlg(lisExecutionPaused,
Format(lisExecutionPausedAdress, [#13#13,
HexStr(ALocation.Address, FDebugger.TargetWidth div 4), #13,
ALocation.FuncName, #13, ALocation.SrcFile, #13#13#13, #13]),
mtInformation, [mbOK],0);
// jump to the deepest stack frame with debugging info
i:=0;
while (i < FDebugger.CallStack.Count) do
begin
StackEntry := FDebugger.CallStack.Entries[i];
if StackEntry.Line > 0
then begin
SrcLine := StackEntry.Line;
SrcFile := StackEntry.Source;
StackEntry.Current := True;
Break;
end;
Inc(i);
end;
inc(i);
if SrcLine < 1 then Exit;
end;
if SrcLine<1 then
Exit;
end;
if FDialogs[ddtAssembler] <> nil
then begin
TAssemblerDlg(FDialogs[ddtAssembler]).SetLocation(FDebugger, Alocation.Address);
if SrcLine < 1 then Exit;
end;
if not GetFullFilename(SrcFile, true) then exit;
NewSource:=CodeToolBoss.LoadFile(SrcFile,true,false);
if NewSource=nil then begin
NewSource := CodeToolBoss.LoadFile(SrcFile, true, false);
if NewSource = nil
then begin
MessageDlg(lisDebugUnableToLoadFile,
Format(lisDebugUnableToLoadFile2, ['"', SrcFile, '"']),
mtError,[mbCancel],0);
exit;
Exit;
end;
// clear old error and execution lines
if SourceNotebook<>nil then begin
if SourceNotebook <> nil
then begin
SourceNotebook.ClearExecutionLines;
SourceNotebook.ClearErrorLines;
end;
// jump editor to execution line
if MainIDE.DoJumpToCodePos(nil,nil,NewSource,1,SrcLine,-1,true)<>mrOk
then exit;
@ -1392,7 +1411,7 @@ procedure TDebugManager.ViewDebugDialog(const ADialogType: TDebugDialogType);
const
DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = (
TDbgOutputForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg, TCallStackDlg,
TEvaluateDlg, TRegistersDlg
TEvaluateDlg, TRegistersDlg, TAssemblerDlg
);
var
CurDialog: TDebuggerDlg;
@ -1414,6 +1433,7 @@ begin
ddtRegisters: InitRegistersDlg;
ddtCallStack: InitCallStackDlg;
ddtEvaluate: InitEvaluateDlg;
ddtAssembler: InitAssemblerDlg;
end;
end
else begin
@ -1486,6 +1506,14 @@ begin
TheDialog.Registers := FRegisters;
end;
procedure TDebugManager.InitAssemblerDlg;
var
TheDialog: TAssemblerDlg;
begin
TheDialog := TAssemblerDlg(FDialogs[ddtAssembler]);
TheDialog.SetLocation(FDebugger, FCurrentLocation.Address);
end;
procedure TDebugManager.InitCallStackDlg;
var
TheDialog: TCallStackDlg;
@ -1504,7 +1532,7 @@ var
DialogType: TDebugDialogType;
begin
for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
FDialogs[DialogType] := nil;
FDialogs[DialogType] := nil;
FDebugger := nil;
FBreakPoints := TManagedBreakPoints.Create(Self);
@ -1517,19 +1545,19 @@ begin
FRegisters := TManagedRegisters.Create;
FUserSourceFiles := TStringList.Create;
inherited Create(TheOwner);
end;
destructor TDebugManager.Destroy;
var
DialogType: TDebugDialogType;
begin
begin
FDestroying:=true;
for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
for DialogType := Low(TDebugDialogType) to High(TDebugDialogType) do
DestroyDebugDialog(DialogType);
SetDebugger(nil);
FreeAndNil(FWatches);
@ -1560,6 +1588,8 @@ begin
itmViewRegisters.Tag := Ord(ddtRegisters);
itmViewCallStack.OnClick := @mnuViewDebugDialogClick;
itmViewCallStack.Tag := Ord(ddtCallStack);
itmViewAssembler.OnClick := @mnuViewDebugDialogClick;
itmViewAssembler.Tag := Ord(ddtAssembler);
itmViewDebugOutput.OnClick := @mnuViewDebugDialogClick;
itmViewDebugOutput.Tag := Ord(ddtOutput);
@ -1594,6 +1624,8 @@ begin
itmViewLocals.Command:=GetCommand(ecToggleLocals);
itmViewRegisters.Command:=GetCommand(ecToggleRegisters);
itmViewCallStack.Command:=GetCommand(ecToggleCallStack);
itmViewAssembler.Command:=GetCommand(ecToggleAssembler);
itmRunMenuInspect.Command:=GetCommand(ecInspect);
itmRunMenuEvaluate.Command:=GetCommand(ecEvaluate);
@ -1607,7 +1639,7 @@ var
begin
if (MainIDE=nil) or (MainIDE.ToolStatus = itExiting)
then exit;
DebuggerInvalid:=(FDebugger=nil) or (MainIDE.ToolStatus<>itDebugger);
with MainIDEBar do begin
// For 'run' and 'step' bypass 'idle', so we can set the filename later
@ -1745,7 +1777,7 @@ begin
SetDebugger(nil);
dbg.Free;
FManagerStates := [];
if MainIDE.ToolStatus = itDebugger
then MainIDE.ToolStatus := itNone;
end;
@ -1778,13 +1810,13 @@ begin
DebuggerClass := TProcessDebugger;
LaunchingCmdLine := BuildBoss.GetRunCommandLine;
SplitCmdLine(LaunchingCmdLine, LaunchingApplication, LaunchingParams);
if BuildBoss.GetProjectUsesAppBundle then
begin
// it is Application Bundle (darwin only)
if not DirectoryExistsUTF8(LaunchingApplication) then
begin
if MessageDlg(lisLaunchingApplicationInvalid,
@ -1797,7 +1829,7 @@ begin
else
Exit;
end;
if DebuggerClass = TProcessDebugger then
begin // use executable path inside Application Bundle (darwin only)
LaunchingApplication := LaunchingApplication + '/Contents/MacOS/' +
@ -1814,7 +1846,7 @@ begin
mtError, [mbOK],0);
Exit;
end;
//todo: this check depends on the debugger class
if (DebuggerClass <> TProcessDebugger)
and not FileIsExecutable(EnvironmentOptions.DebuggerFilename)
@ -1851,10 +1883,10 @@ begin
ClearDebugOutputLog;
FDebugger.OnState := @OnDebuggerChangeState;
FDebugger.OnCurrent := @OnDebuggerCurrentLine;
FDebugger.OnDbgOutput := @OnDebuggerOutput;
FDebugger.OnException := @OnDebuggerException;
FDebugger.OnState := @DebuggerChangeState;
FDebugger.OnCurrent := @DebuggerCurrentLine;
FDebugger.OnDbgOutput := @DebuggerOutput;
FDebugger.OnException := @DebuggerException;
if FDebugger.State = dsNone
then begin
@ -2067,7 +2099,7 @@ begin
if (ASourceMark=nil) or (not ASourceMark.IsBreakPoint)
or (ASourceMark.Data=nil) or (not (ASourceMark.Data is TIDEBreakPoint)) then
RaiseException('TDebugManager.DoDeleteBreakPointAtMark');
DebugLn('TDebugManager.DoDeleteBreakPointAtMark A ',ASourceMark.GetFilename,
' ',IntToStr(ASourceMark.Line));
OldBreakPoint:=TIDEBreakPoint(ASourceMark.Data);
@ -2117,14 +2149,14 @@ begin
Result := mrOK;
end;
function TDebugManager.GetState: TDBGState;
function TDebugManager.GetState: TDBGState;
begin
if FDebugger = nil
then Result := dsNone
else Result := FDebugger.State;
end;
function TDebugManager.GetCommands: TDBGCommands;
function TDebugManager.GetCommands: TDBGCommands;
begin
if FDebugger = nil
then Result := []

2
ide/ideoptiondefs.pas
View File

@ -90,6 +90,7 @@ type
nmiwCallStack,
nmiwEvaluate,
nmiwRegisters,
nmiwAssembler,
// extra
nmiwSearchResultsViewName,
nmiwAnchorEditor,
@ -131,6 +132,7 @@ const
'CallStack',
'EvaluateModify',
'Registers',
'Assembler',
// extra
'SearchResults',
'AnchorEditor',

1
ide/lazarusidestrconsts.pas
View File

@ -284,6 +284,7 @@ resourcestring
lisMenuViewLocalVariables = 'Local Variables';
lisMenuViewRegisters = 'Registers';
lisMenuViewCallStack = 'Call Stack';
lisMenuViewAssembler = 'Assembler';
lisMenuViewDebugOutput = 'Debug output';
lisMenuIDEInternals = 'IDE internals';
lisMenuPackageLinks = 'Package links ...';

2
ide/main.pp
View File

@ -2014,6 +2014,8 @@ begin
;//itmViewRegisters.OnClick(Self);
nmiwCallStack:
;//itmViewCallStack.OnClick(Self);
nmiwAssembler:
;//itmAssembler.OnClick(Self);
end;
end;
end;

1
ide/mainbar.pas
View File

@ -208,6 +208,7 @@ type
itmViewLocals: TIDEMenuCommand;
itmViewRegisters: TIDEMenuCommand;
itmViewCallStack: TIDEMenuCommand;
itmViewAssembler: TIDEMenuCommand;
itmViewDebugOutput: TIDEMenuCommand;
//itmViewIDEInternalsWindows: TIDEMenuSection;
itmViewPackageLinks: TIDEMenuCommand;

1
ide/mainbase.pas
View File

@ -560,6 +560,7 @@ begin
CreateMenuItem(itmViewDebugWindows,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables,'');
CreateMenuItem(itmViewDebugWindows,itmViewRegisters,'itmViewRegisters',lisMenuViewRegisters,'');
CreateMenuItem(itmViewDebugWindows,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'debugger_call_stack');
CreateMenuItem(itmViewDebugWindows,itmViewAssembler,'itmViewAssembler',lisMenuViewAssembler,'');
CreateMenuItem(itmViewDebugWindows,itmViewDebugOutput,'itmViewDebugOutput',lisMenuViewDebugOutput,'debugger_output');
end;
CreateMenuSubSection(ParentMI, itmViewIDEInternalsWindows, 'itmViewIDEInternalsWindows', lisMenuIDEInternals, '');

2
ideintf/idecommands.pas
View File

@ -181,6 +181,8 @@ const
ecToggleRestrictionBrowser = ecFirstLazarus + 322;
ecViewTodoList = ecFirstLazarus + 323;
ecToggleRegisters = ecFirstLazarus + 324;
ecToggleAssembler = ecFirstLazarus + 325;
// sourcenotebook commands
ecNextEditor = ecFirstLazarus + 330;