fpregs.pas 51 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998-2000 by Pierre Muller
  4. Register debug routines for the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPRegs;
  12. {$ifdef NODEBUG}
  13. interface
  14. implementation
  15. end.
  16. {$else NODEBUG}
  17. interface
  18. uses
  19. {$ifdef Windows}
  20. Windows,
  21. {$endif Windows}
  22. Objects,Dialogs,Drivers,Views,
  23. FPViews;
  24. const
  25. MaxRegs = 128;
  26. type
  27. {$undef cpu_known}
  28. TIntRegs = record
  29. {$ifndef test_generic_cpu}
  30. {$ifdef i386}
  31. {$define cpu_known}
  32. eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
  33. cs,ds,es,ss,fs,gs : word;
  34. eflags : dword;
  35. {$endif i386}
  36. {$ifdef x86_64}
  37. {$define cpu_known}
  38. rax,rbx,rcx,rdx,rsi,rdi,rbp,rsp,
  39. r8,r9,r10,r11,r12,r13,r14,r15,
  40. rip : qword;
  41. cs,ds,es,ss,fs,gs : word;
  42. eflags : dword;
  43. {$endif x86_64}
  44. {$ifdef m68k}
  45. {$define cpu_known}
  46. d0,d1,d2,d3,d4,d5,d6,d7 : dword;
  47. a0,a1,a2,a3,a4,a5,fp,sp : dword;
  48. ps,pc : dword;
  49. {$endif m68k}
  50. {$ifdef powerpc}
  51. {$define cpu_known}
  52. r : array [0..31] of dword;
  53. pc,ps,cr,lr,ctr,xer : dword;
  54. {$endif powerpc}
  55. {$ifdef sparc}
  56. {$define cpu_known}
  57. o : array [0..7] of dword;
  58. i : array [0..7] of dword;
  59. l : array [0..7] of dword;
  60. g : array [0..7] of dword;
  61. y,psr,wim,tbr,pc,npc,fsr,csr : dword;
  62. {$endif sparc}
  63. {$endif not test_generic_cpu}
  64. {$ifndef cpu_known}
  65. reg : array [0..MaxRegs-1] of string;
  66. {$endif not cpu_known}
  67. end;
  68. PRegistersView = ^TRegistersView;
  69. TRegistersView = object(TView)
  70. NewReg,OldReg : TIntRegs;
  71. InDraw : boolean;
  72. GDBCount : longint;
  73. first : boolean;
  74. LastOK : boolean;
  75. constructor Init(var Bounds: TRect);
  76. procedure Draw;virtual;
  77. destructor Done; virtual;
  78. end;
  79. PRegistersWindow = ^TRegistersWindow;
  80. TRegistersWindow = Object(TFPDlgWindow)
  81. RV : PRegistersView;
  82. Constructor Init;
  83. constructor Load(var S: TStream);
  84. procedure Store(var S: TStream);
  85. procedure Update; virtual;
  86. destructor Done; virtual;
  87. end;
  88. TFPURegs = record
  89. {$ifndef test_generic_cpu}
  90. {$if defined(i386) or defined(x86_64)}
  91. st0,st1,st2,st3,st4,st5,st6,st7 :string;
  92. ftag,fop,fctrl,fstat,fiseg,foseg : word;
  93. fioff,fooff : cardinal;
  94. {$endif i386 or x86_64}
  95. {$ifdef m68k}
  96. fp0,fp1,fp2,fp3,fp4,fp5,fp6,fp7 : string;
  97. fpcontrol,fpstatus,fpiaddr : dword;
  98. {$endif m68k}
  99. {$ifdef powerpc}
  100. f : array [0..31] of string;
  101. {$endif powerpc}
  102. {$ifdef sparc}
  103. f : array [0..31] of string;
  104. {$endif sparc}
  105. {$endif not test_generic_cpu}
  106. {$ifndef cpu_known}
  107. freg : array [0..MaxRegs-1] of string;
  108. {$endif not cpu_known}
  109. end;
  110. PFPUView = ^TFPUView;
  111. TFPUView = object(TView)
  112. NewReg,OldReg : TFPURegs;
  113. InDraw : boolean;
  114. GDBCount : longint;
  115. {$ifndef cpu_known}
  116. UseInfoFloat : boolean;
  117. {$endif not cpu_known}
  118. first : boolean;
  119. LastOK : boolean;
  120. constructor Init(var Bounds: TRect);
  121. procedure Draw;virtual;
  122. destructor Done; virtual;
  123. end;
  124. PFPUWindow = ^TFPUWindow;
  125. TFPUWindow = Object(TFPDlgWindow)
  126. RV : PFPUView;
  127. Constructor Init;
  128. constructor Load(var S: TStream);
  129. procedure Store(var S: TStream);
  130. procedure Update; virtual;
  131. destructor Done; virtual;
  132. end;
  133. tssereg = record
  134. case byte of
  135. 1 : (bytearray : array[0..15] of byte);
  136. 2 : (wordarray : array[0..7] of word);
  137. 3 : (dwordarray : array[0..3] of dword);
  138. 4 : (qwordarray : array[0..1] of qword);
  139. 5 : (twordfield : array[0..1] of qword);
  140. 6 : (singlearray : array[0..3] of single);
  141. 7 : (doublearray : array[0..1] of double);
  142. end;
  143. tmmxreg = record
  144. case byte of
  145. 1 : (bytearray : array[0..7] of byte);
  146. 2 : (wordarray : array[0..3] of word);
  147. 3 : (dwordarray : array[0..1] of dword);
  148. 4 : (qwordfield : qword);
  149. 6 : (singlearray : array[0..1] of single);
  150. end;
  151. TVectorRegs = record
  152. {$ifndef test_generic_cpu}
  153. {$if defined(i386) or defined(x86_64)}
  154. xmm : array[0..7] of string;
  155. mmx : array[0..7] of string;
  156. mxcsr : string;
  157. {$endif i386 or x86_64}
  158. {$ifdef powerpc}
  159. m : array[0..31] of string;
  160. {$endif powerpc}
  161. {$endif not test_generic_cpu}
  162. {$ifndef cpu_known}
  163. vreg : array [0..MaxRegs-1] of string;
  164. {$endif not cpu_known}
  165. end;
  166. PVectorView = ^TVectorView;
  167. TVectorView = object(TView)
  168. NewReg,OldReg : TVectorRegs;
  169. InDraw : boolean;
  170. GDBCount : longint;
  171. {$ifndef cpu_known}
  172. UseInfoVector : boolean;
  173. {$endif not cpu_known}
  174. first : boolean;
  175. LastOK : boolean;
  176. constructor Init(var Bounds: TRect);
  177. procedure Draw;virtual;
  178. destructor Done; virtual;
  179. end;
  180. PVectorWindow = ^TVectorWindow;
  181. TVectorWindow = Object(TFPDlgWindow)
  182. RV : PVectorView;
  183. Constructor Init;
  184. constructor Load(var S: TStream);
  185. procedure Store(var S: TStream);
  186. procedure Update; virtual;
  187. destructor Done; virtual;
  188. end;
  189. procedure InitRegistersWindow;
  190. procedure DoneRegistersWindow;
  191. procedure InitFPUWindow;
  192. procedure DoneFPUWindow;
  193. procedure InitVectorWindow;
  194. procedure DoneVectorWindow;
  195. procedure RegisterFPRegsViews;
  196. implementation
  197. uses
  198. Strings,
  199. {$ifndef NODEBUG}
  200. {$ifdef GDBMI}
  201. GDBMICon, GDBMIInt,
  202. {$else GDBMI}
  203. GDBCon,GDBInt,
  204. {$endif GDBMI}
  205. {$endif NODEBUG}
  206. App,Menus,
  207. WViews,WEditor,
  208. wutils,
  209. FPConst,FPVars,
  210. FPDebug;
  211. Const
  212. RRegistersWindow: TStreamRec = (
  213. ObjType: 1711;
  214. VmtLink: Ofs(TypeOf(TRegistersWindow)^);
  215. Load: @TRegistersWindow.Load;
  216. Store: @TRegistersWindow.Store
  217. );
  218. RRegistersView: TStreamRec = (
  219. ObjType: 1712;
  220. VmtLink: Ofs(TypeOf(TRegistersView)^);
  221. Load: @TRegistersView.Load;
  222. Store: @TRegistersView.Store
  223. );
  224. RFPUWindow: TStreamRec = (
  225. ObjType: 1713;
  226. VmtLink: Ofs(TypeOf(TFPUWindow)^);
  227. Load: @TFPUWindow.Load;
  228. Store: @TFPUWindow.Store
  229. );
  230. RFPUView: TStreamRec = (
  231. ObjType: 1714;
  232. VmtLink: Ofs(TypeOf(TFPUView)^);
  233. Load: @TFPUView.Load;
  234. Store: @TFPUView.Store
  235. );
  236. RVectorView: TStreamRec = (
  237. ObjType: 1715;
  238. VmtLink: Ofs(TypeOf(TVectorView)^);
  239. Load: @TVectorView.Load;
  240. Store: @TVectorView.Store
  241. );
  242. {$ifdef useresstrings}
  243. resourcestring
  244. {$else}
  245. const
  246. {$endif}
  247. dialog_registers = 'Register View';
  248. dialog_fpu = 'FPU View';
  249. dialog_vector = 'Vector Unit View';
  250. msg_registervaluesnotavailable = '<no values available>';
  251. msg_registerwindowerror = '<debugger error>';
  252. {****************************************************************************
  253. TRegistersView
  254. ****************************************************************************}
  255. function GetIntRegs(var rs : TIntRegs) : boolean;
  256. var
  257. p,po : pchar;
  258. p1 : pchar;
  259. buffer : array[0..255] of char;
  260. i : byte;
  261. begin
  262. GetIntRegs:=false;
  263. {$ifndef NODEBUG}
  264. {$ifdef cpu_known}
  265. {$ifdef i386}
  266. GetIntRegs :=
  267. Debugger^.GetIntRegister('eax', rs.eax) and
  268. Debugger^.GetIntRegister('ebx', rs.ebx) and
  269. Debugger^.GetIntRegister('ecx', rs.ecx) and
  270. Debugger^.GetIntRegister('edx', rs.edx) and
  271. Debugger^.GetIntRegister('esi', rs.esi) and
  272. Debugger^.GetIntRegister('edi', rs.edi) and
  273. Debugger^.GetIntRegister('ebp', rs.ebp) and
  274. Debugger^.GetIntRegister('esp', rs.esp) and
  275. Debugger^.GetIntRegister('eip', rs.eip) and
  276. { under Windows flags are on a register named ps !! PM }
  277. (Debugger^.GetIntRegister('eflags', rs.eflags) or Debugger^.GetIntRegister('ps', rs.eflags)) and
  278. Debugger^.GetIntRegister('cs', rs.cs) and
  279. Debugger^.GetIntRegister('ds', rs.ds) and
  280. Debugger^.GetIntRegister('es', rs.es) and
  281. Debugger^.GetIntRegister('fs', rs.fs) and
  282. Debugger^.GetIntRegister('gs', rs.gs) and
  283. Debugger^.GetIntRegister('ss', rs.ss);
  284. {$endif i386}
  285. {$ifdef x86_64}
  286. GetIntRegs :=
  287. Debugger^.GetIntRegister('rax', rs.rax) and
  288. Debugger^.GetIntRegister('rbx', rs.rbx) and
  289. Debugger^.GetIntRegister('rcx', rs.rcx) and
  290. Debugger^.GetIntRegister('rdx', rs.rdx) and
  291. Debugger^.GetIntRegister('rsi', rs.rsi) and
  292. Debugger^.GetIntRegister('rdi', rs.rdi) and
  293. Debugger^.GetIntRegister('rbp', rs.rbp) and
  294. Debugger^.GetIntRegister('rsp', rs.rsp) and
  295. Debugger^.GetIntRegister('r8', rs.r8) and
  296. Debugger^.GetIntRegister('r9', rs.r9) and
  297. Debugger^.GetIntRegister('r10', rs.r10) and
  298. Debugger^.GetIntRegister('r11', rs.r11) and
  299. Debugger^.GetIntRegister('r12', rs.r12) and
  300. Debugger^.GetIntRegister('r13', rs.r13) and
  301. Debugger^.GetIntRegister('r14', rs.r14) and
  302. Debugger^.GetIntRegister('r15', rs.r15) and
  303. Debugger^.GetIntRegister('rip', rs.rip) and
  304. { under Windows flags are on a register named ps !! PM }
  305. (Debugger^.GetIntRegister('eflags', rs.eflags) or Debugger^.GetIntRegister('ps', rs.eflags)) and
  306. Debugger^.GetIntRegister('cs', rs.cs) and
  307. Debugger^.GetIntRegister('ds', rs.ds) and
  308. Debugger^.GetIntRegister('es', rs.es) and
  309. Debugger^.GetIntRegister('fs', rs.fs) and
  310. Debugger^.GetIntRegister('gs', rs.gs) and
  311. Debugger^.GetIntRegister('ss', rs.ss);
  312. {$endif x86_64}
  313. {$ifdef m68k}
  314. GetIntRegs :=
  315. Debugger^.GetIntRegister('d0', rs.d0) and
  316. Debugger^.GetIntRegister('d1', rs.d1) and
  317. Debugger^.GetIntRegister('d2', rs.d2) and
  318. Debugger^.GetIntRegister('d3', rs.d3) and
  319. Debugger^.GetIntRegister('d4', rs.d4) and
  320. Debugger^.GetIntRegister('d5', rs.d5) and
  321. Debugger^.GetIntRegister('d6', rs.d6) and
  322. Debugger^.GetIntRegister('d7', rs.d7) and
  323. Debugger^.GetIntRegister('a0', rs.a0) and
  324. Debugger^.GetIntRegister('a1', rs.a1) and
  325. Debugger^.GetIntRegister('a2', rs.a2) and
  326. Debugger^.GetIntRegister('a3', rs.a3) and
  327. Debugger^.GetIntRegister('a4', rs.a4) and
  328. Debugger^.GetIntRegister('a5', rs.a5) and
  329. Debugger^.GetIntRegister('fp', rs.fp) and
  330. Debugger^.GetIntRegister('sp', rs.sp) and
  331. Debugger^.GetIntRegister('ps', rs.ps) and
  332. Debugger^.GetIntRegister('pc', rs.pc);
  333. {$endif m68k}
  334. {$ifdef powerpc}
  335. GetIntRegs := true;
  336. for i:=0 to 31 do
  337. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('r'+inttostr(i), rs.r[i]);
  338. { other regs
  339. pc,ps,cr,lr,ctr,xer : dword; }
  340. GetIntRegs := GetIntRegs and
  341. Debugger^.GetIntRegister('pc', rs.pc) and
  342. Debugger^.GetIntRegister('ps', rs.ps) and
  343. Debugger^.GetIntRegister('lr', rs.lr) and
  344. Debugger^.GetIntRegister('ctr', rs.ctr) and
  345. Debugger^.GetIntRegister('xer', rs.xer);
  346. {$endif powerpc}
  347. {$ifdef sparc}
  348. GetIntRegs := true;
  349. for i:=0 to 7 do
  350. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('o'+inttostr(i), rs.o[i]);
  351. for i:=0 to 7 do
  352. if i = 6 then
  353. GetIntRegs := GetIntRegs and (Debugger^.GetIntRegister('i6', rs.i[6]) or Debugger^.GetIntRegister('fp', rs.i[6]))
  354. else
  355. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('i'+inttostr(i), rs.i[i]);
  356. for i:=0 to 7 do
  357. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('l'+inttostr(i), rs.l[i]);
  358. for i:=0 to 7 do
  359. GetIntRegs := GetIntRegs and Debugger^.GetIntRegister('g'+inttostr(i), rs.g[i]);
  360. GetIntRegs := GetIntRegs and
  361. Debugger^.GetIntRegister('y', rs.y) and
  362. Debugger^.GetIntRegister('psr', rs.psr) and
  363. Debugger^.GetIntRegister('wim', rs.wim) and
  364. Debugger^.GetIntRegister('tbs', rs.tbr) and
  365. Debugger^.GetIntRegister('pc', rs.pc) and
  366. Debugger^.GetIntRegister('npc', rs.npc) and
  367. Debugger^.GetIntRegister('fsr', rs.fsr) and
  368. Debugger^.GetIntRegister('csr', rs.csr);
  369. {$endif sparc}
  370. {$else cpu_known}
  371. Debugger^.Command('info registers');
  372. if Debugger^.Error then
  373. exit
  374. else
  375. begin
  376. i:=0;
  377. po:=StrNew(Debugger^.GetOutput);
  378. p:=po;
  379. if assigned(p) then
  380. begin
  381. fillchar(rs,sizeof(rs),0);
  382. p1:=strscan(p,' ');
  383. while assigned(p1) do
  384. begin
  385. p1:=strscan(p,#10);
  386. if assigned(p1) then
  387. begin
  388. strlcopy(buffer,p,p1-p);
  389. rs.reg[i]:=ExtractTabs(strpas(buffer),8);
  390. if i<MaxRegs-1 then
  391. inc(i);
  392. end;
  393. p:=strscan(p1,#10);
  394. if assigned(p) then
  395. begin
  396. p1:=strscan(p,' ');
  397. inc(p);
  398. end
  399. else
  400. break;
  401. end;
  402. { free allocated memory }
  403. strdispose(po);
  404. end
  405. else
  406. exit;
  407. end;
  408. { do not open a messagebox for such errors }
  409. Debugger^.got_error:=false;
  410. GetIntRegs:=true;
  411. {$endif cpu_known}
  412. {$endif not NODEBUG}
  413. end;
  414. constructor TRegistersView.Init(var Bounds: TRect);
  415. begin
  416. inherited init(Bounds);
  417. InDraw:=false;
  418. first:=true;
  419. FillChar(OldReg,Sizeof(OldReg),#0);
  420. FillChar(NewReg,Sizeof(NewReg),#0);
  421. GrowMode:=gfGrowHiX or GfGrowHiY;
  422. GDBCount:=-1;
  423. end;
  424. procedure TRegistersView.Draw;
  425. var
  426. rs : tintregs;
  427. OK : boolean;
  428. color :byte;
  429. i : byte;
  430. procedure SetColor(x,y : longint);
  431. begin
  432. if x=y then
  433. color:=7
  434. else
  435. color:=8;
  436. end;
  437. procedure SetColor(x,y : qword);
  438. begin
  439. if x=y then
  440. color:=7
  441. else
  442. color:=8;
  443. end;
  444. procedure SetStrColor(const x,y : string);
  445. begin
  446. if x=y then
  447. color:=7
  448. else
  449. color:=8;
  450. end;
  451. begin
  452. inherited draw;
  453. {$ifdef NODEBUG}
  454. WriteStr(1,0,msg_registervaluesnotavailable,7);
  455. {$else NODEBUG}
  456. If (not assigned(Debugger)) or (not Debugger^.IsRunning) then
  457. begin
  458. WriteStr(1,0,msg_registervaluesnotavailable,7);
  459. exit;
  460. end;
  461. if InDraw then exit;
  462. InDraw:=true;
  463. if GDBCount<>Debugger^.RunCount then
  464. begin
  465. OldReg:=NewReg;
  466. OK:=GetIntRegs(rs);
  467. LastOK:=OK;
  468. NewReg:=rs;
  469. { get inital values }
  470. if first then
  471. begin
  472. OldReg:=NewReg;
  473. first:=false;
  474. end;
  475. GDBCount:=Debugger^.RunCount;
  476. end
  477. else
  478. begin
  479. rs:=NewReg;
  480. OK:=LastOK;
  481. end;
  482. if OK then
  483. begin
  484. {$ifdef cpu_known}
  485. {$ifdef i386}
  486. SetColor(rs.eax,OldReg.eax);
  487. WriteStr(1,0,'EAX '+HexStr(longint(rs.eax),8),color);
  488. SetColor(rs.ebx,OldReg.ebx);
  489. WriteStr(1,1,'EBX '+HexStr(longint(rs.ebx),8),color);
  490. SetColor(rs.ecx,OldReg.ecx);
  491. WriteStr(1,2,'ECX '+HexStr(longint(rs.ecx),8),color);
  492. SetColor(rs.edx,OldReg.edx);
  493. WriteStr(1,3,'EDX '+HexStr(longint(rs.edx),8),color);
  494. SetColor(rs.eip,OldReg.eip);
  495. WriteStr(1,4,'EIP '+HexStr(longint(rs.eip),8),color);
  496. SetColor(rs.esi,OldReg.esi);
  497. WriteStr(1,5,'ESI '+HexStr(longint(rs.esi),8),color);
  498. SetColor(rs.edi,OldReg.edi);
  499. WriteStr(1,6,'EDI '+HexStr(longint(rs.edi),8),color);
  500. SetColor(rs.esp,OldReg.esp);
  501. WriteStr(1,7,'ESP '+HexStr(longint(rs.esp),8),color);
  502. SetColor(rs.ebp,OldReg.ebp);
  503. WriteStr(1,8,'EBP '+HexStr(longint(rs.ebp),8),color);
  504. SetColor(rs.cs,OldReg.cs);
  505. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  506. SetColor(rs.ds,OldReg.ds);
  507. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  508. SetColor(rs.es,OldReg.es);
  509. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  510. SetColor(rs.fs,OldReg.fs);
  511. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  512. SetColor(rs.gs,OldReg.gs);
  513. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  514. SetColor(rs.ss,OldReg.ss);
  515. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  516. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  517. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  518. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  519. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  520. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  521. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  522. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  523. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  524. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  525. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  526. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  527. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  528. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  529. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  530. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  531. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  532. {$endif i386}
  533. {$ifdef x86_64}
  534. SetColor(rs.rax,OldReg.rax);
  535. WriteStr(1,0,'RAX '+HexStr(rs.rax,16),color);
  536. SetColor(rs.rbx,OldReg.rbx);
  537. WriteStr(1,1,'RBX '+HexStr(rs.rbx,16),color);
  538. SetColor(rs.rcx,OldReg.rcx);
  539. WriteStr(1,2,'RCX '+HexStr(rs.rcx,16),color);
  540. SetColor(rs.rdx,OldReg.rdx);
  541. WriteStr(1,3,'RDX '+HexStr(rs.rdx,16),color);
  542. SetColor(rs.rsi,OldReg.rsi);
  543. WriteStr(1,4,'RSI '+HexStr(rs.rsi,16),color);
  544. SetColor(rs.rdi,OldReg.rdi);
  545. WriteStr(1,5,'RDI '+HexStr(rs.rdi,16),color);
  546. SetColor(rs.rbp,OldReg.rbp);
  547. WriteStr(1,6,'RBP '+HexStr(rs.rbp,16),color);
  548. SetColor(rs.rsp,OldReg.rsp);
  549. WriteStr(1,7,'RSP '+HexStr(rs.rsp,16),color);
  550. SetColor(rs.r8,OldReg.r8);
  551. WriteStr(1,8,'R8 '+HexStr(rs.r8,16),color);
  552. SetColor(rs.r9,OldReg.r9);
  553. WriteStr(1,9,'R9 '+HexStr(rs.r9,16),color);
  554. SetColor(rs.r10,OldReg.r10);
  555. WriteStr(1,10,'R10 '+HexStr(rs.r10,16),color);
  556. SetColor(rs.r11,OldReg.r11);
  557. WriteStr(1,11,'R11 '+HexStr(rs.r11,16),color);
  558. SetColor(rs.r12,OldReg.r12);
  559. WriteStr(1,12,'R12 '+HexStr(rs.r12,16),color);
  560. SetColor(rs.r13,OldReg.r13);
  561. WriteStr(1,13,'R13 '+HexStr(rs.r13,16),color);
  562. SetColor(rs.r14,OldReg.r14);
  563. WriteStr(1,14,'R14 '+HexStr(rs.r14,16),color);
  564. SetColor(rs.r15,OldReg.r15);
  565. WriteStr(1,15,'R15 '+HexStr(rs.r15,16),color);
  566. SetColor(rs.rip,OldReg.rip);
  567. WriteStr(1,16,'RIP '+HexStr(rs.rip,16),color);
  568. SetColor(rs.cs,OldReg.cs);
  569. WriteStr(22,11,'CS '+HexStr(rs.cs,4),color);
  570. SetColor(rs.ds,OldReg.ds);
  571. WriteStr(22,12,'DS '+HexStr(rs.ds,4),color);
  572. SetColor(rs.es,OldReg.es);
  573. WriteStr(22,13,'ES '+HexStr(rs.es,4),color);
  574. SetColor(rs.fs,OldReg.fs);
  575. WriteStr(22,14,'FS '+HexStr(rs.fs,4),color);
  576. SetColor(rs.gs,OldReg.gs);
  577. WriteStr(22,15,'GS '+HexStr(rs.gs,4),color);
  578. SetColor(rs.ss,OldReg.ss);
  579. WriteStr(22,16,'SS '+HexStr(rs.ss,4),color);
  580. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  581. WriteStr(24,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  582. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  583. WriteStr(24,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  584. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  585. WriteStr(24,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  586. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  587. WriteStr(24,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  588. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  589. WriteStr(24,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  590. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  591. WriteStr(24,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  592. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  593. WriteStr(24,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  594. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  595. WriteStr(24,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  596. {$endif x86_64}
  597. {$ifdef m68k}
  598. SetColor(rs.d0,OldReg.d0);
  599. WriteStr(1,0,'d0 '+HexStr(longint(rs.d0),8),color);
  600. SetColor(rs.d1,OldReg.d1);
  601. WriteStr(1,1,'d1 '+HexStr(longint(rs.d1),8),color);
  602. SetColor(rs.d2,OldReg.d2);
  603. WriteStr(1,2,'d2 '+HexStr(longint(rs.d2),8),color);
  604. SetColor(rs.d3,OldReg.d3);
  605. WriteStr(1,3,'d3 '+HexStr(longint(rs.d3),8),color);
  606. SetColor(rs.d4,OldReg.d4);
  607. WriteStr(1,4,'d4 '+HexStr(longint(rs.d4),8),color);
  608. SetColor(rs.d5,OldReg.d5);
  609. WriteStr(1,5,'d5 '+HexStr(longint(rs.d5),8),color);
  610. SetColor(rs.d6,OldReg.d6);
  611. WriteStr(1,6,'d6 '+HexStr(longint(rs.d6),8),color);
  612. SetColor(rs.d7,OldReg.d7);
  613. WriteStr(1,7,'d7 '+HexStr(longint(rs.d7),8),color);
  614. SetColor(rs.a0,OldReg.a0);
  615. WriteStr(14,0,'a0 '+HexStr(longint(rs.a0),8),color);
  616. SetColor(rs.a1,OldReg.a1);
  617. WriteStr(14,1,'a1 '+HexStr(longint(rs.a1),8),color);
  618. SetColor(rs.a2,OldReg.a2);
  619. WriteStr(14,2,'a2 '+HexStr(longint(rs.a2),8),color);
  620. SetColor(rs.a3,OldReg.a3);
  621. WriteStr(14,3,'a3 '+HexStr(longint(rs.a3),8),color);
  622. SetColor(rs.a4,OldReg.a4);
  623. WriteStr(14,4,'a4 '+HexStr(longint(rs.a4),8),color);
  624. SetColor(rs.a5,OldReg.a5);
  625. WriteStr(14,5,'a5 '+HexStr(longint(rs.a5),8),color);
  626. SetColor(rs.fp,OldReg.fp);
  627. WriteStr(14,6,'fp '+HexStr(longint(rs.fp),8),color);
  628. SetColor(rs.sp,OldReg.sp);
  629. WriteStr(14,7,'sp '+HexStr(longint(rs.sp),8),color);
  630. SetColor(rs.pc,OldReg.pc);
  631. WriteStr(1,8,'pc '+HexStr(longint(rs.pc),8),color);
  632. SetColor(rs.ps and $1,OldReg.ps and $1);
  633. WriteStr(22,8,' c'+chr(byte((rs.ps and $1)<>0)+48),color);
  634. SetColor(rs.ps and $2,OldReg.ps and $2);
  635. WriteStr(19,8,' v'+chr(byte((rs.ps and $2)<>0)+48),color);
  636. SetColor(rs.ps and $4,OldReg.ps and $4);
  637. WriteStr(16,8,' z'+chr(byte((rs.ps and $4)<>0)+48),color);
  638. SetColor(rs.ps and $8,OldReg.ps and $8);
  639. WriteStr(14,8, 'x'+chr(byte((rs.ps and $8)<>0)+48),color);
  640. {$endif m68k}
  641. {$ifdef powerpc}
  642. for i:=0 to 15 do
  643. begin
  644. SetColor(rs.r[i],OldReg.r[i]);
  645. if i<10 then
  646. WriteStr(1,i,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color)
  647. else
  648. WriteStr(1,i,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color);
  649. end;
  650. for i:=16 to 31 do
  651. begin
  652. SetColor(rs.r[i],OldReg.r[i]);
  653. WriteStr(15,i-16,'r'+IntToStr(i)+' '+HexStr(longint(rs.r[i]),8),color);
  654. end;
  655. { other regs pc,ps,cr,lr,ctr,xer : dword; }
  656. SetColor(rs.pc,OldReg.pc);
  657. WriteStr(1,16,'pc '+HexStr(longint(rs.pc),8),color);
  658. SetColor(rs.ps,OldReg.ps);
  659. WriteStr(15,16,'ps '+HexStr(longint(rs.ps),8),color);
  660. SetColor(rs.lr,OldReg.lr);
  661. WriteStr(1,17,'lr '+HexStr(longint(rs.lr),8),color);
  662. SetColor(rs.ctr,OldReg.ctr);
  663. WriteStr(15,17,'ctr '+HexStr(longint(rs.ctr),8),color);
  664. SetColor(rs.xer,OldReg.xer);
  665. WriteStr(15,18,'xer '+HexStr(longint(rs.xer),8),color);
  666. {$endif powerpc}
  667. {$ifdef sparc}
  668. for i:=0 to 7 do
  669. begin
  670. SetColor(rs.g[i],OldReg.g[i]);
  671. WriteStr(1,i,'g'+IntToStr(i)+' '+HexStr(longint(rs.g[i]),8),color);
  672. SetColor(rs.l[i],OldReg.l[i]);
  673. WriteStr(1,i+8,'l'+IntToStr(i)+' '+HexStr(longint(rs.l[i]),8),color);
  674. end;
  675. for i:=0 to 7 do
  676. begin
  677. SetColor(rs.i[i],OldReg.i[i]);
  678. if i=6 then
  679. WriteStr(15,i,'fp '+HexStr(longint(rs.i[i]),8),color)
  680. else
  681. WriteStr(15,i,'i'+IntToStr(i)+' '+HexStr(longint(rs.i[i]),8),color);
  682. SetColor(rs.o[i],OldReg.o[i]);
  683. WriteStr(15,i+8,'o'+IntToStr(i)+' '+HexStr(longint(rs.o[i]),8),color);
  684. end;
  685. SetColor(rs.pc,OldReg.pc);
  686. WriteStr(1,16,'pc '+HexStr(longint(rs.pc),8),color);
  687. SetColor(rs.y,OldReg.y);
  688. WriteStr(1,17,'y '+HexStr(longint(rs.y),8),color);
  689. SetColor(rs.psr,OldReg.psr);
  690. WriteStr(1,18,'psr '+HexStr(longint(rs.psr),8),color);
  691. SetColor(rs.csr,OldReg.csr);
  692. WriteStr(1,19,'csr '+HexStr(longint(rs.csr),8),color);
  693. SetColor(rs.npc,OldReg.npc);
  694. WriteStr(15,16,'npc '+HexStr(longint(rs.npc),8),color);
  695. SetColor(rs.tbr,OldReg.tbr);
  696. WriteStr(15,17,'tbr '+HexStr(longint(rs.tbr),8),color);
  697. SetColor(rs.wim,OldReg.wim);
  698. WriteStr(15,18,'wim '+HexStr(longint(rs.wim),8),color);
  699. SetColor(rs.fsr,OldReg.fsr);
  700. WriteStr(15,19,'fsr '+HexStr(longint(rs.fsr),8),color);
  701. {$endif sparc}
  702. {$else cpu_known}
  703. for i:=0 to MaxRegs-1 do
  704. begin
  705. SetStrColor(rs.reg[i],OldReg.reg[i]);
  706. WriteStr(1,i,rs.reg[i],color);
  707. end;
  708. {$endif cpu_known}
  709. end
  710. else
  711. WriteStr(0,0,msg_registerwindowerror,7);
  712. InDraw:=false;
  713. {$endif NODEBUG}
  714. end;
  715. destructor TRegistersView.Done;
  716. begin
  717. inherited done;
  718. end;
  719. {****************************************************************************
  720. TRegistersWindow
  721. ****************************************************************************}
  722. constructor TRegistersWindow.Init;
  723. var
  724. R : TRect;
  725. begin
  726. Desktop^.GetExtent(R);
  727. {$ifdef i386}
  728. R.A.X:=R.B.X-28;
  729. R.B.Y:=R.A.Y+11;
  730. {$endif i386}
  731. {$ifdef x86_64}
  732. R.A.X:=R.B.X-32;
  733. R.B.Y:=R.A.Y+19;
  734. {$endif x86_64}
  735. {$ifdef m68k}
  736. R.A.X:=R.B.X-28;
  737. R.B.Y:=R.A.Y+11;
  738. {$endif m68k}
  739. {$ifdef powerpc}
  740. R.A.X:=R.B.X-30;
  741. R.B.Y:=R.A.Y+21;
  742. {$endif powerpc}
  743. {$ifdef sparc}
  744. R.A.X:=R.B.X-30;
  745. R.B.Y:=R.A.Y+22;
  746. {$endif sparc}
  747. {$ifndef cpu_known}
  748. R.A.X:=R.B.X-28;
  749. R.B.Y:=R.A.Y+22;
  750. {$endif cpu_known}
  751. inherited Init(R,dialog_registers, wnNoNumber);
  752. Flags:=wfClose or wfMove;
  753. {$ifndef cpu_known}
  754. Flags:=Flags or wfgrow;
  755. {$endif cpu_known}
  756. Palette:=wpCyanWindow;
  757. HelpCtx:=hcRegistersWindow;
  758. R.Assign(1,1,Size.X-2,Size.Y-1);
  759. RV:=new(PRegistersView,init(R));
  760. Insert(RV);
  761. If assigned(RegistersWindow) then
  762. dispose(RegistersWindow,done);
  763. RegistersWindow:=@Self;
  764. Update;
  765. end;
  766. constructor TRegistersWindow.Load(var S: TStream);
  767. begin
  768. inherited load(S);
  769. GetSubViewPtr(S,RV);
  770. If assigned(RegistersWindow) then
  771. dispose(RegistersWindow,done);
  772. RegistersWindow:=@Self;
  773. end;
  774. procedure TRegistersWindow.Store(var S: TStream);
  775. begin
  776. inherited Store(s);
  777. PutSubViewPtr(S,RV);
  778. end;
  779. procedure TRegistersWindow.Update;
  780. begin
  781. ReDraw;
  782. end;
  783. destructor TRegistersWindow.Done;
  784. begin
  785. RegistersWindow:=nil;
  786. inherited done;
  787. end;
  788. {****************************************************************************
  789. TFPUView
  790. ****************************************************************************}
  791. function GetFPURegs(var rs : TFPURegs
  792. {$ifndef cpu_known}
  793. ; UseInfoFloat : boolean
  794. {$endif not cpu_known}
  795. ) : boolean;
  796. var
  797. p,po : pchar;
  798. p1 : pchar;
  799. {$ifndef NODEBUG}
  800. reg,value : string;
  801. buffer : array[0..255] of char;
  802. v : string;
  803. res : cardinal;
  804. i : longint;
  805. err : word;
  806. {$endif}
  807. begin
  808. GetFPURegs:=false;
  809. {$ifndef NODEBUG}
  810. {$ifndef cpu_known}
  811. if UseInfoFloat then
  812. begin
  813. Debugger^.Command('info float');
  814. if Debugger^.Error then
  815. begin
  816. UseInfofloat:=false;
  817. Debugger^.Command('info all');
  818. end;
  819. end
  820. else
  821. {$endif not cpu_known}
  822. Debugger^.Command('info all');
  823. if Debugger^.Error then
  824. exit
  825. else
  826. begin
  827. po:=StrNew(Debugger^.GetOutput);
  828. p:=po;
  829. {$ifndef cpu_known}
  830. i:=0;
  831. {$endif not cpu_known}
  832. if assigned(p) then
  833. begin
  834. fillchar(rs,sizeof(rs),0);
  835. p1:=strscan(p,' ');
  836. while assigned(p1) do
  837. begin
  838. strlcopy(buffer,p,p1-p);
  839. reg:=strpas(buffer);
  840. {$ifndef cpu_known}
  841. p1:=strscan(p,#10);
  842. if assigned(p1) then
  843. begin
  844. strlcopy(buffer,p,p1-p);
  845. rs.freg[i]:=ExtractTabs(strpas(buffer),8);
  846. if i<MaxRegs-1 then
  847. inc(i);
  848. end;
  849. {$else cpu_known}
  850. p:=p1;
  851. while p^=' ' do
  852. inc(p);
  853. if p^='$' then
  854. p1:=strscan(p,#9)
  855. else
  856. p1:=strscan(p,#10);
  857. strlcopy(buffer,p,p1-p);
  858. v:=strpas(buffer);
  859. for i:=1 to length(v) do
  860. if v[i]=#9 then
  861. v[i]:=' ';
  862. val(v,res,err);
  863. {$if defined(i386) or defined(x86_64)}
  864. if reg='st0' then
  865. rs.st0:=v
  866. else if reg='st1' then
  867. rs.st1:=v
  868. else if reg='st2' then
  869. rs.st2:=v
  870. else if reg='st3' then
  871. rs.st3:=v
  872. else if reg='st4' then
  873. rs.st4:=v
  874. else if reg='st5' then
  875. rs.st5:=v
  876. else if reg='st6' then
  877. rs.st6:=v
  878. else if reg='st7' then
  879. rs.st7:=v
  880. else if reg='ftag' then
  881. rs.ftag:=res
  882. else if reg='fctrl' then
  883. rs.fctrl:=res
  884. else if reg='fstat' then
  885. rs.fstat:=res
  886. else if reg='fiseg' then
  887. rs.fiseg:=res
  888. else if reg='fioff' then
  889. rs.fioff:=res
  890. else if reg='foseg' then
  891. rs.foseg:=res
  892. else if reg='fooff' then
  893. rs.fooff:=res
  894. else if reg='fop' then
  895. rs.fop:=res;
  896. {$endif i386 or x86_64}
  897. {$ifdef m68k}
  898. if reg='fp0' then
  899. rs.fp0:=v
  900. else if reg='fp1' then
  901. rs.fp1:=v
  902. else if reg='fp2' then
  903. rs.fp2:=v
  904. else if reg='fp3' then
  905. rs.fp3:=v
  906. else if reg='fp4' then
  907. rs.fp4:=v
  908. else if reg='fp5' then
  909. rs.fp5:=v
  910. else if reg='fp6' then
  911. rs.fp6:=v
  912. else if reg='fp7' then
  913. rs.fp7:=v
  914. else if reg='fpcontrol' then
  915. rs.fpcontrol:=res
  916. else if reg='fpstatus' then
  917. rs.fpstatus:=res
  918. else if reg='fpiaddr' then
  919. rs.fpiaddr:=res;
  920. {$endif m68k}
  921. {$ifdef powerpc}
  922. if reg[1]='f' then
  923. for i:=0 to 31 do
  924. if reg='f'+inttostr(i) then
  925. rs.f[i]:=v;
  926. {$endif powerpc}
  927. {$ifdef sparc}
  928. if reg[1]='f' then
  929. for i:=0 to 31 do
  930. if reg='f'+inttostr(i) then
  931. rs.f[i]:=v;
  932. {$endif sparc}
  933. {$endif cpu_known}
  934. p:=strscan(p1,#10);
  935. if assigned(p) then
  936. begin
  937. p1:=strscan(p,' ');
  938. inc(p);
  939. end
  940. else
  941. break;
  942. end;
  943. { free allocated memory }
  944. strdispose(po);
  945. end
  946. else
  947. exit;
  948. end;
  949. { do not open a messagebox for such errors }
  950. Debugger^.got_error:=false;
  951. GetFPURegs:=true;
  952. {$endif}
  953. end;
  954. constructor TFPUView.Init(var Bounds: TRect);
  955. begin
  956. inherited init(Bounds);
  957. GrowMode:=gfGrowHiX or GfGrowHiY;
  958. InDraw:=false;
  959. first:=true;
  960. FillChar(OldReg,Sizeof(oldreg),#0);
  961. FillChar(NewReg,Sizeof(newreg),#0);
  962. GDBCount:=-1;
  963. {$ifndef cpu_known}
  964. UseInfoFloat:=true;
  965. {$endif not cpu_known}
  966. end;
  967. procedure TFPUView.Draw;
  968. var
  969. rs : tfpuregs;
  970. top : byte;
  971. color :byte;
  972. ok : boolean;
  973. i : byte;
  974. const
  975. TypeStr : Array[0..3] of string[6] =
  976. ('Valid ','Zero ','Spec ','Empty ');
  977. procedure SetColor(Const x,y : string);
  978. begin
  979. if x=y then
  980. color:=7
  981. else
  982. color:=8;
  983. end;
  984. procedure SetIColor(Const x,y : cardinal);
  985. begin
  986. if x=y then
  987. color:=7
  988. else
  989. color:=8;
  990. end;
  991. begin
  992. inherited draw;
  993. {$ifdef NODEBUG}
  994. WriteStr(1,0,msg_registervaluesnotavailable,7);
  995. {$else NODEBUG}
  996. If (not assigned(Debugger)) or (not Debugger^.IsRunning) then
  997. begin
  998. WriteStr(1,0,msg_registervaluesnotavailable,7);
  999. exit;
  1000. end;
  1001. if InDraw then
  1002. exit;
  1003. InDraw:=true;
  1004. if GDBCount<>Debugger^.RunCount then
  1005. begin
  1006. OldReg:=NewReg;
  1007. OK:=GetFPURegs(rs
  1008. {$ifndef cpu_known}
  1009. ,UseInfoFloat
  1010. {$endif not cpu_known}
  1011. );
  1012. LastOK:=OK;
  1013. NewReg:=rs;
  1014. { get inital values }
  1015. if first then
  1016. begin
  1017. OldReg:=NewReg;
  1018. first:=false;
  1019. end;
  1020. GDBCount:=Debugger^.RunCount;
  1021. end
  1022. else
  1023. begin
  1024. rs:=newreg;
  1025. OK:=LastOK;
  1026. end;
  1027. if OK then
  1028. begin
  1029. {$ifdef cpu_known}
  1030. {$if defined(i386) or defined(x86_64)}
  1031. top:=(rs.fstat shr 11) and 7;
  1032. SetColor(rs.st0,OldReg.st0);
  1033. WriteStr(1,0,'ST0 '+TypeStr[(rs.ftag shr (2*((0+top) and 7))) and 3]+rs.st0,color);
  1034. SetColor(rs.st1,OldReg.st1);
  1035. WriteStr(1,1,'ST1 '+TypeStr[(rs.ftag shr (2*((1+top) and 7))) and 3]+rs.st1,color);
  1036. SetColor(rs.st2,OldReg.st2);
  1037. WriteStr(1,2,'ST2 '+TypeStr[(rs.ftag shr (2*((2+top) and 7))) and 3]+rs.st2,color);
  1038. SetColor(rs.st3,OldReg.st3);
  1039. WriteStr(1,3,'ST3 '+TypeStr[(rs.ftag shr (2*((3+top) and 7))) and 3]+rs.st3,color);
  1040. SetColor(rs.st4,OldReg.st4);
  1041. WriteStr(1,4,'ST4 '+TypeStr[(rs.ftag shr (2*((4+top) and 7))) and 3]+rs.st4,color);
  1042. SetColor(rs.st5,OldReg.st5);
  1043. WriteStr(1,5,'ST5 '+TypeStr[(rs.ftag shr (2*((5+top) and 7))) and 3]+rs.st5,color);
  1044. SetColor(rs.st6,OldReg.st6);
  1045. WriteStr(1,6,'ST6 '+TypeStr[(rs.ftag shr (2*((6+top) and 7))) and 3]+rs.st6,color);
  1046. SetColor(rs.st7,OldReg.st7);
  1047. WriteStr(1,7,'ST7 '+TypeStr[(rs.ftag shr (2*((7+top) and 7))) and 3]+rs.st7,color);
  1048. SetIColor(rs.ftag,OldReg.ftag);
  1049. WriteStr(1,8,'FTAG '+hexstr(rs.ftag,4),color);
  1050. SetIColor(rs.fctrl,OldReg.fctrl);
  1051. WriteStr(13,8,'FCTRL '+hexstr(rs.fctrl,4),color);
  1052. SetIColor(rs.fstat,OldReg.fstat);
  1053. WriteStr(1,9,'FSTAT '+hexstr(rs.fstat,4),color);
  1054. SetIColor(rs.fop,OldReg.fop);
  1055. WriteStr(13,9,'FOP '+hexstr(rs.fop,4),color);
  1056. if (rs.fiseg<>OldReg.fiseg) or
  1057. (rs.fioff<>OldReg.fioff) then
  1058. color:=8
  1059. else
  1060. color:=7;
  1061. WriteStr(1,10,'FI '+hexstr(rs.fiseg,4)+':'+hexstr(rs.fioff,8),color);
  1062. if (rs.foseg<>OldReg.foseg) or
  1063. (rs.fooff<>OldReg.fooff) then
  1064. color:=8
  1065. else
  1066. color:=7;
  1067. WriteStr(1,11,'FO '+hexstr(rs.foseg,4)+':'+hexstr(rs.fooff,8),color);
  1068. {$endif i386 or x86_64}
  1069. {$ifdef m68k}
  1070. SetColor(rs.fp0,OldReg.fp0);
  1071. WriteStr(1,0,'fp0 '+rs.fp0,color);
  1072. SetColor(rs.fp1,OldReg.fp1);
  1073. WriteStr(1,1,'fp1 '+rs.fp1,color);
  1074. SetColor(rs.fp2,OldReg.fp2);
  1075. WriteStr(1,2,'fp2 '+rs.fp2,color);
  1076. SetColor(rs.fp3,OldReg.fp3);
  1077. WriteStr(1,3,'fp3 '+rs.fp3,color);
  1078. SetColor(rs.fp4,OldReg.fp4);
  1079. WriteStr(1,4,'fp4 '+rs.fp4,color);
  1080. SetColor(rs.fp5,OldReg.fp5);
  1081. WriteStr(1,5,'fp5 '+rs.fp5,color);
  1082. SetColor(rs.fp6,OldReg.fp6);
  1083. WriteStr(1,6,'fp6 '+rs.fp6,color);
  1084. SetColor(rs.fp7,OldReg.fp7);
  1085. WriteStr(1,7,'fp7 '+rs.fp7,color);
  1086. SetIColor(rs.fpcontrol,OldReg.fpcontrol);
  1087. WriteStr(1,8,'fpcontrol '+hexstr(rs.fpcontrol,8),color);
  1088. SetIColor(rs.fpstatus,OldReg.fpstatus);
  1089. WriteStr(1,9,'fpstatus '+hexstr(rs.fpstatus,8),color);
  1090. SetIColor(rs.fpiaddr,OldReg.fpiaddr);
  1091. WriteStr(1,10,'fpiaddr '+hexstr(rs.fpiaddr,8),color);
  1092. {$endif m68k}
  1093. {$ifdef powerpc}
  1094. for i:=0 to 31 do
  1095. begin
  1096. SetColor(rs.f[i],OldReg.f[i]);
  1097. if i<10 then
  1098. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color)
  1099. else
  1100. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color);
  1101. end;
  1102. {$endif powerpc}
  1103. {$ifdef sparc}
  1104. for i:=0 to 31 do
  1105. begin
  1106. SetColor(rs.f[i],OldReg.f[i]);
  1107. if i<10 then
  1108. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color)
  1109. else
  1110. WriteStr(1,i,'f'+IntToStr(i)+' '+rs.f[i],color);
  1111. end;
  1112. {$endif sparc}
  1113. {$else not cpu_known}
  1114. for i:=0 to MaxRegs-1 do
  1115. begin
  1116. SetColor(rs.freg[i],OldReg.freg[i]);
  1117. WriteStr(1,i,rs.freg[i],color);
  1118. end;
  1119. {$endif cpu_known}
  1120. end
  1121. else
  1122. WriteStr(0,0,msg_registerwindowerror,7);
  1123. InDraw:=false;
  1124. {$endif NODEBUG}
  1125. end;
  1126. destructor TFPUView.Done;
  1127. begin
  1128. inherited done;
  1129. end;
  1130. {****************************************************************************
  1131. TFPUWindow
  1132. ****************************************************************************}
  1133. constructor TFPUWindow.Init;
  1134. var
  1135. R : TRect;
  1136. begin
  1137. Desktop^.GetExtent(R);
  1138. {$if defined(i386) or defined(x86_64)}
  1139. R.A.X:=R.B.X-44;
  1140. R.B.Y:=R.A.Y+14;
  1141. {$endif i386 or x86_64}
  1142. {$ifdef m68k}
  1143. R.A.X:=R.B.X-44;
  1144. R.B.Y:=R.A.Y+14;
  1145. {$endif m68k}
  1146. {$ifdef powerpc}
  1147. R.A.X:=R.B.X-44;
  1148. R.B.Y:=R.A.Y+33;
  1149. {$endif powerpc}
  1150. {$ifdef sparc}
  1151. R.A.X:=R.B.X-44;
  1152. R.B.Y:=R.A.Y+33;
  1153. {$endif sparc}
  1154. {$ifndef cpu_known}
  1155. R.A.X:=R.B.X-44;
  1156. R.B.Y:=R.A.Y+33;
  1157. {$endif cpu_known}
  1158. inherited Init(R,dialog_fpu, wnNoNumber);
  1159. Flags:=wfClose or wfMove or wfgrow;
  1160. Palette:=wpCyanWindow;
  1161. HelpCtx:=hcFPURegisters;
  1162. R.Assign(1,1,Size.X-2,Size.Y-1);
  1163. RV:=new(PFPUView,init(R));
  1164. Insert(RV);
  1165. If assigned(FPUWindow) then
  1166. dispose(FPUWindow,done);
  1167. FPUWindow:=@Self;
  1168. Update;
  1169. end;
  1170. constructor TFPUWindow.Load(var S: TStream);
  1171. begin
  1172. inherited load(S);
  1173. GetSubViewPtr(S,RV);
  1174. If assigned(FPUWindow) then
  1175. dispose(FPUWindow,done);
  1176. FPUWindow:=@Self;
  1177. end;
  1178. procedure TFPUWindow.Store(var S: TStream);
  1179. begin
  1180. inherited Store(s);
  1181. PutSubViewPtr(S,RV);
  1182. end;
  1183. procedure TFPUWindow.Update;
  1184. begin
  1185. ReDraw;
  1186. end;
  1187. destructor TFPUWindow.Done;
  1188. begin
  1189. FPUWindow:=nil;
  1190. inherited done;
  1191. end;
  1192. {****************************************************************************
  1193. TVectorView
  1194. ****************************************************************************}
  1195. function GetVectorRegs(var rs : TVectorRegs
  1196. {$ifndef cpu_known}
  1197. ; UseInfoVector : boolean
  1198. {$endif not cpu_known}
  1199. ) : boolean;
  1200. var
  1201. p,po : pchar;
  1202. p1 : pchar;
  1203. {$ifndef NODEBUG}
  1204. reg,value : string;
  1205. buffer : array[0..255] of char;
  1206. v : string;
  1207. res : cardinal;
  1208. i : longint;
  1209. err : word;
  1210. {$endif}
  1211. begin
  1212. GetVectorRegs:=false;
  1213. {$ifndef NODEBUG}
  1214. {$ifndef cpu_known}
  1215. if UseInfoVector then
  1216. begin
  1217. Debugger^.Command('info vector');
  1218. if Debugger^.Error then
  1219. begin
  1220. UseInfoVector:=false;
  1221. Debugger^.Command('info all');
  1222. end;
  1223. end
  1224. else
  1225. {$endif not cpu_known}
  1226. Debugger^.Command('info vector');
  1227. if Debugger^.Error then
  1228. exit
  1229. else
  1230. begin
  1231. po:=StrNew(Debugger^.GetOutput);
  1232. p:=po;
  1233. {$ifndef cpu_known}
  1234. i:=0;
  1235. {$endif not cpu_known}
  1236. if assigned(p) then
  1237. begin
  1238. fillchar(rs,sizeof(rs),0);
  1239. p1:=strscan(p,' ');
  1240. while assigned(p1) do
  1241. begin
  1242. strlcopy(buffer,p,p1-p);
  1243. reg:=strpas(buffer);
  1244. {$ifndef cpu_known}
  1245. p1:=strscan(p,#10);
  1246. if assigned(p1) then
  1247. begin
  1248. strlcopy(buffer,p,p1-p);
  1249. rs.vreg[i]:=ExtractTabs(strpas(buffer),8);
  1250. if i<MaxRegs-1 then
  1251. inc(i);
  1252. end;
  1253. {$else cpu_known}
  1254. p:=p1;
  1255. while p^=' ' do
  1256. inc(p);
  1257. if p^='$' then
  1258. p1:=strscan(p,#9)
  1259. else
  1260. p1:=strscan(p,#10);
  1261. strlcopy(buffer,p,p1-p);
  1262. v:=strpas(buffer);
  1263. for i:=1 to length(v) do
  1264. if v[i]=#9 then
  1265. v[i]:=' ';
  1266. val(v,res,err);
  1267. {$if defined(i386) or defined(x86_64)}
  1268. if reg[1]='x' then
  1269. for i:=0 to 7 do
  1270. begin
  1271. if reg='xmm'+inttostr(i) then
  1272. rs.xmm[i]:=v
  1273. end
  1274. else if reg='mxcsr' then
  1275. rs.mxcsr:=v
  1276. else if reg[1]='m' then
  1277. for i:=0 to 7 do
  1278. begin
  1279. if reg='mm'+inttostr(i) then
  1280. rs.mmx[i]:=v;
  1281. end;
  1282. {$endif i386 or x86_64}
  1283. {$ifdef powerpc}
  1284. { !!!! fixme }
  1285. if reg[1]='v' then
  1286. for i:=0 to 31 do
  1287. if reg='v'+inttostr(i) then
  1288. rs.m[i]:=v;
  1289. {$endif powerpc}
  1290. {$ifdef sparc}
  1291. {$endif sparc}
  1292. {$endif cpu_known}
  1293. p:=strscan(p1,#10);
  1294. if assigned(p) then
  1295. begin
  1296. p1:=strscan(p,' ');
  1297. inc(p);
  1298. end
  1299. else
  1300. break;
  1301. end;
  1302. { free allocated memory }
  1303. strdispose(po);
  1304. end
  1305. else
  1306. exit;
  1307. end;
  1308. { do not open a messagebox for such errors }
  1309. Debugger^.got_error:=false;
  1310. GetVectorRegs:=true;
  1311. {$endif}
  1312. end;
  1313. constructor TVectorView.Init(var Bounds: TRect);
  1314. begin
  1315. inherited init(Bounds);
  1316. GrowMode:=gfGrowHiX or GfGrowHiY;
  1317. InDraw:=false;
  1318. first:=true;
  1319. FillChar(OldReg,Sizeof(oldreg),#0);
  1320. FillChar(NewReg,Sizeof(newreg),#0);
  1321. GDBCount:=-1;
  1322. {$ifndef cpu_known}
  1323. UseInfoVector:=true;
  1324. {$endif not cpu_known}
  1325. end;
  1326. procedure TVectorView.Draw;
  1327. var
  1328. rs : tVectorregs;
  1329. top : byte;
  1330. color :byte;
  1331. ok : boolean;
  1332. i : byte;
  1333. const
  1334. TypeStr : Array[0..3] of string[6] =
  1335. ('Valid ','Zero ','Spec ','Empty ');
  1336. procedure SetColor(Const x,y : string);
  1337. begin
  1338. if x=y then
  1339. color:=7
  1340. else
  1341. color:=8;
  1342. end;
  1343. procedure SetIColor(Const x,y : cardinal);
  1344. begin
  1345. if x=y then
  1346. color:=7
  1347. else
  1348. color:=8;
  1349. end;
  1350. begin
  1351. inherited draw;
  1352. {$ifdef NODEBUG}
  1353. WriteStr(1,0,msg_registervaluesnotavailable,7);
  1354. {$else NODEBUG}
  1355. If (not assigned(Debugger)) or (not Debugger^.IsRunning) then
  1356. begin
  1357. WriteStr(1,0,msg_registervaluesnotavailable,7);
  1358. exit;
  1359. end;
  1360. if InDraw then
  1361. exit;
  1362. InDraw:=true;
  1363. if GDBCount<>Debugger^.RunCount then
  1364. begin
  1365. OldReg:=NewReg;
  1366. OK:=GetVectorRegs(rs
  1367. {$ifndef cpu_known}
  1368. ,UseInfoVector
  1369. {$endif not cpu_known}
  1370. );
  1371. LastOK:=OK;
  1372. NewReg:=rs;
  1373. { get inital values }
  1374. if first then
  1375. begin
  1376. OldReg:=NewReg;
  1377. first:=false;
  1378. end;
  1379. GDBCount:=Debugger^.RunCount;
  1380. end
  1381. else
  1382. begin
  1383. rs:=newreg;
  1384. OK:=LastOK;
  1385. end;
  1386. if OK then
  1387. begin
  1388. {$ifdef cpu_known}
  1389. {$if defined(i386) or defined(x86_64)}
  1390. for i:=0 to 7 do
  1391. begin
  1392. SetColor(rs.xmm[i],OldReg.xmm[i]);
  1393. WriteStr(1,i,'xmm'+IntToStr(i)+' '+rs.xmm[i],color);
  1394. end;
  1395. SetColor(rs.mxcsr,OldReg.mxcsr);
  1396. WriteStr(1,8,'mxcsr'+IntToStr(i)+' '+rs.mxcsr,color);
  1397. for i:=0 to 7 do
  1398. begin
  1399. SetColor(rs.mmx[i],OldReg.mmx[i]);
  1400. WriteStr(1,i+9,'mmx'+IntToStr(i)+' '+rs.mmx[i],color);
  1401. end;
  1402. {$endif i386 or x86_64}
  1403. {$ifdef powerpc}
  1404. for i:=0 to 31 do
  1405. begin
  1406. SetColor(rs.m[i],OldReg.m[i]);
  1407. if i<10 then
  1408. WriteStr(1,i,'m'+IntToStr(i)+' '+rs.m[i],color)
  1409. else
  1410. WriteStr(1,i,'m'+IntToStr(i)+' '+rs.m[i],color);
  1411. end;
  1412. {$endif powerpc}
  1413. {$ifdef sparc}
  1414. { no mm regs on the sparc }
  1415. {$endif sparc}
  1416. {$else not cpu_known}
  1417. for i:=0 to MaxRegs-1 do
  1418. begin
  1419. SetColor(rs.vreg[i],OldReg.vreg[i]);
  1420. WriteStr(1,i,rs.vreg[i],color);
  1421. end;
  1422. {$endif cpu_known}
  1423. end
  1424. else
  1425. WriteStr(0,0,msg_registerwindowerror,7);
  1426. InDraw:=false;
  1427. {$endif NODEBUG}
  1428. end;
  1429. destructor TVectorView.Done;
  1430. begin
  1431. inherited done;
  1432. end;
  1433. {****************************************************************************
  1434. TVectorWindow
  1435. ****************************************************************************}
  1436. constructor TVectorWindow.Init;
  1437. var
  1438. R : TRect;
  1439. begin
  1440. Desktop^.GetExtent(R);
  1441. {$if defined(i386) or defined(x86_64)}
  1442. R.A.X:=R.B.X-60;
  1443. R.B.Y:=R.A.Y+20;
  1444. {$endif i386 or x86_64}
  1445. {$ifdef m68k}
  1446. R.A.X:=R.B.X-60;
  1447. R.B.Y:=R.A.Y+14;
  1448. {$endif m68k}
  1449. {$ifdef powerpc}
  1450. R.A.X:=R.B.X-60;
  1451. R.B.Y:=R.A.Y+33;
  1452. {$endif powerpc}
  1453. {$ifdef sparc}
  1454. R.A.X:=R.B.X-60;
  1455. R.B.Y:=R.A.Y+33;
  1456. {$endif sparc}
  1457. {$ifndef cpu_known}
  1458. R.A.X:=R.B.X-60;
  1459. R.B.Y:=R.A.Y+33;
  1460. {$endif cpu_known}
  1461. inherited Init(R,dialog_Vector, wnNoNumber);
  1462. Flags:=wfClose or wfMove or wfgrow;
  1463. Palette:=wpCyanWindow;
  1464. HelpCtx:=hcVectorRegisters;
  1465. R.Assign(1,1,Size.X-2,Size.Y-1);
  1466. RV:=new(PVectorView,init(R));
  1467. Insert(RV);
  1468. If assigned(VectorWindow) then
  1469. dispose(VectorWindow,done);
  1470. VectorWindow:=@Self;
  1471. Update;
  1472. end;
  1473. constructor TVectorWindow.Load(var S: TStream);
  1474. begin
  1475. inherited load(S);
  1476. GetSubViewPtr(S,RV);
  1477. If assigned(VectorWindow) then
  1478. dispose(VectorWindow,done);
  1479. VectorWindow:=@Self;
  1480. end;
  1481. procedure TVectorWindow.Store(var S: TStream);
  1482. begin
  1483. inherited Store(s);
  1484. PutSubViewPtr(S,RV);
  1485. end;
  1486. procedure TVectorWindow.Update;
  1487. begin
  1488. ReDraw;
  1489. end;
  1490. destructor TVectorWindow.Done;
  1491. begin
  1492. VectorWindow:=nil;
  1493. inherited done;
  1494. end;
  1495. procedure InitRegistersWindow;
  1496. begin
  1497. if RegistersWindow=nil then
  1498. begin
  1499. new(RegistersWindow,init);
  1500. DeskTop^.Insert(RegistersWindow);
  1501. end;
  1502. end;
  1503. procedure DoneRegistersWindow;
  1504. begin
  1505. if assigned(RegistersWindow) then
  1506. begin
  1507. DeskTop^.Delete(RegistersWindow);
  1508. RegistersWindow:=nil;
  1509. end;
  1510. end;
  1511. procedure InitFPUWindow;
  1512. begin
  1513. if FPUWindow=nil then
  1514. begin
  1515. new(FPUWindow,init);
  1516. DeskTop^.Insert(FPUWindow);
  1517. end;
  1518. end;
  1519. procedure DoneFPUWindow;
  1520. begin
  1521. if assigned(FPUWindow) then
  1522. begin
  1523. DeskTop^.Delete(FPUWindow);
  1524. FPUWindow:=nil;
  1525. end;
  1526. end;
  1527. procedure InitVectorWindow;
  1528. begin
  1529. if VectorWindow=nil then
  1530. begin
  1531. new(VectorWindow,init);
  1532. DeskTop^.Insert(VectorWindow);
  1533. end;
  1534. end;
  1535. procedure DoneVectorWindow;
  1536. begin
  1537. if assigned(VectorWindow) then
  1538. begin
  1539. DeskTop^.Delete(VectorWindow);
  1540. VectorWindow:=nil;
  1541. end;
  1542. end;
  1543. procedure RegisterFPRegsViews;
  1544. begin
  1545. RegisterType(RRegistersWindow);
  1546. RegisterType(RRegistersView);
  1547. RegisterType(RFPUWindow);
  1548. RegisterType(RFPUView);
  1549. RegisterType(RVectorView);
  1550. end;
  1551. end.
  1552. {$endif NODEBUG}