mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 02:29:36 +02:00
1682 lines
51 KiB
ObjectPascal
1682 lines
51 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal Integrated Development Environment
|
|
Copyright (c) 1998-2000 by Pierre Muller
|
|
|
|
Register debug 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 FPRegs;
|
|
{$H-}
|
|
{$ifdef NODEBUG}
|
|
interface
|
|
implementation
|
|
end.
|
|
{$else NODEBUG}
|
|
interface
|
|
uses
|
|
{$ifdef Windows}
|
|
Windows,
|
|
{$endif Windows}
|
|
Objects,Dialogs,Drivers,Views,
|
|
FPViews;
|
|
|
|
|
|
const
|
|
MaxRegs = 128;
|
|
|
|
type
|
|
|
|
{$undef cpu_known}
|
|
|
|
TIntRegs = record
|
|
{$ifndef test_generic_cpu}
|
|
{$ifdef i386}
|
|
{$define cpu_known}
|
|
eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
|
|
cs,ds,es,ss,fs,gs : word;
|
|
eflags : dword;
|
|
{$endif i386}
|
|
{$ifdef x86_64}
|
|
{$define cpu_known}
|
|
rax,rbx,rcx,rdx,rsi,rdi,rbp,rsp,
|
|
r8,r9,r10,r11,r12,r13,r14,r15,
|
|
rip : qword;
|
|
cs,ds,es,ss,fs,gs : word;
|
|
eflags : dword;
|
|
{$endif x86_64}
|
|
{$ifdef m68k}
|
|
{$define cpu_known}
|
|
d0,d1,d2,d3,d4,d5,d6,d7 : dword;
|
|
a0,a1,a2,a3,a4,a5,fp,sp : dword;
|
|
ps,pc : dword;
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
{$define cpu_known}
|
|
r : array [0..31] of dword;
|
|
pc,ps,cr,lr,ctr,xer : dword;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
{$define cpu_known}
|
|
o : array [0..7] of dword;
|
|
i : array [0..7] of dword;
|
|
l : array [0..7] of dword;
|
|
g : array [0..7] of dword;
|
|
y,psr,wim,tbr,pc,npc,fsr,csr : dword;
|
|
{$endif sparc}
|
|
{$endif not test_generic_cpu}
|
|
{$ifndef cpu_known}
|
|
reg : array [0..MaxRegs-1] of string;
|
|
{$endif not cpu_known}
|
|
end;
|
|
|
|
PRegistersView = ^TRegistersView;
|
|
TRegistersView = object(TView)
|
|
NewReg,OldReg : TIntRegs;
|
|
InDraw : boolean;
|
|
GDBCount : longint;
|
|
first : boolean;
|
|
LastOK : boolean;
|
|
constructor Init(var Bounds: TRect);
|
|
procedure Draw;virtual;
|
|
destructor Done; virtual;
|
|
end;
|
|
|
|
PRegistersWindow = ^TRegistersWindow;
|
|
TRegistersWindow = Object(TFPDlgWindow)
|
|
RV : PRegistersView;
|
|
Constructor Init;
|
|
constructor Load(var S: TStream);
|
|
procedure Store(var S: TStream);
|
|
procedure Update; virtual;
|
|
destructor Done; virtual;
|
|
end;
|
|
|
|
TFPURegs = record
|
|
{$ifndef test_generic_cpu}
|
|
{$if defined(i386) or defined(x86_64)}
|
|
st0,st1,st2,st3,st4,st5,st6,st7 :string;
|
|
ftag,fop,fctrl,fstat,fiseg,foseg : word;
|
|
fioff,fooff : cardinal;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef m68k}
|
|
fp0,fp1,fp2,fp3,fp4,fp5,fp6,fp7 : string;
|
|
fpcontrol,fpstatus,fpiaddr : dword;
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
f : array [0..31] of string;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
f : array [0..31] of string;
|
|
{$endif sparc}
|
|
{$endif not test_generic_cpu}
|
|
{$ifndef cpu_known}
|
|
freg : array [0..MaxRegs-1] of string;
|
|
{$endif not cpu_known}
|
|
end;
|
|
|
|
PFPUView = ^TFPUView;
|
|
TFPUView = object(TView)
|
|
NewReg,OldReg : TFPURegs;
|
|
InDraw : boolean;
|
|
GDBCount : longint;
|
|
{$ifndef cpu_known}
|
|
UseInfoFloat : boolean;
|
|
{$endif not cpu_known}
|
|
first : boolean;
|
|
LastOK : boolean;
|
|
constructor Init(var Bounds: TRect);
|
|
procedure Draw;virtual;
|
|
destructor Done; virtual;
|
|
end;
|
|
|
|
PFPUWindow = ^TFPUWindow;
|
|
TFPUWindow = Object(TFPDlgWindow)
|
|
RV : PFPUView;
|
|
Constructor Init;
|
|
constructor Load(var S: TStream);
|
|
procedure Store(var S: TStream);
|
|
procedure Update; virtual;
|
|
destructor Done; virtual;
|
|
end;
|
|
|
|
tssereg = record
|
|
case byte of
|
|
1 : (bytearray : array[0..15] of byte);
|
|
2 : (wordarray : array[0..7] of word);
|
|
3 : (dwordarray : array[0..3] of dword);
|
|
4 : (qwordarray : array[0..1] of qword);
|
|
5 : (twordfield : array[0..1] of qword);
|
|
6 : (singlearray : array[0..3] of single);
|
|
7 : (doublearray : array[0..1] of double);
|
|
end;
|
|
|
|
tmmxreg = record
|
|
case byte of
|
|
1 : (bytearray : array[0..7] of byte);
|
|
2 : (wordarray : array[0..3] of word);
|
|
3 : (dwordarray : array[0..1] of dword);
|
|
4 : (qwordfield : qword);
|
|
6 : (singlearray : array[0..1] of single);
|
|
end;
|
|
|
|
TVectorRegs = record
|
|
{$ifndef test_generic_cpu}
|
|
{$if defined(i386) or defined(x86_64)}
|
|
xmm : array[0..7] of string;
|
|
mmx : array[0..7] of string;
|
|
mxcsr : string;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef powerpc}
|
|
m : array[0..31] of string;
|
|
{$endif powerpc}
|
|
{$endif not test_generic_cpu}
|
|
{$ifndef cpu_known}
|
|
vreg : array [0..MaxRegs-1] of string;
|
|
{$endif not cpu_known}
|
|
end;
|
|
|
|
|
|
PVectorView = ^TVectorView;
|
|
TVectorView = object(TView)
|
|
NewReg,OldReg : TVectorRegs;
|
|
InDraw : boolean;
|
|
GDBCount : longint;
|
|
{$ifndef cpu_known}
|
|
UseInfoVector : boolean;
|
|
{$endif not cpu_known}
|
|
first : boolean;
|
|
LastOK : boolean;
|
|
constructor Init(var Bounds: TRect);
|
|
procedure Draw;virtual;
|
|
destructor Done; virtual;
|
|
end;
|
|
|
|
PVectorWindow = ^TVectorWindow;
|
|
TVectorWindow = Object(TFPDlgWindow)
|
|
RV : PVectorView;
|
|
Constructor Init;
|
|
constructor Load(var S: TStream);
|
|
procedure Store(var S: TStream);
|
|
procedure Update; virtual;
|
|
destructor Done; virtual;
|
|
end;
|
|
|
|
|
|
procedure InitRegistersWindow;
|
|
procedure DoneRegistersWindow;
|
|
procedure InitFPUWindow;
|
|
procedure DoneFPUWindow;
|
|
procedure InitVectorWindow;
|
|
procedure DoneVectorWindow;
|
|
|
|
procedure RegisterFPRegsViews;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Strings,
|
|
{$ifndef NODEBUG}
|
|
{$ifdef GDBMI}
|
|
GDBMICon, GDBMIInt,
|
|
{$else GDBMI}
|
|
GDBCon,GDBInt,
|
|
{$endif GDBMI}
|
|
{$endif NODEBUG}
|
|
App,Menus,
|
|
WViews,WEditor,
|
|
wutils,
|
|
FPConst,FPVars,
|
|
FPDebug;
|
|
|
|
|
|
Const
|
|
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
|
|
);
|
|
|
|
RVectorView: TStreamRec = (
|
|
ObjType: 1715;
|
|
VmtLink: Ofs(TypeOf(TVectorView)^);
|
|
Load: @TVectorView.Load;
|
|
Store: @TVectorView.Store
|
|
);
|
|
|
|
{$ifdef useresstrings}
|
|
resourcestring
|
|
{$else}
|
|
const
|
|
{$endif}
|
|
dialog_registers = 'Register View';
|
|
dialog_fpu = 'FPU View';
|
|
dialog_vector = 'Vector Unit View';
|
|
msg_registervaluesnotavailable = '<no values available>';
|
|
msg_registerwindowerror = '<debugger error>';
|
|
|
|
{****************************************************************************
|
|
TRegistersView
|
|
****************************************************************************}
|
|
|
|
function GetIntRegs(var rs : TIntRegs) : boolean;
|
|
|
|
var
|
|
p,po : PAnsiChar;
|
|
p1 : PAnsiChar;
|
|
buffer : array[0..255] of AnsiChar;
|
|
i : byte;
|
|
|
|
begin
|
|
GetIntRegs:=false;
|
|
{$ifndef NODEBUG}
|
|
{$ifdef cpu_known}
|
|
{$ifdef i386}
|
|
GetIntRegs :=
|
|
Debugger^.GetIntRegister('eax', rs.eax) and
|
|
Debugger^.GetIntRegister('ebx', rs.ebx) and
|
|
Debugger^.GetIntRegister('ecx', rs.ecx) and
|
|
Debugger^.GetIntRegister('edx', rs.edx) and
|
|
Debugger^.GetIntRegister('esi', rs.esi) and
|
|
Debugger^.GetIntRegister('edi', rs.edi) and
|
|
Debugger^.GetIntRegister('ebp', rs.ebp) and
|
|
Debugger^.GetIntRegister('esp', rs.esp) and
|
|
Debugger^.GetIntRegister('eip', rs.eip) and
|
|
{ under Windows flags are on a register named ps !! PM }
|
|
(Debugger^.GetIntRegister('eflags', rs.eflags) or Debugger^.GetIntRegister('ps', rs.eflags)) and
|
|
Debugger^.GetIntRegister('cs', rs.cs) and
|
|
Debugger^.GetIntRegister('ds', rs.ds) and
|
|
Debugger^.GetIntRegister('es', rs.es) and
|
|
Debugger^.GetIntRegister('fs', rs.fs) and
|
|
Debugger^.GetIntRegister('gs', rs.gs) and
|
|
Debugger^.GetIntRegister('ss', rs.ss);
|
|
{$endif i386}
|
|
{$ifdef x86_64}
|
|
GetIntRegs :=
|
|
Debugger^.GetIntRegister('rax', rs.rax) and
|
|
Debugger^.GetIntRegister('rbx', rs.rbx) and
|
|
Debugger^.GetIntRegister('rcx', rs.rcx) and
|
|
Debugger^.GetIntRegister('rdx', rs.rdx) and
|
|
Debugger^.GetIntRegister('rsi', rs.rsi) and
|
|
Debugger^.GetIntRegister('rdi', rs.rdi) and
|
|
Debugger^.GetIntRegister('rbp', rs.rbp) and
|
|
Debugger^.GetIntRegister('rsp', rs.rsp) and
|
|
Debugger^.GetIntRegister('r8', rs.r8) and
|
|
Debugger^.GetIntRegister('r9', rs.r9) and
|
|
Debugger^.GetIntRegister('r10', rs.r10) and
|
|
Debugger^.GetIntRegister('r11', rs.r11) and
|
|
Debugger^.GetIntRegister('r12', rs.r12) and
|
|
Debugger^.GetIntRegister('r13', rs.r13) and
|
|
Debugger^.GetIntRegister('r14', rs.r14) and
|
|
Debugger^.GetIntRegister('r15', rs.r15) and
|
|
Debugger^.GetIntRegister('rip', rs.rip) and
|
|
{ under Windows flags are on a register named ps !! PM }
|
|
(Debugger^.GetIntRegister('eflags', rs.eflags) or Debugger^.GetIntRegister('ps', rs.eflags)) and
|
|
Debugger^.GetIntRegister('cs', rs.cs) and
|
|
Debugger^.GetIntRegister('ds', rs.ds) and
|
|
Debugger^.GetIntRegister('es', rs.es) and
|
|
Debugger^.GetIntRegister('fs', rs.fs) and
|
|
Debugger^.GetIntRegister('gs', rs.gs) and
|
|
Debugger^.GetIntRegister('ss', rs.ss);
|
|
{$endif x86_64}
|
|
{$ifdef m68k}
|
|
GetIntRegs :=
|
|
Debugger^.GetIntRegister('d0', rs.d0) and
|
|
Debugger^.GetIntRegister('d1', rs.d1) and
|
|
Debugger^.GetIntRegister('d2', rs.d2) and
|
|
Debugger^.GetIntRegister('d3', rs.d3) and
|
|
Debugger^.GetIntRegister('d4', rs.d4) and
|
|
Debugger^.GetIntRegister('d5', rs.d5) and
|
|
Debugger^.GetIntRegister('d6', rs.d6) and
|
|
Debugger^.GetIntRegister('d7', rs.d7) and
|
|
Debugger^.GetIntRegister('a0', rs.a0) and
|
|
Debugger^.GetIntRegister('a1', rs.a1) and
|
|
Debugger^.GetIntRegister('a2', rs.a2) and
|
|
Debugger^.GetIntRegister('a3', rs.a3) and
|
|
Debugger^.GetIntRegister('a4', rs.a4) and
|
|
Debugger^.GetIntRegister('a5', rs.a5) and
|
|
Debugger^.GetIntRegister('fp', rs.fp) and
|
|
Debugger^.GetIntRegister('sp', rs.sp) and
|
|
Debugger^.GetIntRegister('ps', rs.ps) and
|
|
Debugger^.GetIntRegister('pc', rs.pc);
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
GetIntRegs := true;
|
|
for i:=0 to 31 do
|
|
GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('r'+inttostr(i), rs.r[i]);
|
|
{ other regs
|
|
pc,ps,cr,lr,ctr,xer : dword; }
|
|
GetIntRegs := GetIntRegs and
|
|
Debugger^.GetIntRegister('pc', rs.pc) and
|
|
Debugger^.GetIntRegister('ps', rs.ps) and
|
|
Debugger^.GetIntRegister('lr', rs.lr) and
|
|
Debugger^.GetIntRegister('ctr', rs.ctr) and
|
|
Debugger^.GetIntRegister('xer', rs.xer);
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
GetIntRegs := true;
|
|
for i:=0 to 7 do
|
|
GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('o'+inttostr(i), rs.o[i]);
|
|
for i:=0 to 7 do
|
|
if i = 6 then
|
|
GetIntRegs := GetIntRegs and (Debugger^.GetIntRegister('i6', rs.i[6]) or Debugger^.GetIntRegister('fp', rs.i[6]))
|
|
else
|
|
GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('i'+inttostr(i), rs.i[i]);
|
|
for i:=0 to 7 do
|
|
GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('l'+inttostr(i), rs.l[i]);
|
|
for i:=0 to 7 do
|
|
GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('g'+inttostr(i), rs.g[i]);
|
|
|
|
GetIntRegs := GetIntRegs and
|
|
Debugger^.GetIntRegister('y', rs.y) and
|
|
Debugger^.GetIntRegister('psr', rs.psr) and
|
|
Debugger^.GetIntRegister('wim', rs.wim) and
|
|
Debugger^.GetIntRegister('tbs', rs.tbr) and
|
|
Debugger^.GetIntRegister('pc', rs.pc) and
|
|
Debugger^.GetIntRegister('npc', rs.npc) and
|
|
Debugger^.GetIntRegister('fsr', rs.fsr) and
|
|
Debugger^.GetIntRegister('csr', rs.csr);
|
|
{$endif sparc}
|
|
{$else cpu_known}
|
|
Debugger^.Command('info registers');
|
|
if Debugger^.Error then
|
|
exit
|
|
else
|
|
begin
|
|
i:=0;
|
|
po:=StrNew(Debugger^.GetOutput);
|
|
p:=po;
|
|
if assigned(p) then
|
|
begin
|
|
fillchar(rs,sizeof(rs),0);
|
|
p1:=strscan(p,' ');
|
|
while assigned(p1) do
|
|
begin
|
|
p1:=strscan(p,#10);
|
|
if assigned(p1) then
|
|
begin
|
|
strlcopy(buffer,p,p1-p);
|
|
rs.reg[i]:=ExtractTabs(strpas(buffer),8);
|
|
if i<MaxRegs-1 then
|
|
inc(i);
|
|
end;
|
|
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 cpu_known}
|
|
{$endif not NODEBUG}
|
|
end;
|
|
|
|
constructor TRegistersView.Init(var Bounds: TRect);
|
|
|
|
begin
|
|
inherited init(Bounds);
|
|
InDraw:=false;
|
|
first:=true;
|
|
FillChar(OldReg,Sizeof(OldReg),#0);
|
|
FillChar(NewReg,Sizeof(NewReg),#0);
|
|
GrowMode:=gfGrowHiX or GfGrowHiY;
|
|
GDBCount:=-1;
|
|
end;
|
|
|
|
procedure TRegistersView.Draw;
|
|
|
|
var
|
|
rs : tintregs;
|
|
OK : boolean;
|
|
color :byte;
|
|
i : byte;
|
|
|
|
procedure SetColor(x,y : longint);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
procedure SetColor(x,y : qword);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
procedure SetStrColor(const x,y : string);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
begin
|
|
inherited draw;
|
|
{$ifdef NODEBUG}
|
|
WriteStr(1,0,msg_registervaluesnotavailable,7);
|
|
{$else NODEBUG}
|
|
If (not assigned(Debugger)) or (not Debugger^.IsRunning) then
|
|
begin
|
|
WriteStr(1,0,msg_registervaluesnotavailable,7);
|
|
exit;
|
|
end;
|
|
if InDraw then exit;
|
|
InDraw:=true;
|
|
if GDBCount<>Debugger^.RunCount then
|
|
begin
|
|
OldReg:=NewReg;
|
|
OK:=GetIntRegs(rs);
|
|
LastOK:=OK;
|
|
NewReg:=rs;
|
|
{ get inital values }
|
|
if first then
|
|
begin
|
|
OldReg:=NewReg;
|
|
first:=false;
|
|
end;
|
|
GDBCount:=Debugger^.RunCount;
|
|
end
|
|
else
|
|
begin
|
|
rs:=NewReg;
|
|
OK:=LastOK;
|
|
end;
|
|
if OK then
|
|
begin
|
|
{$ifdef cpu_known}
|
|
{$ifdef i386}
|
|
SetColor(rs.eax,OldReg.eax);
|
|
WriteStr(1,0,'EAX '+HexStr(longint(rs.eax),8),color);
|
|
SetColor(rs.ebx,OldReg.ebx);
|
|
WriteStr(1,1,'EBX '+HexStr(longint(rs.ebx),8),color);
|
|
SetColor(rs.ecx,OldReg.ecx);
|
|
WriteStr(1,2,'ECX '+HexStr(longint(rs.ecx),8),color);
|
|
SetColor(rs.edx,OldReg.edx);
|
|
WriteStr(1,3,'EDX '+HexStr(longint(rs.edx),8),color);
|
|
SetColor(rs.eip,OldReg.eip);
|
|
WriteStr(1,4,'EIP '+HexStr(longint(rs.eip),8),color);
|
|
SetColor(rs.esi,OldReg.esi);
|
|
WriteStr(1,5,'ESI '+HexStr(longint(rs.esi),8),color);
|
|
SetColor(rs.edi,OldReg.edi);
|
|
WriteStr(1,6,'EDI '+HexStr(longint(rs.edi),8),color);
|
|
SetColor(rs.esp,OldReg.esp);
|
|
WriteStr(1,7,'ESP '+HexStr(longint(rs.esp),8),color);
|
|
SetColor(rs.ebp,OldReg.ebp);
|
|
WriteStr(1,8,'EBP '+HexStr(longint(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);
|
|
{$endif i386}
|
|
{$ifdef x86_64}
|
|
SetColor(rs.rax,OldReg.rax);
|
|
WriteStr(1,0,'RAX '+HexStr(rs.rax,16),color);
|
|
SetColor(rs.rbx,OldReg.rbx);
|
|
WriteStr(1,1,'RBX '+HexStr(rs.rbx,16),color);
|
|
SetColor(rs.rcx,OldReg.rcx);
|
|
WriteStr(1,2,'RCX '+HexStr(rs.rcx,16),color);
|
|
SetColor(rs.rdx,OldReg.rdx);
|
|
WriteStr(1,3,'RDX '+HexStr(rs.rdx,16),color);
|
|
SetColor(rs.rsi,OldReg.rsi);
|
|
WriteStr(1,4,'RSI '+HexStr(rs.rsi,16),color);
|
|
SetColor(rs.rdi,OldReg.rdi);
|
|
WriteStr(1,5,'RDI '+HexStr(rs.rdi,16),color);
|
|
SetColor(rs.rbp,OldReg.rbp);
|
|
WriteStr(1,6,'RBP '+HexStr(rs.rbp,16),color);
|
|
SetColor(rs.rsp,OldReg.rsp);
|
|
WriteStr(1,7,'RSP '+HexStr(rs.rsp,16),color);
|
|
SetColor(rs.r8,OldReg.r8);
|
|
WriteStr(1,8,'R8 '+HexStr(rs.r8,16),color);
|
|
SetColor(rs.r9,OldReg.r9);
|
|
WriteStr(1,9,'R9 '+HexStr(rs.r9,16),color);
|
|
SetColor(rs.r10,OldReg.r10);
|
|
WriteStr(1,10,'R10 '+HexStr(rs.r10,16),color);
|
|
SetColor(rs.r11,OldReg.r11);
|
|
WriteStr(1,11,'R11 '+HexStr(rs.r11,16),color);
|
|
SetColor(rs.r12,OldReg.r12);
|
|
WriteStr(1,12,'R12 '+HexStr(rs.r12,16),color);
|
|
SetColor(rs.r13,OldReg.r13);
|
|
WriteStr(1,13,'R13 '+HexStr(rs.r13,16),color);
|
|
SetColor(rs.r14,OldReg.r14);
|
|
WriteStr(1,14,'R14 '+HexStr(rs.r14,16),color);
|
|
SetColor(rs.r15,OldReg.r15);
|
|
WriteStr(1,15,'R15 '+HexStr(rs.r15,16),color);
|
|
SetColor(rs.rip,OldReg.rip);
|
|
WriteStr(1,16,'RIP '+HexStr(rs.rip,16),color);
|
|
SetColor(rs.cs,OldReg.cs);
|
|
WriteStr(22,11,'CS '+HexStr(rs.cs,4),color);
|
|
SetColor(rs.ds,OldReg.ds);
|
|
WriteStr(22,12,'DS '+HexStr(rs.ds,4),color);
|
|
SetColor(rs.es,OldReg.es);
|
|
WriteStr(22,13,'ES '+HexStr(rs.es,4),color);
|
|
SetColor(rs.fs,OldReg.fs);
|
|
WriteStr(22,14,'FS '+HexStr(rs.fs,4),color);
|
|
SetColor(rs.gs,OldReg.gs);
|
|
WriteStr(22,15,'GS '+HexStr(rs.gs,4),color);
|
|
SetColor(rs.ss,OldReg.ss);
|
|
WriteStr(22,16,'SS '+HexStr(rs.ss,4),color);
|
|
SetColor(rs.eflags and $1,OldReg.eflags and $1);
|
|
WriteStr(24,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
|
|
SetColor(rs.eflags and $20,OldReg.eflags and $20);
|
|
WriteStr(24,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
|
|
SetColor(rs.eflags and $80,OldReg.eflags and $80);
|
|
WriteStr(24,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
|
|
SetColor(rs.eflags and $800,OldReg.eflags and $800);
|
|
WriteStr(24,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
|
|
SetColor(rs.eflags and $4,OldReg.eflags and $4);
|
|
WriteStr(24,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
|
|
SetColor(rs.eflags and $200,OldReg.eflags and $200);
|
|
WriteStr(24,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
|
|
SetColor(rs.eflags and $10,OldReg.eflags and $10);
|
|
WriteStr(24,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
|
|
SetColor(rs.eflags and $400,OldReg.eflags and $400);
|
|
WriteStr(24,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
|
|
{$endif x86_64}
|
|
{$ifdef m68k}
|
|
SetColor(rs.d0,OldReg.d0);
|
|
WriteStr(1,0,'d0 '+HexStr(longint(rs.d0),8),color);
|
|
SetColor(rs.d1,OldReg.d1);
|
|
WriteStr(1,1,'d1 '+HexStr(longint(rs.d1),8),color);
|
|
SetColor(rs.d2,OldReg.d2);
|
|
WriteStr(1,2,'d2 '+HexStr(longint(rs.d2),8),color);
|
|
SetColor(rs.d3,OldReg.d3);
|
|
WriteStr(1,3,'d3 '+HexStr(longint(rs.d3),8),color);
|
|
SetColor(rs.d4,OldReg.d4);
|
|
WriteStr(1,4,'d4 '+HexStr(longint(rs.d4),8),color);
|
|
SetColor(rs.d5,OldReg.d5);
|
|
WriteStr(1,5,'d5 '+HexStr(longint(rs.d5),8),color);
|
|
SetColor(rs.d6,OldReg.d6);
|
|
WriteStr(1,6,'d6 '+HexStr(longint(rs.d6),8),color);
|
|
SetColor(rs.d7,OldReg.d7);
|
|
WriteStr(1,7,'d7 '+HexStr(longint(rs.d7),8),color);
|
|
SetColor(rs.a0,OldReg.a0);
|
|
WriteStr(14,0,'a0 '+HexStr(longint(rs.a0),8),color);
|
|
SetColor(rs.a1,OldReg.a1);
|
|
WriteStr(14,1,'a1 '+HexStr(longint(rs.a1),8),color);
|
|
SetColor(rs.a2,OldReg.a2);
|
|
WriteStr(14,2,'a2 '+HexStr(longint(rs.a2),8),color);
|
|
SetColor(rs.a3,OldReg.a3);
|
|
WriteStr(14,3,'a3 '+HexStr(longint(rs.a3),8),color);
|
|
SetColor(rs.a4,OldReg.a4);
|
|
WriteStr(14,4,'a4 '+HexStr(longint(rs.a4),8),color);
|
|
SetColor(rs.a5,OldReg.a5);
|
|
WriteStr(14,5,'a5 '+HexStr(longint(rs.a5),8),color);
|
|
SetColor(rs.fp,OldReg.fp);
|
|
WriteStr(14,6,'fp '+HexStr(longint(rs.fp),8),color);
|
|
SetColor(rs.sp,OldReg.sp);
|
|
WriteStr(14,7,'sp '+HexStr(longint(rs.sp),8),color);
|
|
SetColor(rs.pc,OldReg.pc);
|
|
WriteStr(1,8,'pc '+HexStr(longint(rs.pc),8),color);
|
|
SetColor(rs.ps and $1,OldReg.ps and $1);
|
|
WriteStr(22,8,' c'+chr(byte((rs.ps and $1)<>0)+48),color);
|
|
SetColor(rs.ps and $2,OldReg.ps and $2);
|
|
WriteStr(19,8,' v'+chr(byte((rs.ps and $2)<>0)+48),color);
|
|
SetColor(rs.ps and $4,OldReg.ps and $4);
|
|
WriteStr(16,8,' z'+chr(byte((rs.ps and $4)<>0)+48),color);
|
|
SetColor(rs.ps and $8,OldReg.ps and $8);
|
|
WriteStr(14,8, 'x'+chr(byte((rs.ps and $8)<>0)+48),color);
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
for i:=0 to 15 do
|
|
begin
|
|
SetColor(rs.r[i],OldReg.r[i]);
|
|
if i<10 then
|
|
WriteStr(1,i,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color)
|
|
else
|
|
WriteStr(1,i,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color);
|
|
end;
|
|
for i:=16 to 31 do
|
|
begin
|
|
SetColor(rs.r[i],OldReg.r[i]);
|
|
WriteStr(15,i-16,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color);
|
|
end;
|
|
{ other regs pc,ps,cr,lr,ctr,xer : dword; }
|
|
SetColor(rs.pc,OldReg.pc);
|
|
WriteStr(1,16,'pc '+HexStr(longint(rs.pc),8),color);
|
|
SetColor(rs.ps,OldReg.ps);
|
|
WriteStr(15,16,'ps '+HexStr(longint(rs.ps),8),color);
|
|
SetColor(rs.lr,OldReg.lr);
|
|
WriteStr(1,17,'lr '+HexStr(longint(rs.lr),8),color);
|
|
SetColor(rs.ctr,OldReg.ctr);
|
|
WriteStr(15,17,'ctr '+HexStr(longint(rs.ctr),8),color);
|
|
SetColor(rs.xer,OldReg.xer);
|
|
WriteStr(15,18,'xer '+HexStr(longint(rs.xer),8),color);
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
for i:=0 to 7 do
|
|
begin
|
|
SetColor(rs.g[i],OldReg.g[i]);
|
|
WriteStr(1,i,'g'+IntToStr(i)+' '+HexStr(longint(rs.g[i]),8),color);
|
|
SetColor(rs.l[i],OldReg.l[i]);
|
|
WriteStr(1,i+8,'l'+IntToStr(i)+' '+HexStr(longint(rs.l[i]),8),color);
|
|
end;
|
|
for i:=0 to 7 do
|
|
begin
|
|
SetColor(rs.i[i],OldReg.i[i]);
|
|
if i=6 then
|
|
WriteStr(15,i,'fp '+HexStr(longint(rs.i[i]),8),color)
|
|
else
|
|
WriteStr(15,i,'i'+IntToStr(i)+' '+HexStr(longint(rs.i[i]),8),color);
|
|
SetColor(rs.o[i],OldReg.o[i]);
|
|
WriteStr(15,i+8,'o'+IntToStr(i)+' '+HexStr(longint(rs.o[i]),8),color);
|
|
end;
|
|
SetColor(rs.pc,OldReg.pc);
|
|
WriteStr(1,16,'pc '+HexStr(longint(rs.pc),8),color);
|
|
SetColor(rs.y,OldReg.y);
|
|
WriteStr(1,17,'y '+HexStr(longint(rs.y),8),color);
|
|
SetColor(rs.psr,OldReg.psr);
|
|
WriteStr(1,18,'psr '+HexStr(longint(rs.psr),8),color);
|
|
SetColor(rs.csr,OldReg.csr);
|
|
WriteStr(1,19,'csr '+HexStr(longint(rs.csr),8),color);
|
|
SetColor(rs.npc,OldReg.npc);
|
|
WriteStr(15,16,'npc '+HexStr(longint(rs.npc),8),color);
|
|
SetColor(rs.tbr,OldReg.tbr);
|
|
WriteStr(15,17,'tbr '+HexStr(longint(rs.tbr),8),color);
|
|
SetColor(rs.wim,OldReg.wim);
|
|
WriteStr(15,18,'wim '+HexStr(longint(rs.wim),8),color);
|
|
SetColor(rs.fsr,OldReg.fsr);
|
|
WriteStr(15,19,'fsr '+HexStr(longint(rs.fsr),8),color);
|
|
{$endif sparc}
|
|
{$else cpu_known}
|
|
for i:=0 to MaxRegs-1 do
|
|
begin
|
|
SetStrColor(rs.reg[i],OldReg.reg[i]);
|
|
WriteStr(1,i,rs.reg[i],color);
|
|
end;
|
|
{$endif cpu_known}
|
|
end
|
|
else
|
|
WriteStr(0,0,msg_registerwindowerror,7);
|
|
InDraw:=false;
|
|
{$endif NODEBUG}
|
|
end;
|
|
|
|
destructor TRegistersView.Done;
|
|
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TRegistersWindow
|
|
****************************************************************************}
|
|
|
|
constructor TRegistersWindow.Init;
|
|
|
|
var
|
|
R : TRect;
|
|
|
|
begin
|
|
Desktop^.GetExtent(R);
|
|
{$ifdef i386}
|
|
R.A.X:=R.B.X-28;
|
|
R.B.Y:=R.A.Y+11;
|
|
{$endif i386}
|
|
{$ifdef x86_64}
|
|
R.A.X:=R.B.X-32;
|
|
R.B.Y:=R.A.Y+19;
|
|
{$endif x86_64}
|
|
{$ifdef m68k}
|
|
R.A.X:=R.B.X-28;
|
|
R.B.Y:=R.A.Y+11;
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
R.A.X:=R.B.X-30;
|
|
R.B.Y:=R.A.Y+21;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
R.A.X:=R.B.X-30;
|
|
R.B.Y:=R.A.Y+22;
|
|
{$endif sparc}
|
|
{$ifndef cpu_known}
|
|
R.A.X:=R.B.X-28;
|
|
R.B.Y:=R.A.Y+22;
|
|
{$endif cpu_known}
|
|
inherited Init(R,dialog_registers, wnNoNumber);
|
|
Flags:=wfClose or wfMove;
|
|
{$ifndef cpu_known}
|
|
Flags:=Flags or wfgrow;
|
|
{$endif cpu_known}
|
|
Palette:=wpCyanWindow;
|
|
HelpCtx:=hcRegistersWindow;
|
|
R.Assign(1,1,Size.X-2,Size.Y-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
|
|
ReDraw;
|
|
end;
|
|
|
|
destructor TRegistersWindow.Done;
|
|
|
|
begin
|
|
RegistersWindow:=nil;
|
|
inherited done;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TFPUView
|
|
****************************************************************************}
|
|
|
|
function GetFPURegs(var rs : TFPURegs
|
|
{$ifndef cpu_known}
|
|
; UseInfoFloat : boolean
|
|
{$endif not cpu_known}
|
|
) : boolean;
|
|
|
|
var
|
|
p,po : PAnsiChar;
|
|
p1 : PAnsiChar;
|
|
{$ifndef NODEBUG}
|
|
reg,value : string;
|
|
buffer : array[0..255] of AnsiChar;
|
|
v : string;
|
|
res : cardinal;
|
|
i : longint;
|
|
err : word;
|
|
{$endif}
|
|
|
|
begin
|
|
GetFPURegs:=false;
|
|
{$ifndef NODEBUG}
|
|
{$ifndef cpu_known}
|
|
if UseInfoFloat then
|
|
begin
|
|
Debugger^.Command('info float');
|
|
if Debugger^.Error then
|
|
begin
|
|
UseInfofloat:=false;
|
|
Debugger^.Command('info all');
|
|
end;
|
|
end
|
|
else
|
|
{$endif not cpu_known}
|
|
Debugger^.Command('info all');
|
|
if Debugger^.Error then
|
|
exit
|
|
else
|
|
begin
|
|
po:=StrNew(Debugger^.GetOutput);
|
|
p:=po;
|
|
{$ifndef cpu_known}
|
|
i:=0;
|
|
{$endif not cpu_known}
|
|
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);
|
|
{$ifndef cpu_known}
|
|
p1:=strscan(p,#10);
|
|
if assigned(p1) then
|
|
begin
|
|
strlcopy(buffer,p,p1-p);
|
|
rs.freg[i]:=ExtractTabs(strpas(buffer),8);
|
|
if i<MaxRegs-1 then
|
|
inc(i);
|
|
end;
|
|
{$else cpu_known}
|
|
p:=p1;
|
|
while p^=' ' do
|
|
inc(p);
|
|
if p^='$' then
|
|
p1:=strscan(p,#9)
|
|
else
|
|
p1:=strscan(p,#10);
|
|
strlcopy(buffer,p,p1-p);
|
|
v:=strpas(buffer);
|
|
for i:=1 to length(v) do
|
|
if v[i]=#9 then
|
|
v[i]:=' ';
|
|
val(v,res,err);
|
|
{$if defined(i386) or defined(x86_64)}
|
|
if reg='st0' then
|
|
rs.st0:=v
|
|
else if reg='st1' then
|
|
rs.st1:=v
|
|
else if reg='st2' then
|
|
rs.st2:=v
|
|
else if reg='st3' then
|
|
rs.st3:=v
|
|
else if reg='st4' then
|
|
rs.st4:=v
|
|
else if reg='st5' then
|
|
rs.st5:=v
|
|
else if reg='st6' then
|
|
rs.st6:=v
|
|
else if reg='st7' then
|
|
rs.st7:=v
|
|
else if reg='ftag' then
|
|
rs.ftag:=res
|
|
else if reg='fctrl' then
|
|
rs.fctrl:=res
|
|
else if reg='fstat' then
|
|
rs.fstat:=res
|
|
else if reg='fiseg' then
|
|
rs.fiseg:=res
|
|
else if reg='fioff' then
|
|
rs.fioff:=res
|
|
else if reg='foseg' then
|
|
rs.foseg:=res
|
|
else if reg='fooff' then
|
|
rs.fooff:=res
|
|
else if reg='fop' then
|
|
rs.fop:=res;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef m68k}
|
|
if reg='fp0' then
|
|
rs.fp0:=v
|
|
else if reg='fp1' then
|
|
rs.fp1:=v
|
|
else if reg='fp2' then
|
|
rs.fp2:=v
|
|
else if reg='fp3' then
|
|
rs.fp3:=v
|
|
else if reg='fp4' then
|
|
rs.fp4:=v
|
|
else if reg='fp5' then
|
|
rs.fp5:=v
|
|
else if reg='fp6' then
|
|
rs.fp6:=v
|
|
else if reg='fp7' then
|
|
rs.fp7:=v
|
|
else if reg='fpcontrol' then
|
|
rs.fpcontrol:=res
|
|
else if reg='fpstatus' then
|
|
rs.fpstatus:=res
|
|
else if reg='fpiaddr' then
|
|
rs.fpiaddr:=res;
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
if reg[1]='f' then
|
|
for i:=0 to 31 do
|
|
if reg='f'+inttostr(i) then
|
|
rs.f[i]:=v;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
if reg[1]='f' then
|
|
for i:=0 to 31 do
|
|
if reg='f'+inttostr(i) then
|
|
rs.f[i]:=v;
|
|
{$endif sparc}
|
|
{$endif cpu_known}
|
|
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);
|
|
GrowMode:=gfGrowHiX or GfGrowHiY;
|
|
InDraw:=false;
|
|
first:=true;
|
|
FillChar(OldReg,Sizeof(oldreg),#0);
|
|
FillChar(NewReg,Sizeof(newreg),#0);
|
|
GDBCount:=-1;
|
|
{$ifndef cpu_known}
|
|
UseInfoFloat:=true;
|
|
{$endif not cpu_known}
|
|
end;
|
|
|
|
procedure TFPUView.Draw;
|
|
|
|
var
|
|
rs : tfpuregs;
|
|
top : byte;
|
|
color :byte;
|
|
ok : boolean;
|
|
i : byte;
|
|
const
|
|
TypeStr : Array[0..3] of string[6] =
|
|
('Valid ','Zero ','Spec ','Empty ');
|
|
|
|
procedure SetColor(Const x,y : string);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
procedure SetIColor(Const x,y : cardinal);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
begin
|
|
inherited draw;
|
|
{$ifdef NODEBUG}
|
|
WriteStr(1,0,msg_registervaluesnotavailable,7);
|
|
{$else NODEBUG}
|
|
If (not assigned(Debugger)) or (not Debugger^.IsRunning) then
|
|
begin
|
|
WriteStr(1,0,msg_registervaluesnotavailable,7);
|
|
exit;
|
|
end;
|
|
if InDraw then
|
|
exit;
|
|
InDraw:=true;
|
|
if GDBCount<>Debugger^.RunCount then
|
|
begin
|
|
OldReg:=NewReg;
|
|
OK:=GetFPURegs(rs
|
|
{$ifndef cpu_known}
|
|
,UseInfoFloat
|
|
{$endif not cpu_known}
|
|
);
|
|
LastOK:=OK;
|
|
NewReg:=rs;
|
|
{ get inital values }
|
|
if first then
|
|
begin
|
|
OldReg:=NewReg;
|
|
first:=false;
|
|
end;
|
|
GDBCount:=Debugger^.RunCount;
|
|
end
|
|
else
|
|
begin
|
|
rs:=newreg;
|
|
OK:=LastOK;
|
|
end;
|
|
if OK then
|
|
begin
|
|
{$ifdef cpu_known}
|
|
{$if defined(i386) or defined(x86_64)}
|
|
top:=(rs.fstat shr 11) and 7;
|
|
SetColor(rs.st0,OldReg.st0);
|
|
WriteStr(1,0,'ST0 '+TypeStr[(rs.ftag shr (2*((0+top) and 7))) and 3]+rs.st0,color);
|
|
SetColor(rs.st1,OldReg.st1);
|
|
WriteStr(1,1,'ST1 '+TypeStr[(rs.ftag shr (2*((1+top) and 7))) and 3]+rs.st1,color);
|
|
SetColor(rs.st2,OldReg.st2);
|
|
WriteStr(1,2,'ST2 '+TypeStr[(rs.ftag shr (2*((2+top) and 7))) and 3]+rs.st2,color);
|
|
SetColor(rs.st3,OldReg.st3);
|
|
WriteStr(1,3,'ST3 '+TypeStr[(rs.ftag shr (2*((3+top) and 7))) and 3]+rs.st3,color);
|
|
SetColor(rs.st4,OldReg.st4);
|
|
WriteStr(1,4,'ST4 '+TypeStr[(rs.ftag shr (2*((4+top) and 7))) and 3]+rs.st4,color);
|
|
SetColor(rs.st5,OldReg.st5);
|
|
WriteStr(1,5,'ST5 '+TypeStr[(rs.ftag shr (2*((5+top) and 7))) and 3]+rs.st5,color);
|
|
SetColor(rs.st6,OldReg.st6);
|
|
WriteStr(1,6,'ST6 '+TypeStr[(rs.ftag shr (2*((6+top) and 7))) and 3]+rs.st6,color);
|
|
SetColor(rs.st7,OldReg.st7);
|
|
WriteStr(1,7,'ST7 '+TypeStr[(rs.ftag shr (2*((7+top) and 7))) and 3]+rs.st7,color);
|
|
SetIColor(rs.ftag,OldReg.ftag);
|
|
WriteStr(1,8,'FTAG '+hexstr(rs.ftag,4),color);
|
|
SetIColor(rs.fctrl,OldReg.fctrl);
|
|
WriteStr(13,8,'FCTRL '+hexstr(rs.fctrl,4),color);
|
|
SetIColor(rs.fstat,OldReg.fstat);
|
|
WriteStr(1,9,'FSTAT '+hexstr(rs.fstat,4),color);
|
|
SetIColor(rs.fop,OldReg.fop);
|
|
WriteStr(13,9,'FOP '+hexstr(rs.fop,4),color);
|
|
if (rs.fiseg<>OldReg.fiseg) or
|
|
(rs.fioff<>OldReg.fioff) then
|
|
color:=8
|
|
else
|
|
color:=7;
|
|
WriteStr(1,10,'FI '+hexstr(rs.fiseg,4)+':'+hexstr(rs.fioff,8),color);
|
|
if (rs.foseg<>OldReg.foseg) or
|
|
(rs.fooff<>OldReg.fooff) then
|
|
color:=8
|
|
else
|
|
color:=7;
|
|
WriteStr(1,11,'FO '+hexstr(rs.foseg,4)+':'+hexstr(rs.fooff,8),color);
|
|
{$endif i386 or x86_64}
|
|
{$ifdef m68k}
|
|
SetColor(rs.fp0,OldReg.fp0);
|
|
WriteStr(1,0,'fp0 '+rs.fp0,color);
|
|
SetColor(rs.fp1,OldReg.fp1);
|
|
WriteStr(1,1,'fp1 '+rs.fp1,color);
|
|
SetColor(rs.fp2,OldReg.fp2);
|
|
WriteStr(1,2,'fp2 '+rs.fp2,color);
|
|
SetColor(rs.fp3,OldReg.fp3);
|
|
WriteStr(1,3,'fp3 '+rs.fp3,color);
|
|
SetColor(rs.fp4,OldReg.fp4);
|
|
WriteStr(1,4,'fp4 '+rs.fp4,color);
|
|
SetColor(rs.fp5,OldReg.fp5);
|
|
WriteStr(1,5,'fp5 '+rs.fp5,color);
|
|
SetColor(rs.fp6,OldReg.fp6);
|
|
WriteStr(1,6,'fp6 '+rs.fp6,color);
|
|
SetColor(rs.fp7,OldReg.fp7);
|
|
WriteStr(1,7,'fp7 '+rs.fp7,color);
|
|
SetIColor(rs.fpcontrol,OldReg.fpcontrol);
|
|
WriteStr(1,8,'fpcontrol '+hexstr(rs.fpcontrol,8),color);
|
|
SetIColor(rs.fpstatus,OldReg.fpstatus);
|
|
WriteStr(1,9,'fpstatus '+hexstr(rs.fpstatus,8),color);
|
|
SetIColor(rs.fpiaddr,OldReg.fpiaddr);
|
|
WriteStr(1,10,'fpiaddr '+hexstr(rs.fpiaddr,8),color);
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
for i:=0 to 31 do
|
|
begin
|
|
SetColor(rs.f[i],OldReg.f[i]);
|
|
if i<10 then
|
|
WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color)
|
|
else
|
|
WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color);
|
|
end;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
for i:=0 to 31 do
|
|
begin
|
|
SetColor(rs.f[i],OldReg.f[i]);
|
|
if i<10 then
|
|
WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color)
|
|
else
|
|
WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color);
|
|
end;
|
|
{$endif sparc}
|
|
{$else not cpu_known}
|
|
for i:=0 to MaxRegs-1 do
|
|
begin
|
|
SetColor(rs.freg[i],OldReg.freg[i]);
|
|
WriteStr(1,i,rs.freg[i],color);
|
|
end;
|
|
{$endif cpu_known}
|
|
end
|
|
else
|
|
WriteStr(0,0,msg_registerwindowerror,7);
|
|
InDraw:=false;
|
|
{$endif NODEBUG}
|
|
end;
|
|
|
|
destructor TFPUView.Done;
|
|
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TFPUWindow
|
|
****************************************************************************}
|
|
|
|
constructor TFPUWindow.Init;
|
|
|
|
var
|
|
R : TRect;
|
|
|
|
begin
|
|
Desktop^.GetExtent(R);
|
|
{$if defined(i386) or defined(x86_64)}
|
|
R.A.X:=R.B.X-44;
|
|
R.B.Y:=R.A.Y+14;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef m68k}
|
|
R.A.X:=R.B.X-44;
|
|
R.B.Y:=R.A.Y+14;
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
R.A.X:=R.B.X-44;
|
|
R.B.Y:=R.A.Y+33;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
R.A.X:=R.B.X-44;
|
|
R.B.Y:=R.A.Y+33;
|
|
{$endif sparc}
|
|
{$ifndef cpu_known}
|
|
R.A.X:=R.B.X-44;
|
|
R.B.Y:=R.A.Y+33;
|
|
{$endif cpu_known}
|
|
inherited Init(R,dialog_fpu, wnNoNumber);
|
|
Flags:=wfClose or wfMove or wfgrow;
|
|
Palette:=wpCyanWindow;
|
|
HelpCtx:=hcFPURegisters;
|
|
R.Assign(1,1,Size.X-2,Size.Y-1);
|
|
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;
|
|
|
|
|
|
{****************************************************************************
|
|
TVectorView
|
|
****************************************************************************}
|
|
|
|
function GetVectorRegs(var rs : TVectorRegs
|
|
{$ifndef cpu_known}
|
|
; UseInfoVector : boolean
|
|
{$endif not cpu_known}
|
|
) : boolean;
|
|
|
|
var
|
|
p,po : PAnsiChar;
|
|
p1 : PAnsiChar;
|
|
{$ifndef NODEBUG}
|
|
reg,value : string;
|
|
buffer : array[0..255] of AnsiChar;
|
|
v : string;
|
|
res : cardinal;
|
|
i : longint;
|
|
err : word;
|
|
{$endif}
|
|
|
|
begin
|
|
GetVectorRegs:=false;
|
|
{$ifndef NODEBUG}
|
|
{$ifndef cpu_known}
|
|
if UseInfoVector then
|
|
begin
|
|
Debugger^.Command('info vector');
|
|
if Debugger^.Error then
|
|
begin
|
|
UseInfoVector:=false;
|
|
Debugger^.Command('info all');
|
|
end;
|
|
end
|
|
else
|
|
{$endif not cpu_known}
|
|
Debugger^.Command('info vector');
|
|
if Debugger^.Error then
|
|
exit
|
|
else
|
|
begin
|
|
po:=StrNew(Debugger^.GetOutput);
|
|
p:=po;
|
|
{$ifndef cpu_known}
|
|
i:=0;
|
|
{$endif not cpu_known}
|
|
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);
|
|
{$ifndef cpu_known}
|
|
p1:=strscan(p,#10);
|
|
if assigned(p1) then
|
|
begin
|
|
strlcopy(buffer,p,p1-p);
|
|
rs.vreg[i]:=ExtractTabs(strpas(buffer),8);
|
|
if i<MaxRegs-1 then
|
|
inc(i);
|
|
end;
|
|
{$else cpu_known}
|
|
p:=p1;
|
|
while p^=' ' do
|
|
inc(p);
|
|
if p^='$' then
|
|
p1:=strscan(p,#9)
|
|
else
|
|
p1:=strscan(p,#10);
|
|
strlcopy(buffer,p,p1-p);
|
|
v:=strpas(buffer);
|
|
for i:=1 to length(v) do
|
|
if v[i]=#9 then
|
|
v[i]:=' ';
|
|
val(v,res,err);
|
|
{$if defined(i386) or defined(x86_64)}
|
|
if reg[1]='x' then
|
|
for i:=0 to 7 do
|
|
begin
|
|
if reg='xmm'+inttostr(i) then
|
|
rs.xmm[i]:=v
|
|
end
|
|
else if reg='mxcsr' then
|
|
rs.mxcsr:=v
|
|
else if reg[1]='m' then
|
|
for i:=0 to 7 do
|
|
begin
|
|
if reg='mm'+inttostr(i) then
|
|
rs.mmx[i]:=v;
|
|
end;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef powerpc}
|
|
{ !!!! fixme }
|
|
if reg[1]='v' then
|
|
for i:=0 to 31 do
|
|
if reg='v'+inttostr(i) then
|
|
rs.m[i]:=v;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
{$endif sparc}
|
|
{$endif cpu_known}
|
|
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;
|
|
GetVectorRegs:=true;
|
|
{$endif}
|
|
end;
|
|
|
|
constructor TVectorView.Init(var Bounds: TRect);
|
|
|
|
begin
|
|
inherited init(Bounds);
|
|
GrowMode:=gfGrowHiX or GfGrowHiY;
|
|
InDraw:=false;
|
|
first:=true;
|
|
FillChar(OldReg,Sizeof(oldreg),#0);
|
|
FillChar(NewReg,Sizeof(newreg),#0);
|
|
GDBCount:=-1;
|
|
{$ifndef cpu_known}
|
|
UseInfoVector:=true;
|
|
{$endif not cpu_known}
|
|
end;
|
|
|
|
procedure TVectorView.Draw;
|
|
|
|
var
|
|
rs : tVectorregs;
|
|
top : byte;
|
|
color :byte;
|
|
ok : boolean;
|
|
i : byte;
|
|
const
|
|
TypeStr : Array[0..3] of string[6] =
|
|
('Valid ','Zero ','Spec ','Empty ');
|
|
|
|
procedure SetColor(Const x,y : string);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
procedure SetIColor(Const x,y : cardinal);
|
|
begin
|
|
if x=y then
|
|
color:=7
|
|
else
|
|
color:=8;
|
|
end;
|
|
|
|
begin
|
|
inherited draw;
|
|
{$ifdef NODEBUG}
|
|
WriteStr(1,0,msg_registervaluesnotavailable,7);
|
|
{$else NODEBUG}
|
|
If (not assigned(Debugger)) or (not Debugger^.IsRunning) then
|
|
begin
|
|
WriteStr(1,0,msg_registervaluesnotavailable,7);
|
|
exit;
|
|
end;
|
|
if InDraw then
|
|
exit;
|
|
InDraw:=true;
|
|
if GDBCount<>Debugger^.RunCount then
|
|
begin
|
|
OldReg:=NewReg;
|
|
OK:=GetVectorRegs(rs
|
|
{$ifndef cpu_known}
|
|
,UseInfoVector
|
|
{$endif not cpu_known}
|
|
);
|
|
LastOK:=OK;
|
|
NewReg:=rs;
|
|
{ get inital values }
|
|
if first then
|
|
begin
|
|
OldReg:=NewReg;
|
|
first:=false;
|
|
end;
|
|
GDBCount:=Debugger^.RunCount;
|
|
end
|
|
else
|
|
begin
|
|
rs:=newreg;
|
|
OK:=LastOK;
|
|
end;
|
|
if OK then
|
|
begin
|
|
{$ifdef cpu_known}
|
|
{$if defined(i386) or defined(x86_64)}
|
|
for i:=0 to 7 do
|
|
begin
|
|
SetColor(rs.xmm[i],OldReg.xmm[i]);
|
|
WriteStr(1,i,'xmm'+IntToStr(i)+' '+rs.xmm[i],color);
|
|
end;
|
|
|
|
SetColor(rs.mxcsr,OldReg.mxcsr);
|
|
WriteStr(1,8,'mxcsr'+IntToStr(i)+' '+rs.mxcsr,color);
|
|
|
|
for i:=0 to 7 do
|
|
begin
|
|
SetColor(rs.mmx[i],OldReg.mmx[i]);
|
|
WriteStr(1,i+9,'mmx'+IntToStr(i)+' '+rs.mmx[i],color);
|
|
end;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef powerpc}
|
|
for i:=0 to 31 do
|
|
begin
|
|
SetColor(rs.m[i],OldReg.m[i]);
|
|
if i<10 then
|
|
WriteStr(1,i,'m'+IntToStr(i)+' '+rs.m[i],color)
|
|
else
|
|
WriteStr(1,i,'m'+IntToStr(i)+' '+rs.m[i],color);
|
|
end;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
{ no mm regs on the sparc }
|
|
{$endif sparc}
|
|
{$else not cpu_known}
|
|
for i:=0 to MaxRegs-1 do
|
|
begin
|
|
SetColor(rs.vreg[i],OldReg.vreg[i]);
|
|
WriteStr(1,i,rs.vreg[i],color);
|
|
end;
|
|
{$endif cpu_known}
|
|
end
|
|
else
|
|
WriteStr(0,0,msg_registerwindowerror,7);
|
|
InDraw:=false;
|
|
{$endif NODEBUG}
|
|
end;
|
|
|
|
destructor TVectorView.Done;
|
|
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TVectorWindow
|
|
****************************************************************************}
|
|
|
|
constructor TVectorWindow.Init;
|
|
|
|
var
|
|
R : TRect;
|
|
|
|
begin
|
|
Desktop^.GetExtent(R);
|
|
{$if defined(i386) or defined(x86_64)}
|
|
R.A.X:=R.B.X-60;
|
|
R.B.Y:=R.A.Y+20;
|
|
{$endif i386 or x86_64}
|
|
{$ifdef m68k}
|
|
R.A.X:=R.B.X-60;
|
|
R.B.Y:=R.A.Y+14;
|
|
{$endif m68k}
|
|
{$ifdef powerpc}
|
|
R.A.X:=R.B.X-60;
|
|
R.B.Y:=R.A.Y+33;
|
|
{$endif powerpc}
|
|
{$ifdef sparc}
|
|
R.A.X:=R.B.X-60;
|
|
R.B.Y:=R.A.Y+33;
|
|
{$endif sparc}
|
|
{$ifndef cpu_known}
|
|
R.A.X:=R.B.X-60;
|
|
R.B.Y:=R.A.Y+33;
|
|
{$endif cpu_known}
|
|
inherited Init(R,dialog_Vector, wnNoNumber);
|
|
Flags:=wfClose or wfMove or wfgrow;
|
|
Palette:=wpCyanWindow;
|
|
HelpCtx:=hcVectorRegisters;
|
|
R.Assign(1,1,Size.X-2,Size.Y-1);
|
|
RV:=new(PVectorView,init(R));
|
|
Insert(RV);
|
|
If assigned(VectorWindow) then
|
|
dispose(VectorWindow,done);
|
|
VectorWindow:=@Self;
|
|
Update;
|
|
end;
|
|
|
|
constructor TVectorWindow.Load(var S: TStream);
|
|
|
|
begin
|
|
inherited load(S);
|
|
GetSubViewPtr(S,RV);
|
|
If assigned(VectorWindow) then
|
|
dispose(VectorWindow,done);
|
|
VectorWindow:=@Self;
|
|
end;
|
|
|
|
procedure TVectorWindow.Store(var S: TStream);
|
|
|
|
begin
|
|
inherited Store(s);
|
|
PutSubViewPtr(S,RV);
|
|
end;
|
|
|
|
procedure TVectorWindow.Update;
|
|
|
|
begin
|
|
ReDraw;
|
|
end;
|
|
|
|
destructor TVectorWindow.Done;
|
|
|
|
begin
|
|
VectorWindow:=nil;
|
|
inherited done;
|
|
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 InitFPUWindow;
|
|
begin
|
|
if FPUWindow=nil then
|
|
begin
|
|
new(FPUWindow,init);
|
|
DeskTop^.Insert(FPUWindow);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure DoneFPUWindow;
|
|
begin
|
|
if assigned(FPUWindow) then
|
|
begin
|
|
DeskTop^.Delete(FPUWindow);
|
|
FPUWindow:=nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure InitVectorWindow;
|
|
begin
|
|
if VectorWindow=nil then
|
|
begin
|
|
new(VectorWindow,init);
|
|
DeskTop^.Insert(VectorWindow);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure DoneVectorWindow;
|
|
begin
|
|
if assigned(VectorWindow) then
|
|
begin
|
|
DeskTop^.Delete(VectorWindow);
|
|
VectorWindow:=nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure RegisterFPRegsViews;
|
|
begin
|
|
RegisterType(RRegistersWindow);
|
|
RegisterType(RRegistersView);
|
|
RegisterType(RFPUWindow);
|
|
RegisterType(RFPUView);
|
|
RegisterType(RVectorView);
|
|
end;
|
|
|
|
end.
|
|
{$endif NODEBUG}
|