fpregs.pas 48 KB

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