paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-13 21:00:35 +01:00
Code Issues Packages Projects Releases Wiki Activity
1d7e2bb6cb
fpc/ide/text/fpdebug.pas
pierre 30071b6a3d new merge
2000-11-15 00:14:10 +00:00

3719 lines
101 KiB
ObjectPascal
Raw Blame History

{
$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;
interface
uses
Objects,Dialogs,Drivers,Views,
GDBCon,GDBInt,Menus,
WViews,
FPViews;
type
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;
LastFileName : string;
LastSource : PView; {PsourceWindow !! }
HiddenStepsCount : longint;
{ no need to switch if using another terminal }
NoSwitch : boolean;
RunCount : longint;
FPCBreakErrorNumber : longint;
constructor Init(const exefn:string);
destructor Done;
procedure DoSelectSourceline(const fn:string;line:longint);virtual;
{ procedure DoStartSession;virtual;
procedure DoBreakSession;virtual;}
procedure DoEndSession(code:longint);virtual;
procedure AnnotateError;
procedure InsertBreakpoints;
procedure RemoveBreakpoints;
procedure ReadWatches;
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;
end;
BreakpointType = (bt_function,bt_file_line,bt_watch,bt_awatch,bt_rwatch,bt_invalid);
BreakpointState = (bs_enabled,bs_disabled,bs_deleted);
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_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 : PSourceWindow);
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(TDlgWindow)
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 : PInputLine;
ConditionsIL: PInputLine;
LineIL : PInputLine;
IgnoreIL : PInputLine;
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;
destructor done;virtual;
private
expr : pstring;
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 GetIndentedText(Item,Indent,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;
PWatchItemDialog = ^TWatchItemDialog;
TWatchItemDialog = object(TCenterDialog)
constructor Init(AWatch: PWatch);
function Execute: Word; virtual;
private
Watch : PWatch;
NameIL : PInputLine;
TextST : PAdvancedStaticText;
end;
PWatchesWindow = ^TWatchesWindow;
TWatchesWindow = Object(TDlgWindow)
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 HandleEvent(var Event: TEvent); virtual;
destructor Done; virtual;
end;
PStackWindow = ^TStackWindow;
TStackWindow = Object(TDlgWindow)
FLB : PFramesListBox;
Constructor Init;
constructor Load(var S: TStream);
procedure Store(var S: TStream);
procedure Update; virtual;
destructor Done; virtual;
end;
{$ifdef TP} dword = longint; {$endif}
TIntRegs = record
eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
cs,ds,es,ss,fs,gs : word;
eflags : dword;
end;
PRegistersView = ^TRegistersView;
TRegistersView = object(TView)
OldReg : TIntRegs;
constructor Init(var Bounds: TRect);
procedure Draw;virtual;
destructor Done; virtual;
end;
PRegistersWindow = ^TRegistersWindow;
TRegistersWindow = Object(TDlgWindow)
RV : PRegistersView;
Constructor Init;
constructor Load(var S: TStream);
procedure Store(var S: TStream);
procedure Update; virtual;
destructor Done; virtual;
end;
TFPURegs = record
end;
PFPUView = ^TFPUView;
TFPUView = object(TView)
OldReg : TFPURegs;
constructor Init(var Bounds: TRect);
procedure Draw;virtual;
destructor Done; virtual;
end;
PFPUWindow = ^TFPUWindow;
TFPUWindow = Object(TDlgWindow)
RV : PFPUView;
Constructor Init;
constructor Load(var S: TStream);
procedure Store(var S: TStream);
procedure Update; virtual;
destructor Done; virtual;
end;
const
StackWindow : PStackWindow = nil;
RegistersWindow : PRegistersWindow = nil;
FPUWindow : PFPUWindow = nil;
procedure InitStackWindow;
procedure DoneStackWindow;
procedure InitRegistersWindow;
procedure DoneRegistersWindow;
function ActiveBreakpoints : boolean;
function GDBFileName(st : string) : string;
const
BreakpointTypeStr : Array[BreakpointType] of String[9]
= ( 'function','file-line','watch','awatch','rwatch','invalid' );
BreakpointStateStr : Array[BreakpointState] of String[8]
= ( 'enabled','disabled','invalid' );
DebuggeeTTY : string = '';
var
Debugger : PDebugController;
BreakpointsCollection : PBreakpointCollection;
WatchesCollection : PwatchesCollection;
procedure InitDebugger;
procedure DoneDebugger;
procedure InitGDBWindow;
procedure DoneGDBWindow;
procedure InitBreakpoints;
procedure DoneBreakpoints;
procedure InitWatches;
procedure DoneWatches;
procedure RegisterFPDebugViews;
procedure UpdateDebugViews;
implementation
uses
Dos,Video,
App,Commands,Strings,
{$ifdef win32}
Windebug,
{$endif win32}
{$ifdef Unix}
Linux,FileCtrl,
{$endif Unix}
Systems,
FPString,FPVars,FPUtils,FPConst,FPSwitch,
FPIntf,FPCompil,FPIde,FPHelp,
Validate,WEditor,WUtils;
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
);
RRegistersWindow: TStreamRec = (
ObjType: 1711;
VmtLink: Ofs(TypeOf(TRegistersWindow)^);
Load: @TRegistersWindow.Load;
Store: @TRegistersWindow.Store
);
RRegistersView: TStreamRec = (
ObjType: 1712;
VmtLink: Ofs(TypeOf(TRegistersView)^);
Load: @TRegistersView.Load;
Store: @TRegistersView.Store
);
RFPUWindow: TStreamRec = (
ObjType: 1713;
VmtLink: Ofs(TypeOf(TFPUWindow)^);
Load: @TFPUWindow.Load;
Store: @TFPUWindow.Store
);
RFPUView: TStreamRec = (
ObjType: 1714;
VmtLink: Ofs(TypeOf(TFPUView)^);
Load: @TFPUView.Load;
Store: @TFPUView.Store
);
{$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 Unix}
GDBFileName:=st;
{$else}
{ should we also use / chars ? }
for i:=1 to Length(st) do
if st[i]='\' then
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:='//'+st[1]+copy(st,3,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}
end;
{****************************************************************************
TDebugController
****************************************************************************}
procedure UpdateDebugViews;
begin
DeskTop^.Lock;
If assigned(StackWindow) then
StackWindow^.Update;
If assigned(RegistersWindow) then
RegistersWindow^.Update;
If assigned(Debugger) then
Debugger^.ReadWatches;
If assigned(FPUWindow) then
FPUWindow^.Update;
DeskTop^.UnLock;
end;
constructor TDebugController.Init(const exefn:string);
var f: string;
begin
inherited Init;
CenterDebuggerRow:=IniCenterDebuggerRow;
f := GetShortName(GDBFileName(exefn));
NoSwitch:=False;
LoadFile(f);
SetArgs(GetRunParameters);
Debugger:=@self;
Command('b FPC_BREAK_ERROR');
FPCBreakErrorNumber:=stop_breakpoint_number;
{$ifndef GABOR}
switch_to_user:=true;
{$endif}
InsertBreakpoints;
ReadWatches;
end;
procedure TDebugController.InsertBreakpoints;
procedure DoInsert(PB : PBreakpoint);
begin
PB^.Insert;
end;
begin
BreakpointsCollection^.ForEach(@DoInsert);
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.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;
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;
destructor TDebugController.Done;
begin
{ kill the program if running }
Reset;
RemoveBreakpoints;
inherited Done;
end;
procedure TDebugController.Run;
begin
ResetBreakpointsValues;
{$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
Command('tty '+DebuggeeTTY);
NoSwitch:= true;
end
else
begin
Command('tty '+TTYName(stdin));
NoSwitch := false;
end;
{$endif Unix}
{ Switch to user screen to get correct handles }
UserScreen;
inherited Run;
DebuggerScreen;
IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],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=0) 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 ConfirmBox('Really quit editor?',nil,true)=cmOK then
begin
Message(@IDEApp,evCommand,cmQuit,nil);
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;
NoSwitch:=false;
IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
ResetDebuggerRows;
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
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;
end;
procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
var
W: PSourceWindow;
Found : boolean;
PB : PBreakpoint;
S : String;
BreakIndex : longint;
begin
BreakIndex:=stop_breakpoint_number;
Desktop^.Lock;
{ 0 based line count in Editor }
if Line>0 then
dec(Line);
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 fn='' then
W:=nil
else
W:=TryToOpenFile(nil,fn,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 fn='' then
Found:=false
else
{ it is easier to handle with a * at the end }
Found:=IDEApp.OpenSearch(fn+'*');
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,fn,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:=fn;
Desktop^.UnLock;
if BreakIndex>0 then
begin
PB:=BreakpointsCollection^.GetGDB(BreakIndex);
if (BreakIndex=FPCBreakErrorNumber) then
begin
{ Procedure HandleErrorAddrFrame
(Errno : longint;addr,frame : longint);
[public,alias:'FPC_BREAK_ERROR']; }
{
Error:=GetLongintFrom(GetFramePointer+OffsetFirstArg);
Addr:=GetPointerFrom(GetFramePointer+OffsetSecondArg);}
WarningBox(#3'Run Time Error',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) 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.DoEndSession(code:longint);
var P :Array[1..2] of longint;
begin
IDEApp.SetCmdState([cmResetDebugger],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;
end;
procedure TDebugController.DoDebuggerScreen;
begin
if NoSwitch then
begin
PopStatus;
end
else
begin
IDEApp.ShowIDEScreen;
Message(Application,evBroadcast,cmDebuggerStopped,pointer(RunCount));
PopStatus;
end;
{$ifdef win32}
ChangeDebuggeeWindowTitleTo(Stopped_State);
{$endif win32}
end;
procedure TDebugController.DoUserScreen;
begin
Inc(RunCount);
if NoSwitch then
begin
{$ifdef Unix}
PushStatus(msg_runninginanotherwindow+DebuggeeTTY);
{$else not Unix}
PushStatus(msg_runninginanotherwindow);
{$endif Unix}
end
else
begin
PushStatus(msg_runningprogram);
IDEApp.ShowUserScreen;
end;
{$ifdef win32}
ChangeDebuggeeWindowTitleTo(Running_State);
{$endif win32}
end;
{****************************************************************************
TBreakpoint
****************************************************************************}
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_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);
begin
typ:=bt_file_line;
state:=bs_enabled;
GDBState:=bs_deleted;
{ 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); }
FileName:=NewStr(GDBFileName(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(GDBFileName(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);
begin
S.Write(typ,SizeOf(BreakpointType));
S.Write(state,SizeOf(BreakpointState));
case typ of
bt_file_line :
begin
S.WriteStr(FileName);
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;
begin
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 '+NameAndExtOf(FileName^)+':'+IntToStr(Line))
else if (typ=bt_function) and assigned(name) then
Debugger^.Command('break '+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 }
end;
end
else
{ Here there was a problem !! }
begin
GDBIndex:=0;
if (typ=bt_file_line) and assigned(FileName) then
begin
ClearFormatParams;
AddFormatParamStr(NameAndExtOf(FileName^));
AddFormatParamInt(Line);
ErrorBox(msg_couldnotsetbreakpointat,@FormatParams);
end
else
begin
ClearFormatParams;
AddFormatParamStr(BreakpointTypeStr[typ]);
AddFormatParamStr(GetStr(Name));
ErrorBox(msg_couldnotsetbreakpointtype,@FormatParams);
end;
state:=bs_disabled;
end;
end
else if (GDBState=bs_disabled) and (state=bs_enabled) then
Enable
else if (GDBState=bs_enabled) and (state=bs_disabled) then
Disable;
end;
procedure TBreakpoint.Remove;
begin
If not assigned(Debugger) then Exit;
if GDBIndex>0 then
Debugger^.Command('delete '+IntToStr(GDBIndex));
GDBIndex:=0;
GDBState:=bs_deleted;
end;
procedure TBreakpoint.Enable;
begin
If not assigned(Debugger) then Exit;
if GDBIndex>0 then
Debugger^.Command('enable '+IntToStr(GDBIndex))
else
Insert;
GDBState:=bs_enabled;
end;
procedure TBreakpoint.Disable;
begin
If not assigned(Debugger) then Exit;
if GDBIndex>0 then
Debugger^.Command('disable '+IntToStr(GDBIndex));
GDBState:=bs_disabled;
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(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
if assigned(Debugger) then
begin
Debugger^.RemoveBreakpoints;
Debugger^.InsertBreakpoints;
end;
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 : PSourceWindow);
procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
begin
If assigned(P^.FileName) and
(GDBFileName(FExpand(P^.FileName^))=GDBFileName(FExpand(W^.Editor^.FileName))) then
W^.Editor^.SetLineFlagState(P^.Line-1,lfBreakpoint,P^.state=bs_enabled);
end;
begin
ForEach(@SetInSource);
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;
var PB : PBreakpoint;
function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
begin
IsThere:=(P^.typ=bt_file_line) and (P^.FileName^=FileName) and (P^.Line=LineNr);
end;
begin
FileName:=GDBFileName(FileName);
PB:=FirstThat(@IsThere);
ToggleFileLine:=false;
If Assigned(PB) then
if PB^.state=bs_disabled then
begin
PB^.state:=bs_enabled;
ToggleFileLine:=true;
end
else if PB^.state=bs_enabled then
PB^.state:=bs_disabled;
If not assigned(PB) then
begin
PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
if assigned(PB) then
Begin
Insert(PB);
ToggleFileLine:=true;
End;
end;
if assigned(PB) then
PB^.UpdateSource;
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
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.AddModuleName(const Name: string): PString;
var P: PString;
begin
if ModuleNames<>nil then
P:=ModuleNames^.Add(Name)
else
P:=nil;
AddModuleName:=P;
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;
(* if assigned(ModuleNames) then
ModuleNames^.FreeAll; *)
SetRange(0); DrawView;
Message(Application,evBroadcast,cmClearLineHighlights,@Self);
end;
procedure TBreakpointsListBox.TrackSource;
var W: PSourceWindow;
P: PBreakpointItem;
R: TRect;
(* Row,Col: sw_integer; *)
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);
(* if ModuleNames<>nil then Dispose(ModuleNames, Done);*)
end;
{****************************************************************************
TBreakpointsWindow
****************************************************************************}
constructor TBreakpointsWindow.Init;
var R,R2: TRect;
HSB,VSB: PScrollBar;
ST: PStaticText;
S: String;
X,X1 : Sw_integer;
Btn: PButton;
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);
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(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 4;
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_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;
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;
begin
ClearBreakpoints;
ReloadBreakpoints;
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(3+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.A.X+36;
New(NameIL, Init(R, 128)); Insert(NameIL);
R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_name, NameIL)));
R.Move(0,3);
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(ConditionsIL, Init(R, 128)); Insert(ConditionsIL);
R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_breakpoint_conditions, ConditionsIL)));
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); R.B.Y:=R.A.Y+KeyCount;
Items:=nil;
for I:=high(BreakpointType) downto low(BreakpointType) do
Items:=NewSItem(BreakpointTypeStr[I], Items);
New(TypeRB, Init(R, Items));
Insert(TypeRB);
InsertButtons(@Self);
NameIL^.Select;
end;
function TBreakpointItemDialog.Execute: Word;
var R: word;
S1: string;
err: word;
L: longint;
begin
R:=longint(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);
R:=inherited Execute;
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;
end;
constructor TWatch.Load(var S: TStream);
begin
expr:=S.ReadStr;
last_value:=nil;
current_value:=nil;
Get_new_value;
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;
Get_new_value;
end;
procedure TWatch.Get_new_value;
var p, q : pchar;
i, j, curframe, startframe : longint;
s,s2 : string;
loop_higher, found, last_removed : boolean;
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) then
exit;
if assigned(last_value) then
strdispose(last_value);
last_value:=current_value;
s:=GetStr(expr);
found:=GetValue(s);
Debugger^.got_error:=false;
loop_higher:=not found;
curframe:=Debugger^.get_current_frame;
startframe:=curframe;
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;
s2:='/x $ebp';
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);
loop_higher:=not GetValue(s);
end
else
loop_higher:=false;
end;
s:=GetStr(expr);
if GetValue(s) then
p:=StrNew(Debugger^.GetOutput)
else
p:=StrNew(Debugger^.GetError);
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 }
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
q[i-1]:=#0;
last_removed:=true;
end
else
last_removed:=false;
if assigned(q) then
current_value:=strnew(q)
else
current_value:=strnew('');
if last_removed then
q[i-1]:=#10;
strdispose(p);
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
begin
W1:=StrLen(P^.Current_value)+2+Length(GetStr(P^.expr));
if W1>W then
W:=W1;
end;
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 then
HScrollBar^.SetRange(0,MaxWidth);
if R.B.X-R.A.X>MaxWidth then
HScrollBar^.Hide
else
HScrollBar^.Show;
SetRange(List^.Count);
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);
DrawView;
end;
function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String;
var
PW : PWatch;
ValOffset : Sw_integer;
S : String;
begin
PW:=WatchesCollection^.At(Item);
ValOffset:=Length(GetStr(PW^.Expr))+2;
if Indent<ValOffset then
begin
if not assigned(PW^.current_value) then
S:=' '+GetStr(PW^.Expr)+' <Unknown value>'
else if not assigned(PW^.last_value) or
(strcomp(PW^.Last_value,PW^.Current_value)=0) then
S:=' '+GetStr(PW^.Expr)+' '+GetPChar(PW^.Current_value)
else
S:='!'+GetStr(PW^.Expr)+'!'+GetPchar(PW^.Current_value);
GetIndentedText:=Copy(S,Indent,MaxLen);
end
else
begin
if not assigned(PW^.Current_value) or
(StrLen(PW^.Current_value)<Indent-Valoffset) then
S:=''
else
S:=GetStr(@(PW^.Current_Value[Indent-Valoffset]));
GetIndentedText:=Copy(S,1,MaxLen);
end;
end;
procedure TWatchesListBox.EditCurrent;
var
P: PWatch;
begin
if Range=0 then Exit;
P:=WatchesCollection^.At(Focused);
if P=nil then Exit;
Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
WatchesCollection^.Update;
end;
procedure TWatchesListBox.DeleteCurrent;
var
P: PWatch;
begin
if Range=0 then Exit;
P:=WatchesCollection^.At(Focused);
if P=nil then Exit;
WatchesCollection^.free(P);
WatchesCollection^.Update;
end;
procedure TWatchesListBox.EditNew;
var
P: PWatch;
begin
P:=New(PWatch,Init(''));
if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
begin
WatchesCollection^.Insert(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;
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);
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;
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,
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);
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:=hcWatches;
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(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.Move(-1,-1);
Insert(New(PLabel, Init(R2, label_watch_expressiontowatch, NameIL)));
GetExtent(R);
R.Grow(-1,-1);
R.A.Y:=R.A.Y+3;
R.B.X:=R.A.X+36;
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);
if assigned(Watch^.Current_value) then
S1:=GetPChar(Watch^.Current_value)
else
S1:='';
if assigned(Watch^.Last_value) then
S2:=GetPChar(Watch^.Last_value)
else
S2:='';
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);
R:=inherited Execute;
if R=cmOK then
begin
NameIL^.GetData(S1);
Watch^.Rename(S1);
If assigned(Debugger) then
Debugger^.ReadWatches;
end;
Execute:=R;
end;
{****************************************************************************
TRegistersView
****************************************************************************}
function GetIntRegs(var rs : TIntRegs) : boolean;
var
p,po : pchar;
p1 : pchar;
reg,value : string;
buffer : array[0..255] of char;
v : dword;
code : word;
begin
GetIntRegs:=false;
{$ifndef NODEBUG}
Debugger^.Command('info registers');
if Debugger^.Error then
exit
else
begin
po:=StrNew(Debugger^.GetOutput);
p:=po;
if assigned(p) then
begin
fillchar(rs,sizeof(rs),0);
p1:=strscan(p,' ');
while assigned(p1) do
begin
strlcopy(buffer,p,p1-p);
reg:=strpas(buffer);
p:=strscan(p,'$');
p1:=strscan(p,#9);
strlcopy(buffer,p,p1-p);
value:=strpas(buffer);
val(value,v,code);
if reg='eax' then
rs.eax:=v
else if reg='ebx' then
rs.ebx:=v
else if reg='ecx' then
rs.ecx:=v
else if reg='edx' then
rs.edx:=v
else if reg='eip' then
rs.eip:=v
else if reg='esi' then
rs.esi:=v
else if reg='edi' then
rs.edi:=v
else if reg='esp' then
rs.esp:=v
else if reg='ebp' then
rs.ebp:=v
{ under win32 flags are on a register named ps !! PM }
else if (reg='eflags') or (reg='ps') then
rs.eflags:=v
else if reg='cs' then
rs.cs:=v
else if reg='ds' then
rs.ds:=v
else if reg='es' then
rs.es:=v
else if reg='fs' then
rs.fs:=v
else if reg='gs' then
rs.gs:=v
else if reg='ss' then
rs.ss:=v;
p:=strscan(p1,#10);
if assigned(p) then
begin
p1:=strscan(p,' ');
inc(p);
end
else
break;
end;
{ free allocated memory }
strdispose(po);
end
else
exit;
end;
{ do not open a messagebox for such errors }
Debugger^.got_error:=false;
GetIntRegs:=true;
{$endif}
end;
constructor TRegistersView.Init(var Bounds: TRect);
begin
inherited init(Bounds);
end;
procedure TRegistersView.Draw;
var
rs : tintregs;
color :byte;
procedure SetColor(x,y : longint);
begin
if x=y then
color:=7
else
color:=8;
end;
begin
inherited draw;
If not assigned(Debugger) then
begin
WriteStr(1,0,'<no values available>',7);
exit;
end;
if GetIntRegs(rs) then
begin
SetColor(rs.eax,OldReg.eax);
WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
SetColor(rs.ebx,OldReg.ebx);
WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
SetColor(rs.ecx,OldReg.ecx);
WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
SetColor(rs.edx,OldReg.edx);
WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
SetColor(rs.eip,OldReg.eip);
WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
SetColor(rs.esi,OldReg.esi);
WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
SetColor(rs.edi,OldReg.edi);
WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
SetColor(rs.esp,OldReg.esp);
WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
SetColor(rs.ebp,OldReg.ebp);
WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
SetColor(rs.cs,OldReg.cs);
WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
SetColor(rs.ds,OldReg.ds);
WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
SetColor(rs.es,OldReg.es);
WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
SetColor(rs.fs,OldReg.fs);
WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
SetColor(rs.gs,OldReg.gs);
WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
SetColor(rs.ss,OldReg.ss);
WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
SetColor(rs.eflags and $1,OldReg.eflags and $1);
WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
SetColor(rs.eflags and $20,OldReg.eflags and $20);
WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
SetColor(rs.eflags and $80,OldReg.eflags and $80);
WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
SetColor(rs.eflags and $800,OldReg.eflags and $800);
WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
SetColor(rs.eflags and $4,OldReg.eflags and $4);
WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
SetColor(rs.eflags and $200,OldReg.eflags and $200);
WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
SetColor(rs.eflags and $10,OldReg.eflags and $10);
WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
SetColor(rs.eflags and $400,OldReg.eflags and $400);
WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
OldReg:=rs;
end
else
WriteStr(0,0,'<debugger error>',7);
end;
destructor TRegistersView.Done;
begin
inherited done;
end;
{****************************************************************************
TRegistersWindow
****************************************************************************}
constructor TRegistersWindow.Init;
var
R : TRect;
begin
Desktop^.GetExtent(R);
R.A.X:=R.B.X-28;
R.B.Y:=R.A.Y+11;
inherited Init(R,dialog_registers, wnNoNumber);
Flags:=wfClose or wfMove;
Palette:=wpCyanWindow;
HelpCtx:=hcRegisters;
R.Assign(1,1,26,10);
RV:=new(PRegistersView,init(R));
Insert(RV);
If assigned(RegistersWindow) then
dispose(RegistersWindow,done);
RegistersWindow:=@Self;
Update;
end;
constructor TRegistersWindow.Load(var S: TStream);
begin
inherited load(S);
GetSubViewPtr(S,RV);
If assigned(RegistersWindow) then
dispose(RegistersWindow,done);
RegistersWindow:=@Self;
end;
procedure TRegistersWindow.Store(var S: TStream);
begin
inherited Store(s);
PutSubViewPtr(S,RV);
end;
procedure TRegistersWindow.Update;
begin
ReDraw;
end;
destructor TRegistersWindow.Done;
begin
RegistersWindow:=nil;
inherited done;
end;
{****************************************************************************
TFPUView
****************************************************************************}
function GetFPURegs(var rs : TFPURegs) : boolean;
var
p,po : pchar;
p1 : pchar;
{$ifndef NODEBUG}
{ reg,value : string;
buffer : array[0..255] of char;
v : dword;
code : word;}
{$endif}
begin
GetFPURegs:=false;
{$ifndef NODEBUG}
Debugger^.Command('info registers');
if Debugger^.Error then
exit
else
begin
po:=StrNew(Debugger^.GetOutput);
p:=po;
if assigned(p) then
begin
fillchar(rs,sizeof(rs),0);
p1:=strscan(p,' ');
while assigned(p1) do
begin
{
strlcopy(buffer,p,p1-p);
reg:=strpas(buffer);
p:=strscan(p,'$');
p1:=strscan(p,#9);
strlcopy(buffer,p,p1-p);
value:=strpas(buffer);
val(value,v,code);
if reg='eax' then
rs.eax:=v
else if reg='ebx' then
rs.ebx:=v
else if reg='ecx' then
rs.ecx:=v
else if reg='edx' then
rs.edx:=v
else if reg='eip' then
rs.eip:=v
else if reg='esi' then
rs.esi:=v
else if reg='edi' then
rs.edi:=v
else if reg='esp' then
rs.esp:=v
else if reg='ebp' then
rs.ebp:=v
under win32 flags are on a register named ps !! PM
else if (reg='eflags') or (reg='ps') then
rs.eflags:=v
else if reg='cs' then
rs.cs:=v
else if reg='ds' then
rs.ds:=v
else if reg='es' then
rs.es:=v
else if reg='fs' then
rs.fs:=v
else if reg='gs' then
rs.gs:=v
else if reg='ss' then
rs.ss:=v;
p:=strscan(p1,#10);
if assigned(p) then
begin
p1:=strscan(p,' ');
inc(p);
end
else
break;
}
end;
{ free allocated memory }
strdispose(po);
end
else
exit;
end;
{ do not open a messagebox for such errors }
Debugger^.got_error:=false;
GetFPURegs:=true;
{$endif}
end;
constructor TFPUView.Init(var Bounds: TRect);
begin
inherited init(Bounds);
end;
procedure TFPUView.Draw;
var
rs : tfpuregs;
{ color :byte;
procedure SetColor(x,y : longint);
begin
if x=y then
color:=7
else
color:=8;
end;}
begin
inherited draw;
If not assigned(Debugger) then
begin
WriteStr(1,0,'<no values available>',7);
exit;
end;
if GetFPURegs(rs) then
begin
{
SetColor(rs.eax,OldReg.eax);
WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
SetColor(rs.ebx,OldReg.ebx);
WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
SetColor(rs.ecx,OldReg.ecx);
WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
SetColor(rs.edx,OldReg.edx);
WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
SetColor(rs.eip,OldReg.eip);
WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
SetColor(rs.esi,OldReg.esi);
WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
SetColor(rs.edi,OldReg.edi);
WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
SetColor(rs.esp,OldReg.esp);
WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
SetColor(rs.ebp,OldReg.ebp);
WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
SetColor(rs.cs,OldReg.cs);
WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
SetColor(rs.ds,OldReg.ds);
WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
SetColor(rs.es,OldReg.es);
WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
SetColor(rs.fs,OldReg.fs);
WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
SetColor(rs.gs,OldReg.gs);
WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
SetColor(rs.ss,OldReg.ss);
WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
SetColor(rs.eflags and $1,OldReg.eflags and $1);
WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
SetColor(rs.eflags and $20,OldReg.eflags and $20);
WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
SetColor(rs.eflags and $80,OldReg.eflags and $80);
WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
SetColor(rs.eflags and $800,OldReg.eflags and $800);
WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
SetColor(rs.eflags and $4,OldReg.eflags and $4);
WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
SetColor(rs.eflags and $200,OldReg.eflags and $200);
WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
SetColor(rs.eflags and $10,OldReg.eflags and $10);
WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
SetColor(rs.eflags and $400,OldReg.eflags and $400);
WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
OldReg:=rs;
}
end
else
WriteStr(0,0,'<debugger error>',7);
end;
destructor TFPUView.Done;
begin
inherited done;
end;
{****************************************************************************
TFPUWindow
****************************************************************************}
constructor TFPUWindow.Init;
var
R : TRect;
begin
Desktop^.GetExtent(R);
R.A.X:=R.B.X-28;
R.B.Y:=R.A.Y+11;
inherited Init(R,dialog_fpu, wnNoNumber);
Flags:=wfClose or wfMove;
Palette:=wpCyanWindow;
HelpCtx:=hcRegisters;
R.Assign(1,1,26,10);
RV:=new(PFPUView,init(R));
Insert(RV);
If assigned(FPUWindow) then
dispose(FPUWindow,done);
FPUWindow:=@Self;
Update;
end;
constructor TFPUWindow.Load(var S: TStream);
begin
inherited load(S);
GetSubViewPtr(S,RV);
If assigned(FPUWindow) then
dispose(FPUWindow,done);
FPUWindow:=@Self;
end;
procedure TFPUWindow.Store(var S: TStream);
begin
inherited Store(s);
PutSubViewPtr(S,RV);
end;
procedure TFPUWindow.Update;
begin
ReDraw;
end;
destructor TFPUWindow.Done;
begin
FPUWindow:=nil;
inherited done;
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
{ call backtrace command }
If not assigned(Debugger) then
exit;
{$ifndef NODEBUG}
DeskTop^.Lock;
Clear;
{ forget all old frames }
Debugger^.clear_frames;
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
W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,-1);
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
W^.Editor^.SetLineFlagExclusive(lfDebuggerRow,line_number-1);
end;
end;
end;
if List^.Count > 0 then
FocusItem(0);
DeskTop^.Unlock;
{$endif}
end;
function TFramesListBox.GetLocalMenu: PMenu;
begin
GetLocalMenu:=Inherited GetLocalMenu;
end;
procedure TFramesListBox.GotoSource;
begin
{ select frame for watches }
If not assigned(Debugger) then
exit;
{$ifndef NODEBUG}
Debugger^.Command('f '+IntToStr(Focused));
{ for local vars }
Debugger^.ReadWatches;
{$endif}
{ goto source }
inherited GotoSource;
end;
procedure TFramesListBox.HandleEvent(var Event: TEvent);
begin
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:=hcStack;
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
****************************************************************************}
procedure InitDebugger;
{$ifdef DEBUG}
var s : string;
i,p : longint;
{$endif DEBUG}
var
NeedRecompileExe : boolean;
cm : longint;
begin
{$ifdef DEBUG}
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;
{$I+}
{$endif}
NeedRecompileExe:=false;
if TargetSwitches^.GetCurrSelParam<>source_os.shortname then
begin
ClearFormatParams;
AddFormatParamStr(TargetSwitches^.GetCurrSelParam);
AddFormatParamStr(source_os.shortname);
cm:=ConfirmBox(msg_cantdebugchangetargetto,@FormatParams,true);
if cm=cmCancel then
Exit;
if cm=cmYes then
begin
{ force recompilation }
PrevMainFile:='';
NeedRecompileExe:=true;
TargetSwitches^.SetCurrSelParam(source_os.shortname);
If DebugInfoSwitches^.GetCurrSelParam='-' then
DebugInfoSwitches^.SetCurrSelParam('l');
end;
end;
if not NeedRecompileExe then
NeedRecompileExe:=(not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) or
(PrevMainFile<>MainFile) or NeedRecompile(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;
{$ifdef DEBUG}
PushStatus(msg_startingdebugger);
{$endif DEBUG}
{ init debugcontroller }
if assigned(Debugger) then
dispose(Debugger,Done);
new(Debugger,Init(ExeFile));
{$ifdef GDBWINDOW}
InitGDBWindow;
{$endif def GDBWINDOW}
{$ifdef DEBUG}
PopStatus;
{$endif DEBUG}
end;
procedure DoneDebugger;
begin
{$ifdef DEBUG}
{ PushStatus('Closing debugger');
No its called after App.Done !! }
{$endif}
if assigned(Debugger) then
dispose(Debugger,Done);
Debugger:=nil;
{$ifdef DEBUG}
If Use_gdb_file then
Close(GDB_file);
Use_gdb_file:=false;
{PopStatus;}
{$endif DEBUG}
{DoneGDBWindow;}
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 assigned(GDBWindow) then
begin
DeskTop^.Delete(GDBWindow);
GDBWindow:=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 InitRegistersWindow;
begin
if RegistersWindow=nil then
begin
new(RegistersWindow,init);
DeskTop^.Insert(RegistersWindow);
end;
end;
procedure DoneRegistersWindow;
begin
if assigned(RegistersWindow) then
begin
DeskTop^.Delete(RegistersWindow);
RegistersWindow:=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);
RegisterType(RRegistersWindow);
RegisterType(RRegistersView);
RegisterType(RFPUWindow);
RegisterType(RFPUView);
end;
end.
{
$Log$
Revision 1.6 2000-11-15 00:14:10 pierre
new merge
Revision 1.1.2.10 2000/11/14 17:40:42 pierre
+ External linking now optional
Revision 1.1.2.9 2000/11/14 09:23:55 marco
* Second batch
Revision 1.5 2000/11/13 17:37:41 pierre
merges from fixes branch
Revision 1.1.2.8 2000/11/13 16:59:08 pierre
* some function in double removed from fputils unit
Revision 1.4 2000/10/31 22:35:54 pierre
* New big merge from fixes branch
Revision 1.1.2.7 2000/10/31 07:47:54 pierre
* start to support FPC_BREAK_ERROR
Revision 1.1.2.6 2000/10/26 00:04:35 pierre
+ gdb prompt and FPC_BREAK_ERROR stop
Revision 1.1.2.5 2000/10/09 19:48:15 pierre
* wrong commit corrected
Revision 1.1.2.4 2000/10/09 16:28:24 pierre
* several linux enhancements
Revision 1.3 2000/10/06 22:58:59 pierre
* fixes for linux GDB tty command (merged)
Revision 1.1.2.3 2000/10/06 22:52:34 pierre
* fixes for linux GDB tty command
Revision 1.2 2000/08/22 09:41:39 pierre
* first big merge from fixes branch
Revision 1.1.2.1 2000/07/18 05:50:22 michael
+ Merged Gabors fixes
Revision 1.1 2000/07/13 09:48:34 michael
+ Initial import
Revision 1.63 2000/06/22 09:07:11 pierre
* Gabor changes: see fixes.txt
Revision 1.62 2000/06/11 07:01:32 peter
* give watches window also a number
* leave watches window in the bottom when cascading windows
Revision 1.61 2000/05/02 08:42:27 pierre
* new set of Gabor changes: see fixes.txt
Revision 1.60 2000/04/18 21:45:35 pierre
* Red line for breakpoint was off by one line
Revision 1.59 2000/04/18 11:42:36 pierre
lot of Gabor changes : see fixes.txt
Revision 1.58 2000/03/21 23:32:38 pierre
adapted to wcedit addition by Gabor
Revision 1.57 2000/03/14 14:22:30 pierre
+ generate cmDebuggerStopped broadcast
Revision 1.56 2000/03/08 16:57:01 pierre
* Wrong highlighted line while debugging fixed
+ Check if exe has debugging info
Revision 1.55 2000/03/07 21:52:54 pierre
+ TDebugController.GetValue
Revision 1.54 2000/03/06 11:34:25 pierre
+ windebug unit for Window Title change when debugging
Revision 1.53 2000/02/07 12:51:32 pierre
* typo fix
Revision 1.52 2000/02/07 11:50:30 pierre
Gabor changes for TP
Revision 1.51 2000/02/06 23:43:57 pierre
* breakpoint path problems fixes
Revision 1.50 2000/02/05 01:27:58 pierre
* bug with Toggle Break fixed, hopefully
+ search for local vars in parent procs avoiding
wrong results (see test.pas source)
Revision 1.49 2000/02/04 23:18:05 pierre
* no pushstatus in DoneDebugger because its called after App.done
Revision 1.48 2000/02/04 14:34:46 pierre
readme.txt
Revision 1.47 2000/02/04 00:10:58 pierre
* Breakpoint line in Source Window better handled
Revision 1.46 2000/02/01 10:59:58 pierre
* allow FP to debug itself
Revision 1.45 2000/01/28 22:38:21 pierre
* CrtlF9 starts debugger if there are active breakpoints
Revision 1.44 2000/01/27 22:30:38 florian
* start of FPU window
* current executed line color has a higher priority then a breakpoint now
Revision 1.43 2000/01/20 00:31:53 pierre
* uses ShortName of exe to start GDB
Revision 1.42 2000/01/10 17:49:40 pierre
* Get RegisterView to Update correctly
* Write in white changed regs (keeping a copy of previous values)
Revision 1.41 2000/01/10 16:20:50 florian
* working register window
Revision 1.40 2000/01/10 13:20:57 pierre
+ debug only possible on source target
Revision 1.39 2000/01/10 00:25:06 pierre
* RegisterWindow problem fixed
Revision 1.38 2000/01/09 21:05:51 florian
* some fixes for register view
Revision 1.37 2000/01/08 18:26:20 florian
+ added a register window, doesn't work yet
Revision 1.36 1999/12/20 14:23:16 pierre
* MyApp renamed IDEApp
* TDebugController.ResetDebuggerRows added to
get resetting of debugger rows
Revision 1.35 1999/11/24 14:03:16 pierre
+ Executing... in status line if in another window
Revision 1.34 1999/11/10 17:19:58 pierre
+ Other window for Debuggee code
Revision 1.33 1999/10/25 16:39:03 pierre
+ GetPChar to avoid nil pointer problems
Revision 1.32 1999/09/16 14:34:57 pierre
+ TBreakpoint and TWatch registering
+ WatchesCollection and BreakpointsCollection stored in desk file
* Syntax highlighting was broken
Revision 1.31 1999/09/13 16:24:43 peter
+ clock
* backspace unident like tp7
Revision 1.30 1999/09/09 16:36:30 pierre
* Breakpoint storage problem corrected
Revision 1.29 1999/09/09 16:31:45 pierre
* some breakpoint related fixes and Help contexts
Revision 1.28 1999/09/09 14:20:05 pierre
+ Stack Window
Revision 1.27 1999/08/24 22:04:33 pierre
+ TCodeEditor.SetDebuggerRow
works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
so the current stop point in debugging is not lost if
we move the cursor
Revision 1.26 1999/08/22 22:26:48 pierre
+ Registration of Breakpoint/Watches windows
Revision 1.25 1999/08/16 18:25:15 peter
* Adjusting the selection when the editor didn't contain any line.
* Reserved word recognition redesigned, but this didn't affect the overall
syntax highlight speed remarkably (at least not on my Amd-K6/350).
The syntax scanner loop is a bit slow but the main problem is the
recognition of special symbols. Switching off symbol processing boosts
the performance up to ca. 200%...
* The editor didn't allow copying (for ex to clipboard) of a single character
* 'File|Save as' caused permanently run-time error 3. Not any more now...
* Compiler Messages window (actually the whole desktop) did not act on any
keypress when compilation failed and thus the window remained visible
+ Message windows are now closed upon pressing Esc
+ At 'Run' the IDE checks whether any sources are modified, and recompiles
only when neccessary
+ BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
+ LineSelect (Ctrl+K+L) implemented
* The IDE had problems closing help windows before saving the desktop
Revision 1.24 1999/08/03 20:22:28 peter
+ TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
+ Desktop saving should work now
- History saved
- Clipboard content saved
- Desktop saved
- Symbol info saved
* syntax-highlight bug fixed, which compared special keywords case sensitive
(for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
* with 'whole words only' set, the editor didn't found occourences of the
searched text, if the text appeared previously in the same line, but didn't
satisfied the 'whole-word' condition
* ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
(ie. the beginning of the selection)
* when started typing in a new line, but not at the start (X=0) of it,
the editor inserted the text one character more to left as it should...
* TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
* Shift shouldn't cause so much trouble in TCodeEditor now...
* Syntax highlight had problems recognizing a special symbol if it was
prefixed by another symbol character in the source text
* Auto-save also occours at Dos shell, Tool execution, etc. now...
Revision 1.23 1999/07/28 23:11:17 peter
* fixes from gabor
Revision 1.22 1999/07/12 13:14:15 pierre
* LineEnd bug corrected, now goes end of text even if selected
+ Until Return for debugger
+ Code for Quit inside GDB Window
Revision 1.21 1999/07/11 00:35:14 pierre
* fix problems for wrong watches
Revision 1.20 1999/07/10 01:24:14 pierre
+ First implementation of watches window
Revision 1.19 1999/06/30 23:58:12 pierre
+ BreakpointsList Window implemented
with Edit/New/Delete functions
+ Individual breakpoint dialog with support for all types
ignorecount and conditions
(commands are not yet implemented, don't know if this wolud be useful)
awatch and rwatch have problems because GDB does not annotate them
I fixed v4.16 for this
Revision 1.18 1999/03/16 00:44:42 peter
* forgotten in last commit :(
Revision 1.17 1999/03/02 13:48:28 peter
* fixed far problem is fpdebug
* tile/cascading with message window
* grep fixes
Revision 1.16 1999/03/01 15:41:52 peter
+ Added dummy entries for functions not yet implemented
* MenuBar didn't update itself automatically on command-set changes
* Fixed Debugging/Profiling options dialog
* TCodeEditor converts spaces to tabs at save only if efUseTabChars is
set
* efBackSpaceUnindents works correctly
+ 'Messages' window implemented
+ Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
+ Added TP message-filter support (for ex. you can call GREP thru
GREP2MSG and view the result in the messages window - just like in TP)
* A 'var' was missing from the param-list of THelpFacility.TopicSearch,
so topic search didn't work...
* In FPHELP.PAS there were still context-variables defined as word instead
of THelpCtx
* StdStatusKeys() was missing from the statusdef for help windows
+ Topic-title for index-table can be specified when adding a HTML-files
Revision 1.15 1999/02/20 15:18:29 peter
+ ctrl-c capture with confirm dialog
+ ascii table in the tools menu
+ heapviewer
* empty file fixed
* fixed callback routines in fpdebug to have far for tp7
Revision 1.14 1999/02/16 12:47:36 pierre
* GDBWindow does not popup on F7 or F8 anymore
Revision 1.13 1999/02/16 10:43:54 peter
* use -dGDB for the compiler
* only use gdb_file when -dDEBUG is used
* profiler switch is now a toggle instead of radiobutton
Revision 1.12 1999/02/11 19:07:20 pierre
* GDBWindow redesigned :
normal editor apart from
that any kbEnter will send the line (for begin to cursor)
to GDB command !
GDBWindow opened in Debugger Menu
still buggy :
-echo should not be present if at end of text
-GDBWindow becomes First after each step (I don't know why !)
Revision 1.11 1999/02/11 13:10:03 pierre
+ GDBWindow only with -dGDBWindow for now : still buggy !!
Revision 1.10 1999/02/10 09:55:07 pierre
+ added OldValue and CurrentValue field for watchpoints
+ InitBreakpoints and DoneBreakpoints
+ MessageBox if GDB stops bacause of a watchpoint !
Revision 1.9 1999/02/08 17:43:43 pierre
* RestDebugger or multiple running of debugged program now works
+ added DoContToCursor(F4)
* Breakpoints are now inserted correctly (was mainlyy a problem
of directories)
Revision 1.8 1999/02/05 17:21:52 pierre
Invalid_line renamed InvalidSourceLine
Revision 1.7 1999/02/05 13:08:41 pierre
+ new breakpoint types added
Revision 1.6 1999/02/05 12:11:53 pierre
+ SourceDir that stores directories for sources that the
compiler should not know about
Automatically asked for addition when a new file that
needed filedialog to be found is in an unknown directory
Stored and retrieved from INIFile
+ Breakpoints conditions added to INIFile
* Breakpoints insterted and removed at debin and end of debug session
Revision 1.5 1999/02/04 17:54:22 pierre
+ several commands added
Revision 1.4 1999/02/04 13:32:02 pierre
* Several things added (I cannot commit them independently !)
+ added TBreakpoint and TBreakpointCollection
+ added cmResetDebugger,cmGrep,CmToggleBreakpoint
+ Breakpoint list in INIFile
* Select items now also depend of SwitchMode
* Reading of option '-g' was not possible !
+ added search for -Fu args pathes in TryToOpen
+ added code for automatic opening of FileDialog
if source not found
Revision 1.3 1999/02/02 16:41:38 peter
+ automatic .pas/.pp adding by opening of file
* better debuggerscreen changes
Revision 1.2 1999/01/22 18:14:09 pierre
* adaptd to changes in gdbint and gdbcon for to /
Revision 1.1 1999/01/22 10:24:03 peter
* first debugger things
}
Reference in New Issue View Git Blame Copy Permalink