{ 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 {$ifdef TP} dword = longint; {$endif TP} {$undef cpu_known} TIntRegs = record {$ifndef test_generic_cpu} {$ifdef cpui386} {$define cpu_known} eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword; cs,ds,es,ss,fs,gs : word; eflags : dword; {$endif cpui386} {$ifdef cpum68k} {$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 cpum68k} {$ifdef cpupowerpc} {$define cpu_known} r : array [0..31] of dword; pc,ps,cr,lr,ctr,xer : dword; {$endif cpupowerpc} {$ifdef cpusparc} {$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 cpusparc} {$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; 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 cpui386} st0,st1,st2,st3,st4,st5,st6,st7 :string; ftag,fop,fctrl,fstat,fiseg,foseg : word; fioff,fooff : cardinal; {$endif cpui386} {$ifdef cpum68k} fp0,fp1,fp2,fp3,fp4,fp5,fp6,fp7 : string; fpcontrol,fpstatus,fpiaddr : dword; {$endif cpum68k} {$ifdef cpupowerpc} f : array [0..31] of string; {$endif cpupowerpc} {$ifdef cpusparc} f : array [0..31] of string; {$endif cpusparc} {$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; 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} {$ifdef cpui386} xmm : array[0..7] of string; mmx : array[0..7] of string; mxcsr : string; {$endif cpui386} {$ifdef cpupowerpc} m : array[0..31] of string; {$endif cpupowerpc} {$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; 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} GDBCon,GDBInt, {$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'; {**************************************************************************** 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',7); {$else NODEBUG} If not assigned(Debugger) then begin WriteStr(1,0,'',7); exit; end; if InDraw then exit; InDraw:=true; if GDBCount<>Debugger^.RunCount then begin OldReg:=NewReg; OK:=GetIntRegs(rs); NewReg:=rs; { get inital values } if first then begin OldReg:=NewReg; first:=false; end; GDBCount:=Debugger^.RunCount; end else begin rs:=NewReg; OK:=true; end; if OK then begin {$ifdef cpu_known} {$ifdef cpui386} 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 cpui386} {$ifdef cpum68k} 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 cpum68k} {$ifdef cpupowerpc} 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 cpupowerpc} {$ifdef cpusparc} 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 cpusparc} {$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,'',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 cpui386} R.A.X:=R.B.X-28; R.B.Y:=R.A.Y+11; {$endif cpui386} {$ifdef cpum68k} R.A.X:=R.B.X-28; R.B.Y:=R.A.Y+11; {$endif cpum68k} {$ifdef cpupowerpc} R.A.X:=R.B.X-28; R.B.Y:=R.A.Y+22; {$endif cpupowerpc} {$ifdef cpusparc} R.A.X:=R.B.X-30; R.B.Y:=R.A.Y+22; {$endif cpusparc} {$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',7); {$else NODEBUG} If not assigned(Debugger) then begin WriteStr(1,0,'',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; { get inital values } if first then begin OldReg:=NewReg; first:=false; end; GDBCount:=Debugger^.RunCount; end else begin rs:=newreg; OK:=true; end; if OK then begin {$ifdef cpu_known} {$ifdef cpui386} 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 cpui386} {$ifdef cpum68k} 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 cpum68k} {$ifdef cpupowerpc} 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 cpupowerpc} {$ifdef cpusparc} 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 cpusparc} {$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,'',7); InDraw:=false; {$endif NODEBUG} end; destructor TFPUView.Done; begin inherited done; end; {**************************************************************************** TFPUWindow ****************************************************************************} constructor TFPUWindow.Init; var R : TRect; begin Desktop^.GetExtent(R); {$ifdef cpui386} R.A.X:=R.B.X-44; R.B.Y:=R.A.Y+14; {$endif cpui386} {$ifdef cpum68k} R.A.X:=R.B.X-44; R.B.Y:=R.A.Y+14; {$endif cpum68k} {$ifdef cpupowerpc} R.A.X:=R.B.X-44; R.B.Y:=R.A.Y+33; {$endif cpupowerpc} {$ifdef cpusparc} R.A.X:=R.B.X-44; R.B.Y:=R.A.Y+33; {$endif cpusparc} {$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; {**************************************************************************** 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',7); {$else NODEBUG} If not assigned(Debugger) then begin WriteStr(1,0,'',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} ); NewReg:=rs; { get inital values } if first then begin OldReg:=NewReg; first:=false; end; GDBCount:=Debugger^.RunCount; end else begin rs:=newreg; OK:=true; end; if OK then begin {$ifdef cpu_known} {$ifdef cpui386} 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 cpui386} {$ifdef cpupowerpc} 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 cpupowerpc} {$ifdef cpusparc} { no mm regs on the sparc } {$endif cpusparc} {$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,'',7); InDraw:=false; {$endif NODEBUG} end; destructor TVectorView.Done; begin inherited done; end; {**************************************************************************** TVectorWindow ****************************************************************************} constructor TVectorWindow.Init; var R : TRect; begin Desktop^.GetExtent(R); {$ifdef cpui386} R.A.X:=R.B.X-60; R.B.Y:=R.A.Y+20; {$endif cpui386} {$ifdef cpum68k} R.A.X:=R.B.X-60; R.B.Y:=R.A.Y+14; {$endif cpum68k} {$ifdef cpupowerpc} R.A.X:=R.B.X-60; R.B.Y:=R.A.Y+33; {$endif cpupowerpc} {$ifdef cpusparc} R.A.X:=R.B.X-60; R.B.Y:=R.A.Y+33; {$endif cpusparc} {$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-2); 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}