Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
Repository URL to install this package:
|
Version:
3.2.0 ▾
|
{
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;
{$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 : pchar;
p1 : pchar;
buffer : array[0..255] of char;
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 : pchar;
p1 : pchar;
{$ifndef NODEBUG}
reg,value : string;
buffer : array[0..255] of char;
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 : pchar;
p1 : pchar;
{$ifndef NODEBUG}
reg,value : string;
buffer : array[0..255] of char;
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}