mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-27 03:29:22 +02:00
+ added a register window, doesn't work yet
This commit is contained in:
florian
parent
1c7978a96b
commit
7ff307fb8d
@ -131,6 +131,7 @@ const
|
||||
{ and why aren't these defines then removed? Gabor }
|
||||
cmCopyWin = 240;
|
||||
cmPasteWin = 241;
|
||||
cmRegisters = 242;
|
||||
|
||||
cmNotImplemented = 1000;
|
||||
cmNewFromTemplate = 1001;
|
||||
@ -314,6 +315,7 @@ const
|
||||
hcGrep = hcShift+cmGrep;
|
||||
hcStack = hcShift+cmStack;
|
||||
hcBreakPointList = hcShift+cmBreakpointList;
|
||||
hcRegisters = hcShift+cmRegisters;
|
||||
|
||||
hcOpenAtCursor = hcShift+cmOpenAtCursor;
|
||||
hcBrowseAtCursor = hcShift+cmBrowseAtCursor;
|
||||
@ -372,7 +374,10 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2000-01-03 11:38:33 michael
|
||||
Revision 1.32 2000-01-08 18:26:20 florian
|
||||
+ added a register window, doesn't work yet
|
||||
|
||||
Revision 1.31 2000/01/03 11:38:33 michael
|
||||
Changes from Gabor
|
||||
|
||||
Revision 1.30 1999/11/03 09:39:23 peter
|
||||
@ -561,4 +566,4 @@ END.
|
||||
+ options are now written/read
|
||||
+ find and replace routines
|
||||
|
||||
}
|
||||
}
|
||||
@ -244,12 +244,33 @@ type
|
||||
destructor Done; virtual;
|
||||
end;
|
||||
|
||||
PRegistersView = ^TRegistersView;
|
||||
TRegistersView = object(TView)
|
||||
constructor Init(var Bounds: TRect);
|
||||
procedure Draw;virtual;
|
||||
destructor Done; virtual;
|
||||
end;
|
||||
|
||||
PRegistersWindow = ^TRegistersWindow;
|
||||
TRegistersWindow = Object(TWindow)
|
||||
RV : PRegistersView;
|
||||
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;
|
||||
|
||||
procedure InitStackWindow;
|
||||
procedure DoneStackWindow;
|
||||
|
||||
procedure InitRegistersWindow;
|
||||
procedure DoneRegistersWindow;
|
||||
|
||||
|
||||
const
|
||||
BreakpointTypeStr : Array[BreakpointType] of String[9]
|
||||
@ -274,6 +295,8 @@ procedure DoneWatches;
|
||||
|
||||
procedure RegisterFPDebugViews;
|
||||
|
||||
procedure UpdateDebugViews;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -354,10 +377,34 @@ const
|
||||
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
|
||||
);
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TDebugController
|
||||
****************************************************************************}
|
||||
|
||||
procedure UpdateDebugViews;
|
||||
|
||||
begin
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
If assigned(RegistersWindow) then
|
||||
RegistersWindow^.Update;
|
||||
end;
|
||||
|
||||
constructor TDebugController.Init(const exefn:string);
|
||||
var f: string;
|
||||
begin
|
||||
@ -444,8 +491,7 @@ begin
|
||||
inherited Run;
|
||||
DebuggerScreen;
|
||||
IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
end;
|
||||
|
||||
procedure TDebugController.Continue;
|
||||
@ -457,16 +503,14 @@ begin
|
||||
Run
|
||||
else
|
||||
inherited Continue;
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
{$endif NODEBUG}
|
||||
end;
|
||||
|
||||
procedure TDebugController.UntilReturn;
|
||||
begin
|
||||
Command('finish');
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
{ We could try to get the return value !
|
||||
Not done yet }
|
||||
end;
|
||||
@ -534,8 +578,7 @@ begin
|
||||
begin
|
||||
errornb:=error_num;
|
||||
ReadWatches;
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
|
||||
end;
|
||||
end;
|
||||
@ -563,8 +606,7 @@ begin
|
||||
W^.Editor^.TrackCursor(true);
|
||||
W^.Editor^.SetDebuggerRow(Line);
|
||||
ReadWatches;
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
|
||||
if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
|
||||
W^.Select;
|
||||
@ -580,8 +622,7 @@ begin
|
||||
begin
|
||||
W^.Editor^.SetDebuggerRow(Line);
|
||||
W^.Editor^.TrackCursor(true);
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
ReadWatches;
|
||||
if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
|
||||
W^.Select;
|
||||
@ -606,8 +647,7 @@ begin
|
||||
W^.Editor^.SetDebuggerRow(Line);
|
||||
W^.Editor^.TrackCursor(true);
|
||||
ReadWatches;
|
||||
If assigned(StackWindow) then
|
||||
StackWindow^.Update;
|
||||
UpdateDebugViews;
|
||||
if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
|
||||
W^.Select;
|
||||
LastSource:=W;
|
||||
@ -2073,6 +2113,9 @@ end;
|
||||
begin
|
||||
inherited Load(S);
|
||||
GetSubViewPtr(S,WLB);
|
||||
If assigned(WatchesWindow) then
|
||||
dispose(WatchesWindow,done);
|
||||
WatchesWindow:=@Self;
|
||||
end;
|
||||
|
||||
procedure TWatchesWindow.Store(var S: TStream);
|
||||
@ -2155,6 +2198,97 @@ begin
|
||||
Execute:=R;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TRegistersWindow
|
||||
****************************************************************************}
|
||||
|
||||
constructor TRegistersView.Init(var Bounds: TRect);
|
||||
|
||||
begin
|
||||
inherited init(Bounds);
|
||||
end;
|
||||
|
||||
procedure TRegistersView.Draw;
|
||||
|
||||
var
|
||||
p : pchar;
|
||||
s : string;
|
||||
|
||||
begin
|
||||
inherited draw;
|
||||
If not assigned(Debugger) then
|
||||
exit;
|
||||
{$ifndef NODEBUG}
|
||||
Debugger^.Command('info registers');
|
||||
if Debugger^.Error then
|
||||
p:=StrNew(Debugger^.GetError)
|
||||
else
|
||||
begin
|
||||
p:=StrNew(Debugger^.GetOutput);
|
||||
end;
|
||||
{ do not open a messagebox for such errors }
|
||||
Debugger^.got_error:=false;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
destructor TRegistersView.Done;
|
||||
|
||||
begin
|
||||
inherited done;
|
||||
end;
|
||||
|
||||
constructor TRegistersWindow.Init;
|
||||
|
||||
var
|
||||
R : TRect;
|
||||
|
||||
begin
|
||||
Desktop^.GetExtent(R);
|
||||
R.A.X:=R.B.X-24;
|
||||
R.B.Y:=8;
|
||||
inherited Init(R,' Register View', wnNoNumber);
|
||||
Flags:=wfClose or wfMove;
|
||||
Palette:=wpCyanWindow;
|
||||
HelpCtx:=hcRegisters;
|
||||
R.Grow(-2,-2);
|
||||
R.Move(1,1);
|
||||
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
|
||||
DrawView;
|
||||
end;
|
||||
|
||||
destructor TRegistersWindow.Done;
|
||||
|
||||
begin
|
||||
RegistersWindow:=nil;
|
||||
inherited done;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TStackWindow
|
||||
@ -2271,6 +2405,9 @@ end;
|
||||
begin
|
||||
inherited Load(S);
|
||||
GetSubViewPtr(S,FLB);
|
||||
If assigned(StackWindow) then
|
||||
dispose(StackWindow,done);
|
||||
StackWindow:=@Self;
|
||||
end;
|
||||
|
||||
procedure TStackWindow.Store(var S: TStream);
|
||||
@ -2368,6 +2505,24 @@ begin
|
||||
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));
|
||||
@ -2402,13 +2557,18 @@ begin
|
||||
RegisterType(RWatch);
|
||||
RegisterType(RBreakpointCollection);
|
||||
RegisterType(RWatchesCollection);
|
||||
RegisterType(RRegistersWindow);
|
||||
RegisterType(RRegistersView);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 1999-12-20 14:23:16 pierre
|
||||
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
|
||||
@ -2616,4 +2776,4 @@ end.
|
||||
Revision 1.1 1999/01/22 10:24:03 peter
|
||||
* first debugger things
|
||||
|
||||
}
|
||||
}
|
||||
@ -166,6 +166,7 @@ begin
|
||||
hcCalculator : S:='Show calculator';
|
||||
hcGrep : S:='Run grep';
|
||||
hcMsgGotoSource : S:='Edit source';
|
||||
hcRegisters : S:='Open the Registers Window';
|
||||
|
||||
hcToolsMessages : S:='Open the message window';
|
||||
hcToolsBase..
|
||||
@ -410,7 +411,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.25 2000-01-05 17:25:26 pierre
|
||||
Revision 1.26 2000-01-08 18:26:20 florian
|
||||
+ added a register window, doesn't work yet
|
||||
|
||||
Revision 1.25 2000/01/05 17:25:26 pierre
|
||||
* typo error corrected
|
||||
|
||||
Revision 1.24 2000/01/03 11:38:33 michael
|
||||
|
||||
@ -79,6 +79,7 @@ type
|
||||
procedure DoShowBreakpointList;
|
||||
procedure DoShowWatches;
|
||||
procedure DoAddWatch;
|
||||
procedure DoShowRegisters;
|
||||
|
||||
procedure DoInformation;
|
||||
procedure Messages;
|
||||
@ -295,12 +296,13 @@ begin
|
||||
NewItem('~U~ser screen','Alt+F5', kbAltF5, cmUserScreen, hcUserScreen,
|
||||
NewItem('~B~reakpoint','Ctrl+F8', kbCtrlF8, cmToggleBreakpoint, hcToggleBreakpoint,
|
||||
NewItem('~C~all stack','Ctrl+F3', kbCtrlF3, cmStack, hcStack,
|
||||
NewItem('~R~egisters','', kbNoKey, cmRegisters, hcRegisters,
|
||||
NewItem('~A~dd Watch','Ctrl+F7', kbCtrlF7, cmAddWatch, hcAddWatch,
|
||||
NewItem('~W~atches','', kbNoKey, cmWatches, hcWatches,
|
||||
NewItem('Breakpoint ~L~ist','', kbNoKey, cmBreakpointList, hcBreakpointList,
|
||||
NewLine(
|
||||
NewItem('~G~DB window','', kbNoKey, cmOpenGDBWindow, hcOpenGDBWindow,
|
||||
nil)))))))))),
|
||||
nil))))))))))),
|
||||
NewSubMenu('~T~ools', hcToolsMenu, NewMenu(
|
||||
NewItem('~M~essages', 'F11', kbF11, cmToolsMessages, hcToolsMessages,
|
||||
NewItem('Goto ~n~ext','Alt+F8', kbAltF8, cmToolsMsgNext, hcToolsMsgNext,
|
||||
@ -493,6 +495,7 @@ begin
|
||||
cmWatches : DoShowWatches;
|
||||
cmAddWatch : DoAddWatch;
|
||||
cmOpenGDBWindow : DoOpenGDBWindow;
|
||||
cmRegisters : DoShowRegisters;
|
||||
{ -- Options menu -- }
|
||||
cmSwitchesMode : SetSwitchesMode;
|
||||
cmCompiler : DoCompilerSwitch;
|
||||
@ -869,7 +872,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.49 2000-01-05 00:31:50 pierre
|
||||
Revision 1.50 2000-01-08 18:26:20 florian
|
||||
+ added a register window, doesn't work yet
|
||||
|
||||
Revision 1.49 2000/01/05 00:31:50 pierre
|
||||
* avoid new files to use TABS
|
||||
|
||||
Revision 1.48 2000/01/03 11:38:33 michael
|
||||
@ -1132,4 +1138,4 @@ END.
|
||||
+ options are now written/read
|
||||
+ find and replace routines
|
||||
|
||||
}
|
||||
}
|
||||
@ -59,6 +59,17 @@ begin
|
||||
{$endif NODEBUG}
|
||||
end;
|
||||
|
||||
procedure TIDEApp.DoShowRegisters;
|
||||
begin
|
||||
{$ifdef NODEBUG}
|
||||
NoDebugger;
|
||||
{$else}
|
||||
If not assigned(RegistersWindow) then
|
||||
InitRegistersWindow
|
||||
else
|
||||
RegistersWindow^.MakeFirst;
|
||||
{$endif NODEBUG}
|
||||
end;
|
||||
procedure TIDEApp.DoShowBreakpointList;
|
||||
begin
|
||||
{$ifdef NODEBUG}
|
||||
@ -125,7 +136,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 1999-09-22 16:18:19 pierre
|
||||
Revision 1.10 2000-01-08 18:26:20 florian
|
||||
+ added a register window, doesn't work yet
|
||||
|
||||
Revision 1.9 1999/09/22 16:18:19 pierre
|
||||
+ TIDEApp.DoCloseUserScreenWindow
|
||||
|
||||
Revision 1.8 1999/09/09 14:20:05 pierre
|
||||
@ -166,4 +180,4 @@ end;
|
||||
+ Switches updated
|
||||
+ Run program
|
||||
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user