fpregs.pas 48 KB

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