{ 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 = ''; msg_registerwindowerror = ''; {**************************************************************************** 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 iDebugger^.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 iDebugger^.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 iDebugger^.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}