fpregs.pas 48 KB

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