fpregs.pas 48 KB

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