mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 15:39:24 +01:00
3682 lines
95 KiB
ObjectPascal
3682 lines
95 KiB
ObjectPascal
{
|
||
$Id$
|
||
This file is part of the Free Pascal Integrated Development Environment
|
||
Copyright (c) 1998-2000 by Pierre Muller
|
||
|
||
Debugger call routines for the IDE
|
||
|
||
See the file COPYING.FPC, included in this distribution,
|
||
for details about the copyright.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||
|
||
**********************************************************************}
|
||
unit FPDebug;
|
||
{$ifdef NODEBUG}
|
||
interface
|
||
implementation
|
||
end.
|
||
{$else}
|
||
|
||
interface
|
||
|
||
{$i globdir.inc}
|
||
|
||
uses
|
||
{$ifdef win32}
|
||
Windows,
|
||
{$endif win32}
|
||
Objects,Dialogs,Drivers,Views,
|
||
{$ifndef NODEBUG}
|
||
GDBCon,GDBInt,
|
||
{$endif NODEBUG}
|
||
Menus,
|
||
WViews,WEditor,
|
||
FPViews;
|
||
|
||
type
|
||
{$ifndef NODEBUG}
|
||
PDebugController=^TDebugController;
|
||
TDebugController=object(TGDBController)
|
||
InvalidSourceLine : boolean;
|
||
|
||
{ if true the current debugger raw will stay in middle of
|
||
editor window when debugging PM }
|
||
CenterDebuggerRow : boolean;
|
||
Disableallinvalidbreakpoints : boolean;
|
||
OrigPwd, { pwd at startup }
|
||
LastFileName : string;
|
||
LastSource : PView; {PsourceWindow !! }
|
||
HiddenStepsCount : longint;
|
||
{ no need to switch if using another terminal }
|
||
NoSwitch : boolean;
|
||
HasExe : boolean;
|
||
RunCount : longint;
|
||
WindowWidth : longint;
|
||
FPCBreakErrorNumber : longint;
|
||
{$ifdef SUPPORT_REMOTE}
|
||
isRemoteDebugging:boolean;
|
||
{$endif SUPPORT_REMOTE}
|
||
constructor Init;
|
||
procedure SetExe(const exefn:string);
|
||
procedure SetWidth(AWidth : longint);
|
||
procedure SetSourceDirs;
|
||
destructor Done;
|
||
procedure DoSelectSourceline(const fn:string;line:longint);virtual;
|
||
{ procedure DoStartSession;virtual;
|
||
procedure DoBreakSession;virtual;}
|
||
procedure DoEndSession(code:longint);virtual;
|
||
procedure DoUserSignal;virtual;
|
||
procedure AnnotateError;
|
||
procedure InsertBreakpoints;
|
||
procedure RemoveBreakpoints;
|
||
procedure ReadWatches;
|
||
procedure RereadWatches;
|
||
procedure ResetBreakpointsValues;
|
||
procedure DoDebuggerScreen;virtual;
|
||
procedure DoUserScreen;virtual;
|
||
procedure Reset;virtual;
|
||
procedure ResetDebuggerRows;
|
||
procedure Run;virtual;
|
||
procedure Continue;virtual;
|
||
procedure UntilReturn;virtual;
|
||
procedure CommandBegin(const s:string);virtual;
|
||
procedure CommandEnd(const s:string);virtual;
|
||
function IsRunning : boolean;
|
||
function AllowQuit : boolean;virtual;
|
||
function GetValue(Const expr : string) : pchar;
|
||
function GetFramePointer : CORE_ADDR;
|
||
function GetLongintAt(addr : CORE_ADDR) : longint;
|
||
function GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
|
||
end;
|
||
{$endif NODEBUG}
|
||
|
||
BreakpointType = (bt_function,bt_file_line,bt_watch,
|
||
bt_awatch,bt_rwatch,bt_address,bt_invalid);
|
||
BreakpointState = (bs_enabled,bs_disabled,bs_deleted,bs_delete_after);
|
||
|
||
PBreakpointCollection=^TBreakpointCollection;
|
||
|
||
PBreakpoint=^TBreakpoint;
|
||
TBreakpoint=object(TObject)
|
||
typ : BreakpointType;
|
||
state : BreakpointState;
|
||
owner : PBreakpointCollection;
|
||
Name : PString; { either function name or expr to watch }
|
||
FileName : PString;
|
||
OldValue,CurrentValue : Pstring;
|
||
Line : Longint; { only used for bt_file_line type }
|
||
Conditions : PString; { conditions relative to that breakpoint }
|
||
IgnoreCount : Longint; { how many counts should be ignored }
|
||
Commands : pchar; { commands that should be executed on breakpoint }
|
||
GDBIndex : longint;
|
||
GDBState : BreakpointState;
|
||
constructor Init_function(Const AFunc : String);
|
||
constructor Init_Address(Const AAddress : String);
|
||
constructor Init_Empty;
|
||
constructor Init_file_line(AFile : String; ALine : longint);
|
||
constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
procedure Insert;
|
||
procedure Remove;
|
||
procedure Enable;
|
||
procedure Disable;
|
||
procedure UpdateSource;
|
||
procedure ResetValues;
|
||
destructor Done;virtual;
|
||
end;
|
||
|
||
TBreakpointCollection=object(TCollection)
|
||
function At(Index: Integer): PBreakpoint;
|
||
function GetGDB(index : longint) : PBreakpoint;
|
||
function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
|
||
function ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
|
||
procedure Update;
|
||
procedure ShowBreakpoints(W : PFPWindow);
|
||
function FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
|
||
procedure AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
|
||
procedure ShowAllBreakpoints;
|
||
end;
|
||
|
||
PBreakpointItem = ^TBreakpointItem;
|
||
TBreakpointItem = object(TObject)
|
||
Breakpoint : PBreakpoint;
|
||
constructor Init(ABreakpoint : PBreakpoint);
|
||
function GetText(MaxLen: Sw_integer): string; virtual;
|
||
procedure Selected; virtual;
|
||
function GetModuleName: string; virtual;
|
||
end;
|
||
|
||
PBreakpointsListBox = ^TBreakpointsListBox;
|
||
TBreakpointsListBox = object(THSListBox)
|
||
Transparent : boolean;
|
||
NoSelection : boolean;
|
||
MaxWidth : Sw_integer;
|
||
(* ModuleNames : PStoreCollection; *)
|
||
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||
procedure AddBreakpoint(P: PBreakpointItem); virtual;
|
||
function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
||
function GetLocalMenu: PMenu;virtual;
|
||
procedure Clear; virtual;
|
||
procedure TrackSource; virtual;
|
||
procedure EditNew; virtual;
|
||
procedure EditCurrent; virtual;
|
||
procedure DeleteCurrent; virtual;
|
||
procedure ToggleCurrent;
|
||
procedure Draw; virtual;
|
||
procedure HandleEvent(var Event: TEvent); virtual;
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
destructor Done; virtual;
|
||
end;
|
||
|
||
PBreakpointsWindow = ^TBreakpointsWindow;
|
||
TBreakpointsWindow = object(TFPDlgWindow)
|
||
BreakLB : PBreakpointsListBox;
|
||
constructor Init;
|
||
procedure AddBreakpoint(ABreakpoint : PBreakpoint);
|
||
procedure ClearBreakpoints;
|
||
procedure ReloadBreakpoints;
|
||
procedure Close; virtual;
|
||
procedure SizeLimits(var Min, Max: TPoint);virtual;
|
||
procedure HandleEvent(var Event: TEvent); virtual;
|
||
procedure Update; virtual;
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
destructor Done; virtual;
|
||
end;
|
||
|
||
PBreakpointItemDialog = ^TBreakpointItemDialog;
|
||
|
||
TBreakpointItemDialog = object(TCenterDialog)
|
||
constructor Init(ABreakpoint: PBreakpoint);
|
||
function Execute: Word; virtual;
|
||
private
|
||
Breakpoint : PBreakpoint;
|
||
TypeRB : PRadioButtons;
|
||
NameIL : PEditorInputLine;
|
||
ConditionsIL: PEditorInputLine;
|
||
LineIL : PEditorInputLine;
|
||
IgnoreIL : PEditorInputLine;
|
||
end;
|
||
|
||
PWatch = ^TWatch;
|
||
TWatch = Object(TObject)
|
||
constructor Init(s : string);
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
procedure rename(s : string);
|
||
procedure Get_new_value;
|
||
procedure Force_new_value;
|
||
destructor done;virtual;
|
||
expr : pstring;
|
||
private
|
||
GDBRunCount : longint;
|
||
last_value,current_value : pchar;
|
||
end;
|
||
|
||
PWatchesCollection = ^TWatchesCollection;
|
||
TWatchesCollection = Object(TCollection)
|
||
constructor Init;
|
||
procedure Insert(Item: Pointer); virtual;
|
||
function At(Index: Integer): PWatch;
|
||
procedure Update;
|
||
private
|
||
MaxW : integer;
|
||
end;
|
||
|
||
PWatchesListBox = ^TWatchesListBox;
|
||
TWatchesListBox = object(THSListBox)
|
||
Transparent : boolean;
|
||
MaxWidth : Sw_integer;
|
||
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||
(* procedure AddWatch(P: PWatch); virtual; *)
|
||
procedure Update(AMaxWidth : integer);
|
||
function GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
|
||
function GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String; virtual;
|
||
function GetLocalMenu: PMenu;virtual;
|
||
(* procedure Clear; virtual;
|
||
procedure TrackSource; virtual;*)
|
||
procedure EditNew; virtual;
|
||
procedure EditCurrent; virtual;
|
||
procedure DeleteCurrent; virtual;
|
||
(*procedure ToggleCurrent; *)
|
||
procedure Draw; virtual;
|
||
procedure HandleEvent(var Event: TEvent); virtual;
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
destructor Done; virtual;
|
||
end;
|
||
|
||
PWatchItemDialog = ^TWatchItemDialog;
|
||
|
||
TWatchItemDialog = object(TCenterDialog)
|
||
constructor Init(AWatch: PWatch);
|
||
function Execute: Word; virtual;
|
||
private
|
||
Watch : PWatch;
|
||
NameIL : PEditorInputLine;
|
||
TextST : PAdvancedStaticText;
|
||
end;
|
||
|
||
PWatchesWindow = ^TWatchesWindow;
|
||
TWatchesWindow = Object(TFPDlgWindow)
|
||
WLB : PWatchesListBox;
|
||
Constructor Init;
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
procedure Update; virtual;
|
||
destructor Done; virtual;
|
||
end;
|
||
|
||
PFramesListBox = ^TFramesListBox;
|
||
TFramesListBox = object(TMessageListBox)
|
||
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||
procedure Update;
|
||
function GetLocalMenu: PMenu;virtual;
|
||
procedure GotoSource; virtual;
|
||
procedure GotoAssembly; virtual;
|
||
procedure HandleEvent(var Event: TEvent); virtual;
|
||
destructor Done; virtual;
|
||
end;
|
||
|
||
PStackWindow = ^TStackWindow;
|
||
TStackWindow = Object(TFPDlgWindow)
|
||
FLB : PFramesListBox;
|
||
Constructor Init;
|
||
constructor Load(var S: TStream);
|
||
procedure Store(var S: TStream);
|
||
procedure Update; virtual;
|
||
destructor Done; virtual;
|
||
end;
|
||
|
||
procedure InitStackWindow;
|
||
procedure DoneStackWindow;
|
||
|
||
function ActiveBreakpoints : boolean;
|
||
function GDBFileName(st : string) : string;
|
||
function OSFileName(st : string) : string;
|
||
|
||
|
||
const
|
||
BreakpointTypeStr : Array[BreakpointType] of String[9]
|
||
= ( 'function','file-line','watch','awatch','rwatch','address','invalid');
|
||
BreakpointStateStr : Array[BreakpointState] of String[8]
|
||
= ( 'enabled','disabled','invalid',''{'to be deleted' should never be used});
|
||
|
||
var
|
||
{$ifndef NODEBUG}
|
||
Debugger : PDebugController;
|
||
{$endif NODEBUG}
|
||
BreakpointsCollection : PBreakpointCollection;
|
||
WatchesCollection : PwatchesCollection;
|
||
|
||
procedure InitDebugger;
|
||
procedure DoneDebugger;
|
||
procedure InitGDBWindow;
|
||
procedure DoneGDBWindow;
|
||
procedure InitDisassemblyWindow;
|
||
procedure DoneDisassemblyWindow;
|
||
procedure InitBreakpoints;
|
||
procedure DoneBreakpoints;
|
||
procedure InitWatches;
|
||
procedure DoneWatches;
|
||
|
||
procedure RegisterFPDebugViews;
|
||
|
||
procedure UpdateDebugViews;
|
||
|
||
|
||
implementation
|
||
|
||
uses
|
||
Dos,
|
||
{$ifdef fpc}
|
||
Video,
|
||
{$endif fpc}
|
||
{$ifdef DOS}
|
||
fpusrscr,
|
||
{$endif DOS}
|
||
App,Strings,
|
||
FVConsts,
|
||
{$ifdef win32}
|
||
Windebug,
|
||
{$endif win32}
|
||
{$ifdef Unix}
|
||
{$ifdef VER1_0}
|
||
Linux,
|
||
{$else}
|
||
termio,
|
||
{$endif}
|
||
{$endif Unix}
|
||
Systems,Globals,
|
||
FPRegs,
|
||
FPString,FPVars,FPUtils,FPConst,FPSwitch,
|
||
FPIntf,FPCompil,FPIde,FPHelp,
|
||
Validate,WUtils,Wconsts;
|
||
|
||
const
|
||
RBreakpointsWindow: TStreamRec = (
|
||
ObjType: 1701;
|
||
VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
|
||
Load: @TBreakpointsWindow.Load;
|
||
Store: @TBreakpointsWindow.Store
|
||
);
|
||
|
||
RBreakpointsListBox : TStreamRec = (
|
||
ObjType: 1702;
|
||
VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
|
||
Load: @TBreakpointsListBox.Load;
|
||
Store: @TBreakpointsListBox.Store
|
||
);
|
||
|
||
RWatchesWindow: TStreamRec = (
|
||
ObjType: 1703;
|
||
VmtLink: Ofs(TypeOf(TWatchesWindow)^);
|
||
Load: @TWatchesWindow.Load;
|
||
Store: @TWatchesWindow.Store
|
||
);
|
||
|
||
RWatchesListBox: TStreamRec = (
|
||
ObjType: 1704;
|
||
VmtLink: Ofs(TypeOf(TWatchesListBox)^);
|
||
Load: @TWatchesListBox.Load;
|
||
Store: @TWatchesListBox.Store
|
||
);
|
||
|
||
RStackWindow: TStreamRec = (
|
||
ObjType: 1705;
|
||
VmtLink: Ofs(TypeOf(TStackWindow)^);
|
||
Load: @TStackWindow.Load;
|
||
Store: @TStackWindow.Store
|
||
);
|
||
|
||
RFramesListBox: TStreamRec = (
|
||
ObjType: 1706;
|
||
VmtLink: Ofs(TypeOf(TFramesListBox)^);
|
||
Load: @TFramesListBox.Load;
|
||
Store: @TFramesListBox.Store
|
||
);
|
||
|
||
RBreakpoint: TStreamRec = (
|
||
ObjType: 1707;
|
||
VmtLink: Ofs(TypeOf(TBreakpoint)^);
|
||
Load: @TBreakpoint.Load;
|
||
Store: @TBreakpoint.Store
|
||
);
|
||
|
||
RWatch: TStreamRec = (
|
||
ObjType: 1708;
|
||
VmtLink: Ofs(TypeOf(TWatch)^);
|
||
Load: @TWatch.Load;
|
||
Store: @TWatch.Store
|
||
);
|
||
|
||
|
||
RBreakpointCollection: TStreamRec = (
|
||
ObjType: 1709;
|
||
VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
|
||
Load: @TBreakpointCollection.Load;
|
||
Store: @TBreakpointCollection.Store
|
||
);
|
||
|
||
RWatchesCollection: TStreamRec = (
|
||
ObjType: 1710;
|
||
VmtLink: Ofs(TypeOf(TWatchesCollection)^);
|
||
Load: @TWatchesCollection.Load;
|
||
Store: @TWatchesCollection.Store
|
||
);
|
||
|
||
|
||
|
||
{$ifdef I386}
|
||
const
|
||
FrameName = '$ebp';
|
||
{$define FrameNameKnown}
|
||
{$endif i386}
|
||
{$ifdef m68k}
|
||
const
|
||
FrameName = '$fp';
|
||
{$define FrameNameKnown}
|
||
{$endif m68k}
|
||
{$ifdef powerpc}
|
||
{ stack and frame registers are the same on powerpc,
|
||
so I am not sure that this will work PM }
|
||
const
|
||
FrameName = '$r1';
|
||
{$define FrameNameKnown}
|
||
{$endif powerpc}
|
||
|
||
{$ifdef TP}
|
||
function HexStr(Value: longint; Len: byte): string;
|
||
begin
|
||
HexStr:=IntToHex(Value,Len);
|
||
end;
|
||
{$endif}
|
||
|
||
|
||
function GDBFileName(st : string) : string;
|
||
{$ifndef Unix}
|
||
var i : longint;
|
||
{$endif Unix}
|
||
begin
|
||
{$ifdef NODEBUG}
|
||
GDBFileName:=st;
|
||
{$else NODEBUG}
|
||
{$ifdef Unix}
|
||
GDBFileName:=st;
|
||
{$else}
|
||
{ should we also use / chars ? }
|
||
for i:=1 to Length(st) do
|
||
if st[i]='\' then
|
||
{$ifdef win32}
|
||
{ Don't touch at '\ ' used to escapes spaces in windows file names PM }
|
||
if (i=length(st)) or (st[i+1]<>' ') then
|
||
{$endif win32}
|
||
st[i]:='/';
|
||
{$ifdef win32}
|
||
{ for win32 we should convert e:\ into //e/ PM }
|
||
if (length(st)>2) and (st[2]=':') and (st[3]='/') then
|
||
st:=CygDrivePrefix+'/'+st[1]+copy(st,3,length(st));
|
||
{ support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
|
||
for i:=Length(st) downto 1 do
|
||
if (st[i]=' ') and ((i=1) or (st[i-1]<>'\')) then
|
||
st:=copy(st,1,i-1)+'\'+copy(st,i,length(st));
|
||
{$endif win32}
|
||
{$ifdef go32v2}
|
||
{ for go32v2 we should convert //e/ back into e:/ PM }
|
||
if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
|
||
st:=st[3]+':/'+copy(st,5,length(st));
|
||
{$endif go32v2}
|
||
GDBFileName:=LowerCaseStr(st);
|
||
{$endif}
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
function OSFileName(st : string) : string;
|
||
{$ifndef Unix}
|
||
var i : longint;
|
||
{$endif Unix}
|
||
begin
|
||
{$ifdef Unix}
|
||
OSFileName:=st;
|
||
{$else}
|
||
{$ifdef win32}
|
||
{$ifndef NODEBUG}
|
||
{ for win32 we should convert /cygdrive/e/ into e:\ PM }
|
||
if pos(CygDrivePrefix+'/',st)=1 then
|
||
st:=st[Length(CygdrivePrefix)+2]+':\'+copy(st,length(CygdrivePrefix)+4,length(st));
|
||
{$endif NODEBUG}
|
||
{$endif win32}
|
||
{ support spaces in the name by escaping them but without changing '\ ' into '\\ ' }
|
||
for i:=Length(st) downto 2 do
|
||
if (st[i]=' ') and (st[i-1]='\') then
|
||
st:=copy(st,1,i-2)+copy(st,i,length(st));
|
||
{$ifdef go32v2}
|
||
{ for go32v2 we should convert //e/ back into e:/ PM }
|
||
if (length(st)>3) and (st[1]='/') and (st[2]='/') and (st[4]='/') then
|
||
st:=st[3]+':\'+copy(st,5,length(st));
|
||
{$endif go32v2}
|
||
{ should we also use / chars ? }
|
||
for i:=1 to Length(st) do
|
||
if st[i]='/' then
|
||
st[i]:='\';
|
||
OSFileName:=LowerCaseStr(st);
|
||
{$endif}
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TDebugController
|
||
****************************************************************************}
|
||
|
||
procedure UpdateDebugViews;
|
||
|
||
begin
|
||
{$ifdef SUPPORT_REMOTE}
|
||
PushStatus(msg_getting_info_on+RemoteMachine);
|
||
{$endif SUPPORT_REMOTE}
|
||
DeskTop^.Lock;
|
||
If assigned(StackWindow) then
|
||
StackWindow^.Update;
|
||
If assigned(RegistersWindow) then
|
||
RegistersWindow^.Update;
|
||
{$ifndef NODEBUG}
|
||
If assigned(Debugger) then
|
||
Debugger^.ReadWatches;
|
||
{$endif NODEBUG}
|
||
If assigned(FPUWindow) then
|
||
FPUWindow^.Update;
|
||
If assigned(VectorWindow) then
|
||
VectorWindow^.Update;
|
||
DeskTop^.UnLock;
|
||
{$ifdef SUPPORT_REMOTE}
|
||
PopStatus;
|
||
{$endif SUPPORT_REMOTE}
|
||
end;
|
||
|
||
{$ifndef NODEBUG}
|
||
|
||
constructor TDebugController.Init;
|
||
begin
|
||
inherited Init;
|
||
CenterDebuggerRow:=IniCenterDebuggerRow;
|
||
Disableallinvalidbreakpoints:=false;
|
||
NoSwitch:=False;
|
||
HasExe:=false;
|
||
Debugger:=@self;
|
||
WindowWidth:=-1;
|
||
switch_to_user:=true;
|
||
GetDir(0,OrigPwd);
|
||
Command('set print object off');
|
||
end;
|
||
|
||
procedure TDebugController.SetExe(const exefn:string);
|
||
var f : string;
|
||
begin
|
||
f := GDBFileName(GetShortName(exefn));
|
||
if (f<>'') and ExistsFile(exefn) then
|
||
begin
|
||
LoadFile(f);
|
||
HasExe:=true;
|
||
Command('b FPC_BREAK_ERROR');
|
||
FPCBreakErrorNumber:=last_breakpoint_number;
|
||
{$ifdef FrameNameKnown}
|
||
{ this fails in GDB 5.1 because
|
||
GDB replies that there is an attempt to dereference
|
||
a generic pointer...
|
||
test delayed in DoSourceLine... PM
|
||
Command('cond '+IntToStr(FPCBreakErrorNumber)+
|
||
' (('+FrameName+' + 8)^ <> 0) or'+
|
||
' (('+FrameName+' + 12)^ <> 0)'); }
|
||
{$endif FrameNameKnown}
|
||
SetArgs(GetRunParameters);
|
||
SetSourceDirs;
|
||
InsertBreakpoints;
|
||
ReadWatches;
|
||
end
|
||
else
|
||
begin
|
||
HasExe:=false;
|
||
Command('file');
|
||
end;
|
||
end;
|
||
|
||
procedure TDebugController.SetWidth(AWidth : longint);
|
||
begin
|
||
WindowWidth:=AWidth;
|
||
Command('set width '+inttostr(WindowWidth));
|
||
end;
|
||
|
||
procedure TDebugController.SetSourceDirs;
|
||
var f,s: string;
|
||
i : longint;
|
||
Dir : SearchRec;
|
||
begin
|
||
f:=GetSourceDirectories+';'+OrigPwd;
|
||
repeat
|
||
i:=pos(';',f);
|
||
if i=0 then
|
||
s:=f
|
||
else
|
||
begin
|
||
s:=copy(f,1,i-1);
|
||
system.delete(f,1,i);
|
||
end;
|
||
DefaultReplacements(s);
|
||
if (pos('*',s)=0) and ExistsDir(s) then
|
||
Command('dir '+GDBFileName(GetShortName(s)))
|
||
{ we should also handle the /* cases of -Fu option }
|
||
else if pos('*',s)>0 then
|
||
begin
|
||
Dos.FindFirst(s,Directory,Dir);
|
||
{ the '*' can only be in the last dir level }
|
||
s:=DirOf(s);
|
||
while Dos.DosError=0 do
|
||
begin
|
||
if ((Dir.attr and Directory) <> 0) and ExistsDir(s+Dir.Name) then
|
||
Command('dir '+GDBFileName(GetShortName(s+Dir.Name)));
|
||
Dos.FindNext(Dir);
|
||
end;
|
||
{$ifdef FPC}
|
||
Dos.FindClose(Dir);
|
||
{$endif def FPC}
|
||
end;
|
||
until i=0;
|
||
end;
|
||
|
||
procedure TDebugController.InsertBreakpoints;
|
||
procedure DoInsert(PB : PBreakpoint);
|
||
begin
|
||
PB^.Insert;
|
||
end;
|
||
|
||
begin
|
||
BreakpointsCollection^.ForEach(@DoInsert);
|
||
Disableallinvalidbreakpoints:=false;
|
||
end;
|
||
|
||
procedure TDebugController.ReadWatches;
|
||
|
||
procedure DoRead(PB : PWatch);
|
||
begin
|
||
PB^.Get_new_value;
|
||
end;
|
||
|
||
begin
|
||
WatchesCollection^.ForEach(@DoRead);
|
||
If Assigned(WatchesWindow) then
|
||
WatchesWindow^.Update;
|
||
end;
|
||
|
||
procedure TDebugController.RereadWatches;
|
||
|
||
procedure DoRead(PB : PWatch);
|
||
begin
|
||
PB^.Force_new_value;
|
||
end;
|
||
|
||
begin
|
||
WatchesCollection^.ForEach(@DoRead);
|
||
If Assigned(WatchesWindow) then
|
||
WatchesWindow^.Update;
|
||
end;
|
||
|
||
|
||
procedure TDebugController.RemoveBreakpoints;
|
||
procedure DoDelete(PB : PBreakpoint);
|
||
begin
|
||
PB^.Remove;
|
||
end;
|
||
begin
|
||
BreakpointsCollection^.ForEach(@DoDelete);
|
||
end;
|
||
|
||
procedure TDebugController.ResetBreakpointsValues;
|
||
procedure DoResetVal(PB : PBreakpoint);
|
||
begin
|
||
PB^.ResetValues;
|
||
end;
|
||
begin
|
||
BreakpointsCollection^.ForEach(@DoResetVal);
|
||
end;
|
||
|
||
destructor TDebugController.Done;
|
||
begin
|
||
{ kill the program if running }
|
||
Reset;
|
||
RemoveBreakpoints;
|
||
inherited Done;
|
||
end;
|
||
|
||
|
||
procedure TDebugController.Run;
|
||
{$ifdef Unix}
|
||
var
|
||
Debuggeefile : text;
|
||
ResetOK, TTYUsed : boolean;
|
||
{$endif Unix}
|
||
{$ifdef PALMOSGDB}
|
||
const
|
||
TargetProtocol = 'palmos';
|
||
{$else}
|
||
const
|
||
TargetProtocol = 'remote';
|
||
{$endif PALMOSGDB}
|
||
|
||
{$ifdef SUPPORT_REMOTE}
|
||
var
|
||
S,ErrorStr : string;
|
||
{$endif SUPPORT_REMOTE}
|
||
begin
|
||
ResetBreakpointsValues;
|
||
{$ifdef SUPPORT_REMOTE}
|
||
NoSwitch:=true;
|
||
isRemoteDebugging:=false;
|
||
{$ifndef CROSSGDB}
|
||
If (RemoteMachine<>'') and (RemotePort<>'') then
|
||
{$else CROSSGDB}
|
||
if true then
|
||
{$endif CROSSGDB}
|
||
begin
|
||
isRemoteDebugging:=true;
|
||
S:=RemoteMachine;
|
||
If pos('@',S)>0 then
|
||
S:=copy(S,pos('@',S)+1,High(S));
|
||
If RemotePort<>'' then
|
||
S:=S+':'+RemotePort;
|
||
{$ifdef PALMOSGDB}
|
||
{ set the default value for PalmOS }
|
||
If S='' then
|
||
S:='localhost:2000';
|
||
{$endif PALMOSGDB}
|
||
PushStatus(msg_connectingto+S);
|
||
Command('target '+TargetProtocol+' '+S);
|
||
if Error then
|
||
begin
|
||
ErrorStr:=strpas(GetError);
|
||
ErrorBox(#3'Error in "target '+TargetProtocol+'"'#13#3+ErrorStr,nil);
|
||
PopStatus;
|
||
exit;
|
||
end;
|
||
PopStatus;
|
||
end
|
||
else
|
||
begin
|
||
{$endif SUPPORT_REMOTE}
|
||
{$ifdef win32}
|
||
{ Run the debugge in another console }
|
||
if DebuggeeTTY<>'' then
|
||
Command('set new-console on')
|
||
else
|
||
Command('set new-console off');
|
||
NoSwitch:=DebuggeeTTY<>'';
|
||
{$endif win32}
|
||
{$ifdef Unix}
|
||
{ Run the debuggee in another tty }
|
||
if DebuggeeTTY <> '' then
|
||
begin
|
||
{$I-}
|
||
Assign(Debuggeefile,DebuggeeTTY);
|
||
system.Reset(Debuggeefile);
|
||
ResetOK:=IOResult=0;
|
||
If ResetOK and {$ifdef ver1_0}IsATTY(textrec(Debuggeefile).handle){$else}(IsATTY(textrec(Debuggeefile).handle)<>-1){$endif} then
|
||
begin
|
||
Command('tty '+DebuggeeTTY);
|
||
TTYUsed:=true;
|
||
end
|
||
else
|
||
begin
|
||
Command('tty ');
|
||
TTYUsed:=false;
|
||
end;
|
||
if ResetOK then
|
||
close(Debuggeefile);
|
||
if TTYUsed and (DebuggeeTTY<>TTYName(stdout)) then
|
||
NoSwitch:= true
|
||
else
|
||
NoSwitch:=false;
|
||
end
|
||
else
|
||
begin
|
||
if TTYName(input)<>'' then
|
||
Command('tty '+TTYName(input));
|
||
NoSwitch := false;
|
||
end;
|
||
{$endif Unix}
|
||
{$ifdef SUPPORT_REMOTE}
|
||
end;
|
||
{$endif SUPPORT_REMOTE}
|
||
{ Switch to user screen to get correct handles }
|
||
UserScreen;
|
||
{ Don't try to print GDB messages while in User Screen mode }
|
||
If assigned(GDBWindow) then
|
||
GDBWindow^.Editor^.Lock;
|
||
{$ifdef SUPPORT_REMOTE}
|
||
if isRemoteDebugging then
|
||
begin
|
||
inc(init_count);
|
||
{ pass the stop in start code }
|
||
Command('continue');
|
||
end else
|
||
{$endif SUPPORT_REMOTE}
|
||
{ Set cwd for debuggee }
|
||
SetDir(GetRunDir);
|
||
inherited Run;
|
||
{ Restore cwd for IDE }
|
||
SetDir(StartupDir);
|
||
DebuggerScreen;
|
||
If assigned(GDBWindow) then
|
||
GDBWindow^.Editor^.UnLock;
|
||
IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
|
||
IDEApp.UpdateRunMenu(true);
|
||
UpdateDebugViews;
|
||
end;
|
||
|
||
|
||
function TDebugController.IsRunning : boolean;
|
||
begin
|
||
IsRunning:=debuggee_started;
|
||
end;
|
||
|
||
procedure TDebugController.Continue;
|
||
begin
|
||
{$ifdef NODEBUG}
|
||
NoDebugger;
|
||
{$else}
|
||
if not debuggee_started then
|
||
Run
|
||
else
|
||
inherited Continue;
|
||
UpdateDebugViews;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
procedure TDebugController.UntilReturn;
|
||
begin
|
||
Command('finish');
|
||
UpdateDebugViews;
|
||
{ We could try to get the return value !
|
||
Not done yet }
|
||
end;
|
||
|
||
|
||
procedure TDebugController.CommandBegin(const s:string);
|
||
begin
|
||
if assigned(GDBWindow) and (in_command>1) then
|
||
begin
|
||
{ We should do something special for errors !! }
|
||
If StrLen(GetError)>0 then
|
||
GDBWindow^.WriteErrorText(GetError);
|
||
GDBWindow^.WriteOutputText(GetOutput);
|
||
end;
|
||
if assigned(GDBWindow) then
|
||
GDBWindow^.WriteString(S);
|
||
end;
|
||
|
||
procedure TDebugController.CommandEnd(const s:string);
|
||
begin
|
||
if assigned(GDBWindow) and (in_command<=1) then
|
||
begin
|
||
{ We should do something special for errors !! }
|
||
If StrLen(GetError)>0 then
|
||
GDBWindow^.WriteErrorText(GetError);
|
||
GDBWindow^.WriteOutputText(GetOutput);
|
||
GDBWindow^.Editor^.TextEnd;
|
||
end;
|
||
end;
|
||
|
||
function TDebugController.AllowQuit : boolean;
|
||
begin
|
||
if IsRunning then
|
||
begin
|
||
if ConfirmBox('Really quit GDB window'#13+
|
||
'and kill running program?',nil,true)=cmYes then
|
||
begin
|
||
Reset;
|
||
DoneGDBWindow;
|
||
{AllowQuit:=true;}
|
||
AllowQuit:=false;
|
||
end
|
||
else
|
||
AllowQuit:=false;
|
||
end
|
||
else if ConfirmBox('Really quit GDB window?',nil,true)=cmYes then
|
||
begin
|
||
DoneGDBWindow;
|
||
{AllowQuit:=true;}
|
||
AllowQuit:=false;
|
||
end
|
||
else
|
||
AllowQuit:=false;
|
||
end;
|
||
|
||
procedure TDebugController.ResetDebuggerRows;
|
||
procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
|
||
begin
|
||
if assigned(P) and
|
||
(TypeOf(P^)=TypeOf(TSourceWindow)) then
|
||
PSourceWindow(P)^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
|
||
end;
|
||
|
||
begin
|
||
Desktop^.ForEach(@ResetDebuggerRow);
|
||
end;
|
||
|
||
procedure TDebugController.Reset;
|
||
begin
|
||
inherited Reset;
|
||
{ we need to free the executable
|
||
if we want to recompile it }
|
||
SetExe('');
|
||
NoSwitch:=false;
|
||
{ In case we have something that the compiler touched }
|
||
If IDEApp.IsRunning then
|
||
begin
|
||
IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
|
||
IDEApp.UpdateRunMenu(false);
|
||
AskToReloadAllModifiedFiles;
|
||
ResetDebuggerRows;
|
||
end;
|
||
end;
|
||
|
||
procedure TDebugController.AnnotateError;
|
||
var errornb : longint;
|
||
begin
|
||
if error then
|
||
begin
|
||
errornb:=error_num;
|
||
UpdateDebugViews;
|
||
ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
|
||
end;
|
||
end;
|
||
|
||
function TDebugController.GetValue(Const expr : string) : pchar;
|
||
var
|
||
p,p2,p3 : pchar;
|
||
begin
|
||
if WindowWidth<>-1 then
|
||
Command('set width 0xffffffff');
|
||
Command('p '+expr);
|
||
p:=GetOutput;
|
||
p3:=nil;
|
||
if assigned(p) and (p[strlen(p)-1]=#10) then
|
||
begin
|
||
p3:=p+strlen(p)-1;
|
||
p3^:=#0;
|
||
end;
|
||
if assigned(p) then
|
||
p2:=strpos(p,'=')
|
||
else
|
||
p2:=nil;
|
||
if assigned(p2) then
|
||
p:=p2+1;
|
||
while p^ in [' ',TAB] do
|
||
inc(p);
|
||
{ get rid of type }
|
||
if p^ = '(' then
|
||
p:=strpos(p,')')+1;
|
||
while p^ in [' ',TAB] do
|
||
inc(p);
|
||
if assigned(p) then
|
||
GetValue:=StrNew(p)
|
||
else
|
||
GetValue:=StrNew(GetError);
|
||
if assigned(p3) then
|
||
p3^:=#10;
|
||
got_error:=false;
|
||
if WindowWidth<>-1 then
|
||
Command('set width '+IntToStr(WindowWidth));
|
||
end;
|
||
|
||
function TDebugController.GetFramePointer : CORE_ADDR;
|
||
var
|
||
st : string;
|
||
p : longint;
|
||
begin
|
||
{$ifdef FrameNameKnown}
|
||
Command('p /d '+FrameName);
|
||
st:=strpas(GetOutput);
|
||
p:=pos('=',st);
|
||
while (p<length(st)) and (st[p+1] in [' ',#9]) do
|
||
inc(p);
|
||
Delete(st,1,p);
|
||
p:=1;
|
||
while (st[p] in ['0'..'9']) do
|
||
inc(p);
|
||
Delete(st,p,High(st));
|
||
GetFramePointer:=StrToCard(st);
|
||
{$else not FrameNameKnown}
|
||
GetFramePointer:=0;
|
||
{$endif not FrameNameKnown}
|
||
end;
|
||
|
||
function TDebugController.GetLongintAt(addr : CORE_ADDR) : longint;
|
||
var
|
||
st : string;
|
||
p : longint;
|
||
begin
|
||
Command('x /wd 0x'+hexstr(longint(addr),8));
|
||
st:=strpas(GetOutput);
|
||
p:=pos(':',st);
|
||
while (p<length(st)) and (st[p+1] in [' ',#9]) do
|
||
inc(p);
|
||
Delete(st,1,p);
|
||
p:=1;
|
||
while (st[p] in ['0'..'9']) do
|
||
inc(p);
|
||
Delete(st,p,High(st));
|
||
GetLongintAt:=StrToInt(st);
|
||
end;
|
||
|
||
function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
|
||
var
|
||
st : string;
|
||
p : longint;
|
||
begin
|
||
Command('x /wx 0x'+hexstr(longint(addr),8));
|
||
st:=strpas(GetOutput);
|
||
p:=pos(':',st);
|
||
while (p<length(st)) and (st[p+1] in [' ',#9]) do
|
||
inc(p);
|
||
if (p<length(st)) and (st[p+1]='$') then
|
||
inc(p);
|
||
Delete(st,1,p);
|
||
p:=1;
|
||
while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
|
||
inc(p);
|
||
Delete(st,p,High(st));
|
||
GetPointerAt:=HexToCard(st);
|
||
end;
|
||
|
||
procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
|
||
var
|
||
W: PSourceWindow;
|
||
Found : boolean;
|
||
PB : PBreakpoint;
|
||
S : String;
|
||
BreakIndex : longint;
|
||
stop_addr : CORE_ADDR;
|
||
i,ExitCode : longint;
|
||
ExitAddr,ExitFrame : CORE_ADDR;
|
||
const
|
||
{ try to find the parameters }
|
||
FirstArgOffset = -sizeof(pointer);
|
||
SecondArgOffset = 2*-sizeof(pointer);
|
||
ThirdArgOffset = 3*-sizeof(pointer);
|
||
|
||
begin
|
||
BreakIndex:=stop_breakpoint_number;
|
||
Desktop^.Lock;
|
||
{ 0 based line count in Editor }
|
||
if Line>0 then
|
||
dec(Line);
|
||
|
||
S:=fn;
|
||
stop_addr:=current_pc;
|
||
|
||
if (BreakIndex=FPCBreakErrorNumber) then
|
||
begin
|
||
{ Procedure HandleErrorAddrFrame
|
||
(Errno : longint;addr,frame : longint);
|
||
[public,alias:'FPC_BREAK_ERROR']; }
|
||
{$ifdef FrameNameKnown}
|
||
ExitCode:=GetLongintAt(GetFramePointer+FirstArgOffset);
|
||
ExitAddr:=GetPointerAt(GetFramePointer+SecondArgOffset);
|
||
ExitFrame:=GetPointerAt(GetFramePointer+ThirdArgOffset);
|
||
if (ExitCode=0) and (ExitAddr=0) then
|
||
begin
|
||
Desktop^.Unlock;
|
||
Command('continue');
|
||
exit;
|
||
end;
|
||
{ forget all old frames }
|
||
clear_frames;
|
||
{ record new frames }
|
||
Command('backtrace');
|
||
for i:=0 to frame_count-1 do
|
||
begin
|
||
with frames[i]^ do
|
||
begin
|
||
if ExitAddr=address then
|
||
begin
|
||
Command('f '+IntToStr(i));
|
||
if assigned(file_name) then
|
||
begin
|
||
s:=strpas(file_name);
|
||
line:=line_number;
|
||
stop_addr:=address;
|
||
end;
|
||
break;
|
||
end;
|
||
end;
|
||
end;
|
||
{$endif FrameNameKnown}
|
||
end;
|
||
{ Update Disassembly position }
|
||
if Assigned(DisassemblyWindow) then
|
||
DisassemblyWindow^.SetCurAddress(stop_addr);
|
||
|
||
if (fn=LastFileName) then
|
||
begin
|
||
W:=PSourceWindow(LastSource);
|
||
if assigned(W) then
|
||
begin
|
||
W^.Editor^.SetCurPtr(0,Line);
|
||
W^.Editor^.TrackCursor(CenterDebuggerRow);
|
||
W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
|
||
UpdateDebugViews;
|
||
|
||
{if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
|
||
handled by SelectInDebugSession}
|
||
W^.SelectInDebugSession;
|
||
InvalidSourceLine:=false;
|
||
end
|
||
else
|
||
InvalidSourceLine:=true;
|
||
end
|
||
else
|
||
begin
|
||
if s='' then
|
||
W:=nil
|
||
else
|
||
W:=TryToOpenFile(nil,s,0,Line,false);
|
||
if assigned(W) then
|
||
begin
|
||
W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
|
||
W^.Editor^.TrackCursor(CenterDebuggerRow);
|
||
UpdateDebugViews;
|
||
{if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
|
||
handled by SelectInDebugSession}
|
||
W^.SelectInDebugSession;
|
||
LastSource:=W;
|
||
InvalidSourceLine:=false;
|
||
end
|
||
{ only search a file once }
|
||
else
|
||
begin
|
||
Desktop^.UnLock;
|
||
if s='' then
|
||
Found:=false
|
||
else
|
||
{ it is easier to handle with a * at the end }
|
||
Found:=IDEApp.OpenSearch(s+'*');
|
||
Desktop^.Lock;
|
||
if not Found then
|
||
begin
|
||
InvalidSourceLine:=true;
|
||
LastSource:=Nil;
|
||
{ Show the stack in that case }
|
||
InitStackWindow;
|
||
UpdateDebugViews;
|
||
StackWindow^.MakeFirst;
|
||
end
|
||
else
|
||
begin
|
||
{ should now be open }
|
||
W:=TryToOpenFile(nil,s,0,Line,true);
|
||
W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,Line);
|
||
W^.Editor^.TrackCursor(CenterDebuggerRow);
|
||
UpdateDebugViews;
|
||
{if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
|
||
handled by SelectInDebugSession}
|
||
W^.SelectInDebugSession;
|
||
LastSource:=W;
|
||
InvalidSourceLine:=false;
|
||
end;
|
||
end;
|
||
end;
|
||
LastFileName:=s;
|
||
Desktop^.UnLock;
|
||
if BreakIndex>0 then
|
||
begin
|
||
PB:=BreakpointsCollection^.GetGDB(BreakIndex);
|
||
if (BreakIndex=FPCBreakErrorNumber) then
|
||
begin
|
||
if (ExitCode<>0) or (ExitAddr<>0) then
|
||
WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
|
||
#3'Error address $'+IntToHex(ExitAddr,8),nil)
|
||
else
|
||
WarningBox(#3'Run Time Error',nil);
|
||
end
|
||
else if not assigned(PB) then
|
||
begin
|
||
WarningBox(#3'Stopped by breakpoint '+IntToStr(BreakIndex),nil);
|
||
end
|
||
{ For watch we should get old and new value !! }
|
||
else if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
|
||
(PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) and
|
||
(PB^.typ<>bt_address) then
|
||
begin
|
||
Command('p '+GetStr(PB^.Name));
|
||
S:=GetPChar(GetOutput);
|
||
got_error:=false;
|
||
If Pos('=',S)>0 then
|
||
S:=Copy(S,Pos('=',S)+1,255);
|
||
If S[Length(S)]=#10 then
|
||
Delete(S,Length(S),1);
|
||
if Assigned(PB^.OldValue) then
|
||
DisposeStr(PB^.OldValue);
|
||
PB^.OldValue:=PB^.CurrentValue;
|
||
PB^.CurrentValue:=NewStr(S);
|
||
If PB^.typ=bt_function then
|
||
WarningBox(#3'GDB stopped due to'#13+
|
||
#3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
|
||
else if (GetStr(PB^.OldValue)<>S) then
|
||
WarningBox(#3'GDB stopped due to'#13+
|
||
#3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
|
||
#3+'Old value = '+GetStr(PB^.OldValue)+#13+
|
||
#3+'New value = '+GetStr(PB^.CurrentValue),nil)
|
||
else
|
||
WarningBox(#3'GDB stopped due to'#13+
|
||
#3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
|
||
#3+' value = '+GetStr(PB^.CurrentValue),nil);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TDebugController.DoUserSignal;
|
||
var P :Array[1..2] of pstring;
|
||
S1, S2 : string;
|
||
begin
|
||
S1:=strpas(signal_name);
|
||
S2:=strpas(signal_string);
|
||
P[1]:=@S1;
|
||
P[2]:=@S2;
|
||
WarningBox(msg_programsignal,@P);
|
||
end;
|
||
|
||
procedure TDebugController.DoEndSession(code:longint);
|
||
var P :Array[1..2] of longint;
|
||
begin
|
||
IDEApp.SetCmdState([cmUntilReturn,cmResetDebugger],false);
|
||
IDEApp.UpdateRunMenu(false);
|
||
ResetDebuggerRows;
|
||
LastExitCode:=Code;
|
||
If HiddenStepsCount=0 then
|
||
InformationBox(msg_programexitedwithexitcode,@code)
|
||
else
|
||
begin
|
||
P[1]:=code;
|
||
P[2]:=HiddenStepsCount;
|
||
WarningBox(msg_programexitedwithcodeandsteps,@P);
|
||
end;
|
||
{ In case we have something that the compiler touched }
|
||
AskToReloadAllModifiedFiles;
|
||
{$ifdef win32}
|
||
main_pid_valid:=false;
|
||
{$endif win32}
|
||
end;
|
||
|
||
|
||
procedure TDebugController.DoDebuggerScreen;
|
||
{$ifdef win32}
|
||
var
|
||
IdeMode : DWord;
|
||
{$endif win32}
|
||
begin
|
||
if NoSwitch then
|
||
begin
|
||
PopStatus;
|
||
end
|
||
else
|
||
begin
|
||
IDEApp.ShowIDEScreen;
|
||
Message(Application,evBroadcast,cmDebuggerStopped,pointer(ptrint(RunCount)));
|
||
PopStatus;
|
||
end;
|
||
{$ifdef win32}
|
||
if NoSwitch then
|
||
begin
|
||
{ Ctrl-C as normal char }
|
||
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
|
||
IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_WINDOW_INPUT) and not ENABLE_PROCESSED_INPUT;
|
||
SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
|
||
end;
|
||
ChangeDebuggeeWindowTitleTo(Stopped_State);
|
||
{$endif win32}
|
||
end;
|
||
|
||
|
||
procedure TDebugController.DoUserScreen;
|
||
|
||
{$ifdef win32}
|
||
var
|
||
IdeMode : DWord;
|
||
{$endif win32}
|
||
begin
|
||
Inc(RunCount);
|
||
if NoSwitch then
|
||
begin
|
||
{$ifdef SUPPORT_REMOTE}
|
||
PushStatus(msg_runningremotely+RemoteMachine);
|
||
{$else not SUPPORT_REMOTE}
|
||
{$ifdef Unix}
|
||
PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
|
||
{$else not Unix}
|
||
PushStatus(msg_runninginanotherwindow);
|
||
{$endif Unix}
|
||
{$endif not SUPPORT_REMOTE}
|
||
end
|
||
else
|
||
begin
|
||
PushStatus(msg_runningprogram);
|
||
IDEApp.ShowUserScreen;
|
||
end;
|
||
{$ifdef win32}
|
||
if NoSwitch then
|
||
begin
|
||
{ Ctrl-C as interrupt }
|
||
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @IdeMode);
|
||
IdeMode:=(IdeMode or ENABLE_MOUSE_INPUT or ENABLE_PROCESSED_INPUT or ENABLE_WINDOW_INPUT);
|
||
SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
|
||
end;
|
||
ChangeDebuggeeWindowTitleTo(Running_State);
|
||
{$endif win32}
|
||
end;
|
||
|
||
{$endif NODEBUG}
|
||
|
||
|
||
{****************************************************************************
|
||
TBreakpoint
|
||
****************************************************************************}
|
||
|
||
function ActiveBreakpoints : boolean;
|
||
var
|
||
IsActive : boolean;
|
||
|
||
procedure TestActive(PB : PBreakpoint);
|
||
begin
|
||
If PB^.state=bs_enabled then
|
||
IsActive:=true;
|
||
end;
|
||
begin
|
||
IsActive:=false;
|
||
If assigned(BreakpointsCollection) then
|
||
BreakpointsCollection^.ForEach(@TestActive);
|
||
ActiveBreakpoints:=IsActive;
|
||
end;
|
||
|
||
|
||
constructor TBreakpoint.Init_function(Const AFunc : String);
|
||
begin
|
||
typ:=bt_function;
|
||
state:=bs_enabled;
|
||
GDBState:=bs_deleted;
|
||
Name:=NewStr(AFunc);
|
||
FileName:=nil;
|
||
Line:=0;
|
||
IgnoreCount:=0;
|
||
Commands:=nil;
|
||
Conditions:=nil;
|
||
OldValue:=nil;
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
constructor TBreakpoint.Init_Address(Const AAddress : String);
|
||
begin
|
||
typ:=bt_address;
|
||
state:=bs_enabled;
|
||
GDBState:=bs_deleted;
|
||
Name:=NewStr(AAddress);
|
||
FileName:=nil;
|
||
Line:=0;
|
||
IgnoreCount:=0;
|
||
Commands:=nil;
|
||
Conditions:=nil;
|
||
OldValue:=nil;
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
constructor TBreakpoint.Init_Empty;
|
||
begin
|
||
typ:=bt_function;
|
||
state:=bs_enabled;
|
||
GDBState:=bs_deleted;
|
||
Name:=Nil;
|
||
FileName:=nil;
|
||
Line:=0;
|
||
IgnoreCount:=0;
|
||
Commands:=nil;
|
||
Conditions:=nil;
|
||
OldValue:=nil;
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
|
||
begin
|
||
typ:=atyp;
|
||
state:=bs_enabled;
|
||
GDBState:=bs_deleted;
|
||
Name:=NewStr(AnExpr);
|
||
IgnoreCount:=0;
|
||
Commands:=nil;
|
||
Conditions:=nil;
|
||
OldValue:=nil;
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
|
||
var
|
||
CurDir : String;
|
||
begin
|
||
typ:=bt_file_line;
|
||
state:=bs_enabled;
|
||
GDBState:=bs_deleted;
|
||
AFile:=FEXpand(AFile);
|
||
(*
|
||
{ d:test.pas:12 does not work !! }
|
||
{ I do not know how to solve this if
|
||
if (Length(AFile)>1) and (AFile[2]=':') then
|
||
AFile:=Copy(AFile,3,255); }
|
||
{$ifdef Unix}
|
||
CurDir:=GetCurDir;
|
||
{$else}
|
||
CurDir:=LowerCaseStr(GetCurDir);
|
||
{$endif Unix}
|
||
if Pos(CurDir,OSFileName(AFile))=1 then
|
||
FileName:=NewStr(Copy(OSFileName(AFile),length(CurDir)+1,255))
|
||
else
|
||
*)
|
||
FileName:=NewStr(OSFileName(AFile));
|
||
Name:=nil;
|
||
Line:=ALine;
|
||
IgnoreCount:=0;
|
||
Commands:=nil;
|
||
Conditions:=nil;
|
||
OldValue:=nil;
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
constructor TBreakpoint.Load(var S: TStream);
|
||
var
|
||
FName : PString;
|
||
begin
|
||
S.Read(typ,SizeOf(BreakpointType));
|
||
S.Read(state,SizeOf(BreakpointState));
|
||
GDBState:=bs_deleted;
|
||
case typ of
|
||
bt_file_line :
|
||
begin
|
||
{ convert to current target }
|
||
FName:=S.ReadStr;
|
||
FileName:=NewStr(OSFileName(GetStr(FName)));
|
||
If Assigned(FName) then
|
||
DisposeStr(FName);
|
||
S.Read(Line,SizeOf(Line));
|
||
Name:=nil;
|
||
end;
|
||
else
|
||
begin
|
||
Name:=S.ReadStr;
|
||
Line:=0;
|
||
FileName:=nil;
|
||
end;
|
||
end;
|
||
S.Read(IgnoreCount,SizeOf(IgnoreCount));
|
||
Commands:=S.StrRead;
|
||
Conditions:=S.ReadStr;
|
||
OldValue:=nil;
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
procedure TBreakpoint.Store(var S: TStream);
|
||
var
|
||
St : String;
|
||
begin
|
||
S.Write(typ,SizeOf(BreakpointType));
|
||
S.Write(state,SizeOf(BreakpointState));
|
||
case typ of
|
||
bt_file_line :
|
||
begin
|
||
st:=OSFileName(GetStr(FileName));
|
||
S.WriteStr(@St);
|
||
S.Write(Line,SizeOf(Line));
|
||
end;
|
||
else
|
||
begin
|
||
S.WriteStr(Name);
|
||
end;
|
||
end;
|
||
S.Write(IgnoreCount,SizeOf(IgnoreCount));
|
||
S.StrWrite(Commands);
|
||
S.WriteStr(Conditions);
|
||
end;
|
||
|
||
procedure TBreakpoint.Insert;
|
||
var
|
||
p,p2 : pchar;
|
||
st : string;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
If not assigned(Debugger) then Exit;
|
||
Remove;
|
||
Debugger^.last_breakpoint_number:=0;
|
||
if (GDBState=bs_deleted) and (state=bs_enabled) then
|
||
begin
|
||
if (typ=bt_file_line) and assigned(FileName) then
|
||
Debugger^.Command('break '+GDBFileName(NameAndExtOf(GetStr(FileName)))+':'+IntToStr(Line))
|
||
else if (typ=bt_function) and assigned(name) then
|
||
Debugger^.Command('break '+name^)
|
||
else if (typ=bt_address) and assigned(name) then
|
||
Debugger^.Command('break *0x'+name^)
|
||
else if (typ=bt_watch) and assigned(name) then
|
||
Debugger^.Command('watch '+name^)
|
||
else if (typ=bt_awatch) and assigned(name) then
|
||
Debugger^.Command('awatch '+name^)
|
||
else if (typ=bt_rwatch) and assigned(name) then
|
||
Debugger^.Command('rwatch '+name^);
|
||
if Debugger^.last_breakpoint_number<>0 then
|
||
begin
|
||
GDBIndex:=Debugger^.last_breakpoint_number;
|
||
GDBState:=bs_enabled;
|
||
Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
|
||
If IgnoreCount>0 then
|
||
Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
|
||
If Assigned(Commands) then
|
||
begin
|
||
{Commands are not handled yet }
|
||
Debugger^.Command('command '+IntToStr(GDBIndex));
|
||
p:=commands;
|
||
while assigned(p) do
|
||
begin
|
||
p2:=strscan(p,#10);
|
||
if assigned(p2) then
|
||
p2^:=#0;
|
||
st:=strpas(p);
|
||
Debugger^.command(st);
|
||
if assigned(p2) then
|
||
p2^:=#10;
|
||
p:=p2;
|
||
if assigned(p) then
|
||
inc(p);
|
||
end;
|
||
Debugger^.Command('end');
|
||
end;
|
||
end
|
||
else
|
||
{ Here there was a problem !! }
|
||
begin
|
||
GDBIndex:=0;
|
||
if not Debugger^.Disableallinvalidbreakpoints then
|
||
begin
|
||
if (typ=bt_file_line) and assigned(FileName) then
|
||
begin
|
||
ClearFormatParams;
|
||
AddFormatParamStr(NameAndExtOf(FileName^));
|
||
AddFormatParamInt(Line);
|
||
if ChoiceBox(msg_couldnotsetbreakpointat,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
|
||
Debugger^.Disableallinvalidbreakpoints:=true;
|
||
end
|
||
else
|
||
begin
|
||
ClearFormatParams;
|
||
AddFormatParamStr(BreakpointTypeStr[typ]);
|
||
AddFormatParamStr(GetStr(Name));
|
||
if ChoiceBox(msg_couldnotsetbreakpointtype,@FormatParams,[btn_ok,button_DisableAllBreakpoints],false)=cmUserBtn2 then
|
||
Debugger^.Disableallinvalidbreakpoints:=true;
|
||
end;
|
||
end;
|
||
state:=bs_disabled;
|
||
UpdateSource;
|
||
end;
|
||
end
|
||
else if (GDBState=bs_disabled) and (state=bs_enabled) then
|
||
Enable
|
||
else if (GDBState=bs_enabled) and (state=bs_disabled) then
|
||
Disable;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
procedure TBreakpoint.Remove;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
If not assigned(Debugger) then Exit;
|
||
if GDBIndex>0 then
|
||
Debugger^.Command('delete '+IntToStr(GDBIndex));
|
||
GDBIndex:=0;
|
||
GDBState:=bs_deleted;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
procedure TBreakpoint.Enable;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
If not assigned(Debugger) then Exit;
|
||
if GDBIndex>0 then
|
||
Debugger^.Command('enable '+IntToStr(GDBIndex))
|
||
else
|
||
Insert;
|
||
GDBState:=bs_disabled;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
procedure TBreakpoint.Disable;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
If not assigned(Debugger) then Exit;
|
||
if GDBIndex>0 then
|
||
Debugger^.Command('disable '+IntToStr(GDBIndex));
|
||
GDBState:=bs_disabled;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
procedure TBreakpoint.ResetValues;
|
||
begin
|
||
if assigned(OldValue) then
|
||
DisposeStr(OldValue);
|
||
OldValue:=nil;
|
||
if assigned(CurrentValue) then
|
||
DisposeStr(CurrentValue);
|
||
CurrentValue:=nil;
|
||
end;
|
||
|
||
procedure TBreakpoint.UpdateSource;
|
||
var W: PSourceWindow;
|
||
b : boolean;
|
||
begin
|
||
if typ=bt_file_line then
|
||
begin
|
||
W:=SearchOnDesktop(OSFileName(GetStr(FileName)),false);
|
||
If assigned(W) then
|
||
begin
|
||
if state=bs_enabled then
|
||
b:=true
|
||
else
|
||
b:=false;
|
||
W^.Editor^.SetLineFlagState(Line-1,lfBreakpoint,b);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
destructor TBreakpoint.Done;
|
||
begin
|
||
Remove;
|
||
ResetValues;
|
||
if assigned(Name) then
|
||
DisposeStr(Name);
|
||
if assigned(FileName) then
|
||
DisposeStr(FileName);
|
||
if assigned(Conditions) then
|
||
DisposeStr(Conditions);
|
||
if assigned(Commands) then
|
||
StrDispose(Commands);
|
||
inherited Done;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TBreakpointCollection
|
||
****************************************************************************}
|
||
|
||
function TBreakpointCollection.At(Index: Integer): PBreakpoint;
|
||
begin
|
||
At:=inherited At(Index);
|
||
end;
|
||
|
||
|
||
procedure TBreakpointCollection.Update;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
if assigned(Debugger) then
|
||
begin
|
||
Debugger^.RemoveBreakpoints;
|
||
Debugger^.InsertBreakpoints;
|
||
end;
|
||
{$endif NODEBUG}
|
||
if assigned(BreakpointsWindow) then
|
||
BreakpointsWindow^.Update;
|
||
end;
|
||
|
||
function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
|
||
|
||
function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
|
||
begin
|
||
IsNum:=P^.GDBIndex=index;
|
||
end;
|
||
|
||
begin
|
||
if index=0 then
|
||
GetGDB:=nil
|
||
else
|
||
GetGDB:=FirstThat(@IsNum);
|
||
end;
|
||
|
||
procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
|
||
|
||
procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
|
||
begin
|
||
If assigned(P^.FileName) and
|
||
(OSFileName(P^.FileName^)=OSFileName(FExpand(PSourceWindow(W)^.Editor^.FileName))) then
|
||
PSourceWindow(W)^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
|
||
end;
|
||
|
||
procedure SetInDisassembly(P : PBreakpoint);{$ifndef FPC}far;{$endif}
|
||
var
|
||
PDL : PDisasLine;
|
||
S : string;
|
||
ps,qs,i : longint;
|
||
begin
|
||
for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
|
||
begin
|
||
PDL:=PDisasLine(PDisassemblyWindow(W)^.Editor^.GetLine(i));
|
||
if PDL^.Address=0 then
|
||
begin
|
||
if (P^.typ=bt_file_line) then
|
||
begin
|
||
S:=PDisassemblyWindow(W)^.Editor^.GetDisplayText(i);
|
||
ps:=pos(':',S);
|
||
qs:=pos(' ',copy(S,ps+1,High(S)));
|
||
if (GDBFileName(P^.FileName^)=GDBFileName(FExpand(Copy(S,1,ps-1)))) and
|
||
(StrToInt(copy(S,ps+1,qs-1))=P^.line) then
|
||
PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
If (P^.typ=bt_address) and (PDL^.Address=HexToCard(P^.Name^)) then
|
||
PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
if W=PFPWindow(DisassemblyWindow) then
|
||
ForEach(@SetInDisassembly)
|
||
else
|
||
ForEach(@SetInSource);
|
||
end;
|
||
|
||
|
||
procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Change : longint);
|
||
|
||
procedure AdaptInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
|
||
begin
|
||
If assigned(P^.FileName) and
|
||
(P^.FileName^=OSFileName(FExpand(Editor^.FileName))) then
|
||
begin
|
||
if P^.state=bs_enabled then
|
||
Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,false);
|
||
if P^.Line-1>=Pos then
|
||
begin
|
||
if (Change>0) or (P^.Line-1>=Pos-Change) then
|
||
P^.line:=P^.Line+Change
|
||
else
|
||
begin
|
||
{ removing inside a ForEach call leads to problems }
|
||
{ so we do that after PM }
|
||
P^.state:=bs_delete_after;
|
||
end;
|
||
end;
|
||
if P^.state=bs_enabled then
|
||
Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,true);
|
||
end;
|
||
end;
|
||
|
||
var
|
||
I : longint;
|
||
begin
|
||
ForEach(@AdaptInSource);
|
||
I:=Count-1;
|
||
While (I>=0) do
|
||
begin
|
||
if At(I)^.state=bs_delete_after then
|
||
AtFree(I);
|
||
Dec(I);
|
||
end;
|
||
end;
|
||
|
||
function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : longint) : PBreakpoint;
|
||
|
||
function IsAtLine(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
|
||
begin
|
||
If assigned(P^.FileName) and
|
||
(P^.FileName^=OSFileName(FExpand(Editor^.FileName))) and
|
||
(Line=P^.Line) then
|
||
IsAtLine:=true
|
||
else
|
||
IsAtLine:=false;
|
||
end;
|
||
|
||
begin
|
||
FindBreakpointAt:=FirstThat(@IsAtLine);
|
||
end;
|
||
|
||
procedure TBreakpointCollection.ShowAllBreakpoints;
|
||
|
||
procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
|
||
var
|
||
W : PSourceWindow;
|
||
begin
|
||
If assigned(P^.FileName) then
|
||
begin
|
||
W:=SearchOnDesktop(P^.FileName^,false);
|
||
if assigned(W) then
|
||
W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
ForEach(@SetInSource);
|
||
end;
|
||
|
||
function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
|
||
|
||
function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
|
||
begin
|
||
IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
|
||
end;
|
||
|
||
begin
|
||
GetType:=FirstThat(@IsThis);
|
||
end;
|
||
|
||
|
||
function TBreakpointCollection.ToggleFileLine(FileName: String;LineNr : Longint) : boolean;
|
||
|
||
function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
|
||
begin
|
||
IsThere:=(P^.typ=bt_file_line) and assigned(P^.FileName) and
|
||
(OSFileName(P^.FileName^)=FileName) and (P^.Line=LineNr);
|
||
end;
|
||
|
||
var
|
||
PB : PBreakpoint;
|
||
begin
|
||
ToggleFileLine:=false;
|
||
FileName:=OSFileName(FExpand(FileName));
|
||
PB:=FirstThat(@IsThere);
|
||
If Assigned(PB) then
|
||
begin
|
||
{ delete it form source window }
|
||
PB^.state:=bs_disabled;
|
||
PB^.UpdateSource;
|
||
{ remove from collection }
|
||
BreakpointsCollection^.free(PB);
|
||
end
|
||
else
|
||
begin
|
||
PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
|
||
if assigned(PB) then
|
||
Begin
|
||
Insert(PB);
|
||
PB^.UpdateSource;
|
||
ToggleFileLine:=true;
|
||
End;
|
||
end;
|
||
Update;
|
||
end;
|
||
|
||
|
||
|
||
{****************************************************************************
|
||
TBreakpointItem
|
||
****************************************************************************}
|
||
|
||
constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
|
||
begin
|
||
inherited Init;
|
||
Breakpoint:=ABreakpoint;
|
||
end;
|
||
|
||
function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
|
||
var S: string;
|
||
begin
|
||
with Breakpoint^ do
|
||
begin
|
||
S:=BreakpointTypeStr[typ];
|
||
While Length(S)<10 do
|
||
S:=S+' ';
|
||
S:=S+'|';
|
||
S:=S+BreakpointStateStr[state]+' ';
|
||
While Length(S)<20 do
|
||
S:=S+' ';
|
||
S:=S+'|';
|
||
if (typ=bt_file_line) then
|
||
S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
|
||
else
|
||
S:=S+GetStr(name);
|
||
While Length(S)<40 do
|
||
S:=S+' ';
|
||
S:=S+'|';
|
||
if IgnoreCount>0 then
|
||
S:=S+IntToStr(IgnoreCount);
|
||
While Length(S)<49 do
|
||
S:=S+' ';
|
||
S:=S+'|';
|
||
if assigned(Conditions) then
|
||
S:=S+' '+GetStr(Conditions);
|
||
if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
|
||
GetText:=S;
|
||
end;
|
||
end;
|
||
|
||
procedure TBreakpointItem.Selected;
|
||
begin
|
||
end;
|
||
|
||
function TBreakpointItem.GetModuleName: string;
|
||
begin
|
||
if breakpoint^.typ=bt_file_line then
|
||
GetModuleName:=GetStr(breakpoint^.FileName)
|
||
else
|
||
GetModuleName:='';
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TBreakpointsListBox
|
||
****************************************************************************}
|
||
|
||
constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||
begin
|
||
inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
|
||
GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
|
||
NoSelection:=true;
|
||
end;
|
||
|
||
function TBreakpointsListBox.GetLocalMenu: PMenu;
|
||
var M: PMenu;
|
||
begin
|
||
if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
|
||
M:=NewMenu(
|
||
NewItem(menu_bplocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
|
||
NewItem(menu_bplocal_editbreakpoint,'',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
|
||
NewItem(menu_bplocal_newbreakpoint,'',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
|
||
NewItem(menu_bplocal_deletebreakpoint,'',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
|
||
NewItem(menu_bplocal_togglestate,'',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
|
||
nil))))));
|
||
GetLocalMenu:=M;
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
|
||
var DontClear: boolean;
|
||
begin
|
||
case Event.What of
|
||
evKeyDown :
|
||
begin
|
||
DontClear:=false;
|
||
case Event.KeyCode of
|
||
kbEnd :
|
||
FocusItem(List^.Count-1);
|
||
kbHome :
|
||
FocusItem(0);
|
||
kbEnter :
|
||
Message(@Self,evCommand,cmMsgGotoSource,nil);
|
||
kbIns :
|
||
Message(@Self,evCommand,cmNewBreakpoint,nil);
|
||
kbDel :
|
||
Message(@Self,evCommand,cmDeleteBreakpoint,nil);
|
||
else
|
||
DontClear:=true;
|
||
end;
|
||
if not DontClear then
|
||
ClearEvent(Event);
|
||
end;
|
||
evBroadcast :
|
||
case Event.Command of
|
||
cmListItemSelected :
|
||
if Event.InfoPtr=@Self then
|
||
Message(@Self,evCommand,cmEditBreakpoint,nil);
|
||
end;
|
||
evCommand :
|
||
begin
|
||
DontClear:=false;
|
||
case Event.Command of
|
||
cmMsgTrackSource :
|
||
if Range>0 then
|
||
TrackSource;
|
||
cmEditBreakpoint :
|
||
EditCurrent;
|
||
cmToggleBreakpoint :
|
||
ToggleCurrent;
|
||
cmDeleteBreakpoint :
|
||
DeleteCurrent;
|
||
cmNewBreakpoint :
|
||
EditNew;
|
||
cmMsgClear :
|
||
Clear;
|
||
else
|
||
DontClear:=true;
|
||
end;
|
||
if not DontClear then
|
||
ClearEvent(Event);
|
||
end;
|
||
end;
|
||
inherited HandleEvent(Event);
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
|
||
var W : integer;
|
||
begin
|
||
if List=nil then New(List, Init(20,20));
|
||
W:=length(P^.GetText(255));
|
||
if W>MaxWidth then
|
||
begin
|
||
MaxWidth:=W;
|
||
if HScrollBar<>nil then
|
||
HScrollBar^.SetRange(0,MaxWidth);
|
||
end;
|
||
List^.Insert(P);
|
||
SetRange(List^.Count);
|
||
if Focused=List^.Count-1-1 then
|
||
FocusItem(List^.Count-1);
|
||
P^.Breakpoint^.UpdateSource;
|
||
DrawView;
|
||
end;
|
||
|
||
function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
|
||
var P: PBreakpointItem;
|
||
S: string;
|
||
begin
|
||
P:=List^.At(Item);
|
||
S:=P^.GetText(MaxLen);
|
||
GetText:=copy(S,1,MaxLen);
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.Clear;
|
||
begin
|
||
if assigned(List) then
|
||
Dispose(List, Done);
|
||
List:=nil;
|
||
MaxWidth:=0;
|
||
SetRange(0); DrawView;
|
||
Message(Application,evBroadcast,cmClearLineHighlights,@Self);
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.TrackSource;
|
||
var W: PSourceWindow;
|
||
P: PBreakpointItem;
|
||
R: TRect;
|
||
begin
|
||
(*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
|
||
if Range=0 then Exit;*)
|
||
P:=List^.At(Focused);
|
||
if P^.GetModuleName='' then Exit;
|
||
Desktop^.Lock;
|
||
GetNextEditorBounds(R);
|
||
R.B.Y:=Owner^.Origin.Y;
|
||
W:=EditorWindowFile(P^.GetModuleName);
|
||
if assigned(W) then
|
||
begin
|
||
W^.GetExtent(R);
|
||
R.B.Y:=Owner^.Origin.Y;
|
||
W^.ChangeBounds(R);
|
||
W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
|
||
end
|
||
else
|
||
W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
|
||
if W<>nil then
|
||
begin
|
||
W^.Select;
|
||
W^.Editor^.TrackCursor(true);
|
||
W^.Editor^.SetLineFlagExclusive(lfHighlightRow,P^.Breakpoint^.Line);
|
||
end;
|
||
if Assigned(Owner) then
|
||
Owner^.Select;
|
||
Desktop^.UnLock;
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.ToggleCurrent;
|
||
var
|
||
P: PBreakpointItem;
|
||
begin
|
||
if Range=0 then Exit;
|
||
P:=List^.At(Focused);
|
||
if P=nil then Exit;
|
||
if P^.Breakpoint^.state=bs_enabled then
|
||
P^.Breakpoint^.state:=bs_disabled
|
||
else if P^.Breakpoint^.state=bs_disabled then
|
||
P^.Breakpoint^.state:=bs_enabled;
|
||
P^.Breakpoint^.UpdateSource;
|
||
BreakpointsCollection^.Update;
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.EditCurrent;
|
||
var
|
||
P: PBreakpointItem;
|
||
begin
|
||
if Range=0 then Exit;
|
||
P:=List^.At(Focused);
|
||
if P=nil then Exit;
|
||
Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
|
||
P^.Breakpoint^.UpdateSource;
|
||
BreakpointsCollection^.Update;
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.DeleteCurrent;
|
||
var
|
||
P: PBreakpointItem;
|
||
begin
|
||
if Range=0 then Exit;
|
||
P:=List^.At(Focused);
|
||
if P=nil then Exit;
|
||
{ delete it form source window }
|
||
P^.Breakpoint^.state:=bs_disabled;
|
||
P^.Breakpoint^.UpdateSource;
|
||
BreakpointsCollection^.free(P^.Breakpoint);
|
||
List^.free(P);
|
||
BreakpointsCollection^.Update;
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.EditNew;
|
||
var
|
||
P: PBreakpoint;
|
||
begin
|
||
P:=New(PBreakpoint,Init_Empty);
|
||
if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
|
||
begin
|
||
P^.UpdateSource;
|
||
BreakpointsCollection^.Insert(P);
|
||
BreakpointsCollection^.Update;
|
||
end
|
||
else
|
||
dispose(P,Done);
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.Draw;
|
||
var
|
||
I, J, Item: Sw_Integer;
|
||
NormalColor, SelectedColor, FocusedColor, Color: Word;
|
||
ColWidth, CurCol, Indent: Integer;
|
||
B: TDrawBuffer;
|
||
Text: String;
|
||
SCOff: Byte;
|
||
TC: byte;
|
||
procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
|
||
begin
|
||
if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
|
||
if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
|
||
begin
|
||
NormalColor := GetColor(1);
|
||
FocusedColor := GetColor(3);
|
||
SelectedColor := GetColor(4);
|
||
end else
|
||
begin
|
||
NormalColor := GetColor(2);
|
||
SelectedColor := GetColor(4);
|
||
end;
|
||
if Transparent then
|
||
begin MT(NormalColor); MT(SelectedColor); end;
|
||
if NoSelection then
|
||
SelectedColor:=NormalColor;
|
||
if HScrollBar <> nil then Indent := HScrollBar^.Value
|
||
else Indent := 0;
|
||
ColWidth := Size.X div NumCols + 1;
|
||
for I := 0 to Size.Y - 1 do
|
||
begin
|
||
for J := 0 to NumCols-1 do
|
||
begin
|
||
Item := J*Size.Y + I + TopItem;
|
||
CurCol := J*ColWidth;
|
||
if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
|
||
(Focused = Item) and (Range > 0) then
|
||
begin
|
||
Color := FocusedColor;
|
||
SetCursor(CurCol+1,I);
|
||
SCOff := 0;
|
||
end
|
||
else if (Item < Range) and IsSelected(Item) then
|
||
begin
|
||
Color := SelectedColor;
|
||
SCOff := 2;
|
||
end
|
||
else
|
||
begin
|
||
Color := NormalColor;
|
||
SCOff := 4;
|
||
end;
|
||
MoveChar(B[CurCol], ' ', Color, ColWidth);
|
||
if Item < Range then
|
||
begin
|
||
Text := GetText(Item, ColWidth + Indent);
|
||
Text := Copy(Text,Indent,ColWidth);
|
||
MoveStr(B[CurCol+1], Text, Color);
|
||
if ShowMarkers then
|
||
begin
|
||
WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
|
||
WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
|
||
end;
|
||
end;
|
||
MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
|
||
end;
|
||
WriteLine(0, I, Size.X, 1, B);
|
||
end;
|
||
end;
|
||
|
||
constructor TBreakpointsListBox.Load(var S: TStream);
|
||
begin
|
||
inherited Load(S);
|
||
end;
|
||
|
||
procedure TBreakpointsListBox.Store(var S: TStream);
|
||
var OL: PCollection;
|
||
OldR : integer;
|
||
begin
|
||
OL:=List;
|
||
OldR:=Range;
|
||
Range:=0;
|
||
New(List, Init(1,1));
|
||
|
||
inherited Store(S);
|
||
|
||
Dispose(List, Done);
|
||
Range:=OldR;
|
||
List:=OL;
|
||
{ ^^^ nasty trick - has anyone a better idea how to avoid storing the
|
||
collection? Pasting here a modified version of TListBox.Store+
|
||
TAdvancedListBox.Store isn't a better solution, since by eventually
|
||
changing the obj-hierarchy you'll always have to modify this, too - BG }
|
||
end;
|
||
|
||
destructor TBreakpointsListBox.Done;
|
||
begin
|
||
inherited Done;
|
||
if List<>nil then Dispose(List, Done);
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TBreakpointsWindow
|
||
****************************************************************************}
|
||
|
||
constructor TBreakpointsWindow.Init;
|
||
var R,R2: TRect;
|
||
HSB,VSB: PScrollBar;
|
||
ST: PStaticText;
|
||
S: String;
|
||
X,X1 : Sw_integer;
|
||
Btn: PButton;
|
||
const
|
||
NumButtons = 5;
|
||
begin
|
||
Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
|
||
inherited Init(R, dialog_breakpointlist, wnNoNumber);
|
||
|
||
HelpCtx:=hcBreakpointListWindow;
|
||
|
||
GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
|
||
S:=label_breakpointpropheader;
|
||
New(ST, Init(R,S));
|
||
ST^.GrowMode:=gfGrowHiX;
|
||
Insert(ST);
|
||
GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
|
||
New(ST, Init(R, CharStr('<27>', MaxViewWidth)));
|
||
ST^.GrowMode:=gfGrowHiX;
|
||
Insert(ST);
|
||
GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
|
||
R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
|
||
New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
|
||
HSB^.SetStep(R.B.X-R.A.X-2,1);
|
||
R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
|
||
New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
|
||
VSB^.SetStep(R.B.Y-R.A.Y-2,1);
|
||
New(BreakLB, Init(R,HSB,VSB));
|
||
BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
||
BreakLB^.Transparent:=true;
|
||
Insert(BreakLB);
|
||
GetExtent(R);R.Grow(-1,-1);
|
||
Dec(R.B.Y);
|
||
R.A.Y:=R.B.Y-2;
|
||
X:=(R.B.X-R.A.X) div NumButtons;
|
||
X1:=R.A.X+(X div 2);
|
||
R.A.X:=X1-3;R.B.X:=X1+7;
|
||
New(Btn, Init(R, button_Close, cmClose, bfDefault));
|
||
Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
|
||
Insert(Btn);
|
||
X1:=X1+X;
|
||
R.A.X:=X1-3;R.B.X:=X1+7;
|
||
New(Btn, Init(R, button_New, cmNewBreakpoint, bfNormal));
|
||
Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
|
||
Insert(Btn);
|
||
X1:=X1+X;
|
||
R.A.X:=X1-3;R.B.X:=X1+7;
|
||
New(Btn, Init(R, button_Edit, cmEditBreakpoint, bfNormal));
|
||
Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
|
||
Insert(Btn);
|
||
X1:=X1+X;
|
||
R.A.X:=X1-3;R.B.X:=X1+7;
|
||
New(Btn, Init(R, button_ToggleButton, cmToggleBreakInList, bfNormal));
|
||
Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
|
||
Insert(Btn);
|
||
X1:=X1+X;
|
||
R.A.X:=X1-3;R.B.X:=X1+7;
|
||
New(Btn, Init(R, button_Delete, cmDeleteBreakpoint, bfNormal));
|
||
Btn^.GrowMode:=gfGrowLoY+gfGrowHiY;
|
||
Insert(Btn);
|
||
BreakLB^.Select;
|
||
Update;
|
||
BreakpointsWindow:=@self;
|
||
end;
|
||
|
||
constructor TBreakpointsWindow.Load(var S: TStream);
|
||
begin
|
||
inherited Load(S);
|
||
GetSubViewPtr(S,BreakLB);
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.Store(var S: TStream);
|
||
begin
|
||
inherited Store(S);
|
||
PutSubViewPtr(S,BreakLB);
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
|
||
begin
|
||
BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.ClearBreakpoints;
|
||
begin
|
||
BreakLB^.Clear;
|
||
ReDraw;
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.ReloadBreakpoints;
|
||
procedure InsertInBreakLB(P : PBreakpoint);
|
||
begin
|
||
BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
|
||
end;
|
||
begin
|
||
If not assigned(BreakpointsCollection) then
|
||
exit;
|
||
BreakpointsCollection^.ForEach(@InsertInBreakLB);
|
||
ReDraw;
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
|
||
begin
|
||
inherited SizeLimits(Min,Max);
|
||
Min.X:=40; Min.Y:=18;
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.Close;
|
||
begin
|
||
Hide;
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
|
||
var DontClear : boolean;
|
||
begin
|
||
case Event.What of
|
||
evKeyDown :
|
||
begin
|
||
if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
|
||
begin
|
||
ClearEvent(Event);
|
||
Hide;
|
||
end;
|
||
end;
|
||
evCommand :
|
||
begin
|
||
DontClear:=False;
|
||
case Event.Command of
|
||
cmNewBreakpoint :
|
||
BreakLB^.EditNew;
|
||
cmEditBreakpoint :
|
||
BreakLB^.EditCurrent;
|
||
cmDeleteBreakpoint :
|
||
BreakLB^.DeleteCurrent;
|
||
cmToggleBreakInList :
|
||
BreakLB^.ToggleCurrent;
|
||
cmClose :
|
||
Hide;
|
||
else
|
||
DontClear:=true;
|
||
end;
|
||
if not DontClear then
|
||
ClearEvent(Event);
|
||
end;
|
||
evBroadcast :
|
||
case Event.Command of
|
||
cmUpdate :
|
||
Update;
|
||
end;
|
||
end;
|
||
inherited HandleEvent(Event);
|
||
end;
|
||
|
||
procedure TBreakpointsWindow.Update;
|
||
var
|
||
StoreFocus : longint;
|
||
begin
|
||
StoreFocus:=BreakLB^.Focused;
|
||
ClearBreakpoints;
|
||
ReloadBreakpoints;
|
||
If StoreFocus<BreakLB^.Range then
|
||
BreakLB^.FocusItem(StoreFocus);
|
||
end;
|
||
|
||
destructor TBreakpointsWindow.Done;
|
||
begin
|
||
inherited Done;
|
||
BreakpointsWindow:=nil;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TBreakpointItemDialog
|
||
****************************************************************************}
|
||
|
||
constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
|
||
var R,R2,R3: TRect;
|
||
Items: PSItem;
|
||
I : BreakpointType;
|
||
KeyCount: sw_integer;
|
||
begin
|
||
KeyCount:=longint(high(BreakpointType));
|
||
|
||
R.Assign(0,0,60,Max(9+KeyCount,18));
|
||
inherited Init(R,dialog_modifynewbreakpoint);
|
||
Breakpoint:=ABreakpoint;
|
||
|
||
GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
|
||
Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.B.X-3;
|
||
New(NameIL, Init(R, 255)); Insert(NameIL);
|
||
R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
|
||
Insert(New(PHistory, Init(R2, NameIL, hidBreakPointDialogName)));
|
||
R.Copy(R3); Inc(R.A.Y); R.B.Y:=R.A.Y+1;
|
||
R2.Copy(R); R2.Move(-1,-1);
|
||
Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
|
||
R.Move(0,3);
|
||
R.B.X:=R.B.X-3;
|
||
New(ConditionsIL, Init(R, 255)); Insert(ConditionsIL);
|
||
R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
|
||
Insert(New(PHistory, Init(R2, ConditionsIL, hidBreakPointDialogCond)));
|
||
R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
|
||
R.Move(0,3); R.B.X:=R.A.X+36;
|
||
New(LineIL, Init(R, 128)); Insert(LineIL);
|
||
LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
|
||
R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_line, LineIL)));
|
||
R.Move(0,3);
|
||
New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
|
||
IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
|
||
R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_ignorecount, IgnoreIL)));
|
||
|
||
R.Copy(R3); Inc(R.A.X,38); Inc(R.A.Y,7); R.B.Y:=R.A.Y+KeyCount;
|
||
Items:=nil;
|
||
{ don't use invalid type }
|
||
for I:=pred(high(BreakpointType)) downto low(BreakpointType) do
|
||
Items:=NewSItem(BreakpointTypeStr[I], Items);
|
||
New(TypeRB, Init(R, Items));
|
||
|
||
R2.Copy(R); R2.Move(-1,-1); R2.B.Y:=R2.A.Y+1;
|
||
Insert(New(PLabel, Init(R2, label_breakpoint_type, TypeRB)));
|
||
|
||
Insert(TypeRB);
|
||
|
||
InsertButtons(@Self);
|
||
|
||
NameIL^.Select;
|
||
end;
|
||
|
||
function TBreakpointItemDialog.Execute: Word;
|
||
var R: sw_word;
|
||
S1: string;
|
||
err: word;
|
||
L: longint;
|
||
begin
|
||
R:=sw_word(Breakpoint^.typ);
|
||
TypeRB^.SetData(R);
|
||
|
||
If Breakpoint^.typ=bt_file_line then
|
||
S1:=GetStr(Breakpoint^.FileName)
|
||
else
|
||
S1:=GetStr(Breakpoint^.name);
|
||
NameIL^.SetData(S1);
|
||
|
||
If Breakpoint^.typ=bt_file_line then
|
||
S1:=IntToStr(Breakpoint^.Line)
|
||
else
|
||
S1:='0';
|
||
LineIL^.SetData(S1);
|
||
|
||
S1:=IntToStr(Breakpoint^.IgnoreCount);
|
||
IgnoreIL^.SetData(S1);
|
||
S1:=GetStr(Breakpoint^.Conditions);
|
||
ConditionsIL^.SetData(S1);
|
||
|
||
if assigned(FirstEditorWindow) then
|
||
FindReplaceEditor:=FirstEditorWindow^.Editor;
|
||
|
||
R:=inherited Execute;
|
||
|
||
FindReplaceEditor:=nil;
|
||
if R=cmOK then
|
||
begin
|
||
TypeRB^.GetData(R);
|
||
L:=R;
|
||
Breakpoint^.typ:=BreakpointType(L);
|
||
|
||
NameIL^.GetData(S1);
|
||
If Breakpoint^.typ=bt_file_line then
|
||
begin
|
||
If assigned(Breakpoint^.FileName) then
|
||
DisposeStr(Breakpoint^.FileName);
|
||
Breakpoint^.FileName:=NewStr(S1);
|
||
end
|
||
else
|
||
begin
|
||
If assigned(Breakpoint^.Name) then
|
||
DisposeStr(Breakpoint^.Name);
|
||
Breakpoint^.name:=NewStr(S1);
|
||
end;
|
||
If Breakpoint^.typ=bt_file_line then
|
||
begin
|
||
LineIL^.GetData(S1);
|
||
Val(S1,L,err);
|
||
Breakpoint^.Line:=L;
|
||
end;
|
||
IgnoreIL^.GetData(S1);
|
||
Val(S1,L,err);
|
||
Breakpoint^.IgnoreCount:=L;
|
||
|
||
ConditionsIL^.GetData(S1);
|
||
If assigned(Breakpoint^.Conditions) then
|
||
DisposeStr(Breakpoint^.Conditions);
|
||
Breakpoint^.Conditions:=NewStr(S1);
|
||
end;
|
||
Execute:=R;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TWatch
|
||
****************************************************************************}
|
||
|
||
constructor TWatch.Init(s : string);
|
||
begin
|
||
expr:=NewStr(s);
|
||
last_value:=nil;
|
||
current_value:=nil;
|
||
Get_new_value;
|
||
GDBRunCount:=-1;
|
||
end;
|
||
|
||
constructor TWatch.Load(var S: TStream);
|
||
begin
|
||
expr:=S.ReadStr;
|
||
last_value:=nil;
|
||
current_value:=nil;
|
||
Get_new_value;
|
||
GDBRunCount:=-1;
|
||
end;
|
||
|
||
procedure TWatch.Store(var S: TStream);
|
||
begin
|
||
S.WriteStr(expr);
|
||
end;
|
||
|
||
procedure TWatch.rename(s : string);
|
||
begin
|
||
if assigned(expr) then
|
||
begin
|
||
if GetStr(expr)=S then
|
||
exit;
|
||
DisposeStr(expr);
|
||
end;
|
||
expr:=NewStr(s);
|
||
if assigned(last_value) then
|
||
StrDispose(last_value);
|
||
last_value:=nil;
|
||
if assigned(current_value) then
|
||
StrDispose(current_value);
|
||
current_value:=nil;
|
||
GDBRunCount:=-1;
|
||
Get_new_value;
|
||
end;
|
||
|
||
procedure TWatch.Get_new_value;
|
||
{$ifndef NODEBUG}
|
||
var p, q : pchar;
|
||
i, j, curframe, startframe : longint;
|
||
s,s2 : string;
|
||
loop_higher, found : boolean;
|
||
last_removed : char;
|
||
|
||
function GetValue(var s : string) : boolean;
|
||
begin
|
||
Debugger^.command('p '+s);
|
||
if not Debugger^.Error then
|
||
begin
|
||
s:=StrPas(Debugger^.GetOutput);
|
||
GetValue:=true;
|
||
end
|
||
else
|
||
begin
|
||
s:=StrPas(Debugger^.GetError);
|
||
GetValue:=false;
|
||
{ do not open a messagebox for such errors }
|
||
Debugger^.got_error:=false;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
If not assigned(Debugger) or Not Debugger^.HasExe or
|
||
(GDBRunCount=Debugger^.RunCount) then
|
||
exit;
|
||
GDBRunCount:=Debugger^.RunCount;
|
||
if assigned(last_value) then
|
||
strdispose(last_value);
|
||
last_value:=current_value;
|
||
s:=GetStr(expr);
|
||
{ Fix 2d array indexing, change [x,x] to [x][x] }
|
||
i:=pos('[',s);
|
||
if i>0 then
|
||
begin
|
||
while i<length(s) do
|
||
begin
|
||
if s[i]=',' then
|
||
begin
|
||
s[i]:='[';
|
||
insert(']',s,i);
|
||
inc(i);
|
||
end;
|
||
inc(i);
|
||
end;
|
||
end;
|
||
found:=GetValue(s);
|
||
Debugger^.got_error:=false;
|
||
loop_higher:=not found;
|
||
if not found then
|
||
begin
|
||
curframe:=Debugger^.get_current_frame;
|
||
startframe:=curframe;
|
||
end
|
||
else
|
||
begin
|
||
curframe:=0;
|
||
startframe:=0;
|
||
end;
|
||
while loop_higher do
|
||
begin
|
||
s:='parent_ebp';
|
||
if GetValue(s) then
|
||
begin
|
||
repeat
|
||
inc(curframe);
|
||
if not Debugger^.set_current_frame(curframe) then
|
||
loop_higher:=false;
|
||
{$ifdef FrameNameKnown}
|
||
s2:='/x '+FrameName;
|
||
{$else not FrameNameKnown}
|
||
s2:='/x $ebp';
|
||
{$endif FrameNameKnown}
|
||
getValue(s2);
|
||
j:=pos('=',s2);
|
||
if j>0 then
|
||
s2:=copy(s2,j+1,length(s2));
|
||
while s2[1] in [' ',TAB] do
|
||
delete(s2,1,1);
|
||
if pos(s2,s)>0 then
|
||
loop_higher :=false;
|
||
until not loop_higher;
|
||
{ try again at that level }
|
||
s:=GetStr(expr);
|
||
found:=GetValue(s);
|
||
loop_higher:=not found;
|
||
end
|
||
else
|
||
loop_higher:=false;
|
||
end;
|
||
if found then
|
||
p:=StrNew(Debugger^.GetOutput)
|
||
else
|
||
begin
|
||
{ get a reasonable output at least }
|
||
s:=GetStr(expr);
|
||
GetValue(s);
|
||
p:=StrNew(Debugger^.GetError);
|
||
end;
|
||
Debugger^.got_error:=false;
|
||
{ We should try here to find the expr in parent
|
||
procedure if there are
|
||
I will implement this as I added a
|
||
parent_ebp pseudo local var to local procedure
|
||
in stabs debug info PM }
|
||
{ But there are some pitfalls like
|
||
locals redefined in other sublocals that call the function }
|
||
if curframe<>startframe then
|
||
Debugger^.set_current_frame(startframe);
|
||
|
||
q:=nil;
|
||
if assigned(p) and (p[0]='$') then
|
||
q:=StrPos(p,'=');
|
||
if not assigned(q) then
|
||
q:=p;
|
||
if assigned(q) then
|
||
i:=strlen(q)
|
||
else
|
||
i:=0;
|
||
if (i>0) and (q[i-1]=#10) then
|
||
begin
|
||
while (i>1) and ((q[i-2]=' ') or (q[i-2]=#9)) do
|
||
dec(i);
|
||
last_removed:=q[i-1];
|
||
q[i-1]:=#0;
|
||
end
|
||
else
|
||
last_removed:=#0;
|
||
if assigned(q) then
|
||
current_value:=strnew(q)
|
||
else
|
||
current_value:=strnew('');
|
||
if last_removed<>#0 then
|
||
q[i-1]:=last_removed;
|
||
strdispose(p);
|
||
GDBRunCount:=Debugger^.RunCount;
|
||
end;
|
||
{$else NODEBUG}
|
||
begin
|
||
end;
|
||
{$endif NODEBUG}
|
||
|
||
procedure TWatch.Force_new_value;
|
||
begin
|
||
GDBRunCount:=-1;
|
||
Get_new_value;
|
||
end;
|
||
|
||
destructor TWatch.Done;
|
||
begin
|
||
if assigned(expr) then
|
||
disposestr(expr);
|
||
if assigned(last_value) then
|
||
strdispose(last_value);
|
||
if assigned(current_value) then
|
||
strdispose(current_value);
|
||
inherited done;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TWatchesCollection
|
||
****************************************************************************}
|
||
|
||
constructor TWatchesCollection.Init;
|
||
begin
|
||
inherited Init(10,10);
|
||
end;
|
||
|
||
procedure TWatchesCollection.Insert(Item: Pointer);
|
||
begin
|
||
PWatch(Item)^.Get_new_value;
|
||
Inherited Insert(Item);
|
||
Update;
|
||
end;
|
||
|
||
procedure TWatchesCollection.Update;
|
||
var
|
||
W,W1 : integer;
|
||
|
||
procedure GetMax(P : PWatch);
|
||
begin
|
||
if assigned(P^.Current_value) then
|
||
W1:=StrLen(P^.Current_value)+3+Length(GetStr(P^.expr))
|
||
else
|
||
W1:=2+Length(GetStr(P^.expr));
|
||
if W1>W then
|
||
W:=W1;
|
||
end;
|
||
|
||
begin
|
||
W:=0;
|
||
ForEach(@GetMax);
|
||
MaxW:=W;
|
||
If assigned(WatchesWindow) then
|
||
WatchesWindow^.WLB^.Update(MaxW);
|
||
end;
|
||
|
||
function TWatchesCollection.At(Index: Integer): PWatch;
|
||
begin
|
||
At:=Inherited At(Index);
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TWatchesListBox
|
||
****************************************************************************}
|
||
|
||
constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||
begin
|
||
inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
|
||
If assigned(List) then
|
||
dispose(list,done);
|
||
List:=WatchesCollection;
|
||
end;
|
||
|
||
procedure TWatchesListBox.Update(AMaxWidth : integer);
|
||
var R : TRect;
|
||
begin
|
||
GetExtent(R);
|
||
MaxWidth:=AMaxWidth;
|
||
if (HScrollBar<>nil) and (R.B.X-R.A.X<MaxWidth) then
|
||
HScrollBar^.SetRange(0,MaxWidth-(R.B.X-R.A.X))
|
||
else
|
||
HScrollBar^.SetRange(0,0);
|
||
if R.B.X-R.A.X>MaxWidth then
|
||
HScrollBar^.Hide
|
||
else
|
||
HScrollBar^.Show;
|
||
SetRange(List^.Count+1);
|
||
if R.B.Y-R.A.Y>Range then
|
||
VScrollBar^.Hide
|
||
else
|
||
VScrollBar^.Show;
|
||
|
||
{if Focused=List^.Count-1-1 then
|
||
FocusItem(List^.Count-1);
|
||
What was that for ?? PM }
|
||
DrawView;
|
||
end;
|
||
|
||
function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer;var Modified : boolean): String;
|
||
var
|
||
PW : PWatch;
|
||
ValOffset : Sw_integer;
|
||
S : String;
|
||
begin
|
||
Modified:=false;
|
||
if Item>=WatchesCollection^.Count then
|
||
begin
|
||
GetIndentedText:='';
|
||
exit;
|
||
end;
|
||
|
||
PW:=WatchesCollection^.At(Item);
|
||
ValOffset:=Length(GetStr(PW^.Expr))+2;
|
||
if not assigned(PW^.expr) then
|
||
GetIndentedText:=''
|
||
else if Indent<ValOffset then
|
||
begin
|
||
S:=GetStr(PW^.Expr);
|
||
if Indent=0 then
|
||
S:=' '+S
|
||
else
|
||
S:=Copy(S,Indent,High(S));
|
||
if not assigned(PW^.current_value) then
|
||
S:=S+' <Unknown value>'
|
||
else
|
||
S:=S+' '+GetPChar(PW^.Current_value);
|
||
GetIndentedText:=Copy(S,1,MaxLen);
|
||
end
|
||
else
|
||
begin
|
||
if not assigned(PW^.Current_value) or
|
||
(StrLen(PW^.Current_value)<Indent-Valoffset) then
|
||
S:=''
|
||
else
|
||
S:=GetPchar(@(PW^.Current_Value[Indent-Valoffset]));
|
||
GetIndentedText:=Copy(S,1,MaxLen);
|
||
end;
|
||
if assigned(PW^.current_value) and
|
||
assigned(PW^.last_value) and
|
||
(strcomp(PW^.Last_value,PW^.Current_value)<>0) then
|
||
Modified:=true;
|
||
end;
|
||
|
||
procedure TWatchesListBox.EditCurrent;
|
||
var
|
||
P: PWatch;
|
||
begin
|
||
if Range=0 then Exit;
|
||
if Focused<WatchesCollection^.Count then
|
||
P:=WatchesCollection^.At(Focused)
|
||
else
|
||
P:=New(PWatch,Init(''));
|
||
Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
|
||
WatchesCollection^.Update;
|
||
end;
|
||
|
||
function TWatchesListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
|
||
var
|
||
Dummy_Modified : boolean;
|
||
begin
|
||
GetText:=GetIndentedText(Item, 0, MaxLen, Dummy_Modified);
|
||
end;
|
||
|
||
procedure TWatchesListBox.DeleteCurrent;
|
||
var
|
||
P: PWatch;
|
||
begin
|
||
if (Range=0) or
|
||
(Focused>=WatchesCollection^.Count) then
|
||
exit;
|
||
P:=WatchesCollection^.At(Focused);
|
||
WatchesCollection^.free(P);
|
||
WatchesCollection^.Update;
|
||
end;
|
||
|
||
procedure TWatchesListBox.EditNew;
|
||
var
|
||
P: PWatch;
|
||
S : string;
|
||
begin
|
||
if Focused<WatchesCollection^.Count then
|
||
begin
|
||
P:=WatchesCollection^.At(Focused);
|
||
S:=GetStr(P^.expr);
|
||
end
|
||
else
|
||
S:='';
|
||
P:=New(PWatch,Init(S));
|
||
if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
|
||
begin
|
||
WatchesCollection^.AtInsert(Focused,P);
|
||
WatchesCollection^.Update;
|
||
end
|
||
else
|
||
dispose(P,Done);
|
||
end;
|
||
|
||
procedure TWatchesListBox.Draw;
|
||
var
|
||
I, J, Item: Sw_Integer;
|
||
NormalColor, SelectedColor, FocusedColor, Color: Word;
|
||
ColWidth, CurCol, Indent: Integer;
|
||
B: TDrawBuffer;
|
||
Modified : boolean;
|
||
Text: String;
|
||
SCOff: Byte;
|
||
TC: byte;
|
||
procedure MT(var C: word);
|
||
begin
|
||
if TC<>0 then C:=(C and $ff0f) or (TC and $f0);
|
||
end;
|
||
begin
|
||
if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
|
||
if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
|
||
begin
|
||
NormalColor := GetColor(1);
|
||
FocusedColor := GetColor(3);
|
||
SelectedColor := GetColor(4);
|
||
end else
|
||
begin
|
||
NormalColor := GetColor(2);
|
||
SelectedColor := GetColor(4);
|
||
end;
|
||
if Transparent then
|
||
begin MT(NormalColor); MT(SelectedColor); end;
|
||
(* if NoSelection then
|
||
SelectedColor:=NormalColor;*)
|
||
if HScrollBar <> nil then Indent := HScrollBar^.Value
|
||
else Indent := 0;
|
||
ColWidth := Size.X div NumCols + 1;
|
||
for I := 0 to Size.Y - 1 do
|
||
begin
|
||
for J := 0 to NumCols-1 do
|
||
begin
|
||
Item := J*Size.Y + I + TopItem;
|
||
CurCol := J*ColWidth;
|
||
if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
|
||
(Focused = Item) and (Range > 0) then
|
||
begin
|
||
Color := FocusedColor;
|
||
SetCursor(CurCol+1,I);
|
||
SCOff := 0;
|
||
end
|
||
else if (Item < Range) and IsSelected(Item) then
|
||
begin
|
||
Color := SelectedColor;
|
||
SCOff := 2;
|
||
end
|
||
else
|
||
begin
|
||
Color := NormalColor;
|
||
SCOff := 4;
|
||
end;
|
||
MoveChar(B[CurCol], ' ', Color, ColWidth);
|
||
if Item < Range then
|
||
begin
|
||
(* Text := GetText(Item, ColWidth + Indent);
|
||
Text := Copy(Text,Indent,ColWidth); *)
|
||
Text:=GetIndentedText(Item,Indent,ColWidth,Modified);
|
||
if modified then
|
||
begin
|
||
SCOff:=0;
|
||
Color:=(Color and $fff0) or Red;
|
||
end;
|
||
MoveStr(B[CurCol], Text, Color);
|
||
if {ShowMarkers or } Modified then
|
||
begin
|
||
WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
|
||
WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
|
||
WordRec(B[CurCol+ColWidth-2]).Hi := Color and $ff;
|
||
end;
|
||
end;
|
||
MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
|
||
end;
|
||
WriteLine(0, I, Size.X, 1, B);
|
||
end;
|
||
end;
|
||
|
||
function TWatchesListBox.GetLocalMenu: PMenu;
|
||
var M: PMenu;
|
||
begin
|
||
if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
|
||
M:=NewMenu(
|
||
NewItem(menu_watchlocal_edit,'',kbNoKey,cmEdit,hcNoContext,
|
||
NewItem(menu_watchlocal_new,'',kbNoKey,cmNew,hcNoContext,
|
||
NewItem(menu_watchlocal_delete,'',kbNoKey,cmDelete,hcNoContext,
|
||
NewLine(
|
||
NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
|
||
nil))))));
|
||
GetLocalMenu:=M;
|
||
end;
|
||
|
||
procedure TWatchesListBox.HandleEvent(var Event: TEvent);
|
||
var DontClear: boolean;
|
||
begin
|
||
case Event.What of
|
||
evKeyDown :
|
||
begin
|
||
DontClear:=false;
|
||
case Event.KeyCode of
|
||
kbEnter :
|
||
Message(@Self,evCommand,cmEdit,nil);
|
||
kbIns :
|
||
Message(@Self,evCommand,cmNew,nil);
|
||
kbDel :
|
||
Message(@Self,evCommand,cmDelete,nil);
|
||
else
|
||
DontClear:=true;
|
||
end;
|
||
if not DontClear then
|
||
ClearEvent(Event);
|
||
end;
|
||
evBroadcast :
|
||
case Event.Command of
|
||
cmListItemSelected :
|
||
if Event.InfoPtr=@Self then
|
||
Message(@Self,evCommand,cmEdit,nil);
|
||
end;
|
||
evCommand :
|
||
begin
|
||
DontClear:=false;
|
||
case Event.Command of
|
||
cmEdit :
|
||
EditCurrent;
|
||
cmDelete :
|
||
DeleteCurrent;
|
||
cmNew :
|
||
EditNew;
|
||
else
|
||
DontClear:=true;
|
||
end;
|
||
if not DontClear then
|
||
ClearEvent(Event);
|
||
end;
|
||
end;
|
||
inherited HandleEvent(Event);
|
||
end;
|
||
|
||
constructor TWatchesListBox.Load(var S: TStream);
|
||
begin
|
||
inherited Load(S);
|
||
If assigned(List) then
|
||
dispose(list,done);
|
||
List:=WatchesCollection;
|
||
{ we must set Range PM }
|
||
SetRange(List^.count+1);
|
||
end;
|
||
|
||
procedure TWatchesListBox.Store(var S: TStream);
|
||
var OL: PCollection;
|
||
OldRange : Sw_integer;
|
||
begin
|
||
OL:=List;
|
||
OldRange:=Range;
|
||
Range:=0;
|
||
New(List, Init(1,1));
|
||
inherited Store(S);
|
||
Dispose(List, Done);
|
||
List:=OL;
|
||
{ ^^^ nasty trick - has anyone a better idea how to avoid storing the
|
||
collection? Pasting here a modified version of TListBox.Store+
|
||
TAdvancedListBox.Store isn't a better solution, since by eventually
|
||
changing the obj-hierarchy you'll always have to modify this, too - BG }
|
||
SetRange(OldRange);
|
||
end;
|
||
|
||
destructor TWatchesListBox.Done;
|
||
begin
|
||
List:=nil;
|
||
inherited Done;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TWatchesWindow
|
||
****************************************************************************}
|
||
|
||
Constructor TWatchesWindow.Init;
|
||
var
|
||
HSB,VSB: PScrollBar;
|
||
R,R2 : trect;
|
||
begin
|
||
Desktop^.GetExtent(R);
|
||
R.A.Y:=R.B.Y-7;
|
||
inherited Init(R, dialog_watches,SearchFreeWindowNo);
|
||
Palette:=wpCyanWindow;
|
||
GetExtent(R);
|
||
HelpCtx:=hcWatchesWindow;
|
||
R.Grow(-1,-1);
|
||
R2.Copy(R);
|
||
Inc(R2.B.Y);
|
||
R2.A.Y:=R2.B.Y-1;
|
||
New(HSB, Init(R2));
|
||
HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
|
||
HSB^.SetStep(R.B.X-R.A.X,1);
|
||
Insert(HSB);
|
||
R2.Copy(R);
|
||
Inc(R2.B.X);
|
||
R2.A.X:=R2.B.X-1;
|
||
New(VSB, Init(R2));
|
||
VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
|
||
Insert(VSB);
|
||
New(WLB,Init(R,HSB,VSB));
|
||
WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
||
WLB^.Transparent:=true;
|
||
Insert(WLB);
|
||
If assigned(WatchesWindow) then
|
||
dispose(WatchesWindow,done);
|
||
WatchesWindow:=@Self;
|
||
Update;
|
||
end;
|
||
|
||
procedure TWatchesWindow.Update;
|
||
begin
|
||
WatchesCollection^.Update;
|
||
Draw;
|
||
end;
|
||
|
||
constructor TWatchesWindow.Load(var S: TStream);
|
||
begin
|
||
inherited Load(S);
|
||
GetSubViewPtr(S,WLB);
|
||
If assigned(WatchesWindow) then
|
||
dispose(WatchesWindow,done);
|
||
WatchesWindow:=@Self;
|
||
end;
|
||
|
||
procedure TWatchesWindow.Store(var S: TStream);
|
||
begin
|
||
inherited Store(S);
|
||
PutSubViewPtr(S,WLB);
|
||
end;
|
||
|
||
Destructor TWatchesWindow.Done;
|
||
begin
|
||
WatchesWindow:=nil;
|
||
Dispose(WLB,done);
|
||
inherited done;
|
||
end;
|
||
|
||
|
||
{****************************************************************************
|
||
TWatchItemDialog
|
||
****************************************************************************}
|
||
|
||
constructor TWatchItemDialog.Init(AWatch: PWatch);
|
||
var R,R2: TRect;
|
||
begin
|
||
R.Assign(0,0,50,10);
|
||
inherited Init(R,'Edit Watch');
|
||
Watch:=AWatch;
|
||
|
||
GetExtent(R); R.Grow(-3,-2);
|
||
Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
|
||
New(NameIL, Init(R, 255)); Insert(NameIL);
|
||
R2.Copy(R); R2.A.X:=R2.B.X; R2.B.X:=R2.A.X+3;
|
||
Insert(New(PHistory, Init(R2, NameIL, hidWatchDialog)));
|
||
R2.Copy(R); R2.Move(-1,-1);
|
||
Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
|
||
GetExtent(R);
|
||
R.Grow(-3,-1);
|
||
R.A.Y:=R.A.Y+3;
|
||
TextST:=New(PAdvancedStaticText, Init(R, label_watch_values));
|
||
Insert(TextST);
|
||
|
||
InsertButtons(@Self);
|
||
|
||
NameIL^.Select;
|
||
end;
|
||
|
||
function TWatchItemDialog.Execute: Word;
|
||
var R: word;
|
||
S1,S2: string;
|
||
begin
|
||
S1:=GetStr(Watch^.expr);
|
||
NameIL^.SetData(S1);
|
||
|
||
S1:=GetPChar(Watch^.Current_value);
|
||
S2:=GetPChar(Watch^.Last_value);
|
||
|
||
ClearFormatParams;
|
||
AddFormatParamStr(S1);
|
||
AddFormatParamStr(S2);
|
||
if assigned(Watch^.Last_value) and
|
||
assigned(Watch^.Current_value) and
|
||
(strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
|
||
S1:=FormatStrF(msg_watch_currentvalue,FormatParams)
|
||
else
|
||
S1:=FormatStrF(msg_watch_currentandpreviousvalue,FormatParams);
|
||
|
||
TextST^.SetText(S1);
|
||
|
||
if assigned(FirstEditorWindow) then
|
||
FindReplaceEditor:=FirstEditorWindow^.Editor;
|
||
|
||
R:=inherited Execute;
|
||
|
||
FindReplaceEditor:=nil;
|
||
|
||
if R=cmOK then
|
||
begin
|
||
NameIL^.GetData(S1);
|
||
Watch^.Rename(S1);
|
||
{$ifndef NODEBUG}
|
||
If assigned(Debugger) then
|
||
Debugger^.ReadWatches;
|
||
{$endif NODEBUG}
|
||
end;
|
||
Execute:=R;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
TStackWindow
|
||
****************************************************************************}
|
||
|
||
constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||
begin
|
||
Inherited Init(Bounds,AHScrollBar,AVScrollBar);
|
||
end;
|
||
|
||
procedure TFramesListBox.Update;
|
||
|
||
var i : longint;
|
||
W : PSourceWindow;
|
||
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
{ call backtrace command }
|
||
If not assigned(Debugger) then
|
||
exit;
|
||
DeskTop^.Lock;
|
||
Clear;
|
||
{ forget all old frames }
|
||
Debugger^.clear_frames;
|
||
|
||
if Debugger^.WindowWidth<>-1 then
|
||
Debugger^.Command('set width 0xffffffff');
|
||
Debugger^.Command('backtrace');
|
||
{ generate list }
|
||
{ all is in tframeentry }
|
||
for i:=0 to Debugger^.frame_count-1 do
|
||
begin
|
||
with Debugger^.frames[i]^ do
|
||
begin
|
||
if assigned(file_name) then
|
||
AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
|
||
AddModuleName(GetPChar(file_name)),line_number,1)))
|
||
else
|
||
AddItem(new(PMessageItem,init(0,HexStr(address,8)+' '+GetPChar(function_name)+GetPChar(args),
|
||
AddModuleName(''),line_number,1)));
|
||
W:=SearchOnDesktop(GetPChar(file_name),false);
|
||
{ First reset all Debugger rows }
|
||
If assigned(W) then
|
||
begin
|
||
W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
|
||
W^.Editor^.DebuggerRow:=-1;
|
||
end;
|
||
end;
|
||
end;
|
||
{ Now set all Debugger rows }
|
||
for i:=0 to Debugger^.frame_count-1 do
|
||
begin
|
||
with Debugger^.frames[i]^ do
|
||
begin
|
||
W:=SearchOnDesktop(GetPChar(file_name),false);
|
||
If assigned(W) then
|
||
begin
|
||
If W^.Editor^.DebuggerRow=-1 then
|
||
begin
|
||
W^.Editor^.SetLineFlagState(line_number-1,lfDebuggerRow,true);
|
||
W^.Editor^.DebuggerRow:=line_number-1;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
if Assigned(list) and (List^.Count > 0) then
|
||
FocusItem(0);
|
||
if Debugger^.WindowWidth<>-1 then
|
||
Debugger^.Command('set width '+IntToStr(Debugger^.WindowWidth));
|
||
DeskTop^.Unlock;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
function TFramesListBox.GetLocalMenu: PMenu;
|
||
begin
|
||
GetLocalMenu:=Inherited GetLocalMenu;
|
||
end;
|
||
|
||
procedure TFramesListBox.GotoSource;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
{ select frame for watches }
|
||
If not assigned(Debugger) then
|
||
exit;
|
||
Debugger^.Command('f '+IntToStr(Focused));
|
||
{ for local vars }
|
||
Debugger^.RereadWatches;
|
||
{$endif NODEBUG}
|
||
{ goto source }
|
||
inherited GotoSource;
|
||
end;
|
||
|
||
procedure TFramesListBox.GotoAssembly;
|
||
begin
|
||
{$ifndef NODEBUG}
|
||
{ select frame for watches }
|
||
If not assigned(Debugger) then
|
||
exit;
|
||
Debugger^.Command('f '+IntToStr(Focused));
|
||
{ for local vars }
|
||
Debugger^.RereadWatches;
|
||
{$endif}
|
||
{ goto source/assembly mixture }
|
||
InitDisassemblyWindow;
|
||
DisassemblyWindow^.LoadFunction('');
|
||
{$ifndef NODEBUG}
|
||
DisassemblyWindow^.SetCurAddress(Debugger^.frames[Focused]^.address);
|
||
DisassemblyWindow^.SelectInDebugSession;
|
||
{$endif NODEBUG}
|
||
end;
|
||
|
||
|
||
procedure TFramesListBox.HandleEvent(var Event: TEvent);
|
||
begin
|
||
if ((Event.What=EvKeyDown) and (Event.CharCode='i')) or
|
||
((Event.What=EvCommand) and (Event.Command=cmDisassemble)) then
|
||
GotoAssembly;
|
||
inherited HandleEvent(Event);
|
||
end;
|
||
|
||
destructor TFramesListBox.Done;
|
||
begin
|
||
Inherited Done;
|
||
end;
|
||
|
||
Constructor TStackWindow.Init;
|
||
var
|
||
HSB,VSB: PScrollBar;
|
||
R,R2 : trect;
|
||
begin
|
||
Desktop^.GetExtent(R);
|
||
R.A.Y:=R.B.Y-5;
|
||
inherited Init(R, dialog_callstack, wnNoNumber);
|
||
Palette:=wpCyanWindow;
|
||
GetExtent(R);
|
||
HelpCtx:=hcStackWindow;
|
||
R.Grow(-1,-1);
|
||
R2.Copy(R);
|
||
Inc(R2.B.Y);
|
||
R2.A.Y:=R2.B.Y-1;
|
||
New(HSB, Init(R2));
|
||
HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
|
||
Insert(HSB);
|
||
R2.Copy(R);
|
||
Inc(R2.B.X);
|
||
R2.A.X:=R2.B.X-1;
|
||
New(VSB, Init(R2));
|
||
VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
|
||
Insert(VSB);
|
||
New(FLB,Init(R,HSB,VSB));
|
||
FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
|
||
Insert(FLB);
|
||
If assigned(StackWindow) then
|
||
dispose(StackWindow,done);
|
||
StackWindow:=@Self;
|
||
Update;
|
||
end;
|
||
|
||
procedure TStackWindow.Update;
|
||
begin
|
||
FLB^.Update;
|
||
DrawView;
|
||
end;
|
||
|
||
constructor TStackWindow.Load(var S: TStream);
|
||
begin
|
||
inherited Load(S);
|
||
GetSubViewPtr(S,FLB);
|
||
If assigned(StackWindow) then
|
||
dispose(StackWindow,done);
|
||
StackWindow:=@Self;
|
||
end;
|
||
|
||
procedure TStackWindow.Store(var S: TStream);
|
||
begin
|
||
inherited Store(S);
|
||
PutSubViewPtr(S,FLB);
|
||
end;
|
||
|
||
Destructor TStackWindow.Done;
|
||
begin
|
||
StackWindow:=nil;
|
||
Dispose(FLB,done);
|
||
inherited done;
|
||
end;
|
||
|
||
{****************************************************************************
|
||
Init/Final
|
||
****************************************************************************}
|
||
|
||
|
||
function GetGDBTargetShortName : string;
|
||
begin
|
||
{$ifdef SUPPORT_REMOTE}
|
||
{$ifdef PALMOSGDB}
|
||
GetGDBTargetShortName:='palmos';
|
||
{$else}
|
||
GetGDBTargetShortName:='linux';
|
||
{$endif PALMOSGDB}
|
||
{$else not SUPPORT_REMOTE}
|
||
GetGDBTargetShortName:=source_info.shortname
|
||
{$endif not SUPPORT_REMOTE}
|
||
end;
|
||
|
||
procedure InitDebugger;
|
||
{$ifdef DEBUG}
|
||
var s : string;
|
||
i,p : longint;
|
||
{$endif DEBUG}
|
||
var
|
||
NeedRecompileExe : boolean;
|
||
cm : longint;
|
||
begin
|
||
{$ifdef DEBUG}
|
||
if not use_gdb_file then
|
||
begin
|
||
Assign(gdb_file,GDBOutFileName);
|
||
{$I-}
|
||
Rewrite(gdb_file);
|
||
if InOutRes<>0 then
|
||
begin
|
||
s:=GDBOutFileName;
|
||
p:=pos('.',s);
|
||
if p>1 then
|
||
for i:=0 to 9 do
|
||
begin
|
||
s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
|
||
InOutRes:=0;
|
||
Assign(gdb_file,s);
|
||
rewrite(gdb_file);
|
||
if InOutRes=0 then
|
||
break;
|
||
end;
|
||
end;
|
||
if IOResult=0 then
|
||
Use_gdb_file:=true;
|
||
end;
|
||
{$I+}
|
||
{$endif}
|
||
|
||
NeedRecompileExe:=false;
|
||
if UpCaseStr(TargetSwitches^.GetCurrSelParam)<>UpCaseStr(GetGDBTargetShortName) then
|
||
begin
|
||
ClearFormatParams;
|
||
AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
|
||
AddFormatParamStr(GetGDBTargetShortName);
|
||
cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
|
||
if cm=cmCancel then
|
||
Exit;
|
||
if cm=cmYes then
|
||
begin
|
||
{ force recompilation }
|
||
PrevMainFile:='';
|
||
NeedRecompileExe:=true;
|
||
TargetSwitches^.SetCurrSelParam(GetGDBTargetShortName);
|
||
If DebugInfoSwitches^.GetCurrSelParam='-' then
|
||
DebugInfoSwitches^.SetCurrSelParam('l');
|
||
IDEApp.UpdateTarget;
|
||
end;
|
||
end;
|
||
if not NeedRecompileExe then
|
||
NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
|
||
(PrevMainFile<>MainFile) or NeedRecompile(cRun,false);
|
||
if Not NeedRecompileExe and Not MainHasDebugInfo then
|
||
begin
|
||
ClearFormatParams;
|
||
cm:=ConfirmBox(msg_compiledwithoutdebuginforecompile,nil,true);
|
||
if cm=cmCancel then
|
||
Exit;
|
||
if cm=cmYes then
|
||
begin
|
||
{ force recompilation }
|
||
PrevMainFile:='';
|
||
NeedRecompileExe:=true;
|
||
DebugInfoSwitches^.SetCurrSelParam('l');
|
||
end;
|
||
end;
|
||
if NeedRecompileExe then
|
||
DoCompile(cRun);
|
||
if CompilationPhase<>cpDone then
|
||
Exit;
|
||
if (EXEFile='') then
|
||
begin
|
||
ErrorBox(msg_nothingtodebug,nil);
|
||
Exit;
|
||
end;
|
||
{ init debugcontroller }
|
||
{$ifndef NODEBUG}
|
||
if not assigned(Debugger) then
|
||
begin
|
||
PushStatus(msg_startingdebugger);
|
||
new(Debugger,Init);
|
||
PopStatus;
|
||
end;
|
||
Debugger^.SetExe(ExeFile);
|
||
{$endif NODEBUG}
|
||
{$ifdef GDBWINDOW}
|
||
InitGDBWindow;
|
||
{$endif def GDBWINDOW}
|
||
end;
|
||
|
||
|
||
procedure DoneDebugger;
|
||
begin
|
||
{$ifdef DEBUG}
|
||
If IDEApp.IsRunning then
|
||
PushStatus('Closing debugger');
|
||
{$endif}
|
||
{$ifndef NODEBUG}
|
||
if assigned(Debugger) then
|
||
dispose(Debugger,Done);
|
||
Debugger:=nil;
|
||
{$endif NODEBUG}
|
||
{$ifdef DOS}
|
||
If assigned(UserScreen) then
|
||
PDosScreen(UserScreen)^.FreeGraphBuffer;
|
||
{$endif DOS}
|
||
{$ifdef DEBUG}
|
||
If Use_gdb_file then
|
||
begin
|
||
Use_gdb_file:=false;
|
||
Close(GDB_file);
|
||
end;
|
||
If IDEApp.IsRunning then
|
||
PopStatus;
|
||
{$endif DEBUG}
|
||
end;
|
||
|
||
procedure InitGDBWindow;
|
||
var
|
||
R : TRect;
|
||
begin
|
||
if GDBWindow=nil then
|
||
begin
|
||
DeskTop^.GetExtent(R);
|
||
new(GDBWindow,init(R));
|
||
DeskTop^.Insert(GDBWindow);
|
||
end;
|
||
end;
|
||
|
||
procedure DoneGDBWindow;
|
||
begin
|
||
If IDEApp.IsRunning and
|
||
assigned(GDBWindow) then
|
||
begin
|
||
DeskTop^.Delete(GDBWindow);
|
||
end;
|
||
GDBWindow:=nil;
|
||
end;
|
||
|
||
procedure InitDisassemblyWindow;
|
||
var
|
||
R : TRect;
|
||
begin
|
||
if DisassemblyWindow=nil then
|
||
begin
|
||
DeskTop^.GetExtent(R);
|
||
new(DisassemblyWindow,init(R));
|
||
DeskTop^.Insert(DisassemblyWindow);
|
||
end;
|
||
end;
|
||
|
||
procedure DoneDisassemblyWindow;
|
||
begin
|
||
if assigned(DisassemblyWindow) then
|
||
begin
|
||
DeskTop^.Delete(DisassemblyWindow);
|
||
Dispose(DisassemblyWindow,Done);
|
||
DisassemblyWindow:=nil;
|
||
end;
|
||
end;
|
||
|
||
procedure InitStackWindow;
|
||
begin
|
||
if StackWindow=nil then
|
||
begin
|
||
new(StackWindow,init);
|
||
DeskTop^.Insert(StackWindow);
|
||
end;
|
||
end;
|
||
|
||
procedure DoneStackWindow;
|
||
begin
|
||
if assigned(StackWindow) then
|
||
begin
|
||
DeskTop^.Delete(StackWindow);
|
||
StackWindow:=nil;
|
||
end;
|
||
end;
|
||
|
||
procedure InitBreakpoints;
|
||
begin
|
||
New(BreakpointsCollection,init(10,10));
|
||
end;
|
||
|
||
procedure DoneBreakpoints;
|
||
begin
|
||
Dispose(BreakpointsCollection,Done);
|
||
BreakpointsCollection:=nil;
|
||
end;
|
||
|
||
procedure InitWatches;
|
||
begin
|
||
New(WatchesCollection,init);
|
||
end;
|
||
|
||
procedure DoneWatches;
|
||
begin
|
||
Dispose(WatchesCollection,Done);
|
||
WatchesCollection:=nil;
|
||
end;
|
||
|
||
procedure RegisterFPDebugViews;
|
||
begin
|
||
RegisterType(RWatchesWindow);
|
||
RegisterType(RBreakpointsWindow);
|
||
RegisterType(RWatchesListBox);
|
||
RegisterType(RBreakpointsListBox);
|
||
RegisterType(RStackWindow);
|
||
RegisterType(RFramesListBox);
|
||
RegisterType(RBreakpoint);
|
||
RegisterType(RWatch);
|
||
RegisterType(RBreakpointCollection);
|
||
RegisterType(RWatchesCollection);
|
||
end;
|
||
|
||
end.
|
||
{$endif}
|
||
|
||
{
|
||
$Log$
|
||
Revision 1.62 2005-03-13 12:25:02 florian
|
||
+ Recent files write full name now as hint in the status line
|
||
* Rundir hint in status line fixed
|
||
|
||
Revision 1.61 2005/02/14 17:13:18 peter
|
||
* truncate log
|
||
|
||
Revision 1.60 2005/01/08 11:43:18 florian
|
||
+ vector unit window
|
||
|
||
}
|