paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-25 16:43:24 +02:00
Code Issues Packages Projects Releases Wiki Activity
66dd127bd9
fpc/ide/fpregs.pas
Jonas Maebe ed8e0bd27c * fixed ppc compilation error
2004-02-06 21:34:43 +00:00

1071 lines
32 KiB
ObjectPascal
Raw Blame History

{
$Id$
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;
interface
uses
{$ifdef win32}
Windows,
{$endif win32}
Objects,Dialogs,Drivers,Views,
FPViews;
const
MaxRegs = 128;
type
{$ifdef TP}
dword = longint;
{$endif TP}
{$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 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}
{$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;
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}
{$ifdef I386}
st0,st1,st2,st3,st4,st5,st6,st7 :string;
ftag,fop,fctrl,fstat,fiseg,foseg : word;
fioff,fooff : cardinal;
{$endif I386}
{$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}
{$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}
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;
procedure InitRegistersWindow;
procedure DoneRegistersWindow;
procedure InitFPUWindow;
procedure DoneFPUWindow;
procedure RegisterFPRegsViews;
implementation
uses
Strings,
GDBCon,GDBInt,
App,Menus,
WViews,WEditor,
{$ifdef powerpc}
wutils, { for inttostr }
{$endif powerpc}
FPConst,FPVars,
FPString,
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
);
{****************************************************************************
TRegistersView
****************************************************************************}
function GetIntRegs(var rs : TIntRegs) : boolean;
var
p,po : pchar;
p1 : pchar;
reg,value : string;
buffer : array[0..255] of char;
v : dword;
code : word;
i : byte;
begin
GetIntRegs:=false;
{$ifndef NODEBUG}
Debugger^.Command('info registers');
if Debugger^.Error then
exit
else
begin
{$ifndef cpu_known}
i:=0;
{$endif not cpu_known}
po:=StrNew(Debugger^.GetOutput);
p:=po;
if assigned(p) then
begin
fillchar(rs,sizeof(rs),0);
p1:=strscan(p,' ');
while assigned(p1) do
begin
{$ifndef cpu_known}
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;
{$else cpu_known}
strlcopy(buffer,p,p1-p);
reg:=strpas(buffer);
p:=strscan(p,'$');
p1:=strscan(p,#9);
strlcopy(buffer,p,p1-p);
value:=strpas(buffer);
val(value,v,code);
{$ifdef i386}
if reg='eax' then
rs.eax:=v
else if reg='ebx' then
rs.ebx:=v
else if reg='ecx' then
rs.ecx:=v
else if reg='edx' then
rs.edx:=v
else if reg='eip' then
rs.eip:=v
else if reg='esi' then
rs.esi:=v
else if reg='edi' then
rs.edi:=v
else if reg='esp' then
rs.esp:=v
else if reg='ebp' then
rs.ebp:=v
{ under win32 flags are on a register named ps !! PM }
else if (reg='eflags') or (reg='ps') then
rs.eflags:=v
else if reg='cs' then
rs.cs:=v
else if reg='ds' then
rs.ds:=v
else if reg='es' then
rs.es:=v
else if reg='fs' then
rs.fs:=v
else if reg='gs' then
rs.gs:=v
else if reg='ss' then
rs.ss:=v;
{$endif i386}
{$ifdef m68k}
if reg='d0' then
rs.d0:=v
else if reg='d1' then
rs.d1:=v
else if reg='d2' then
rs.d2:=v
else if reg='d3' then
rs.d3:=v
else if reg='d4' then
rs.d4:=v
else if reg='d5' then
rs.d5:=v
else if reg='d6' then
rs.d6:=v
else if reg='d7' then
rs.d7:=v
else if reg='a0' then
rs.a0:=v
else if reg='a1' then
rs.a1:=v
else if reg='a2' then
rs.a2:=v
else if reg='a3' then
rs.a3:=v
else if reg='a4' then
rs.a4:=v
else if reg='a5' then
rs.a5:=v
else if reg='fp' then
rs.fp:=v
else if reg='sp' then
rs.sp:=v
else if (reg='ps') then
rs.ps:=v
else if reg='pc' then
rs.pc:=v;
{$endif m68k}
{$ifdef powerpc}
if (reg[1]='r') then
begin
for i:=0 to 31 do
if reg='r'+inttostr(i) then
rs.r[i]:=v;
end
{ other regs
pc,ps,cr,lr,ctr,xer : dword; }
else if (reg='pc') then
rs.pc:=v
else if (reg='ps') then
rs.ps:=v
else if (reg='lr') then
rs.lr:=v
else if (reg='ctr') then
rs.ctr:=v
else if (reg='xer') then
rs.xer:=v;
{$endif powerpc}
{$endif not 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;
GetIntRegs:=true;
{$endif}
end;
constructor TRegistersView.Init(var Bounds: TRect);
begin
inherited init(Bounds);
InDraw:=false;
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 SetStrColor(const x,y : string);
begin
if x=y then
color:=7
else
color:=8;
end;
begin
inherited draw;
If not assigned(Debugger) then
begin
WriteStr(1,0,'<no values available>',7);
exit;
end;
if InDraw then exit;
InDraw:=true;
if GDBCount<>Debugger^.RunCount then
begin
OldReg:=NewReg;
OK:=GetIntRegs(rs);
NewReg:=rs;
GDBCount:=Debugger^.RunCount;
end
else
begin
rs:=NewReg;
OK:=true;
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 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}
{$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,'<debugger error>',7);
InDraw:=false;
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 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-28;
R.B.Y:=R.A.Y+22;
{$endif powerpc}
{$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-2);
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);
{$ifdef i386}
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}
{$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}
{$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;
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;
If not assigned(Debugger) then
begin
WriteStr(1,0,'<no values available>',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}
);
NewReg:=rs;
GDBCount:=Debugger^.RunCount;
end
else
begin
rs:=newreg;
OK:=true;
end;
if OK then
begin
{$ifdef cpu_known}
{$ifdef i386}
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}
{$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}
{$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,'<debugger error>',7);
InDraw:=false;
end;
destructor TFPUView.Done;
begin
inherited done;
end;
{****************************************************************************
TFPUWindow
****************************************************************************}
constructor TFPUWindow.Init;
var
R : TRect;
begin
Desktop^.GetExtent(R);
{$ifdef i386}
R.A.X:=R.B.X-44;
R.B.Y:=R.A.Y+14;
{$endif i386}
{$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}
{$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-2);
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;
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 RegisterFPRegsViews;
begin
RegisterType(RRegistersWindow);
RegisterType(RRegistersView);
RegisterType(RFPUWindow);
RegisterType(RFPUView);
end;
end.
{
$Log$
Revision 1.3 2004-02-06 21:34:43 jonas
* fixed ppc compilation error
Revision 1.2 2002/12/16 15:51:13 pierre
* added unknown cpu register windows
Revision 1.1 2002/12/12 00:01:59 pierre
Register window code separated in a new unit
}
Reference in New Issue View Git Blame Copy Permalink